{-# LANGUAGE CPP #-}
-- |
-- Copyright  : (c) Ivan Perez and Manuel Baerenz, 2016
-- License    : BSD3
-- Maintainer : ivan.perez@keera.co.uk
--
-- 'MSF's with a 'State' monadic layer.
--
-- This module contains functions to work with 'MSF's that include a 'State'
-- monadic layer. This includes functions to create new 'MSF's that include an
-- additional layer, and functions to flatten that layer out of the 'MSF`'s
-- transformer stack.
--
-- It is based on the _strict_ state monad 'Control.Monad.Trans.State.Strict',
-- so when combining it with other modules such as @mtl@'s,
-- the strict version has to be included, i.e. 'Control.Monad.State.Strict'
-- instead of 'Control.Monad.State' or 'Control.Monad.State.Lazy'.
module Control.Monad.Trans.MSF.State
    ( module Control.Monad.Trans.State.Strict
    -- * 'State' 'MSF' running and wrapping
    , stateS
    , runStateS
    , runStateS_
    , runStateS__
    )
  where

-- External imports
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif

import Control.Arrow                    (arr, (>>>))
import Control.Monad.Trans.State.Strict hiding (liftCallCC, liftCatch,
                                         liftListen, liftPass)
import Data.Tuple                       (swap)

-- Internal imports
import Data.MonadicStreamFunction.Core (MSF, morphGS, feedback)

-- * 'State' 'MSF' running and wrapping

-- | Build an 'MSF' in the 'State' monad from one that takes the state as an
-- extra input. This is the opposite of 'runStateS'.
stateS :: (Functor m, Monad m) => MSF m (s, a) (s, b) -> MSF (StateT s m) a b
stateS :: forall (m :: * -> *) s a b.
(Functor m, Monad m) =>
MSF m (s, a) (s, b) -> MSF (StateT s m) a b
stateS = (forall c. ((s, a) -> m ((s, b), c)) -> a -> StateT s m (b, c))
-> MSF m (s, a) (s, b) -> MSF (StateT s m) a b
forall (m2 :: * -> *) a1 (m1 :: * -> *) b1 a2 b2.
Monad m2 =>
(forall c. (a1 -> m1 (b1, c)) -> a2 -> m2 (b2, c))
-> MSF m1 a1 b1 -> MSF m2 a2 b2
morphGS ((forall c. ((s, a) -> m ((s, b), c)) -> a -> StateT s m (b, c))
 -> MSF m (s, a) (s, b) -> MSF (StateT s m) a b)
-> (forall c. ((s, a) -> m ((s, b), c)) -> a -> StateT s m (b, c))
-> MSF m (s, a) (s, b)
-> MSF (StateT s m) a b
forall a b. (a -> b) -> a -> b
$ \(s, a) -> m ((s, b), c)
f a
a -> (s -> m ((b, c), s)) -> StateT s m (b, c)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m ((b, c), s)) -> StateT s m (b, c))
-> (s -> m ((b, c), s)) -> StateT s m (b, c)
forall a b. (a -> b) -> a -> b
$ \s
s -> (\((s
s', b
b), c
c) -> ((b
b, c
c), s
s'))
     (((s, b), c) -> ((b, c), s)) -> m ((s, b), c) -> m ((b, c), s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (s, a) -> m ((s, b), c)
f (s
s, a
a)

-- | Build an 'MSF' that takes a state as an extra input from one on the
-- 'State' monad. This is the opposite of 'stateS'.
runStateS :: (Functor m, Monad m) => MSF (StateT s m) a b -> MSF m (s, a) (s, b)
runStateS :: forall (m :: * -> *) s a b.
(Functor m, Monad m) =>
MSF (StateT s m) a b -> MSF m (s, a) (s, b)
runStateS = (forall c. (a -> StateT s m (b, c)) -> (s, a) -> m ((s, b), c))
-> MSF (StateT s m) a b -> MSF m (s, a) (s, b)
forall (m2 :: * -> *) a1 (m1 :: * -> *) b1 a2 b2.
Monad m2 =>
(forall c. (a1 -> m1 (b1, c)) -> a2 -> m2 (b2, c))
-> MSF m1 a1 b1 -> MSF m2 a2 b2
morphGS ((forall c. (a -> StateT s m (b, c)) -> (s, a) -> m ((s, b), c))
 -> MSF (StateT s m) a b -> MSF m (s, a) (s, b))
-> (forall c. (a -> StateT s m (b, c)) -> (s, a) -> m ((s, b), c))
-> MSF (StateT s m) a b
-> MSF m (s, a) (s, b)
forall a b. (a -> b) -> a -> b
$ \a -> StateT s m (b, c)
f (s
s, a
a) -> (\((b
b, c
c), s
s') -> ((s
s', b
b), c
c))
        (((b, c), s) -> ((s, b), c)) -> m ((b, c), s) -> m ((s, b), c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT s m (b, c) -> s -> m ((b, c), s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (a -> StateT s m (b, c)
f a
a) s
s

-- | Build an 'MSF' /function/ that takes a fixed state as additional input,
-- from an 'MSF' in the 'State' monad, and outputs the new state with every
-- transformation step.
runStateS_ :: (Functor m, Monad m)
           => MSF (StateT s m) a b
           -> s
           -> MSF m a (s, b)
runStateS_ :: forall (m :: * -> *) s a b.
(Functor m, Monad m) =>
MSF (StateT s m) a b -> s -> MSF m a (s, b)
runStateS_ MSF (StateT s m) a b
msf s
s =
  s -> MSF m (a, s) ((s, b), s) -> MSF m a (s, b)
forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback s
s (MSF m (a, s) ((s, b), s) -> MSF m a (s, b))
-> MSF m (a, s) ((s, b), s) -> MSF m a (s, b)
forall a b. (a -> b) -> a -> b
$
    ((a, s) -> (s, a)) -> MSF m (a, s) (s, a)
forall b c. (b -> c) -> MSF m b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (a, s) -> (s, a)
forall a b. (a, b) -> (b, a)
swap MSF m (a, s) (s, a)
-> MSF m (s, a) ((s, b), s) -> MSF m (a, s) ((s, b), s)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> MSF (StateT s m) a b -> MSF m (s, a) (s, b)
forall (m :: * -> *) s a b.
(Functor m, Monad m) =>
MSF (StateT s m) a b -> MSF m (s, a) (s, b)
runStateS MSF (StateT s m) a b
msf MSF m (s, a) (s, b)
-> MSF m (s, b) ((s, b), s) -> MSF m (s, a) ((s, b), s)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((s, b) -> ((s, b), s)) -> MSF m (s, b) ((s, b), s)
forall b c. (b -> c) -> MSF m b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(s
s', b
b) -> ((s
s', b
b), s
s'))

-- | Build an 'MSF' /function/ that takes a fixed state as additional input,
-- from an 'MSF' in the 'State' monad.
runStateS__ :: (Functor m, Monad m) => MSF (StateT s m) a b -> s -> MSF m a b
runStateS__ :: forall (m :: * -> *) s a b.
(Functor m, Monad m) =>
MSF (StateT s m) a b -> s -> MSF m a b
runStateS__ MSF (StateT s m) a b
msf s
s = MSF (StateT s m) a b -> s -> MSF m a (s, b)
forall (m :: * -> *) s a b.
(Functor m, Monad m) =>
MSF (StateT s m) a b -> s -> MSF m a (s, b)
runStateS_ MSF (StateT s m) a b
msf s
s MSF m a (s, b) -> MSF m (s, b) b -> MSF m a b
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((s, b) -> b) -> MSF m (s, b) b
forall b c. (b -> c) -> MSF m b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (s, b) -> b
forall a b. (a, b) -> b
snd