    {-# 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
    -- 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
    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)

    -- | 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
    (Constant a b -> Constant a b -> Bool)
    -> (Constant a b -> Constant a b -> Bool) -> Eq (Constant a b)
    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, Eq (Constant a b)
    Eq (Constant a b)
    -> (Constant a b -> Constant a b -> Ordering)
    -> (Constant a b -> Constant a b -> Bool)
    -> (Constant a b -> Constant a b -> Bool)
    -> (Constant a b -> Constant a b -> Bool)
    -> (Constant a b -> Constant a b -> Bool)
    -> (Constant a b -> Constant a b -> Constant a b)
    -> (Constant a b -> Constant a b -> Constant a b)
    -> Ord (Constant a b)
    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)

    -- 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 = (String -> ReadS (Constant a b)) -> Int -> ReadS (Constant a b)
    forall a. (String -> ReadS a) -> Int -> ReadS a
    readsData ((String -> ReadS (Constant a b)) -> Int -> ReadS (Constant a b))
    -> (String -> ReadS (Constant a b)) -> Int -> ReadS (Constant a b)
    forall a b. (a -> b) -> a -> b
    $
             (Int -> ReadS a)
    -> String -> (a -> Constant a b) -> String -> ReadS (Constant a b)
    forall a t.
    (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
    readsUnaryWith Int -> ReadS a
    forall a. Read a => Int -> ReadS a
    readsPrec String
    "Constant" a -> Constant a b
    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) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
    forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
    showsUnaryWith Int -> a -> ShowS
    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]
    _ = (String -> ReadS (Constant a b)) -> Int -> ReadS (Constant a b)
    forall a. (String -> ReadS a) -> Int -> ReadS a
    readsData ((String -> ReadS (Constant a b)) -> Int -> ReadS (Constant a b))
    -> (String -> ReadS (Constant a b)) -> Int -> ReadS (Constant a b)
    forall a b. (a -> b) -> a -> b
    $
             (Int -> ReadS a)
    -> String -> (a -> Constant a b) -> String -> ReadS (Constant a b)
    forall a t.
    (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
    readsUnaryWith Int -> ReadS a
    rp String
    "Constant" a -> Constant a b
    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) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
    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 = (a -> a -> Bool)
    -> (a -> b -> Bool) -> Constant a a -> Constant a b -> Bool
    forall (f :: * -> * -> *) a b c d.
    Eq2 f =>
    (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
    liftEq2 a -> a -> Bool
    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 = (a -> a -> Ordering)
    -> (a -> b -> Ordering) -> Constant a a -> Constant a b -> Ordering
    forall (f :: * -> * -> *) a b c d.
    Ord2 f =>
    (a -> b -> Ordering)
    -> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
    liftCompare2 a -> a -> Ordering
    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 = (Int -> ReadS a)
    -> ReadS [a]
    -> (Int -> ReadS a)
    -> ReadS [a]
    -> Int
    -> ReadS (Constant a a)
    forall (f :: * -> * -> *) a b.
    Read2 f =>
    (Int -> ReadS a)
    -> ReadS [a]
    -> (Int -> ReadS b)
    -> ReadS [b]
    -> Int
    -> ReadS (f a b)
    liftReadsPrec2 Int -> ReadS a
    forall a. Read a => Int -> ReadS a
    readsPrec ReadS [a]
    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 = (Int -> a -> ShowS)
    -> ([a] -> ShowS)
    -> (Int -> a -> ShowS)
    -> ([a] -> ShowS)
    -> Int
    -> Constant a a
    -> ShowS
    forall (f :: * -> * -> *) a b.
    Show2 f =>
    (Int -> a -> ShowS)
    -> ([a] -> ShowS)
    -> (Int -> b -> ShowS)
    -> ([b] -> ShowS)
    -> Int
    -> f a b
    -> ShowS
    liftShowsPrec2 Int -> a -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec [a] -> ShowS
    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) = a -> Constant a b
    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
    _) = m
    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) = Constant a b -> f (Constant a b)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a -> Constant a b
    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 = a -> Constant a b
    forall {k} a (b :: k). a -> Constant a b
    Constant (a
    x a -> a -> a
    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
    _ = a -> Constant a a
    forall {k} a (b :: k). a -> Constant a b
    Constant a
    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 = a -> Constant a b
    forall {k} a (b :: k). a -> Constant a b
    Constant (a
    x a -> a -> a
    forall a. Monoid a => a -> a -> a
    `mappend` a
    y)
        {-# INLINE (<*>) #-}

    instance (Monoid a) => Monoid (Constant a b) where
        mempty :: Constant a b
    mempty = a -> Constant a b
    forall {k} a (b :: k). a -> Constant a b
    Constant a
    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) = b -> Constant b c
    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) = a -> Constant a c
    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) = c -> Constant c d
    forall {k} a (b :: k). a -> Constant a b
    Constant (c -> Constant c d) -> f c -> f (Constant c d)
    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) = a -> Constant a a'
    forall {k} a (b :: k). a -> Constant a b
    Constant a
    a
        {-# INLINE contramap #-}
    #endif