(original) (raw)

{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-}

module Data.Functor.Const (Const(..)) where

import Data.Bits (Bits, FiniteBits) import Data.Foldable (Foldable(foldMap)) import Foreign.Storable (Storable)

import GHC.Arr (Ix) import GHC.Base import GHC.Enum (Bounded, Enum) import GHC.Float (Floating, RealFloat) import GHC.Generics (Generic, Generic1) import GHC.Num (Num) import GHC.Real (Fractional, Integral, Real, RealFrac) import GHC.Read (Read(readsPrec), readParen, lex) import GHC.Show (Show(showsPrec), showParen, showString)

newtype Const a b = Const { getConst :: a } deriving ( Bits
, Bounded
, Enum
, Eq
, FiniteBits , Floating
, Fractional , Generic
, Generic1
, Integral
, Ix
, Semigroup
, Monoid
, Num
, Ord
, Real
, RealFrac
, RealFloat
, Storable
)

instance Read a => Read (Const a b) where readsPrec d = readParen (d > 10) $ [r](#local-6989586621679239761) -> [(Const x,t) | ("Const", s) <- lex r, (x, t) <- readsPrec 11 s]

instance Show a => Show (Const a b) where showsPrec d (Const x) = showParen (d > 10) $ showString "Const " . showsPrec 11 x

instance Foldable (Const m) where foldMap _ _ = mempty

instance Functor (Const m) where fmap _ (Const v) = Const v

instance Monoid m => Applicative (Const m) where pure _ = Const mempty liftA2 _ (Const x) (Const y) = Const (x [mappend](GHC.Base.html#mappend) y) (<*>) = coerce (mappend :: m -> m -> m)