    {-# 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(..), Monad (..)
                    , Monoid(..), Ord(..), Semigroup(..), ($), liftM, otherwise )
    import qualified GHC.List as List

    -- 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
        -- By default, we would get a lazy right fold. This forces the use of a strict
        -- left fold instead.
        mconcat :: [Max a] -> Max a
    mconcat = (Max a -> Max a -> Max a) -> Max a -> [Max a] -> Max a
    forall a b. (b -> a -> b) -> b -> [a] -> b
    List.foldl' Max a -> Max a -> Max a
    forall a. Semigroup a => a -> a -> a
    (<>) Max a
    forall a. Monoid a => a
    mempty
        {-# INLINE mconcat #-}

    -- | @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
        -- By default, we would get a lazy right fold. This forces the use of a strict
        -- left fold instead.
        mconcat :: [Min a] -> Min a
    mconcat = (Min a -> Min a -> Min a) -> Min a -> [Min a] -> Min a
    forall a b. (b -> a -> b) -> b -> [a] -> b
    List.foldl' Min a -> Min a -> Min a
    forall a. Semigroup a => a -> a -> a
    (<>) Min a
    forall a. Monoid a => a
    mempty
        {-# INLINE mconcat #-}

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

    -- | A state transformer monad parameterized by the state and inner monad.
    -- The implementation is copied from the transformers package with the
    -- return tuple swapped.
    --
    -- @since 4.18.0.0
    newtype StateT s m a = StateT { forall s (m :: * -> *) a. StateT s m a -> s -> m (s, a)
    runStateT :: s -> m (s, a) }

    -- | @since 4.18.0.0
    instance Monad m => Functor (StateT s m) where
        fmap :: forall a b. (a -> b) -> StateT s m a -> StateT s m b
    fmap = (a -> b) -> StateT s m a -> StateT s m b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM
        {-# INLINE fmap #-}

    -- | @since 4.18.0.0
    instance Monad m => Applicative (StateT s m) where
        pure :: forall a. a -> StateT s m a
    pure a
    a = (s -> m (s, a)) -> StateT s m a
    forall s (m :: * -> *) a. (s -> m (s, a)) -> StateT s m a
    StateT ((s -> m (s, a)) -> StateT s m a)
    -> (s -> m (s, a)) -> StateT s m a
    forall a b. (a -> b) -> a -> b
    $ \ s
    s -> (s, a) -> m (s, a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (s
    s, a
    a)
        {-# INLINE pure #-}
        StateT s -> m (s, a -> b)
    mf <*> :: forall a b. StateT s m (a -> b) -> StateT s m a -> StateT s m b
    <*> StateT s -> m (s, a)
    mx = (s -> m (s, b)) -> StateT s m b
    forall s (m :: * -> *) a. (s -> m (s, a)) -> StateT s m a
    StateT ((s -> m (s, b)) -> StateT s m b)
    -> (s -> m (s, b)) -> StateT s m b
    forall a b. (a -> b) -> a -> b
    $ \ s
    s -> do
            (s
    s', a -> b
    f) <- s -> m (s, a -> b)
    mf s
    s
            (s
    s'', a
    x) <- s -> m (s, a)
    mx s
    s'
            (s, b) -> m (s, b)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (s
    s'', a -> b
    f a
    x)
        {-# INLINE (<*>) #-}
        StateT s m a
    m *> :: forall a b. StateT s m a -> StateT s m b -> StateT s m b
    *> StateT s m b
    k = StateT s m a
    m StateT s m a -> (a -> StateT s m b) -> StateT s m b
    forall a b. StateT s m a -> (a -> StateT s m b) -> StateT s m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \a
    _ -> StateT s m b
    k
        {-# INLINE (*>) #-}

    -- | @since 4.18.0.0
    instance (Monad m) => Monad (StateT s m) where
        StateT s m a
    m >>= :: forall a b. StateT s m a -> (a -> StateT s m b) -> StateT s m b
    >>= a -> StateT s m b
    k  = (s -> m (s, b)) -> StateT s m b
    forall s (m :: * -> *) a. (s -> m (s, a)) -> StateT s m a
    StateT ((s -> m (s, b)) -> StateT s m b)
    -> (s -> m (s, b)) -> StateT s m b
    forall a b. (a -> b) -> a -> b
    $ \ s
    s -> do
            (s
    s', a
    a) <- StateT s m a -> s -> m (s, a)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (s, a)
    runStateT StateT s m a
    m s
    s
            StateT s m b -> s -> m (s, b)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (s, a)
    runStateT (a -> StateT s m b
    k a
    a) s
    s'
        {-# INLINE (>>=) #-}

    -- 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
    forall a b. Coercible a b => a -> b
    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.
    -}