{-# LANGUAGE CPP #-}
module Control.Monad.Trans.MSF.List
  ( module Control.Monad.Trans.MSF.List
  , module Control.Monad.Trans.List
  ) where

-- External
import Control.Monad.Trans.List
  hiding (liftCallCC, liftCatch) -- Avoid conflicting exports

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

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

-- * List monad

-- Name alternative (in the article): collect
widthFirst :: (Functor m, Monad m) => MSF (ListT m) a b -> MSF m a [b]
widthFirst :: 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 :: * -> *) a a.
Monad m =>
[MSF (ListT m) a a] -> MSF m a [a]
widthFirst' [MSF (ListT m) a b
msf] where
    widthFirst' :: [MSF (ListT m) a a] -> MSF m a [a]
widthFirst' [MSF (ListT m) a a]
msfs = (a -> m ([a], MSF m a [a])) -> MSF m a [a]
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((a -> m ([a], MSF m a [a])) -> MSF m a [a])
-> (a -> m ([a], MSF m a [a])) -> MSF m a [a]
forall a b. (a -> b) -> a -> b
$ \a
a -> do
        ([a]
bs, [MSF (ListT m) a a]
msfs') <- [(a, MSF (ListT m) a a)] -> ([a], [MSF (ListT m) a a])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(a, MSF (ListT m) a a)] -> ([a], [MSF (ListT m) a a]))
-> ([[(a, MSF (ListT m) a a)]] -> [(a, MSF (ListT m) a a)])
-> [[(a, MSF (ListT m) a a)]]
-> ([a], [MSF (ListT m) a a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(a, MSF (ListT m) a a)]] -> [(a, MSF (ListT m) a a)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(a, MSF (ListT m) a a)]] -> ([a], [MSF (ListT m) a a]))
-> m [[(a, MSF (ListT m) a a)]] -> m ([a], [MSF (ListT m) a a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MSF (ListT m) a a -> m [(a, MSF (ListT m) a a)])
-> [MSF (ListT m) a a] -> m [[(a, MSF (ListT m) a a)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ListT m (a, MSF (ListT m) a a) -> m [(a, MSF (ListT m) a a)]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT (ListT m (a, MSF (ListT m) a a) -> m [(a, MSF (ListT m) a a)])
-> (MSF (ListT m) a a -> ListT m (a, MSF (ListT m) a a))
-> MSF (ListT m) a a
-> m [(a, MSF (ListT m) a a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MSF (ListT m) a a -> a -> ListT m (a, MSF (ListT m) a a))
-> a -> MSF (ListT m) a a -> ListT m (a, MSF (ListT m) a a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip MSF (ListT m) a a -> a -> ListT m (a, MSF (ListT m) a a)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF a
a) [MSF (ListT m) a a]
msfs
        ([a], MSF m a [a]) -> m ([a], MSF m a [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
bs, [MSF (ListT m) a a] -> MSF m a [a]
widthFirst' [MSF (ListT m) a a]
msfs')


-- Name alternatives: "choose", "parallely" (problematic because it's not multicore)
sequenceS :: Monad m => [MSF m a b] -> MSF (ListT m) a b
sequenceS :: [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. m [a] -> ListT m a
ListT (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
$ [m (b, MSF (ListT m) a b)] -> m [(b, MSF (ListT m) a b)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([m (b, MSF (ListT m) a b)] -> m [(b, MSF (ListT m) a b)])
-> [m (b, MSF (ListT m) a b)] -> 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
    apply :: 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 (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'])
-- sequenceS = foldl (<+>) arrowzero . map liftMSFTrans

-- | Apply an 'MSF' to every input.
mapMSF :: Monad m => MSF m a b -> MSF m [a] [b]
mapMSF :: 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 :: 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 (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])
`seq` ([t], MSF m [a] [t]) -> m ([t], MSF m [a] [t])
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'')