module Data.Stream.Recursive where

-- base
import Control.Applicative (Alternative (..))

-- mmorph
import Control.Monad.Morph (MFunctor (..))

-- automaton
import Data.Stream (StreamT (..), stepStream)
import Data.Stream.Result

{- | A stream transformer in recursive encoding.

One step of the stream transformer performs a monadic action and results in an output and a new stream.
-}
newtype Recursive m a = Recursive {forall (m :: Type -> Type) a.
Recursive m a -> m (Result (Recursive m a) a)
getRecursive :: m (Result (Recursive m a) a)}

{- | Translate a coalgebraically encoded stream into a recursive one.

This is usually a performance penalty.
-}
toRecursive :: (Functor m) => StreamT m a -> Recursive m a
toRecursive :: forall (m :: Type -> Type) a.
Functor m =>
StreamT m a -> Recursive m a
toRecursive StreamT m a
automaton = m (Result (Recursive m a) a) -> Recursive m a
forall (m :: Type -> Type) a.
m (Result (Recursive m a) a) -> Recursive m a
Recursive (m (Result (Recursive m a) a) -> Recursive m a)
-> m (Result (Recursive m a) a) -> Recursive m a
forall a b. (a -> b) -> a -> b
$ (StreamT m a -> Recursive m a)
-> Result (StreamT m a) a -> Result (Recursive m a) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState StreamT m a -> Recursive m a
forall (m :: Type -> Type) a.
Functor m =>
StreamT m a -> Recursive m a
toRecursive (Result (StreamT m a) a -> Result (Recursive m a) a)
-> m (Result (StreamT m a) a) -> m (Result (Recursive m a) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> StreamT m a -> m (Result (StreamT m a) a)
forall (m :: Type -> Type) a.
Functor m =>
StreamT m a -> m (Result (StreamT m a) a)
stepStream StreamT m a
automaton
{-# INLINE toRecursive #-}

{- | Translate a recursive stream into a coalgebraically encoded one.

The internal state is the stream itself.
-}
fromRecursive :: Recursive m a -> StreamT m a
fromRecursive :: forall (m :: Type -> Type) a. Recursive m a -> StreamT m a
fromRecursive Recursive m a
coalgebraic =
  StreamT
    { state :: Recursive m a
state = Recursive m a
coalgebraic
    , step :: Recursive m a -> m (Result (Recursive m a) a)
step = Recursive m a -> m (Result (Recursive m a) a)
forall (m :: Type -> Type) a.
Recursive m a -> m (Result (Recursive m a) a)
getRecursive
    }
{-# INLINE fromRecursive #-}

instance MFunctor Recursive where
  hoist :: forall (m :: Type -> Type) (n :: Type -> Type) b.
Monad m =>
(forall a. m a -> n a) -> Recursive m b -> Recursive n b
hoist forall a. m a -> n a
morph = Recursive m b -> Recursive n b
go
    where
      go :: Recursive m b -> Recursive n b
go Recursive {m (Result (Recursive m b) b)
getRecursive :: forall (m :: Type -> Type) a.
Recursive m a -> m (Result (Recursive m a) a)
getRecursive :: m (Result (Recursive m b) b)
getRecursive} = n (Result (Recursive n b) b) -> Recursive n b
forall (m :: Type -> Type) a.
m (Result (Recursive m a) a) -> Recursive m a
Recursive (n (Result (Recursive n b) b) -> Recursive n b)
-> n (Result (Recursive n b) b) -> Recursive n b
forall a b. (a -> b) -> a -> b
$ m (Result (Recursive n b) b) -> n (Result (Recursive n b) b)
forall a. m a -> n a
morph (m (Result (Recursive n b) b) -> n (Result (Recursive n b) b))
-> m (Result (Recursive n b) b) -> n (Result (Recursive n b) b)
forall a b. (a -> b) -> a -> b
$ (Recursive m b -> Recursive n b)
-> Result (Recursive m b) b -> Result (Recursive n b) b
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState Recursive m b -> Recursive n b
go (Result (Recursive m b) b -> Result (Recursive n b) b)
-> m (Result (Recursive m b) b) -> m (Result (Recursive n b) b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Result (Recursive m b) b)
getRecursive

instance (Functor m) => Functor (Recursive m) where
  fmap :: forall a b. (a -> b) -> Recursive m a -> Recursive m b
fmap a -> b
f Recursive {m (Result (Recursive m a) a)
getRecursive :: forall (m :: Type -> Type) a.
Recursive m a -> m (Result (Recursive m a) a)
getRecursive :: m (Result (Recursive m a) a)
getRecursive} = m (Result (Recursive m b) b) -> Recursive m b
forall (m :: Type -> Type) a.
m (Result (Recursive m a) a) -> Recursive m a
Recursive (m (Result (Recursive m b) b) -> Recursive m b)
-> m (Result (Recursive m b) b) -> Recursive m b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Result (Recursive m b) a -> Result (Recursive m b) b
forall a b.
(a -> b) -> Result (Recursive m b) a -> Result (Recursive m b) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Result (Recursive m b) a -> Result (Recursive m b) b)
-> (Result (Recursive m a) a -> Result (Recursive m b) a)
-> Result (Recursive m a) a
-> Result (Recursive m b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Recursive m a -> Recursive m b)
-> Result (Recursive m a) a -> Result (Recursive m b) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState ((a -> b) -> Recursive m a -> Recursive m b
forall a b. (a -> b) -> Recursive m a -> Recursive m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (Result (Recursive m a) a -> Result (Recursive m b) b)
-> m (Result (Recursive m a) a) -> m (Result (Recursive m b) b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Result (Recursive m a) a)
getRecursive

instance (Applicative m) => Applicative (Recursive m) where
  pure :: forall a. a -> Recursive m a
pure a
a = Recursive m a
go
    where
      go :: Recursive m a
go = m (Result (Recursive m a) a) -> Recursive m a
forall (m :: Type -> Type) a.
m (Result (Recursive m a) a) -> Recursive m a
Recursive (m (Result (Recursive m a) a) -> Recursive m a)
-> m (Result (Recursive m a) a) -> Recursive m a
forall a b. (a -> b) -> a -> b
$! Result (Recursive m a) a -> m (Result (Recursive m a) a)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result (Recursive m a) a -> m (Result (Recursive m a) a))
-> Result (Recursive m a) a -> m (Result (Recursive m a) a)
forall a b. (a -> b) -> a -> b
$! Recursive m a -> a -> Result (Recursive m a) a
forall s a. s -> a -> Result s a
Result Recursive m a
go a
a

  Recursive m (Result (Recursive m (a -> b)) (a -> b))
mf <*> :: forall a b. Recursive m (a -> b) -> Recursive m a -> Recursive m b
<*> Recursive m (Result (Recursive m a) a)
ma = m (Result (Recursive m b) b) -> Recursive m b
forall (m :: Type -> Type) a.
m (Result (Recursive m a) a) -> Recursive m a
Recursive (m (Result (Recursive m b) b) -> Recursive m b)
-> m (Result (Recursive m b) b) -> Recursive m b
forall a b. (a -> b) -> a -> b
$! (\(Result Recursive m (a -> b)
cf a -> b
f) (Result Recursive m a
ca a
a) -> Recursive m b -> b -> Result (Recursive m b) b
forall s a. s -> a -> Result s a
Result (Recursive m (a -> b)
cf Recursive m (a -> b) -> Recursive m a -> Recursive m b
forall a b. Recursive m (a -> b) -> Recursive m a -> Recursive m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Recursive m a
ca) (b -> Result (Recursive m b) b) -> b -> Result (Recursive m b) b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
a) (Result (Recursive m (a -> b)) (a -> b)
 -> Result (Recursive m a) a -> Result (Recursive m b) b)
-> m (Result (Recursive m (a -> b)) (a -> b))
-> m (Result (Recursive m a) a -> Result (Recursive m b) b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Result (Recursive m (a -> b)) (a -> b))
mf m (Result (Recursive m a) a -> Result (Recursive m b) b)
-> m (Result (Recursive m a) a) -> m (Result (Recursive m b) b)
forall a b. m (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> m (Result (Recursive m a) a)
ma

-- | Constantly perform the same effect, without remembering a state.
constM :: (Functor m) => m a -> Recursive m a
constM :: forall (m :: Type -> Type) a. Functor m => m a -> Recursive m a
constM m a
ma = Recursive m a
go
  where
    go :: Recursive m a
go = m (Result (Recursive m a) a) -> Recursive m a
forall (m :: Type -> Type) a.
m (Result (Recursive m a) a) -> Recursive m a
Recursive (m (Result (Recursive m a) a) -> Recursive m a)
-> m (Result (Recursive m a) a) -> Recursive m a
forall a b. (a -> b) -> a -> b
$ Recursive m a -> a -> Result (Recursive m a) a
forall s a. s -> a -> Result s a
Result Recursive m a
go (a -> Result (Recursive m a) a)
-> m a -> m (Result (Recursive m a) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
ma

instance (Alternative m) => Alternative (Recursive m) where
  empty :: forall a. Recursive m a
empty = m a -> Recursive m a
forall (m :: Type -> Type) a. Functor m => m a -> Recursive m a
constM m a
forall a. m a
forall (f :: Type -> Type) a. Alternative f => f a
empty

  Recursive m (Result (Recursive m a) a)
ma1 <|> :: forall a. Recursive m a -> Recursive m a -> Recursive m a
<|> Recursive m (Result (Recursive m a) a)
ma2 = m (Result (Recursive m a) a) -> Recursive m a
forall (m :: Type -> Type) a.
m (Result (Recursive m a) a) -> Recursive m a
Recursive (m (Result (Recursive m a) a) -> Recursive m a)
-> m (Result (Recursive m a) a) -> Recursive m a
forall a b. (a -> b) -> a -> b
$ m (Result (Recursive m a) a)
ma1 m (Result (Recursive m a) a)
-> m (Result (Recursive m a) a) -> m (Result (Recursive m a) a)
forall a. m a -> m a -> m a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> m (Result (Recursive m a) a)
ma2