module Data.Stream.Final 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 final encoding.

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

{- | Translate an initially encoded stream into a finally encoded one.

This is usually a performance penalty.
-}
toFinal :: (Functor m) => StreamT m a -> Final m a
toFinal :: forall (m :: Type -> Type) a. Functor m => StreamT m a -> Final m a
toFinal StreamT m a
automaton = m (Result (Final m a) a) -> Final m a
forall (m :: Type -> Type) a. m (Result (Final m a) a) -> Final m a
Final (m (Result (Final m a) a) -> Final m a)
-> m (Result (Final m a) a) -> Final m a
forall a b. (a -> b) -> a -> b
$ (StreamT m a -> Final m a)
-> Result (StreamT m a) a -> Result (Final m a) a
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState StreamT m a -> Final m a
forall (m :: Type -> Type) a. Functor m => StreamT m a -> Final m a
toFinal (Result (StreamT m a) a -> Result (Final m a) a)
-> m (Result (StreamT m a) a) -> m (Result (Final 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 toFinal #-}

{- | Translate a finally encoded stream into an initially encoded one.

The internal state is the stream itself.
-}
fromFinal :: Final m a -> StreamT m a
fromFinal :: forall (m :: Type -> Type) a. Final m a -> StreamT m a
fromFinal Final m a
final =
  StreamT
    { state :: Final m a
state = Final m a
final
    , step :: Final m a -> m (Result (Final m a) a)
step = Final m a -> m (Result (Final m a) a)
forall (m :: Type -> Type) a. Final m a -> m (Result (Final m a) a)
getFinal
    }
{-# INLINE fromFinal #-}

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

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

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

  Final m (Result (Final m (a -> b)) (a -> b))
mf <*> :: forall a b. Final m (a -> b) -> Final m a -> Final m b
<*> Final m (Result (Final m a) a)
ma = m (Result (Final m b) b) -> Final m b
forall (m :: Type -> Type) a. m (Result (Final m a) a) -> Final m a
Final (m (Result (Final m b) b) -> Final m b)
-> m (Result (Final m b) b) -> Final m b
forall a b. (a -> b) -> a -> b
$! (\(Result Final m (a -> b)
cf a -> b
f) (Result Final m a
ca a
a) -> Final m b -> b -> Result (Final m b) b
forall s a. s -> a -> Result s a
Result (Final m (a -> b)
cf Final m (a -> b) -> Final m a -> Final m b
forall a b. Final m (a -> b) -> Final m a -> Final m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Final m a
ca) (b -> Result (Final m b) b) -> b -> Result (Final m b) b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
a) (Result (Final m (a -> b)) (a -> b)
 -> Result (Final m a) a -> Result (Final m b) b)
-> m (Result (Final m (a -> b)) (a -> b))
-> m (Result (Final m a) a -> Result (Final m b) b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Result (Final m (a -> b)) (a -> b))
mf m (Result (Final m a) a -> Result (Final m b) b)
-> m (Result (Final m a) a) -> m (Result (Final 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 (Final m a) a)
ma

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

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

  Final m (Result (Final m a) a)
ma1 <|> :: forall a. Final m a -> Final m a -> Final m a
<|> Final m (Result (Final m a) a)
ma2 = m (Result (Final m a) a) -> Final m a
forall (m :: Type -> Type) a. m (Result (Final m a) a) -> Final m a
Final (m (Result (Final m a) a) -> Final m a)
-> m (Result (Final m a) a) -> Final m a
forall a b. (a -> b) -> a -> b
$ m (Result (Final m a) a)
ma1 m (Result (Final m a) a)
-> m (Result (Final m a) a) -> m (Result (Final 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 (Final m a) a)
ma2