    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE FunctionalDependencies #-}
    #ifdef TRUSTWORTHY
    {-# LANGUAGE Trustworthy #-}
    #endif
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Lens.Internal.Action
    -- Copyright   :  (C) 2012-2014 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  provisional
    -- Portability :  non-portable
    --
    ----------------------------------------------------------------------------
    module Control.Lens.Action.Internal
      (
      -- ** Actions
        Effective(..)
      , Effect(..)
      ) where

    import Control.Applicative
    import Control.Applicative.Backwards
    import Control.Monad
    import Data.Functor.Bind
    import Data.Functor.Contravariant
    import Data.Functor.Identity
    import Data.Profunctor.Unsafe
    import Data.Semigroup

    import Control.Lens.Internal.Getter

    -------------------------------------------------------------------------------
    -- Programming with Effects
    -------------------------------------------------------------------------------

    -- | An 'Effective' 'Functor' ignores its argument and is isomorphic to a 'Monad' wrapped around a value.
    --
    -- That said, the 'Monad' is possibly rather unrelated to any 'Applicative' structure.
    class (Monad m, Functor f, Contravariant f) => Effective m r f | f -> m r where
      effective :: m r -> f a
      ineffective :: f a -> m r

    instance Effective m r f => Effective m (Dual r) (Backwards f) where
      effective :: m (Dual r) -> Backwards f a
    effective = f a -> Backwards f a
    forall k (f :: k -> *) (a :: k). f a -> Backwards f a
    Backwards (f a -> Backwards f a)
    -> (m (Dual r) -> f a) -> m (Dual r) -> Backwards f a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m r -> f a
    forall (m :: * -> *) r (f :: * -> *) a.
    Effective m r f =>
    m r -> f a
    effective (m r -> f a) -> (m (Dual r) -> m r) -> m (Dual r) -> f a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Dual r -> r) -> m (Dual r) -> m r
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Dual r -> r
    forall a. Dual a -> a
    getDual
      {-# INLINE effective #-}
      ineffective :: Backwards f a -> m (Dual r)
    ineffective = (r -> Dual r) -> m r -> m (Dual r)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM r -> Dual r
    forall a. a -> Dual a
    Dual (m r -> m (Dual r))
    -> (Backwards f a -> m r) -> Backwards f a -> m (Dual r)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f a -> m r
    forall (m :: * -> *) r (f :: * -> *) a.
    Effective m r f =>
    f a -> m r
    ineffective (f a -> m r) -> (Backwards f a -> f a) -> Backwards f a -> m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Backwards f a -> f a
    forall k (f :: k -> *) (a :: k). Backwards f a -> f a
    forwards
      {-# INLINE ineffective #-}

    instance Effective Identity r (Const r) where
      effective :: Identity r -> Const r a
    effective = r -> Const r a
    forall k a (b :: k). a -> Const a b
    Const (r -> Const r a) -> (Identity r -> r) -> Identity r -> Const r a
    forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
    (Profunctor p, Coercible c b) =>
    q b c -> p a b -> p a c
    #. Identity r -> r
    forall a. Identity a -> a
    runIdentity
      {-# INLINE effective #-}
      ineffective :: Const r a -> Identity r
    ineffective = r -> Identity r
    forall a. a -> Identity a
    Identity (r -> Identity r) -> (Const r a -> r) -> Const r a -> Identity r
    forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
    (Profunctor p, Coercible c b) =>
    q b c -> p a b -> p a c
    #. Const r a -> r
    forall a k (b :: k). Const a b -> a
    getConst
      {-# INLINE ineffective #-}

    instance Effective m r f => Effective m r (AlongsideLeft f b) where
      effective :: m r -> AlongsideLeft f b a
    effective = f (a, b) -> AlongsideLeft f b a
    forall (f :: * -> *) b a. f (a, b) -> AlongsideLeft f b a
    AlongsideLeft (f (a, b) -> AlongsideLeft f b a)
    -> (m r -> f (a, b)) -> m r -> AlongsideLeft f b a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m r -> f (a, b)
    forall (m :: * -> *) r (f :: * -> *) a.
    Effective m r f =>
    m r -> f a
    effective
      {-# INLINE effective #-}
      ineffective :: AlongsideLeft f b a -> m r
    ineffective = f (a, b) -> m r
    forall (m :: * -> *) r (f :: * -> *) a.
    Effective m r f =>
    f a -> m r
    ineffective (f (a, b) -> m r)
    -> (AlongsideLeft f b a -> f (a, b)) -> AlongsideLeft f b a -> m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AlongsideLeft f b a -> f (a, b)
    forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
    getAlongsideLeft
      {-# INLINE ineffective #-}

    instance Effective m r f => Effective m r (AlongsideRight f b) where
      effective :: m r -> AlongsideRight f b a
    effective = f (b, a) -> AlongsideRight f b a
    forall (f :: * -> *) a b. f (a, b) -> AlongsideRight f a b
    AlongsideRight (f (b, a) -> AlongsideRight f b a)
    -> (m r -> f (b, a)) -> m r -> AlongsideRight f b a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m r -> f (b, a)
    forall (m :: * -> *) r (f :: * -> *) a.
    Effective m r f =>
    m r -> f a
    effective
      {-# INLINE effective #-}
      ineffective :: AlongsideRight f b a -> m r
    ineffective = f (b, a) -> m r
    forall (m :: * -> *) r (f :: * -> *) a.
    Effective m r f =>
    f a -> m r
    ineffective (f (b, a) -> m r)
    -> (AlongsideRight f b a -> f (b, a))
    -> AlongsideRight f b a
    -> m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AlongsideRight f b a -> f (b, a)
    forall (f :: * -> *) a b. AlongsideRight f a b -> f (a, b)
    getAlongsideRight
      {-# INLINE ineffective #-}

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

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

    instance Functor (Effect m r) where
      fmap :: (a -> b) -> Effect m r a -> Effect m r b
    fmap _ (Effect m :: 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 :: (a -> b) -> Effect m r b -> Effect m r a
    contramap _ (Effect m :: 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 => Effective m r (Effect m r) where
      effective :: m r -> Effect m r a
    effective = m r -> Effect m r a
    forall (m :: * -> *) r a. m r -> Effect m r a
    Effect
      {-# INLINE effective #-}
      ineffective :: Effect m r a -> m r
    ineffective = Effect m r a -> m r
    forall (m :: * -> *) r a. Effect m r a -> m r
    getEffect
      {-# INLINE ineffective #-}

    instance (Apply m, Semigroup r) => Semigroup (Effect m r a) where
      Effect ma :: m r
    ma <> :: Effect m r a -> Effect m r a -> Effect m r a
    <> Effect mb :: 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 (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 (Apply m, 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 (m :: * -> *) a. Monad m => a -> m a
    return r
    forall a. Monoid a => a
    mempty)
      {-# INLINE mempty #-}
      Effect ma :: m r
    ma mappend :: Effect m r a -> Effect m r a -> Effect m r a
    `mappend` Effect mb :: 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. Monoid a => a -> a -> a
    mappend m r
    ma m r
    mb)
      {-# INLINE mappend #-}

    instance (Apply m, Semigroup r) => Apply (Effect m r) where
      Effect ma :: m r
    ma <.> :: Effect m r (a -> b) -> Effect m r a -> Effect m r b
    <.> Effect mb :: 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 (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 :: a -> Effect m r a
    pure _ = m r -> Effect m r a
    forall (m :: * -> *) r a. m r -> Effect m r a
    Effect (r -> m r
    forall (m :: * -> *) a. Monad m => a -> m a
    return r
    forall a. Monoid a => a
    mempty)
      {-# INLINE pure #-}
      Effect ma :: m r
    ma <*> :: Effect m r (a -> b) -> Effect m r a -> Effect m r b
    <*> Effect mb :: 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 (<*>) #-}