{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE StrictData #-}

module Data.Stream.Result where

-- base
import Data.Bifunctor (Bifunctor (..))

-- automaton
import Data.Stream.Internal

{- | A tuple that is strict in its first argument.

This type is used in streams and automata to encode the result of a state transition.
The new state should always be strict to avoid space leaks.
-}
data Result s a = Result {forall s a. Result s a -> s
resultState :: s, forall s a. Result s a -> a
output :: ~a}
  deriving ((forall a b. (a -> b) -> Result s a -> Result s b)
-> (forall a b. a -> Result s b -> Result s a)
-> Functor (Result s)
forall a b. a -> Result s b -> Result s a
forall a b. (a -> b) -> Result s a -> Result s b
forall s a b. a -> Result s b -> Result s a
forall s a b. (a -> b) -> Result s a -> Result s b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s a b. (a -> b) -> Result s a -> Result s b
fmap :: forall a b. (a -> b) -> Result s a -> Result s b
$c<$ :: forall s a b. a -> Result s b -> Result s a
<$ :: forall a b. a -> Result s b -> Result s a
Functor)

instance Bifunctor Result where
  second :: forall b c a. (b -> c) -> Result a b -> Result a c
second = (b -> c) -> Result a b -> Result a c
forall a b. (a -> b) -> Result a a -> Result a b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
  first :: forall a b c. (a -> b) -> Result a c -> Result b c
first = (a -> b) -> Result a c -> Result b c
forall a b c. (a -> b) -> Result a c -> Result b c
mapResultState

-- | Apply a function to the state of a 'Result'.
mapResultState :: (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState :: forall a b c. (a -> b) -> Result a c -> Result b c
mapResultState s1 -> s2
f Result {s1
resultState :: forall s a. Result s a -> s
resultState :: s1
resultState, a
output :: forall s a. Result s a -> a
output :: a
output} = Result {resultState :: s2
resultState = s1 -> s2
f s1
resultState, a
output :: a
output :: a
output}
{-# INLINE mapResultState #-}

-- | Analogous to 'Applicative''s '(<*>)'.
apResult :: Result s1 (a -> b) -> Result s2 a -> Result (JointState s1 s2) b
apResult :: forall s1 a b s2.
Result s1 (a -> b) -> Result s2 a -> Result (JointState s1 s2) b
apResult (Result s1
resultStateA a -> b
outputF) (Result s2
resultStateB a
outputA) = JointState s1 s2 -> b -> Result (JointState s1 s2) b
forall s a. s -> a -> Result s a
Result (s1 -> s2 -> JointState s1 s2
forall a b. a -> b -> JointState a b
JointState s1
resultStateA s2
resultStateB) (b -> Result (JointState s1 s2) b)
-> b -> Result (JointState s1 s2) b
forall a b. (a -> b) -> a -> b
$ a -> b
outputF a
outputA
{-# INLINE apResult #-}

-- | A state transformer with 'Result' instead of a standard tuple as its result.
newtype ResultStateT s m a = ResultStateT {forall s (m :: Type -> Type) a.
ResultStateT s m a -> s -> m (Result s a)
getResultStateT :: s -> m (Result s a)}
  deriving ((forall a b. (a -> b) -> ResultStateT s m a -> ResultStateT s m b)
-> (forall a b. a -> ResultStateT s m b -> ResultStateT s m a)
-> Functor (ResultStateT s m)
forall a b. a -> ResultStateT s m b -> ResultStateT s m a
forall a b. (a -> b) -> ResultStateT s m a -> ResultStateT s m b
forall s (m :: Type -> Type) a b.
Functor m =>
a -> ResultStateT s m b -> ResultStateT s m a
forall s (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> ResultStateT s m a -> ResultStateT s m b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> ResultStateT s m a -> ResultStateT s m b
fmap :: forall a b. (a -> b) -> ResultStateT s m a -> ResultStateT s m b
$c<$ :: forall s (m :: Type -> Type) a b.
Functor m =>
a -> ResultStateT s m b -> ResultStateT s m a
<$ :: forall a b. a -> ResultStateT s m b -> ResultStateT s m a
Functor)

instance (Monad m) => Applicative (ResultStateT s m) where
  pure :: forall a. a -> ResultStateT s m a
pure a
output = (s -> m (Result s a)) -> ResultStateT s m a
forall s (m :: Type -> Type) a.
(s -> m (Result s a)) -> ResultStateT s m a
ResultStateT (\s
resultState -> Result s a -> m (Result s a)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Result {s
resultState :: s
resultState :: s
resultState, a
output :: a
output :: a
output})

  ResultStateT s -> m (Result s (a -> b))
mf <*> :: forall a b.
ResultStateT s m (a -> b)
-> ResultStateT s m a -> ResultStateT s m b
<*> ResultStateT s -> m (Result s a)
ma = (s -> m (Result s b)) -> ResultStateT s m b
forall s (m :: Type -> Type) a.
(s -> m (Result s a)) -> ResultStateT s m a
ResultStateT ((s -> m (Result s b)) -> ResultStateT s m b)
-> (s -> m (Result s b)) -> ResultStateT s m b
forall a b. (a -> b) -> a -> b
$ \s
s -> do
    Result s
s' a -> b
f <- s -> m (Result s (a -> b))
mf s
s
    Result s
s'' a
a <- s -> m (Result s a)
ma s
s'
    Result s b -> m (Result s b)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (s -> b -> Result s b
forall s a. s -> a -> Result s a
Result s
s'' (a -> b
f a
a))