    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE Trustworthy #-}

    {-# OPTIONS_GHC -Wno-orphans -Wno-warnings-deprecations #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Lens.Internal.Zoom
    -- Copyright   :  (C) 2012-2016 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    ----------------------------------------------------------------------------
    module Control.Lens.Internal.Zoom
      (
      -- * Zoom
        Focusing(..)
      , FocusingWith(..)
      , FocusingPlus(..)
      , FocusingOn(..)
      , FocusingMay(..), May(..)
      , FocusingErr(..), Err(..)
      , FocusingFree(..), Freed(..)
      -- * Magnify
      , Effect(..)
      , EffectRWS(..)
      ) where

    import Prelude ()

    import Control.Lens.Internal.Prelude
    import Control.Monad
    import Control.Monad.Trans.Free
    import Data.Functor.Bind

    ------------------------------------------------------------------------------
    -- Focusing
    ------------------------------------------------------------------------------

    -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into 'Control.Monad.State.StateT'.
    newtype Focusing m s a = Focusing { forall (m :: * -> *) s a. Focusing m s a -> m (s, a)
    unfocusing :: m (s, a) }

    instance Monad m => Functor (Focusing m s) where
      fmap :: forall a b. (a -> b) -> Focusing m s a -> Focusing m s b
    fmap a -> b
    f (Focusing m (s, a)
    m) = m (s, b) -> Focusing m s b
    forall (m :: * -> *) s a. m (s, a) -> Focusing m s a
    Focusing (m (s, b) -> Focusing m s b) -> m (s, b) -> Focusing m s b
    forall a b. (a -> b) -> a -> b
    $ do
         (s, a) <- m (s, a)
    m
         return (s, f a)
      {-# INLINE fmap #-}

    instance (Monad m, Semigroup s) => Apply (Focusing m s) where
      Focusing m (s, a -> b)
    mf <.> :: forall a b.
    Focusing m s (a -> b) -> Focusing m s a -> Focusing m s b
    <.> Focusing m (s, a)
    ma = m (s, b) -> Focusing m s b
    forall (m :: * -> *) s a. m (s, a) -> Focusing m s a
    Focusing (m (s, b) -> Focusing m s b) -> m (s, b) -> Focusing m s b
    forall a b. (a -> b) -> a -> b
    $ do
        (s, f) <- m (s, a -> b)
    mf
        (s', a) <- ma
        return (s <> s', f a)
      {-# INLINE (<.>) #-}

    instance (Monad m, Monoid s) => Applicative (Focusing m s) where
      pure :: forall a. a -> Focusing m s a
    pure a
    a = m (s, a) -> Focusing m s a
    forall (m :: * -> *) s a. m (s, a) -> Focusing m s a
    Focusing ((s, a) -> m (s, a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (s
    forall a. Monoid a => a
    mempty, a
    a))
      {-# INLINE pure #-}
      Focusing m (s, a -> b)
    mf <*> :: forall a b.
    Focusing m s (a -> b) -> Focusing m s a -> Focusing m s b
    <*> Focusing m (s, a)
    ma = m (s, b) -> Focusing m s b
    forall (m :: * -> *) s a. m (s, a) -> Focusing m s a
    Focusing (m (s, b) -> Focusing m s b) -> m (s, b) -> Focusing m s b
    forall a b. (a -> b) -> a -> b
    $ do
        (s, f) <- m (s, a -> b)
    mf
        (s', a) <- ma
        return (mappend s s', f a)
      {-# INLINE (<*>) #-}

    ------------------------------------------------------------------------------
    -- FocusingWith
    ------------------------------------------------------------------------------

    -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into 'Control.Monad.RWS.RWST'.
    newtype FocusingWith w m s a = FocusingWith { forall w (m :: * -> *) s a. FocusingWith w m s a -> m (s, a, w)
    unfocusingWith :: m (s, a, w) }

    instance Monad m => Functor (FocusingWith w m s) where
      fmap :: forall a b.
    (a -> b) -> FocusingWith w m s a -> FocusingWith w m s b
    fmap a -> b
    f (FocusingWith m (s, a, w)
    m) = m (s, b, w) -> FocusingWith w m s b
    forall w (m :: * -> *) s a. m (s, a, w) -> FocusingWith w m s a
    FocusingWith (m (s, b, w) -> FocusingWith w m s b)
    -> m (s, b, w) -> FocusingWith w m s b
    forall a b. (a -> b) -> a -> b
    $ do
         (s, a, w) <- m (s, a, w)
    m
         return (s, f a, w)
      {-# INLINE fmap #-}

    instance (Monad m, Semigroup s, Semigroup w) => Apply (FocusingWith w m s) where
      FocusingWith m (s, a -> b, w)
    mf <.> :: forall a b.
    FocusingWith w m s (a -> b)
    -> FocusingWith w m s a -> FocusingWith w m s b
    <.> FocusingWith m (s, a, w)
    ma = m (s, b, w) -> FocusingWith w m s b
    forall w (m :: * -> *) s a. m (s, a, w) -> FocusingWith w m s a
    FocusingWith (m (s, b, w) -> FocusingWith w m s b)
    -> m (s, b, w) -> FocusingWith w m s b
    forall a b. (a -> b) -> a -> b
    $ do
        (s, f, w) <- m (s, a -> b, w)
    mf
        (s', a, w') <- ma
        return (s <> s', f a, w <> w')
      {-# INLINE (<.>) #-}

    instance (Monad m, Monoid s, Monoid w) => Applicative (FocusingWith w m s) where
      pure :: forall a. a -> FocusingWith w m s a
    pure a
    a = m (s, a, w) -> FocusingWith w m s a
    forall w (m :: * -> *) s a. m (s, a, w) -> FocusingWith w m s a
    FocusingWith ((s, a, w) -> m (s, a, w)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (s
    forall a. Monoid a => a
    mempty, a
    a, w
    forall a. Monoid a => a
    mempty))
      {-# INLINE pure #-}
      FocusingWith m (s, a -> b, w)
    mf <*> :: forall a b.
    FocusingWith w m s (a -> b)
    -> FocusingWith w m s a -> FocusingWith w m s b
    <*> FocusingWith m (s, a, w)
    ma = m (s, b, w) -> FocusingWith w m s b
    forall w (m :: * -> *) s a. m (s, a, w) -> FocusingWith w m s a
    FocusingWith (m (s, b, w) -> FocusingWith w m s b)
    -> m (s, b, w) -> FocusingWith w m s b
    forall a b. (a -> b) -> a -> b
    $ do
        (s, f, w) <- m (s, a -> b, w)
    mf
        (s', a, w') <- ma
        return (mappend s s', f a, mappend w w')
      {-# INLINE (<*>) #-}

    ------------------------------------------------------------------------------
    -- FocusingPlus
    ------------------------------------------------------------------------------

    -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into 'Control.Monad.Writer.WriterT'.
    newtype FocusingPlus w k s a = FocusingPlus { forall w (k :: * -> * -> *) s a. FocusingPlus w k s a -> k (s, w) a
    unfocusingPlus :: k (s, w) a }

    instance Functor (k (s, w)) => Functor (FocusingPlus w k s) where
      fmap :: forall a b.
    (a -> b) -> FocusingPlus w k s a -> FocusingPlus w k s b
    fmap a -> b
    f (FocusingPlus k (s, w) a
    as) = k (s, w) b -> FocusingPlus w k s b
    forall w (k :: * -> * -> *) s a. k (s, w) a -> FocusingPlus w k s a
    FocusingPlus ((a -> b) -> k (s, w) a -> k (s, w) b
    forall a b. (a -> b) -> k (s, w) a -> k (s, w) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f k (s, w) a
    as)
      {-# INLINE fmap #-}

    instance Apply (k (s, w)) => Apply (FocusingPlus w k s) where
      FocusingPlus k (s, w) (a -> b)
    kf <.> :: forall a b.
    FocusingPlus w k s (a -> b)
    -> FocusingPlus w k s a -> FocusingPlus w k s b
    <.> FocusingPlus k (s, w) a
    ka = k (s, w) b -> FocusingPlus w k s b
    forall w (k :: * -> * -> *) s a. k (s, w) a -> FocusingPlus w k s a
    FocusingPlus (k (s, w) (a -> b)
    kf k (s, w) (a -> b) -> k (s, w) a -> k (s, w) b
    forall a b. k (s, w) (a -> b) -> k (s, w) a -> k (s, w) b
    forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
    <.> k (s, w) a
    ka)
      {-# INLINE (<.>) #-}

    instance Applicative (k (s, w)) => Applicative (FocusingPlus w k s) where
      pure :: forall a. a -> FocusingPlus w k s a
    pure = k (s, w) a -> FocusingPlus w k s a
    forall w (k :: * -> * -> *) s a. k (s, w) a -> FocusingPlus w k s a
    FocusingPlus (k (s, w) a -> FocusingPlus w k s a)
    -> (a -> k (s, w) a) -> a -> FocusingPlus w k s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> k (s, w) a
    forall a. a -> k (s, w) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      {-# INLINE pure #-}
      FocusingPlus k (s, w) (a -> b)
    kf <*> :: forall a b.
    FocusingPlus w k s (a -> b)
    -> FocusingPlus w k s a -> FocusingPlus w k s b
    <*> FocusingPlus k (s, w) a
    ka = k (s, w) b -> FocusingPlus w k s b
    forall w (k :: * -> * -> *) s a. k (s, w) a -> FocusingPlus w k s a
    FocusingPlus (k (s, w) (a -> b)
    kf k (s, w) (a -> b) -> k (s, w) a -> k (s, w) b
    forall a b. k (s, w) (a -> b) -> k (s, w) a -> k (s, w) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> k (s, w) a
    ka)
      {-# INLINE (<*>) #-}

    ------------------------------------------------------------------------------
    -- FocusingOn
    ------------------------------------------------------------------------------

    -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into 'Control.Monad.Trans.Maybe.MaybeT' or 'Control.Monad.Trans.List.ListT'.
    newtype FocusingOn f k s a = FocusingOn { forall (f :: * -> *) (k :: * -> * -> *) s a.
    FocusingOn f k s a -> k (f s) a
    unfocusingOn :: k (f s) a }

    instance Functor (k (f s)) => Functor (FocusingOn f k s) where
      fmap :: forall a b. (a -> b) -> FocusingOn f k s a -> FocusingOn f k s b
    fmap a -> b
    f (FocusingOn k (f s) a
    as) = k (f s) b -> FocusingOn f k s b
    forall (f :: * -> *) (k :: * -> * -> *) s a.
    k (f s) a -> FocusingOn f k s a
    FocusingOn ((a -> b) -> k (f s) a -> k (f s) b
    forall a b. (a -> b) -> k (f s) a -> k (f s) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f k (f s) a
    as)
      {-# INLINE fmap #-}

    instance Apply (k (f s)) => Apply (FocusingOn f k s) where
      FocusingOn k (f s) (a -> b)
    kf <.> :: forall a b.
    FocusingOn f k s (a -> b)
    -> FocusingOn f k s a -> FocusingOn f k s b
    <.> FocusingOn k (f s) a
    ka = k (f s) b -> FocusingOn f k s b
    forall (f :: * -> *) (k :: * -> * -> *) s a.
    k (f s) a -> FocusingOn f k s a
    FocusingOn (k (f s) (a -> b)
    kf k (f s) (a -> b) -> k (f s) a -> k (f s) b
    forall a b. k (f s) (a -> b) -> k (f s) a -> k (f s) b
    forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
    <.> k (f s) a
    ka)
      {-# INLINE (<.>) #-}

    instance Applicative (k (f s)) => Applicative (FocusingOn f k s) where
      pure :: forall a. a -> FocusingOn f k s a
    pure = k (f s) a -> FocusingOn f k s a
    forall (f :: * -> *) (k :: * -> * -> *) s a.
    k (f s) a -> FocusingOn f k s a
    FocusingOn (k (f s) a -> FocusingOn f k s a)
    -> (a -> k (f s) a) -> a -> FocusingOn f k s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> k (f s) a
    forall a. a -> k (f s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      {-# INLINE pure #-}
      FocusingOn k (f s) (a -> b)
    kf <*> :: forall a b.
    FocusingOn f k s (a -> b)
    -> FocusingOn f k s a -> FocusingOn f k s b
    <*> FocusingOn k (f s) a
    ka = k (f s) b -> FocusingOn f k s b
    forall (f :: * -> *) (k :: * -> * -> *) s a.
    k (f s) a -> FocusingOn f k s a
    FocusingOn (k (f s) (a -> b)
    kf k (f s) (a -> b) -> k (f s) a -> k (f s) b
    forall a b. k (f s) (a -> b) -> k (f s) a -> k (f s) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> k (f s) a
    ka)
      {-# INLINE (<*>) #-}

    ------------------------------------------------------------------------------
    -- May
    ------------------------------------------------------------------------------

    -- | Make a 'Monoid' out of 'Maybe' for error handling.
    newtype May a = May { forall a. May a -> Maybe a
    getMay :: Maybe a }

    instance Semigroup a => Semigroup (May a) where
      May Maybe a
    Nothing <> :: May a -> May a -> May a
    <> May a
    _ = Maybe a -> May a
    forall a. Maybe a -> May a
    May Maybe a
    forall a. Maybe a
    Nothing
      May a
    _ <> May Maybe a
    Nothing = Maybe a -> May a
    forall a. Maybe a -> May a
    May Maybe a
    forall a. Maybe a
    Nothing
      May (Just a
    a) <> May (Just a
    b) = Maybe a -> May a
    forall a. Maybe a -> May a
    May (a -> Maybe a
    forall a. a -> Maybe a
    Just (a
    a a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    b))
      {-# INLINE (<>) #-}

    instance Monoid a => Monoid (May a) where
      mempty :: May a
    mempty = Maybe a -> May a
    forall a. Maybe a -> May a
    May (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    forall a. Monoid a => a
    mempty)
      {-# INLINE mempty #-}
    #if !(MIN_VERSION_base(4,11,0))
      May Nothing `mappend` _ = May Nothing
      _ `mappend` May Nothing = May Nothing
      May (Just a) `mappend` May (Just b) = May (Just (mappend a b))
      {-# INLINE mappend #-}
    #endif

    ------------------------------------------------------------------------------
    -- FocusingMay
    ------------------------------------------------------------------------------

    -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into 'Control.Monad.Error.ErrorT'.
    newtype FocusingMay k s a = FocusingMay { forall (k :: * -> * -> *) s a. FocusingMay k s a -> k (May s) a
    unfocusingMay :: k (May s) a }

    instance Functor (k (May s)) => Functor (FocusingMay k s) where
      fmap :: forall a b. (a -> b) -> FocusingMay k s a -> FocusingMay k s b
    fmap a -> b
    f (FocusingMay k (May s) a
    as) = k (May s) b -> FocusingMay k s b
    forall (k :: * -> * -> *) s a. k (May s) a -> FocusingMay k s a
    FocusingMay ((a -> b) -> k (May s) a -> k (May s) b
    forall a b. (a -> b) -> k (May s) a -> k (May s) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f k (May s) a
    as)
      {-# INLINE fmap #-}

    instance Apply (k (May s)) => Apply (FocusingMay k s) where
      FocusingMay k (May s) (a -> b)
    kf <.> :: forall a b.
    FocusingMay k s (a -> b) -> FocusingMay k s a -> FocusingMay k s b
    <.> FocusingMay k (May s) a
    ka = k (May s) b -> FocusingMay k s b
    forall (k :: * -> * -> *) s a. k (May s) a -> FocusingMay k s a
    FocusingMay (k (May s) (a -> b)
    kf k (May s) (a -> b) -> k (May s) a -> k (May s) b
    forall a b. k (May s) (a -> b) -> k (May s) a -> k (May s) b
    forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
    <.> k (May s) a
    ka)
      {-# INLINE (<.>) #-}

    instance Applicative (k (May s)) => Applicative (FocusingMay k s) where
      pure :: forall a. a -> FocusingMay k s a
    pure = k (May s) a -> FocusingMay k s a
    forall (k :: * -> * -> *) s a. k (May s) a -> FocusingMay k s a
    FocusingMay (k (May s) a -> FocusingMay k s a)
    -> (a -> k (May s) a) -> a -> FocusingMay k s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> k (May s) a
    forall a. a -> k (May s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      {-# INLINE pure #-}
      FocusingMay k (May s) (a -> b)
    kf <*> :: forall a b.
    FocusingMay k s (a -> b) -> FocusingMay k s a -> FocusingMay k s b
    <*> FocusingMay k (May s) a
    ka = k (May s) b -> FocusingMay k s b
    forall (k :: * -> * -> *) s a. k (May s) a -> FocusingMay k s a
    FocusingMay (k (May s) (a -> b)
    kf k (May s) (a -> b) -> k (May s) a -> k (May s) b
    forall a b. k (May s) (a -> b) -> k (May s) a -> k (May s) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> k (May s) a
    ka)
      {-# INLINE (<*>) #-}

    ------------------------------------------------------------------------------
    -- Err
    ------------------------------------------------------------------------------

    -- | Make a 'Monoid' out of 'Either' for error handling.
    newtype Err e a = Err { forall e a. Err e a -> Either e a
    getErr :: Either e a }

    instance Semigroup a => Semigroup (Err e a) where
      Err (Left e
    e) <> :: Err e a -> Err e a -> Err e a
    <> Err e a
    _ = Either e a -> Err e a
    forall e a. Either e a -> Err e a
    Err (e -> Either e a
    forall a b. a -> Either a b
    Left e
    e)
      Err e a
    _ <> Err (Left e
    e) = Either e a -> Err e a
    forall e a. Either e a -> Err e a
    Err (e -> Either e a
    forall a b. a -> Either a b
    Left e
    e)
      Err (Right a
    a) <> Err (Right a
    b) = Either e a -> Err e a
    forall e a. Either e a -> Err e a
    Err (a -> Either e a
    forall a b. b -> Either a b
    Right (a
    a a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    b))
      {-# INLINE (<>) #-}

    instance Monoid a => Monoid (Err e a) where
      mempty :: Err e a
    mempty = Either e a -> Err e a
    forall e a. Either e a -> Err e a
    Err (a -> Either e a
    forall a b. b -> Either a b
    Right a
    forall a. Monoid a => a
    mempty)
      {-# INLINE mempty #-}
    #if !(MIN_VERSION_base(4,11,0))
      Err (Left e) `mappend` _ = Err (Left e)
      _ `mappend` Err (Left e) = Err (Left e)
      Err (Right a) `mappend` Err (Right b) = Err (Right (mappend a b))
      {-# INLINE mappend #-}
    #endif

    ------------------------------------------------------------------------------
    -- FocusingErr
    ------------------------------------------------------------------------------

    -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into 'Control.Monad.Error.ErrorT'.
    newtype FocusingErr e k s a = FocusingErr { forall e (k :: * -> * -> *) s a.
    FocusingErr e k s a -> k (Err e s) a
    unfocusingErr :: k (Err e s) a }

    instance Functor (k (Err e s)) => Functor (FocusingErr e k s) where
      fmap :: forall a b. (a -> b) -> FocusingErr e k s a -> FocusingErr e k s b
    fmap a -> b
    f (FocusingErr k (Err e s) a
    as) = k (Err e s) b -> FocusingErr e k s b
    forall e (k :: * -> * -> *) s a.
    k (Err e s) a -> FocusingErr e k s a
    FocusingErr ((a -> b) -> k (Err e s) a -> k (Err e s) b
    forall a b. (a -> b) -> k (Err e s) a -> k (Err e s) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f k (Err e s) a
    as)
      {-# INLINE fmap #-}

    instance Apply (k (Err e s)) => Apply (FocusingErr e k s) where
      FocusingErr k (Err e s) (a -> b)
    kf <.> :: forall a b.
    FocusingErr e k s (a -> b)
    -> FocusingErr e k s a -> FocusingErr e k s b
    <.> FocusingErr k (Err e s) a
    ka = k (Err e s) b -> FocusingErr e k s b
    forall e (k :: * -> * -> *) s a.
    k (Err e s) a -> FocusingErr e k s a
    FocusingErr (k (Err e s) (a -> b)
    kf k (Err e s) (a -> b) -> k (Err e s) a -> k (Err e s) b
    forall a b. k (Err e s) (a -> b) -> k (Err e s) a -> k (Err e s) b
    forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
    <.> k (Err e s) a
    ka)
      {-# INLINE (<.>) #-}

    instance Applicative (k (Err e s)) => Applicative (FocusingErr e k s) where
      pure :: forall a. a -> FocusingErr e k s a
    pure = k (Err e s) a -> FocusingErr e k s a
    forall e (k :: * -> * -> *) s a.
    k (Err e s) a -> FocusingErr e k s a
    FocusingErr (k (Err e s) a -> FocusingErr e k s a)
    -> (a -> k (Err e s) a) -> a -> FocusingErr e k s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> k (Err e s) a
    forall a. a -> k (Err e s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      {-# INLINE pure #-}
      FocusingErr k (Err e s) (a -> b)
    kf <*> :: forall a b.
    FocusingErr e k s (a -> b)
    -> FocusingErr e k s a -> FocusingErr e k s b
    <*> FocusingErr k (Err e s) a
    ka = k (Err e s) b -> FocusingErr e k s b
    forall e (k :: * -> * -> *) s a.
    k (Err e s) a -> FocusingErr e k s a
    FocusingErr (k (Err e s) (a -> b)
    kf k (Err e s) (a -> b) -> k (Err e s) a -> k (Err e s) b
    forall a b. k (Err e s) (a -> b) -> k (Err e s) a -> k (Err e s) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> k (Err e s) a
    ka)
      {-# INLINE (<*>) #-}

    ------------------------------------------------------------------------------
    -- Freed
    ------------------------------------------------------------------------------

    -- | Make a 'Monoid' out of 'FreeF' for result collection.

    newtype Freed f m a = Freed { forall (f :: * -> *) (m :: * -> *) a.
    Freed f m a -> FreeF f a (FreeT f m a)
    getFreed :: FreeF f a (FreeT f m a) }

    instance (Applicative f, Semigroup a, Monad m) => Semigroup (Freed f m a) where
      Freed (Pure a
    a) <> :: Freed f m a -> Freed f m a -> Freed f m a
    <> Freed (Pure a
    b) = FreeF f a (FreeT f m a) -> Freed f m a
    forall (f :: * -> *) (m :: * -> *) a.
    FreeF f a (FreeT f m a) -> Freed f m a
    Freed (FreeF f a (FreeT f m a) -> Freed f m a)
    -> FreeF f a (FreeT f m a) -> Freed f m a
    forall a b. (a -> b) -> a -> b
    $ a -> FreeF f a (FreeT f m a)
    forall (f :: * -> *) a b. a -> FreeF f a b
    Pure (a -> FreeF f a (FreeT f m a)) -> a -> FreeF f a (FreeT f m a)
    forall a b. (a -> b) -> a -> b
    $ a
    a a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    b
      Freed (Pure a
    a) <> Freed (Free f (FreeT f m a)
    g) = FreeF f a (FreeT f m a) -> Freed f m a
    forall (f :: * -> *) (m :: * -> *) a.
    FreeF f a (FreeT f m a) -> Freed f m a
    Freed (FreeF f a (FreeT f m a) -> Freed f m a)
    -> FreeF f a (FreeT f m a) -> Freed f m a
    forall a b. (a -> b) -> a -> b
    $ f (FreeT f m a) -> FreeF f a (FreeT f m a)
    forall (f :: * -> *) a b. f b -> FreeF f a b
    Free (f (FreeT f m a) -> FreeF f a (FreeT f m a))
    -> f (FreeT f m a) -> FreeF f a (FreeT f m a)
    forall a b. (a -> b) -> a -> b
    $ (FreeT f m a -> FreeT f m a -> FreeT f m a)
    -> f (FreeT f m a) -> f (FreeT f m a) -> f (FreeT f m a)
    forall a b c. (a -> b -> c) -> f a -> f b -> f c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 ((a -> a -> a) -> FreeT f m a -> FreeT f m a -> FreeT f m a
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 a -> a -> a
    forall a. Semigroup a => a -> a -> a
    (<>)) (FreeT f m a -> f (FreeT f m a)
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FreeT f m a -> f (FreeT f m a)) -> FreeT f m a -> f (FreeT f m a)
    forall a b. (a -> b) -> a -> b
    $ a -> FreeT f m a
    forall a. a -> FreeT f m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a) f (FreeT f m a)
    g
      Freed (Free f (FreeT f m a)
    f) <> Freed (Pure a
    b) = FreeF f a (FreeT f m a) -> Freed f m a
    forall (f :: * -> *) (m :: * -> *) a.
    FreeF f a (FreeT f m a) -> Freed f m a
    Freed (FreeF f a (FreeT f m a) -> Freed f m a)
    -> FreeF f a (FreeT f m a) -> Freed f m a
    forall a b. (a -> b) -> a -> b
    $ f (FreeT f m a) -> FreeF f a (FreeT f m a)
    forall (f :: * -> *) a b. f b -> FreeF f a b
    Free (f (FreeT f m a) -> FreeF f a (FreeT f m a))
    -> f (FreeT f m a) -> FreeF f a (FreeT f m a)
    forall a b. (a -> b) -> a -> b
    $ (FreeT f m a -> FreeT f m a -> FreeT f m a)
    -> f (FreeT f m a) -> f (FreeT f m a) -> f (FreeT f m a)
    forall a b c. (a -> b -> c) -> f a -> f b -> f c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 ((a -> a -> a) -> FreeT f m a -> FreeT f m a -> FreeT f m a
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 a -> a -> a
    forall a. Semigroup a => a -> a -> a
    (<>)) f (FreeT f m a)
    f (FreeT f m a -> f (FreeT f m a)
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FreeT f m a -> f (FreeT f m a)) -> FreeT f m a -> f (FreeT f m a)
    forall a b. (a -> b) -> a -> b
    $ a -> FreeT f m a
    forall a. a -> FreeT f m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    b)
      Freed (Free f (FreeT f m a)
    f) <> Freed (Free f (FreeT f m a)
    g) = FreeF f a (FreeT f m a) -> Freed f m a
    forall (f :: * -> *) (m :: * -> *) a.
    FreeF f a (FreeT f m a) -> Freed f m a
    Freed (FreeF f a (FreeT f m a) -> Freed f m a)
    -> FreeF f a (FreeT f m a) -> Freed f m a
    forall a b. (a -> b) -> a -> b
    $ f (FreeT f m a) -> FreeF f a (FreeT f m a)
    forall (f :: * -> *) a b. f b -> FreeF f a b
    Free (f (FreeT f m a) -> FreeF f a (FreeT f m a))
    -> f (FreeT f m a) -> FreeF f a (FreeT f m a)
    forall a b. (a -> b) -> a -> b
    $ (FreeT f m a -> FreeT f m a -> FreeT f m a)
    -> f (FreeT f m a) -> f (FreeT f m a) -> f (FreeT f m a)
    forall a b c. (a -> b -> c) -> f a -> f b -> f c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 ((a -> a -> a) -> FreeT f m a -> FreeT f m a -> FreeT f m a
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 a -> a -> a
    forall a. Semigroup a => a -> a -> a
    (<>)) f (FreeT f m a)
    f f (FreeT f m a)
    g

    instance (Applicative f, Monoid a, Monad m) => Monoid (Freed f m a) where
      mempty :: Freed f m a
    mempty = FreeF f a (FreeT f m a) -> Freed f m a
    forall (f :: * -> *) (m :: * -> *) a.
    FreeF f a (FreeT f m a) -> Freed f m a
    Freed (FreeF f a (FreeT f m a) -> Freed f m a)
    -> FreeF f a (FreeT f m a) -> Freed f m a
    forall a b. (a -> b) -> a -> b
    $ a -> FreeF f a (FreeT f m a)
    forall (f :: * -> *) a b. a -> FreeF f a b
    Pure a
    forall a. Monoid a => a
    mempty

    #if !(MIN_VERSION_base(4,11,0))
      Freed (Pure a) `mappend` Freed (Pure b) = Freed $ Pure $ a `mappend` b
      Freed (Pure a) `mappend` Freed (Free g) = Freed $ Free $ liftA2 (liftM2 mappend) (pure $ return a) g
      Freed (Free f) `mappend` Freed (Pure b) = Freed $ Free $ liftA2 (liftM2 mappend) f (pure $ return b)
      Freed (Free f) `mappend` Freed (Free g) = Freed $ Free $ liftA2 (liftM2 mappend) f g
    #endif

    ------------------------------------------------------------------------------
    -- FocusingFree
    ------------------------------------------------------------------------------

    -- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into
    -- 'Control.Monad.Trans.FreeT'
    newtype FocusingFree f m k s a = FocusingFree { forall (f :: * -> *) (m :: * -> *) (k :: * -> * -> *) s a.
    FocusingFree f m k s a -> k (Freed f m s) a
    unfocusingFree :: k (Freed f m s) a }

    instance Functor (k (Freed f m s)) => Functor (FocusingFree f m k s) where
      fmap :: forall a b.
    (a -> b) -> FocusingFree f m k s a -> FocusingFree f m k s b
    fmap a -> b
    f (FocusingFree k (Freed f m s) a
    as) = k (Freed f m s) b -> FocusingFree f m k s b
    forall (f :: * -> *) (m :: * -> *) (k :: * -> * -> *) s a.
    k (Freed f m s) a -> FocusingFree f m k s a
    FocusingFree ((a -> b) -> k (Freed f m s) a -> k (Freed f m s) b
    forall a b. (a -> b) -> k (Freed f m s) a -> k (Freed f m s) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f k (Freed f m s) a
    as)
      {-# INLINE fmap #-}

    instance Apply (k (Freed f m s)) => Apply (FocusingFree f m k s) where
      FocusingFree k (Freed f m s) (a -> b)
    kf <.> :: forall a b.
    FocusingFree f m k s (a -> b)
    -> FocusingFree f m k s a -> FocusingFree f m k s b
    <.> FocusingFree k (Freed f m s) a
    ka = k (Freed f m s) b -> FocusingFree f m k s b
    forall (f :: * -> *) (m :: * -> *) (k :: * -> * -> *) s a.
    k (Freed f m s) a -> FocusingFree f m k s a
    FocusingFree (k (Freed f m s) (a -> b)
    kf k (Freed f m s) (a -> b) -> k (Freed f m s) a -> k (Freed f m s) b
    forall a b.
    k (Freed f m s) (a -> b) -> k (Freed f m s) a -> k (Freed f m s) b
    forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
    <.> k (Freed f m s) a
    ka)
      {-# INLINE (<.>) #-}

    instance Applicative (k (Freed f m s)) => Applicative (FocusingFree f m k s) where
      pure :: forall a. a -> FocusingFree f m k s a
    pure = k (Freed f m s) a -> FocusingFree f m k s a
    forall (f :: * -> *) (m :: * -> *) (k :: * -> * -> *) s a.
    k (Freed f m s) a -> FocusingFree f m k s a
    FocusingFree (k (Freed f m s) a -> FocusingFree f m k s a)
    -> (a -> k (Freed f m s) a) -> a -> FocusingFree f m k s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> k (Freed f m s) a
    forall a. a -> k (Freed f m s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      {-# INLINE pure #-}
      FocusingFree k (Freed f m s) (a -> b)
    kf <*> :: forall a b.
    FocusingFree f m k s (a -> b)
    -> FocusingFree f m k s a -> FocusingFree f m k s b
    <*> FocusingFree k (Freed f m s) a
    ka = k (Freed f m s) b -> FocusingFree f m k s b
    forall (f :: * -> *) (m :: * -> *) (k :: * -> * -> *) s a.
    k (Freed f m s) a -> FocusingFree f m k s a
    FocusingFree (k (Freed f m s) (a -> b)
    kf k (Freed f m s) (a -> b) -> k (Freed f m s) a -> k (Freed f m s) b
    forall a b.
    k (Freed f m s) (a -> b) -> k (Freed f m s) a -> k (Freed f m s) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> k (Freed f m s) a
    ka)
      {-# INLINE (<*>) #-}

    -----------------------------------------------------------------------------
    --- Effect
    -------------------------------------------------------------------------------

    -- | Wrap a monadic effect with a phantom type argument.
    newtype Effect m r a = Effect { forall (m :: * -> *) r a. Effect m r a -> m r
    getEffect :: m r }
    -- type role Effect representational nominal phantom

    instance Functor (Effect m r) where
      fmap :: forall a b. (a -> b) -> Effect m r a -> Effect m r b
    fmap a -> b
    _ (Effect m r
    m) = m r -> Effect m r b
    forall (m :: * -> *) r a. m r -> Effect m r a
    Effect m r
    m
      {-# INLINE fmap #-}

    instance Contravariant (Effect m r) where
      contramap :: forall a' a. (a' -> a) -> Effect m r a -> Effect m r a'
    contramap a' -> a
    _ (Effect m r
    m) = m r -> Effect m r a'
    forall (m :: * -> *) r a. m r -> Effect m r a
    Effect m r
    m
      {-# INLINE contramap #-}

    instance (Monad m, Semigroup r) => Semigroup (Effect m r a) where
      Effect m r
    ma <> :: Effect m r a -> Effect m r a -> Effect m r a
    <> Effect m r
    mb = m r -> Effect m r a
    forall (m :: * -> *) r a. m r -> Effect m r a
    Effect ((r -> r -> r) -> m r -> m r -> m r
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 r -> r -> r
    forall a. Semigroup a => a -> a -> a
    (<>) m r
    ma m r
    mb)
      {-# INLINE (<>) #-}

    instance (Monad m, Monoid r) => Monoid (Effect m r a) where
      mempty :: Effect m r a
    mempty = m r -> Effect m r a
    forall (m :: * -> *) r a. m r -> Effect m r a
    Effect (r -> m r
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return r
    forall a. Monoid a => a
    mempty)
      {-# INLINE mempty #-}
    #if !(MIN_VERSION_base(4,11,0))
      Effect ma `mappend` Effect mb = Effect (liftM2 mappend ma mb)
      {-# INLINE mappend #-}
    #endif

    instance (Apply m, Semigroup r) => Apply (Effect m r) where
      Effect m r
    ma <.> :: forall a b. Effect m r (a -> b) -> Effect m r a -> Effect m r b
    <.> Effect m r
    mb = m r -> Effect m r b
    forall (m :: * -> *) r a. m r -> Effect m r a
    Effect ((r -> r -> r) -> m r -> m r -> m r
    forall a b c. (a -> b -> c) -> m a -> m b -> m c
    forall (f :: * -> *) a b c.
    Apply f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftF2 r -> r -> r
    forall a. Semigroup a => a -> a -> a
    (<>) m r
    ma m r
    mb)
      {-# INLINE (<.>) #-}

    instance (Monad m, Monoid r) => Applicative (Effect m r) where
      pure :: forall a. a -> Effect m r a
    pure a
    _ = m r -> Effect m r a
    forall (m :: * -> *) r a. m r -> Effect m r a
    Effect (r -> m r
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return r
    forall a. Monoid a => a
    mempty)
      {-# INLINE pure #-}
      Effect m r
    ma <*> :: forall a b. Effect m r (a -> b) -> Effect m r a -> Effect m r b
    <*> Effect m r
    mb = m r -> Effect m r b
    forall (m :: * -> *) r a. m r -> Effect m r a
    Effect ((r -> r -> r) -> m r -> m r -> m r
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 r -> r -> r
    forall a. Monoid a => a -> a -> a
    mappend m r
    ma m r
    mb)
      {-# INLINE (<*>) #-}

    ------------------------------------------------------------------------------
    -- EffectRWS
    ------------------------------------------------------------------------------

    -- | Wrap a monadic effect with a phantom type argument. Used when magnifying 'Control.Monad.RWS.RWST'.
    newtype EffectRWS w st m s a = EffectRWS { forall w st (m :: * -> *) s a.
    EffectRWS w st m s a -> st -> m (s, st, w)
    getEffectRWS :: st -> m (s,st,w) }

    instance Functor (EffectRWS w st m s) where
      fmap :: forall a b.
    (a -> b) -> EffectRWS w st m s a -> EffectRWS w st m s b
    fmap a -> b
    _ (EffectRWS st -> m (s, st, w)
    m) = (st -> m (s, st, w)) -> EffectRWS w st m s b
    forall w st (m :: * -> *) s a.
    (st -> m (s, st, w)) -> EffectRWS w st m s a
    EffectRWS st -> m (s, st, w)
    m
      {-# INLINE fmap #-}

    instance (Semigroup s, Semigroup w, Bind m) => Apply (EffectRWS w st m s) where
      EffectRWS st -> m (s, st, w)
    m <.> :: forall a b.
    EffectRWS w st m s (a -> b)
    -> EffectRWS w st m s a -> EffectRWS w st m s b
    <.> EffectRWS st -> m (s, st, w)
    n = (st -> m (s, st, w)) -> EffectRWS w st m s b
    forall w st (m :: * -> *) s a.
    (st -> m (s, st, w)) -> EffectRWS w st m s a
    EffectRWS ((st -> m (s, st, w)) -> EffectRWS w st m s b)
    -> (st -> m (s, st, w)) -> EffectRWS w st m s b
    forall a b. (a -> b) -> a -> b
    $ \st
    st -> st -> m (s, st, w)
    m st
    st m (s, st, w) -> ((s, st, w) -> m (s, st, w)) -> m (s, st, w)
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
    >>- \ (s
    s,st
    t,w
    w) -> ((s, st, w) -> (s, st, w)) -> m (s, st, w) -> m (s, st, w)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(s
    s',st
    u,w
    w') -> (s
    s s -> s -> s
    forall a. Semigroup a => a -> a -> a
    <> s
    s', st
    u, w
    w w -> w -> w
    forall a. Semigroup a => a -> a -> a
    <> w
    w')) (st -> m (s, st, w)
    n st
    t)
      {-# INLINE (<.>) #-}

    instance (Monoid s, Monoid w, Monad m) => Applicative (EffectRWS w st m s) where
      pure :: forall a. a -> EffectRWS w st m s a
    pure a
    _ = (st -> m (s, st, w)) -> EffectRWS w st m s a
    forall w st (m :: * -> *) s a.
    (st -> m (s, st, w)) -> EffectRWS w st m s a
    EffectRWS ((st -> m (s, st, w)) -> EffectRWS w st m s a)
    -> (st -> m (s, st, w)) -> EffectRWS w st m s a
    forall a b. (a -> b) -> a -> b
    $ \st
    st -> (s, st, w) -> m (s, st, w)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (s
    forall a. Monoid a => a
    mempty, st
    st, w
    forall a. Monoid a => a
    mempty)
      {-# INLINE pure #-}
      EffectRWS st -> m (s, st, w)
    m <*> :: forall a b.
    EffectRWS w st m s (a -> b)
    -> EffectRWS w st m s a -> EffectRWS w st m s b
    <*> EffectRWS st -> m (s, st, w)
    n = (st -> m (s, st, w)) -> EffectRWS w st m s b
    forall w st (m :: * -> *) s a.
    (st -> m (s, st, w)) -> EffectRWS w st m s a
    EffectRWS ((st -> m (s, st, w)) -> EffectRWS w st m s b)
    -> (st -> m (s, st, w)) -> EffectRWS w st m s b
    forall a b. (a -> b) -> a -> b
    $ \st
    st -> st -> m (s, st, w)
    m st
    st m (s, st, w) -> ((s, st, w) -> m (s, st, w)) -> m (s, st, w)
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ (s
    s,st
    t,w
    w) -> st -> m (s, st, w)
    n st
    t m (s, st, w) -> ((s, st, w) -> m (s, st, w)) -> m (s, st, w)
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ (s
    s',st
    u,w
    w') -> (s, st, w) -> m (s, st, w)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (s -> s -> s
    forall a. Monoid a => a -> a -> a
    mappend s
    s s
    s', st
    u, w -> w -> w
    forall a. Monoid a => a -> a -> a
    mappend w
    w w
    w')
      {-# INLINE (<*>) #-}

    instance Contravariant (EffectRWS w st m s) where
      contramap :: forall a' a.
    (a' -> a) -> EffectRWS w st m s a -> EffectRWS w st m s a'
    contramap a' -> a
    _ (EffectRWS st -> m (s, st, w)
    m) = (st -> m (s, st, w)) -> EffectRWS w st m s a'
    forall w st (m :: * -> *) s a.
    (st -> m (s, st, w)) -> EffectRWS w st m s a
    EffectRWS st -> m (s, st, w)
    m
      {-# INLINE contramap #-}