{-# 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 { Const a b -> a
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 :: Int -> ReadS (Const a b)
readsPrec d :: Int
d = Bool -> ReadS (Const a b) -> ReadS (Const a b)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10)
(ReadS (Const a b) -> ReadS (Const a b))
-> ReadS (Const a b) -> ReadS (Const a b)
forall a b. (a -> b) -> a -> b
$ \r :: String
r -> [(a -> Const a b
forall k a (b :: k). a -> Const a b
Const a
x,String
t) | ("Const", s :: String
s) <- ReadS String
lex String
r, (x :: a
x, t :: String
t) <- Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec 11 String
s]
instance Show a => Show (Const a b) where
showsPrec :: Int -> Const a b -> ShowS
showsPrec d :: Int
d (Const x :: a
x) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString "Const " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 a
x
instance Foldable (Const m) where
foldMap :: (a -> m) -> Const m a -> m
foldMap _ _ = m
forall a. Monoid a => a
mempty
instance Functor (Const m) where
fmap :: (a -> b) -> Const m a -> Const m b
fmap _ (Const v :: m
v) = m -> Const m b
forall k a (b :: k). a -> Const a b
Const m
v
instance Monoid m => Applicative (Const m) where
pure :: a -> Const m a
pure _ = m -> Const m a
forall k a (b :: k). a -> Const a b
Const m
forall a. Monoid a => a
mempty
liftA2 :: (a -> b -> c) -> Const m a -> Const m b -> Const m c
liftA2 _ (Const x :: m
x) (Const y :: m
y) = m -> Const m c
forall k a (b :: k). a -> Const a b
Const (m
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` m
y)
<*> :: Const m (a -> b) -> Const m a -> Const m b
(<*>) = (m -> m -> m) -> Const m (a -> b) -> Const m a -> Const m b
forall a b. Coercible a b => a -> b
coerce (m -> m -> m
forall a. Monoid a => a -> a -> a
mappend :: m -> m -> m)