{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
#endif
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE AutoDeriveTypeable #-}
#endif
module Data.Functor.Constant (
Constant(..),
) where
import Data.Functor.Classes
#if MIN_VERSION_base(4,12,0)
import Data.Functor.Contravariant
#endif
import Control.Applicative
import Data.Foldable
import Data.Monoid (Monoid(..))
import Data.Traversable (Traversable(traverse))
#if MIN_VERSION_base(4,8,0)
import Data.Bifunctor (Bifunctor(..))
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..))
#endif
#if MIN_VERSION_base(4,10,0)
import Data.Bifoldable (Bifoldable(..))
import Data.Bitraversable (Bitraversable(..))
#endif
import Prelude hiding (null, length)
newtype Constant a b = Constant { forall {k} a (b :: k). Constant a b -> a
getConstant :: a }
deriving (Constant a b -> Constant a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a k (b :: k). Eq a => Constant a b -> Constant a b -> Bool
/= :: Constant a b -> Constant a b -> Bool
$c/= :: forall a k (b :: k). Eq a => Constant a b -> Constant a b -> Bool
== :: Constant a b -> Constant a b -> Bool
$c== :: forall a k (b :: k). Eq a => Constant a b -> Constant a b -> Bool
Eq, Constant a b -> Constant a b -> Bool
Constant a b -> Constant a b -> Ordering
Constant a b -> Constant a b -> Constant a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {k} {b :: k}. Ord a => Eq (Constant a b)
forall a k (b :: k). Ord a => Constant a b -> Constant a b -> Bool
forall a k (b :: k).
Ord a =>
Constant a b -> Constant a b -> Ordering
forall a k (b :: k).
Ord a =>
Constant a b -> Constant a b -> Constant a b
min :: Constant a b -> Constant a b -> Constant a b
$cmin :: forall a k (b :: k).
Ord a =>
Constant a b -> Constant a b -> Constant a b
max :: Constant a b -> Constant a b -> Constant a b
$cmax :: forall a k (b :: k).
Ord a =>
Constant a b -> Constant a b -> Constant a b
>= :: Constant a b -> Constant a b -> Bool
$c>= :: forall a k (b :: k). Ord a => Constant a b -> Constant a b -> Bool
> :: Constant a b -> Constant a b -> Bool
$c> :: forall a k (b :: k). Ord a => Constant a b -> Constant a b -> Bool
<= :: Constant a b -> Constant a b -> Bool
$c<= :: forall a k (b :: k). Ord a => Constant a b -> Constant a b -> Bool
< :: Constant a b -> Constant a b -> Bool
$c< :: forall a k (b :: k). Ord a => Constant a b -> Constant a b -> Bool
compare :: Constant a b -> Constant a b -> Ordering
$ccompare :: forall a k (b :: k).
Ord a =>
Constant a b -> Constant a b -> Ordering
Ord)
instance (Read a) => Read (Constant a b) where
readsPrec :: Int -> ReadS (Constant a b)
readsPrec = forall a. (String -> ReadS a) -> Int -> ReadS a
readsData forall a b. (a -> b) -> a -> b
$
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith forall a. Read a => Int -> ReadS a
readsPrec String
"Constant" forall {k} a (b :: k). a -> Constant a b
Constant
instance (Show a) => Show (Constant a b) where
showsPrec :: Int -> Constant a b -> ShowS
showsPrec Int
d (Constant a
x) = forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith forall a. Show a => Int -> a -> ShowS
showsPrec String
"Constant" Int
d a
x
instance Eq2 Constant where
liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> Constant a c -> Constant b d -> Bool
liftEq2 a -> b -> Bool
eq c -> d -> Bool
_ (Constant a
x) (Constant b
y) = a -> b -> Bool
eq a
x b
y
{-# INLINE liftEq2 #-}
instance Ord2 Constant where
liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> Constant a c -> Constant b d -> Ordering
liftCompare2 a -> b -> Ordering
comp c -> d -> Ordering
_ (Constant a
x) (Constant b
y) = a -> b -> Ordering
comp a
x b
y
{-# INLINE liftCompare2 #-}
instance Read2 Constant where
liftReadsPrec2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (Constant a b)
liftReadsPrec2 Int -> ReadS a
rp ReadS [a]
_ Int -> ReadS b
_ ReadS [b]
_ = forall a. (String -> ReadS a) -> Int -> ReadS a
readsData forall a b. (a -> b) -> a -> b
$
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith Int -> ReadS a
rp String
"Constant" forall {k} a (b :: k). a -> Constant a b
Constant
instance Show2 Constant where
liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Constant a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp [a] -> ShowS
_ Int -> b -> ShowS
_ [b] -> ShowS
_ Int
d (Constant a
x) = forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp String
"Constant" Int
d a
x
instance (Eq a) => Eq1 (Constant a) where
liftEq :: forall a b.
(a -> b -> Bool) -> Constant a a -> Constant a b -> Bool
liftEq = forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 forall a. Eq a => a -> a -> Bool
(==)
{-# INLINE liftEq #-}
instance (Ord a) => Ord1 (Constant a) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> Constant a a -> Constant a b -> Ordering
liftCompare = forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE liftCompare #-}
instance (Read a) => Read1 (Constant a) where
liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Constant a a)
liftReadsPrec = forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 forall a. Read a => Int -> ReadS a
readsPrec forall a. Read a => ReadS [a]
readList
{-# INLINE liftReadsPrec #-}
instance (Show a) => Show1 (Constant a) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Constant a a -> ShowS
liftShowsPrec = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList
{-# INLINE liftShowsPrec #-}
instance Functor (Constant a) where
fmap :: forall a b. (a -> b) -> Constant a a -> Constant a b
fmap a -> b
_ (Constant a
x) = forall {k} a (b :: k). a -> Constant a b
Constant a
x
{-# INLINE fmap #-}
instance Foldable (Constant a) where
foldMap :: forall m a. Monoid m => (a -> m) -> Constant a a -> m
foldMap a -> m
_ (Constant a
_) = forall a. Monoid a => a
mempty
{-# INLINE foldMap #-}
#if MIN_VERSION_base(4,8,0)
null :: forall a. Constant a a -> Bool
null (Constant a
_) = Bool
True
length :: forall a. Constant a a -> Int
length (Constant a
_) = Int
0
#endif
instance Traversable (Constant a) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Constant a a -> f (Constant a b)
traverse a -> f b
_ (Constant a
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall {k} a (b :: k). a -> Constant a b
Constant a
x)
{-# INLINE traverse #-}
#if MIN_VERSION_base(4,9,0)
instance (Semigroup a) => Semigroup (Constant a b) where
Constant a
x <> :: Constant a b -> Constant a b -> Constant a b
<> Constant a
y = forall {k} a (b :: k). a -> Constant a b
Constant (a
x forall a. Semigroup a => a -> a -> a
<> a
y)
{-# INLINE (<>) #-}
#endif
instance (Monoid a) => Applicative (Constant a) where
pure :: forall a. a -> Constant a a
pure a
_ = forall {k} a (b :: k). a -> Constant a b
Constant forall a. Monoid a => a
mempty
{-# INLINE pure #-}
Constant a
x <*> :: forall a b. Constant a (a -> b) -> Constant a a -> Constant a b
<*> Constant a
y = forall {k} a (b :: k). a -> Constant a b
Constant (a
x forall a. Monoid a => a -> a -> a
`mappend` a
y)
{-# INLINE (<*>) #-}
instance (Monoid a) => Monoid (Constant a b) where
mempty :: Constant a b
mempty = forall {k} a (b :: k). a -> Constant a b
Constant forall a. Monoid a => a
mempty
{-# INLINE mempty #-}
#if !MIN_VERSION_base(4,11,0)
Constant x `mappend` Constant y = Constant (x `mappend` y)
{-# INLINE mappend #-}
#endif
#if MIN_VERSION_base(4,8,0)
instance Bifunctor Constant where
first :: forall a b c. (a -> b) -> Constant a c -> Constant b c
first a -> b
f (Constant a
x) = forall {k} a (b :: k). a -> Constant a b
Constant (a -> b
f a
x)
{-# INLINE first #-}
second :: forall b c a. (b -> c) -> Constant a b -> Constant a c
second b -> c
_ (Constant a
x) = forall {k} a (b :: k). a -> Constant a b
Constant a
x
{-# INLINE second #-}
#endif
#if MIN_VERSION_base(4,10,0)
instance Bifoldable Constant where
bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Constant a b -> m
bifoldMap a -> m
f b -> m
_ (Constant a
a) = a -> m
f a
a
{-# INLINE bifoldMap #-}
instance Bitraversable Constant where
bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Constant a b -> f (Constant c d)
bitraverse a -> f c
f b -> f d
_ (Constant a
a) = forall {k} a (b :: k). a -> Constant a b
Constant forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a
{-# INLINE bitraverse #-}
#endif
#if MIN_VERSION_base(4,12,0)
instance Contravariant (Constant a) where
contramap :: forall a' a. (a' -> a) -> Constant a a -> Constant a a'
contramap a' -> a
_ (Constant a
a) = forall {k} a (b :: k). a -> Constant a b
Constant a
a
{-# INLINE contramap #-}
#endif