{-# LANGUAGE CPP #-}
-- The following warning id disabled so that we do not see warnings during
-- compilation caused by the intentional use of ListT.
#if __GLASGOW_HASKELL__ < 800
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
#else
{-# OPTIONS_GHC -Wno-deprecations #-}
#endif
-- |
-- Copyright  : (c) Ivan Perez and Manuel Baerenz, 2016
-- License    : BSD3
-- Maintainer : ivan.perez@keera.co.uk
--
-- 'MSF's with a list monadic layer.
--
-- This module contains functions to work with MSFs that include a 'ListT'
-- monadic layer. MSFs on a list monad may produce multiple outputs and
-- continuations, or none. This enables the possibility for spawning new MSFs,
-- or stopping MSFs, at will.
--
-- A common use case is to be able to dynamically spawn new interactive
-- elements in applications (e.g., a game object that splits in two, or that
-- fires to an enemy).
--
-- WARNING: the ListT transformer is considered dangerous, and imposes
-- additional constraints on the inner monad in order for the combination of
-- the monad and the transformer to be a monad. Use at your own risk.
module Control.Monad.Trans.MSF.List
    ( module Control.Monad.Trans.MSF.List
    , module List
    )
  where

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

#ifdef LIST_TRANSFORMER
import           Control.Monad    (sequence)
import           List.Transformer (ListT (ListT, next), Step (..), fold, select)
import qualified List.Transformer as List
#else
import Control.Monad.Trans.List as List hiding (liftCallCC, liftCatch)
#endif

-- Internal imports
import Data.MonadicStreamFunction.InternalCore (MSF (MSF, unMSF))

-- * List monad

#ifdef LIST_TRANSFORMER

-- | Run an 'MSF' in the 'ListT' transformer (i.e., multiple MSFs producing
-- each producing one output), by applying the input stream to each MSF in the
-- list transformer and concatenating the outputs of the MSFs together.
--
-- An MSF in the ListT transformer can spawn into more than one MSF, or none,
-- so the outputs produced at each individual step are not guaranteed to all
-- have the same length.
widthFirst :: (Functor m, Monad m) => MSF (ListT m) a b -> MSF m a [b]
widthFirst :: forall (m :: * -> *) a b.
(Functor m, Monad m) =>
MSF (ListT m) a b -> MSF m a [b]
widthFirst MSF (ListT m) a b
msf = [MSF (ListT m) a b] -> MSF m a [b]
forall {m :: * -> *} {b} {a}.
Monad m =>
[MSF (ListT m) b a] -> MSF m b [a]
widthFirst' [MSF (ListT m) a b
msf]
  where
    widthFirst' :: [MSF (ListT m) b a] -> MSF m b [a]
widthFirst' [MSF (ListT m) b a]
msfs = (b -> m ([a], MSF m b [a])) -> MSF m b [a]
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((b -> m ([a], MSF m b [a])) -> MSF m b [a])
-> (b -> m ([a], MSF m b [a])) -> MSF m b [a]
forall a b. (a -> b) -> a -> b
$ \b
a -> do
      ([a]
bs, [MSF (ListT m) b a]
msfs') <- [(a, MSF (ListT m) b a)] -> ([a], [MSF (ListT m) b a])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(a, MSF (ListT m) b a)] -> ([a], [MSF (ListT m) b a]))
-> ([[(a, MSF (ListT m) b a)]] -> [(a, MSF (ListT m) b a)])
-> [[(a, MSF (ListT m) b a)]]
-> ([a], [MSF (ListT m) b a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(a, MSF (ListT m) b a)]] -> [(a, MSF (ListT m) b a)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(a, MSF (ListT m) b a)]] -> ([a], [MSF (ListT m) b a]))
-> m [[(a, MSF (ListT m) b a)]] -> m ([a], [MSF (ListT m) b a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MSF (ListT m) b a -> m [(a, MSF (ListT m) b a)])
-> [MSF (ListT m) b a] -> m [[(a, MSF (ListT m) b a)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ListT m (a, MSF (ListT m) b a) -> m [(a, MSF (ListT m) b a)]
forall (m :: * -> *) a. (Functor m, Monad m) => ListT m a -> m [a]
toList (ListT m (a, MSF (ListT m) b a) -> m [(a, MSF (ListT m) b a)])
-> (MSF (ListT m) b a -> ListT m (a, MSF (ListT m) b a))
-> MSF (ListT m) b a
-> m [(a, MSF (ListT m) b a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MSF (ListT m) b a -> b -> ListT m (a, MSF (ListT m) b a))
-> b -> MSF (ListT m) b a -> ListT m (a, MSF (ListT m) b a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip MSF (ListT m) b a -> b -> ListT m (a, MSF (ListT m) b a)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF b
a) [MSF (ListT m) b a]
msfs
      ([a], MSF m b [a]) -> m ([a], MSF m b [a])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
bs, [MSF (ListT m) b a] -> MSF m b [a]
widthFirst' [MSF (ListT m) b a]
msfs')

    toList :: (Functor m, Monad m) => ListT m a -> m [a]
    toList :: forall (m :: * -> *) a. (Functor m, Monad m) => ListT m a -> m [a]
toList = ([a] -> [a]) -> m [a] -> m [a]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. [a] -> [a]
reverse (m [a] -> m [a]) -> (ListT m a -> m [a]) -> ListT m a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> a -> [a]) -> [a] -> ([a] -> [a]) -> ListT m a -> m [a]
forall (m :: * -> *) x a b.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> ListT m a -> m b
fold ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [a] -> [a]
forall a. a -> a
id

-- | Build an 'MSF' in the 'ListT' transformer by broadcasting the input stream
-- value to each MSF in a given list.
sequenceS :: Monad m => [MSF m a b] -> MSF (ListT m) a b
sequenceS :: forall (m :: * -> *) a b.
Monad m =>
[MSF m a b] -> MSF (ListT m) a b
sequenceS [MSF m a b]
msfs = (a -> ListT m (b, MSF (ListT m) a b)) -> MSF (ListT m) a b
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((a -> ListT m (b, MSF (ListT m) a b)) -> MSF (ListT m) a b)
-> (a -> ListT m (b, MSF (ListT m) a b)) -> MSF (ListT m) a b
forall a b. (a -> b) -> a -> b
$ \a
a -> [m (b, MSF (ListT m) a b)] -> ListT m (b, MSF (ListT m) a b)
forall (m :: * -> *) a. Monad m => [m a] -> ListT m a
sequence' ([m (b, MSF (ListT m) a b)] -> ListT m (b, MSF (ListT m) a b))
-> [m (b, MSF (ListT m) a b)] -> ListT m (b, MSF (ListT m) a b)
forall a b. (a -> b) -> a -> b
$ a -> MSF m a b -> m (b, MSF (ListT m) a b)
forall (m :: * -> *) a b.
Monad m =>
a -> MSF m a b -> m (b, MSF (ListT m) a b)
apply a
a (MSF m a b -> m (b, MSF (ListT m) a b))
-> [MSF m a b] -> [m (b, MSF (ListT m) a b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MSF m a b]
msfs
  where
    sequence' :: Monad m => [m a] -> ListT m a
    sequence' :: forall (m :: * -> *) a. Monad m => [m a] -> ListT m a
sequence' [m a]
xs = m (Step m a) -> ListT m a
forall (m :: * -> *) a. m (Step m a) -> ListT m a
ListT (m (Step m a) -> ListT m a) -> m (Step m a) -> ListT m a
forall a b. (a -> b) -> a -> b
$ ListT m a -> m (Step m a)
forall (m :: * -> *) a. ListT m a -> m (Step m a)
next (ListT m a -> m (Step m a))
-> ([a] -> ListT m a) -> [a] -> m (Step m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> ListT m a
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f a -> m a
select ([a] -> m (Step m a)) -> m [a] -> m (Step m a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [m a] -> m [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [m a]
xs

    apply :: Monad m => a -> MSF m a b -> m (b, MSF (ListT m) a b)
    apply :: forall (m :: * -> *) a b.
Monad m =>
a -> MSF m a b -> m (b, MSF (ListT m) a b)
apply a
a MSF m a b
msf = do
      (b
b, MSF m a b
msf') <- MSF m a b -> a -> m (b, MSF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF MSF m a b
msf a
a
      (b, MSF (ListT m) a b) -> m (b, MSF (ListT m) a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, [MSF m a b] -> MSF (ListT m) a b
forall (m :: * -> *) a b.
Monad m =>
[MSF m a b] -> MSF (ListT m) a b
sequenceS [MSF m a b
msf'])

#else

{-# DEPRECATED widthFirst "This ListT definition is deprecated. Use the list-transformer variant of this function instead." #-}
-- | Run an 'MSF' in the 'ListT' transformer (i.e., multiple MSFs producing
-- each producing one output), by applying the input stream to each MSF in the
-- list transformer and concatenating the outputs of the MSFs together.
--
-- An MSF in the ListT transformer can spawn into more than one MSF, or none,
-- so the outputs produced at each individual step are not guaranteed to all
-- have the same length.
widthFirst :: (Functor m, Monad m) => MSF (ListT m) a b -> MSF m a [b]
widthFirst msf = widthFirst' [msf]
  where
    widthFirst' msfs = MSF $ \a -> do
      (bs, msfs') <- unzip . concat <$> mapM (runListT . flip unMSF a) msfs
      return (bs, widthFirst' msfs')

{-# DEPRECATED sequenceS "This ListT definition is deprecated. Use the list-transformer variant of this function instead." #-}
-- | Build an 'MSF' in the 'ListT' transformer by broadcasting the input stream
-- value to each MSF in a given list.
sequenceS :: Monad m => [MSF m a b] -> MSF (ListT m) a b
sequenceS msfs = MSF $ \a -> ListT $ sequence $ apply a <$> msfs
  where
    apply a msf = do
      (b, msf') <- unMSF msf a
      return (b, sequenceS [msf'])

#endif

-- | Apply an 'MSF' to every input.
mapMSF :: Monad m => MSF m a b -> MSF m [a] [b]
mapMSF :: forall (m :: * -> *) a b. Monad m => MSF m a b -> MSF m [a] [b]
mapMSF = ([a] -> m ([b], MSF m [a] [b])) -> MSF m [a] [b]
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF (([a] -> m ([b], MSF m [a] [b])) -> MSF m [a] [b])
-> (MSF m a b -> [a] -> m ([b], MSF m [a] [b]))
-> MSF m a b
-> MSF m [a] [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSF m a b -> [a] -> m ([b], MSF m [a] [b])
forall (m :: * -> *) a t.
Monad m =>
MSF m a t -> [a] -> m ([t], MSF m [a] [t])
consume
  where
    consume :: Monad m => MSF m a t -> [a] -> m ([t], MSF m [a] [t])
    consume :: forall (m :: * -> *) a t.
Monad m =>
MSF m a t -> [a] -> m ([t], MSF m [a] [t])
consume MSF m a t
sf []     = ([t], MSF m [a] [t]) -> m ([t], MSF m [a] [t])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], MSF m a t -> MSF m [a] [t]
forall (m :: * -> *) a b. Monad m => MSF m a b -> MSF m [a] [b]
mapMSF MSF m a t
sf)
    consume MSF m a t
sf (a
a:[a]
as) = do
      (t
b, MSF m a t
sf')   <- MSF m a t -> a -> m (t, MSF m a t)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF MSF m a t
sf a
a
      ([t]
bs, MSF m [a] [t]
sf'') <- MSF m a t -> [a] -> m ([t], MSF m [a] [t])
forall (m :: * -> *) a t.
Monad m =>
MSF m a t -> [a] -> m ([t], MSF m [a] [t])
consume MSF m a t
sf' [a]
as
      t
b t -> m ([t], MSF m [a] [t]) -> m ([t], MSF m [a] [t])
forall a b. a -> b -> b
`seq` ([t], MSF m [a] [t]) -> m ([t], MSF m [a] [t])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (t
bt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
bs, MSF m [a] [t]
sf'')