    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Lens.Action
    -- Copyright   :  (C) 2012-13 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    ----------------------------------------------------------------------------
    module Control.Lens.Action
      (
      -- * Composable Actions
        Action
      , act
      , acts
      , perform
      , performs
      , liftAct
      , (^!)
      , (^!!)
      , (^!?)

      -- * Indexed Actions
      , IndexedAction
      , iact
      , iperform
      , iperforms
      , (^@!)
      , (^@!!)
      , (^@!?)

      -- * Folds with Effects
      , MonadicFold
      , IndexedMonadicFold

      -- * Implementation Details
      , Acting
      , IndexedActing
      , Effective
      ) where

    import Control.Comonad
    import Control.Lens.Internal.Action
    import Control.Lens.Internal.Fold
    import Control.Lens.Internal.Indexed
    import Control.Lens.Type
    import Control.Monad (liftM)
    import Control.Monad.Trans.Class
    import Data.Profunctor
    import Data.Profunctor.Rep
    import Data.Profunctor.Unsafe

    -- $setup
    -- >>> :set -XNoOverloadedStrings
    -- >>> import Control.Lens

    infixr 8 ^!, ^!!, ^@!, ^@!!, ^!?, ^@!?

    -- | Used to evaluate an 'Action'.
    type Acting m r s t a b = LensLike (Effect m r) s t a b

    -- | Perform an 'Action'.
    --
    -- @
    -- 'perform' ≡ 'flip' ('^!')
    -- @
    perform :: Monad m => Acting m a s t a b -> s -> m a
    perform l = getEffect #. l (Effect #. return)
    {-# INLINE perform #-}

    -- | Perform an 'Action' and modify the result.
    --
    -- @
    -- 'performs' :: 'Monad' m => 'Acting' m e s t a b -> (a -> e) -> s -> m e
    -- @
    performs :: (Profunctor p, Monad m) => Over p (Effect m e) s t a b -> p a e -> s -> m e
    performs l f = getEffect #. l (rmap (Effect #. return) f)
    {-# INLINE performs #-}

    -- | Perform an 'Action'.
    --
    -- >>> ["hello","world"]^!folded.act putStrLn
    -- hello
    -- world
    (^!) :: Monad m => s -> Acting m a s t a b -> m a
    a ^! l = getEffect (l (Effect #. return) a)
    {-# INLINE (^!) #-}

    -- | Perform a 'MonadicFold' and collect all of the results in a list.
    --
    -- >>> ["ab","cd","ef"]^!!folded.acts
    -- ["ace","acf","ade","adf","bce","bcf","bde","bdf"]
    (^!!) :: Monad m => s -> Acting m [a] s t a b -> m [a]
    a ^!! l = getEffect (l (Effect #. return . return) a)
    {-# INLINE (^!!) #-}

    -- | Perform a 'MonadicFold' and collect the leftmost result.
    --
    -- /Note:/ this still causes all effects for all elements.
    --
    -- >>> [Just 1, Just 2, Just 3]^!?folded.acts
    -- Just (Just 1)
    -- >>> [Just 1, Nothing]^!?folded.acts
    -- Nothing
    (^!?) :: Monad m => s -> Acting m (Leftmost a) s t a b -> m (Maybe a)
    a ^!?  l = liftM getLeftmost .# getEffect $ l (Effect #. return . LLeaf) a
    {-# INLINE (^!?) #-}

    -- | Construct an 'Action' from a monadic side-effect.
    --
    -- >>> ["hello","world"]^!folded.act (\x -> [x,x ++ "!"])
    -- ["helloworld","helloworld!","hello!world","hello!world!"]
    --
    -- @
    -- 'act' :: 'Monad' m => (s -> m a) -> 'Action' m s a
    -- 'act' sma afb a = 'effective' (sma a '>>=' 'ineffective' '.' afb)
    -- @
    act :: Monad m => (s -> m a) -> IndexPreservingAction m s a
    act sma pafb = cotabulate $ \ws -> effective $ do
       a <- sma (extract ws)
       ineffective (corep pafb (a <$ ws))
    {-# INLINE act #-}

    -- | A self-running 'Action', analogous to 'Control.Monad.join'.
    --
    -- @
    -- 'acts' ≡ 'act' 'id'
    -- @
    --
    -- >>> (1,"hello")^!_2.acts.to succ
    -- "ifmmp"
    acts :: Action m (m a) a
    acts = act id
    {-# INLINE acts #-}

    -- | Apply a 'Monad' transformer to an 'Action'.
    liftAct :: (MonadTrans trans, Monad m) => Acting m a s t a b -> Action (trans m) s a
    liftAct l = act (lift . perform l)
    {-# INLINE liftAct #-}

    -----------------------------------------------------------------------------
    -- Indexed Actions
    ----------------------------------------------------------------------------

    -- | Used to evaluate an 'IndexedAction'.
    type IndexedActing i m r s t a b = Over (Indexed i) (Effect m r) s t a b

    -- | Perform an 'IndexedAction'.
    --
    -- @
    -- 'iperform' ≡ 'flip' ('^@!')
    -- @
    iperform :: Monad m => IndexedActing i m (i, a) s t a b -> s -> m (i, a)
    iperform l = getEffect #. l (Indexed $ \i a -> Effect (return (i, a)))
    {-# INLINE iperform #-}

    -- | Perform an 'IndexedAction' and modify the result.
    iperforms :: Monad m => IndexedActing i m e s t a b -> (i -> a -> e) -> s -> m e
    iperforms l = performs l .# Indexed
    {-# INLINE iperforms #-}

    -- | Perform an 'IndexedAction'.
    (^@!) :: Monad m => s -> IndexedActing i m (i, a) s t a b -> m (i, a)
    s ^@! l = getEffect (l (Indexed $ \i a -> Effect (return (i, a))) s)
    {-# INLINE (^@!) #-}

    -- | Obtain a list of all of the results of an 'IndexedMonadicFold'.
    (^@!!) :: Monad m => s -> IndexedActing i m [(i, a)] s t a b -> m [(i, a)]
    s ^@!! l = getEffect (l (Indexed $ \i a -> Effect (return [(i, a)])) s)
    {-# INLINE (^@!!) #-}

    -- | Perform an 'IndexedMonadicFold' and collect the 'Leftmost' result.
    --
    -- /Note:/ this still causes all effects for all elements.
    (^@!?) :: Monad m => s -> IndexedActing i m (Leftmost (i, a)) s t a b -> m (Maybe (i, a))
    a ^@!?  l = liftM getLeftmost .# getEffect $ l (Indexed $ \i -> Effect #. return . LLeaf . (,) i) a
    {-# INLINE (^@!?) #-}

    -- | Construct an 'IndexedAction' from a monadic side-effect.
    iact :: Monad m => (s -> m (i, a)) -> IndexedAction i m s a
    iact smia iafb s = effective $ do
      (i, a) <- smia s
      ineffective (indexed iafb i a)
    {-# INLINE iact #-}