{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE DeriveDataTypeable #-}
#endif
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveGeneric #-}
#endif
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802
{-# LANGUAGE AutoDeriveTypeable #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Functor.Constant
-- Copyright   :  (c) Ross Paterson 2010
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  R.Paterson@city.ac.uk
-- Stability   :  experimental
-- Portability :  portable
--
-- The constant functor.
-----------------------------------------------------------------------------

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
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
import Data.Traversable (Traversable(traverse))
#endif
#if MIN_VERSION_base(4,8,0)
import Data.Bifunctor (Bifunctor(..))
#endif
#if (MIN_VERSION_base(4,9,0)) && !(MIN_VERSION_base(4,11,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)
#if __GLASGOW_HASKELL__ >= 800
import Data.Data
#endif
#if __GLASGOW_HASKELL__ >= 704
import GHC.Generics
#endif

-- | Constant functor.
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
#if __GLASGOW_HASKELL__ >= 800
        , Constant a b -> DataType
Constant a b -> Constr
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall {a} {k} {b :: k}.
(Typeable b, Typeable k, Data a) =>
Typeable (Constant a b)
forall a k (b :: k).
(Typeable b, Typeable k, Data a) =>
Constant a b -> DataType
forall a k (b :: k).
(Typeable b, Typeable k, Data a) =>
Constant a b -> Constr
forall a k (b :: k).
(Typeable b, Typeable k, Data a) =>
(forall b. Data b => b -> b) -> Constant a b -> Constant a b
forall a k (b :: k) u.
(Typeable b, Typeable k, Data a) =>
Int -> (forall d. Data d => d -> u) -> Constant a b -> u
forall a k (b :: k) u.
(Typeable b, Typeable k, Data a) =>
(forall d. Data d => d -> u) -> Constant a b -> [u]
forall a k (b :: k) r r'.
(Typeable b, Typeable k, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Constant a b -> r
forall a k (b :: k) r r'.
(Typeable b, Typeable k, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Constant a b -> r
forall a k (b :: k) (m :: * -> *).
(Typeable b, Typeable k, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Constant a b -> m (Constant a b)
forall a k (b :: k) (m :: * -> *).
(Typeable b, Typeable k, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Constant a b -> m (Constant a b)
forall a k (b :: k) (c :: * -> *).
(Typeable b, Typeable k, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Constant a b)
forall a k (b :: k) (c :: * -> *).
(Typeable b, Typeable k, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constant a b -> c (Constant a b)
forall a k (b :: k) (t :: * -> *) (c :: * -> *).
(Typeable b, Typeable k, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Constant a b))
forall a k (b :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable b, Typeable k, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Constant a b))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Constant a b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constant a b -> c (Constant a b)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constant a b -> m (Constant a b)
$cgmapMo :: forall a k (b :: k) (m :: * -> *).
(Typeable b, Typeable k, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Constant a b -> m (Constant a b)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constant a b -> m (Constant a b)
$cgmapMp :: forall a k (b :: k) (m :: * -> *).
(Typeable b, Typeable k, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Constant a b -> m (Constant a b)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Constant a b -> m (Constant a b)
$cgmapM :: forall a k (b :: k) (m :: * -> *).
(Typeable b, Typeable k, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Constant a b -> m (Constant a b)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Constant a b -> u
$cgmapQi :: forall a k (b :: k) u.
(Typeable b, Typeable k, Data a) =>
Int -> (forall d. Data d => d -> u) -> Constant a b -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Constant a b -> [u]
$cgmapQ :: forall a k (b :: k) u.
(Typeable b, Typeable k, Data a) =>
(forall d. Data d => d -> u) -> Constant a b -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Constant a b -> r
$cgmapQr :: forall a k (b :: k) r r'.
(Typeable b, Typeable k, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Constant a b -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Constant a b -> r
$cgmapQl :: forall a k (b :: k) r r'.
(Typeable b, Typeable k, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Constant a b -> r
gmapT :: (forall b. Data b => b -> b) -> Constant a b -> Constant a b
$cgmapT :: forall a k (b :: k).
(Typeable b, Typeable k, Data a) =>
(forall b. Data b => b -> b) -> Constant a b -> Constant a b
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Constant a b))
$cdataCast2 :: forall a k (b :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable b, Typeable k, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Constant a b))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Constant a b))
$cdataCast1 :: forall a k (b :: k) (t :: * -> *) (c :: * -> *).
(Typeable b, Typeable k, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Constant a b))
dataTypeOf :: Constant a b -> DataType
$cdataTypeOf :: forall a k (b :: k).
(Typeable b, Typeable k, Data a) =>
Constant a b -> DataType
toConstr :: Constant a b -> Constr
$ctoConstr :: forall a k (b :: k).
(Typeable b, Typeable k, Data a) =>
Constant a b -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Constant a b)
$cgunfold :: forall a k (b :: k) (c :: * -> *).
(Typeable b, Typeable k, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Constant a b)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constant a b -> c (Constant a b)
$cgfoldl :: forall a k (b :: k) (c :: * -> *).
(Typeable b, Typeable k, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constant a b -> c (Constant a b)
Data
#endif
#if __GLASGOW_HASKELL__ >= 710
        , forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a k (b :: k) x. Rep (Constant a b) x -> Constant a b
forall a k (b :: k) x. Constant a b -> Rep (Constant a b) x
$cto :: forall a k (b :: k) x. Rep (Constant a b) x -> Constant a b
$cfrom :: forall a k (b :: k) x. Constant a b -> Rep (Constant a b) x
Generic, forall k a (a :: k). Rep1 (Constant a) a -> Constant a a
forall k a (a :: k). Constant a a -> Rep1 (Constant a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall k a (a :: k). Rep1 (Constant a) a -> Constant a a
$cfrom1 :: forall k a (a :: k). Constant a a -> Rep1 (Constant a) a
Generic1
#elif __GLASGOW_HASKELL__ >= 704
        , Generic
#endif
        )

-- These instances would be equivalent to the derived instances of the
-- newtype if the field were removed.

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

-- Instances of lifted Prelude classes

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)
    -- From base-4.11, Monoid(mappend) defaults to Semigroup((<>))
    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