    {-# LANGUAGE Trustworthy #-}
    {-# LANGUAGE NoImplicitPrelude #-}

    -----------------------------------------------------------------------------
    -- This is a non-exposed internal module.
    --
    -- This code contains utility function and data structures that are used
    -- to improve the efficiency of several instances in the Data.* namespace.
    -----------------------------------------------------------------------------
    module Data.Functor.Utils where

    import Data.Coerce (Coercible, coerce)
    import GHC.Base ( Applicative(..), Functor(..), Maybe(..), Monoid(..), Ord(..)
                    , Semigroup(..), ($), otherwise )

    -- We don't expose Max and Min because, as Edward Kmett pointed out to me,
    -- there are two reasonable ways to define them. One way is to use Maybe, as we
    -- do here; the other way is to impose a Bounded constraint on the Monoid
    -- instance. We may eventually want to add both versions, but we don't want to
    -- trample on anyone's toes by imposing Max = MaxMaybe.

    newtype Max a = Max {forall a. Max a -> Maybe a
    getMax :: Maybe a}
    newtype Min a = Min {forall a. Min a -> Maybe a
    getMin :: Maybe a}

    -- | @since 4.11.0.0
    instance Ord a => Semigroup (Max a) where
        {-# INLINE (<>) #-}
        Max a
    m <> :: Max a -> Max a -> Max a
    <> Max Maybe a
    Nothing = Max a
    m
        Max Maybe a
    Nothing <> Max a
    n = Max a
    n
        (Max m :: Maybe a
    m@(Just a
    x)) <> (Max n :: Maybe a
    n@(Just a
    y))
          | a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    y    = Maybe a -> Max a
    forall a. Maybe a -> Max a
    Max Maybe a
    m
          | Bool
    otherwise = Maybe a -> Max a
    forall a. Maybe a -> Max a
    Max Maybe a
    n

    -- | @since 4.8.0.0
    instance Ord a => Monoid (Max a) where
        mempty :: Max a
    mempty = Maybe a -> Max a
    forall a. Maybe a -> Max a
    Max Maybe a
    forall a. Maybe a
    Nothing

    -- | @since 4.11.0.0
    instance Ord a => Semigroup (Min a) where
        {-# INLINE (<>) #-}
        Min a
    m <> :: Min a -> Min a -> Min a
    <> Min Maybe a
    Nothing = Min a
    m
        Min Maybe a
    Nothing <> Min a
    n = Min a
    n
        (Min m :: Maybe a
    m@(Just a
    x)) <> (Min n :: Maybe a
    n@(Just a
    y))
          | a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    y    = Maybe a -> Min a
    forall a. Maybe a -> Min a
    Min Maybe a
    m
          | Bool
    otherwise = Maybe a -> Min a
    forall a. Maybe a -> Min a
    Min Maybe a
    n

    -- | @since 4.8.0.0
    instance Ord a => Monoid (Min a) where
        mempty :: Min a
    mempty = Maybe a -> Min a
    forall a. Maybe a -> Min a
    Min Maybe a
    forall a. Maybe a
    Nothing

    -- left-to-right state-transforming monad
    newtype StateL s a = StateL { forall s a. StateL s a -> s -> (s, a)
    runStateL :: s -> (s, a) }

    -- | @since 4.0
    instance Functor (StateL s) where
        fmap :: forall a b. (a -> b) -> StateL s a -> StateL s b
    fmap a -> b
    f (StateL s -> (s, a)
    k) = (s -> (s, b)) -> StateL s b
    forall s a. (s -> (s, a)) -> StateL s a
    StateL ((s -> (s, b)) -> StateL s b) -> (s -> (s, b)) -> StateL s b
    forall a b. (a -> b) -> a -> b
    $ \ s
    s -> let (s
    s', a
    v) = s -> (s, a)
    k s
    s in (s
    s', a -> b
    f a
    v)

    -- | @since 4.0
    instance Applicative (StateL s) where
        pure :: forall a. a -> StateL s a
    pure a
    x = (s -> (s, a)) -> StateL s a
    forall s a. (s -> (s, a)) -> StateL s a
    StateL (\ s
    s -> (s
    s, a
    x))
        StateL s -> (s, a -> b)
    kf <*> :: forall a b. StateL s (a -> b) -> StateL s a -> StateL s b
    <*> StateL s -> (s, a)
    kv = (s -> (s, b)) -> StateL s b
    forall s a. (s -> (s, a)) -> StateL s a
    StateL ((s -> (s, b)) -> StateL s b) -> (s -> (s, b)) -> StateL s b
    forall a b. (a -> b) -> a -> b
    $ \ s
    s ->
            let (s
    s', a -> b
    f) = s -> (s, a -> b)
    kf s
    s
                (s
    s'', a
    v) = s -> (s, a)
    kv s
    s'
            in (s
    s'', a -> b
    f a
    v)
        liftA2 :: forall a b c.
    (a -> b -> c) -> StateL s a -> StateL s b -> StateL s c
    liftA2 a -> b -> c
    f (StateL s -> (s, a)
    kx) (StateL s -> (s, b)
    ky) = (s -> (s, c)) -> StateL s c
    forall s a. (s -> (s, a)) -> StateL s a
    StateL ((s -> (s, c)) -> StateL s c) -> (s -> (s, c)) -> StateL s c
    forall a b. (a -> b) -> a -> b
    $ \s
    s ->
            let (s
    s', a
    x) = s -> (s, a)
    kx s
    s
                (s
    s'', b
    y) = s -> (s, b)
    ky s
    s'
            in (s
    s'', a -> b -> c
    f a
    x b
    y)

    -- right-to-left state-transforming monad
    newtype StateR s a = StateR { forall s a. StateR s a -> s -> (s, a)
    runStateR :: s -> (s, a) }

    -- | @since 4.0
    instance Functor (StateR s) where
        fmap :: forall a b. (a -> b) -> StateR s a -> StateR s b
    fmap a -> b
    f (StateR s -> (s, a)
    k) = (s -> (s, b)) -> StateR s b
    forall s a. (s -> (s, a)) -> StateR s a
    StateR ((s -> (s, b)) -> StateR s b) -> (s -> (s, b)) -> StateR s b
    forall a b. (a -> b) -> a -> b
    $ \ s
    s -> let (s
    s', a
    v) = s -> (s, a)
    k s
    s in (s
    s', a -> b
    f a
    v)

    -- | @since 4.0
    instance Applicative (StateR s) where
        pure :: forall a. a -> StateR s a
    pure a
    x = (s -> (s, a)) -> StateR s a
    forall s a. (s -> (s, a)) -> StateR s a
    StateR (\ s
    s -> (s
    s, a
    x))
        StateR s -> (s, a -> b)
    kf <*> :: forall a b. StateR s (a -> b) -> StateR s a -> StateR s b
    <*> StateR s -> (s, a)
    kv = (s -> (s, b)) -> StateR s b
    forall s a. (s -> (s, a)) -> StateR s a
    StateR ((s -> (s, b)) -> StateR s b) -> (s -> (s, b)) -> StateR s b
    forall a b. (a -> b) -> a -> b
    $ \ s
    s ->
            let (s
    s', a
    v) = s -> (s, a)
    kv s
    s
                (s
    s'', a -> b
    f) = s -> (s, a -> b)
    kf s
    s'
            in (s
    s'', a -> b
    f a
    v)
        liftA2 :: forall a b c.
    (a -> b -> c) -> StateR s a -> StateR s b -> StateR s c
    liftA2 a -> b -> c
    f (StateR s -> (s, a)
    kx) (StateR s -> (s, b)
    ky) = (s -> (s, c)) -> StateR s c
    forall s a. (s -> (s, a)) -> StateR s a
    StateR ((s -> (s, c)) -> StateR s c) -> (s -> (s, c)) -> StateR s c
    forall a b. (a -> b) -> a -> b
    $ \ s
    s ->
            let (s
    s', b
    y) = s -> (s, b)
    ky s
    s
                (s
    s'', a
    x) = s -> (s, a)
    kx s
    s'
            in (s
    s'', a -> b -> c
    f a
    x b
    y)

    -- See Note [Function coercion]
    (#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
    #. :: forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
    (#.) b -> c
    _f = (a -> b) -> a -> c
    coerce
    {-# INLINE (#.) #-}

    {-
    Note [Function coercion]
    ~~~~~~~~~~~~~~~~~~~~~~~

    Several functions here use (#.) instead of (.) to avoid potential efficiency
    problems relating to #7542. The problem, in a nutshell:

    If N is a newtype constructor, then N x will always have the same
    representation as x (something similar applies for a newtype deconstructor).
    However, if f is a function,

    N . f = \x -> N (f x)

    This looks almost the same as f, but the eta expansion lifts it--the lhs could
    be _|_, but the rhs never is. This can lead to very inefficient code.  Thus we
    steal a technique from Shachaf and Edward Kmett and adapt it to the current
    (rather clean) setting. Instead of using  N . f,  we use  N #. f, which is
    just

    coerce f `asTypeOf` (N . f)

    That is, we just *pretend* that f has the right type, and thanks to the safety
    of coerce, the type checker guarantees that nothing really goes wrong. We still
    have to be a bit careful, though: remember that #. completely ignores the
    *value* of its left operand.
    -}