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