# LANGUAGE CPP #
{-# LANGUAGE Rank2Types #-}
# LANGUAGE FlexibleContexts #
# LANGUAGE MultiParamTypeClasses #
#ifdef TRUSTWORTHY
# LANGUAGE Trustworthy #
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Lens.Action
  Copyright    :   ( C ) 2012 - 14  
-- License     :  BSD-style (see the file LICENSE)
  Maintainer   :     <  >
-- 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.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.Sieve
import Data.Profunctor.Unsafe

import Control.Lens.Action.Internal
import Control.Lens.Action.Type

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

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

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

-- | Perform an 'Action'.
--
-- @
-- 'perform' ≡ 'flip' ('^!')
-- @
perform :: Monad m => Acting m a s a -> 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 a -> (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 a -> 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"]
--
-- @
  > [ 1,2]^!!folded.act ( \i - > putStr ( show i + + " : " ) > > getLine).each.to succ
  1 : aa
  2 : bb
-- "bbcc"
-- @
(^!!) :: Monad m => s -> Acting m [a] s a -> 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 a -> 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 (cosieve pafb (a <$ ws))
# INLINE act #

-- | A self-running 'Action', analogous to 'Control.Monad.join'.
--
-- @
-- 'acts' ≡ 'act' 'id'
-- @
--
  > > > ( 1,"hello")^!_2.acts.to succ
-- "ifmmp"
--
-- @
  > ( 1,getLine)^!!_2.acts.folded.to succ
-- aa
-- "bb"
-- @
acts :: IndexPreservingAction 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 a -> IndexPreservingAction (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 a = Over (Indexed i) (Effect m r) s s a a

-- | Perform an 'IndexedAction'.
--
-- @
  ' iperform ' ≡ ' flip ' ( ' ^@ ! ' )
-- @
iperform :: Monad m => IndexedActing i m (i, a) s a -> 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 a -> (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 a -> 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 a -> 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 a -> 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 #

# LANGUAGE Rank2Types #
---------------------------------------------------------------------------
 |
 Module      :  Control.Lens.Action
 License     :  BSD-style (see the file LICENSE)
 Stability   :  experimental
 Portability :  non-portable

--------------------------------------------------------------------------
 * Composable Actions
 * Indexed Actions
 * Folds with Effects
 * Implementation Details
 $setup
 >>> :set -XNoOverloadedStrings
 | Used to evaluate an 'Action'.
 | Perform an 'Action'.

 @
 'perform' ≡ 'flip' ('^!')
 @
 | Perform an 'Action' and modify the result.

 @
 'performs' :: 'Monad' m => 'Acting' m e s a -> (a -> e) -> s -> m e
 @
 | Perform an 'Action'.

 >>> ["hello","world"]^!folded.act putStrLn
 hello
 world
# INLINE (^!) #

 >>> ["ab","cd","ef"]^!!folded.acts
 ["ace","acf","ade","adf","bce","bcf","bde","bdf"]

 @
 "bbcc"
 @
# INLINE (^!!) #

 /Note:/ this still causes all effects for all elements.

 Just (Just 1)
 Nothing
# 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)
 @
 | A self-running 'Action', analogous to 'Control.Monad.join'.

 @
 'acts' ≡ 'act' 'id'
 @

 "ifmmp"

 @
 aa
 "bb"
 @
 | Apply a 'Monad' transformer to an 'Action'.
---------------------------------------------------------------------------
 Indexed Actions
--------------------------------------------------------------------------
 | Used to evaluate an 'IndexedAction'.
 | Perform an 'IndexedAction'.

 @
 @
 | Perform an 'IndexedAction' and modify the result.
 | Perform an 'IndexedAction'.
 | Obtain a list of all of the results of an 'IndexedMonadicFold'.
 | Perform an 'IndexedMonadicFold' and collect the 'Leftmost' result.

 /Note:/ this still causes all effects for all elements.
 | Construct an 'IndexedAction' from a monadic side-effect.
# LANGUAGE CPP #
# LANGUAGE FlexibleContexts #
# LANGUAGE MultiParamTypeClasses #
#ifdef TRUSTWORTHY
# LANGUAGE Trustworthy #
#endif
  Copyright    :   ( C ) 2012 - 14  
  Maintainer   :     <  >
module Control.Lens.Action
  (
    Action
  , act
  , acts
  , perform
  , performs
  , liftAct
  , (^!)
  , (^!!)
  , (^!?)

  , IndexedAction
  , iact
  , iperform
  , iperforms
  , (^@!)
  , (^@!!)
  , (^@!?)

  , MonadicFold
  , IndexedMonadicFold

  , Acting
  , IndexedActing
  , Effective
  ) where

import Control.Comonad
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.Sieve
import Data.Profunctor.Unsafe

import Control.Lens.Action.Internal
import Control.Lens.Action.Type

  > > > import Control . Lens

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

type Acting m r s a = LensLike (Effect m r) s s a a

perform :: Monad m => Acting m a s a -> s -> m a
perform l = getEffect #. l (Effect #. return)
# INLINE perform #

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 #

(^!) :: Monad m => s -> Acting m a s a -> m a
a ^! l = getEffect (l (Effect #. return) a)

  | Perform a ' MonadicFold ' and collect all of the results in a list .
  > [ 1,2]^!!folded.act ( \i - > putStr ( show i + + " : " ) > > getLine).each.to succ
  1 : aa
  2 : bb
(^!!) :: Monad m => s -> Acting m [a] s a -> m [a]
a ^!! l = getEffect (l (Effect #. return . return) a)

  | Perform a ' MonadicFold ' and collect the leftmost result .
  > > > [ Just 1 , Just 2 , Just 3]^!?folded.acts
  > > > [ Just 1 , Nothing]^!?folded.acts
(^!?) :: Monad m => s -> Acting m (Leftmost a) s a -> m (Maybe a)
a ^!?  l = liftM getLeftmost .# getEffect $ l (Effect #. return . LLeaf) a

act :: Monad m => (s -> m a) -> IndexPreservingAction m s a
act sma pafb = cotabulate $ \ws -> effective $ do
   a <- sma (extract ws)
   ineffective (cosieve pafb (a <$ ws))
# INLINE act #

  > > > ( 1,"hello")^!_2.acts.to succ
  > ( 1,getLine)^!!_2.acts.folded.to succ
acts :: IndexPreservingAction m (m a) a
acts = act id
# INLINE acts #

liftAct :: (MonadTrans trans, Monad m) => Acting m a s a -> IndexPreservingAction (trans m) s a
liftAct l = act (lift . perform l)
# INLINE liftAct #


type IndexedActing i m r s a = Over (Indexed i) (Effect m r) s s a a

  ' iperform ' ≡ ' flip ' ( ' ^@ ! ' )
iperform :: Monad m => IndexedActing i m (i, a) s a -> s -> m (i, a)
iperform l = getEffect #. l (Indexed $ \i a -> Effect (return (i, a)))
# INLINE iperform #

iperforms :: Monad m => IndexedActing i m e s a -> (i -> a -> e) -> s -> m e
iperforms l = performs l .# Indexed
# INLINE iperforms #

(^@!) :: Monad m => s -> IndexedActing i m (i, a) s a -> m (i, a)
s ^@! l = getEffect (l (Indexed $ \i a -> Effect (return (i, a))) s)
# INLINE ( ^@ ! ) #

(^@!!) :: Monad m => s -> IndexedActing i m [(i, a)] s a -> m [(i, a)]
s ^@!! l = getEffect (l (Indexed $ \i a -> Effect (return [(i, a)])) s)
# INLINE ( ^@ ! ! ) #

(^@!?) :: Monad m => s -> IndexedActing i m (Leftmost (i, a)) s a -> m (Maybe (i, a))
a ^@!?  l = liftM getLeftmost .# getEffect $ l (Indexed $ \i -> Effect #. return . LLeaf . (,) i) a
# INLINE ( ^@ ! ? ) #

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 #
