{- | Handle a global 'ChangesetT' layer in an 'Automaton'.

A global accumulation state can be hidden by an automaton by making it an internal state.
-}
module Data.Automaton.Trans.Changeset (
  module Control.Monad.Trans.Changeset,
  changesetS,
  getChangesetS,
  runChangesetS,
  runChangesetS_,
)
where

-- base
import Control.Arrow (arr, returnA, (>>>))
import Data.Functor ((<&>))

-- changeset
import Control.Monad.Trans.Changeset
import Data.Monoid.RightAction (RightAction (actRight))

-- automaton
import Data.Automaton (Automaton, feedback, withAutomaton)
import Data.Stream.Result (Result (..))

{- | Convert from explicit states to the 'ChangesetT' monad transformer.

The original automaton is interpreted to take the current accumulated state as input and return the log to be appended as output.

This is the opposite of 'runChangesetS'.
-}
changesetS :: (Functor m) => Automaton m (s, a) (w, b) -> Automaton (ChangesetT s w m) a b
changesetS :: forall (m :: Type -> Type) s a w b.
Functor m =>
Automaton m (s, a) (w, b) -> Automaton (ChangesetT s w m) a b
changesetS = (forall s.
 ((s, a) -> m (Result s (w, b)))
 -> a -> ChangesetT s w m (Result s b))
-> Automaton m (s, a) (w, b) -> Automaton (ChangesetT s w m) a b
forall (m1 :: Type -> Type) (m2 :: Type -> Type) a1 b1 a2 b2.
(Functor m1, Functor m2) =>
(forall s. (a1 -> m1 (Result s b1)) -> a2 -> m2 (Result s b2))
-> Automaton m1 a1 b1 -> Automaton m2 a2 b2
withAutomaton ((forall s.
  ((s, a) -> m (Result s (w, b)))
  -> a -> ChangesetT s w m (Result s b))
 -> Automaton m (s, a) (w, b) -> Automaton (ChangesetT s w m) a b)
-> (forall s.
    ((s, a) -> m (Result s (w, b)))
    -> a -> ChangesetT s w m (Result s b))
-> Automaton m (s, a) (w, b)
-> Automaton (ChangesetT s w m) a b
forall a b. (a -> b) -> a -> b
$ \(s, a) -> m (Result s (w, b))
f a
a -> (s -> m (w, Result s b)) -> ChangesetT s w m (Result s b)
forall s w (m :: Type -> Type) a.
(s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w, Result s b)) -> ChangesetT s w m (Result s b))
-> (s -> m (w, Result s b)) -> ChangesetT s w m (Result s b)
forall a b. (a -> b) -> a -> b
$ \s
s ->
  (s, a) -> m (Result s (w, b))
f (s
s, a
a)
    m (Result s (w, b))
-> (Result s (w, b) -> (w, Result s b)) -> m (w, Result s b)
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(Result s
s' (w
w, b
b)) -> (w
w, s -> b -> Result s b
forall s a. s -> a -> Result s a
Result s
s' b
b))

{- | Make the accumulation transition in 'ChangesetT' explicit as 'Automaton' inputs and outputs.

This is the opposite of 'changesetS'.
-}
getChangesetS :: (Functor m) => Automaton (ChangesetT s w m) a b -> Automaton m (s, a) (w, b)
getChangesetS :: forall (m :: Type -> Type) s w a b.
Functor m =>
Automaton (ChangesetT s w m) a b -> Automaton m (s, a) (w, b)
getChangesetS = (forall s.
 (a -> ChangesetT s w m (Result s b))
 -> (s, a) -> m (Result s (w, b)))
-> Automaton (ChangesetT s w m) a b -> Automaton m (s, a) (w, b)
forall (m1 :: Type -> Type) (m2 :: Type -> Type) a1 b1 a2 b2.
(Functor m1, Functor m2) =>
(forall s. (a1 -> m1 (Result s b1)) -> a2 -> m2 (Result s b2))
-> Automaton m1 a1 b1 -> Automaton m2 a2 b2
withAutomaton ((forall s.
  (a -> ChangesetT s w m (Result s b))
  -> (s, a) -> m (Result s (w, b)))
 -> Automaton (ChangesetT s w m) a b -> Automaton m (s, a) (w, b))
-> (forall s.
    (a -> ChangesetT s w m (Result s b))
    -> (s, a) -> m (Result s (w, b)))
-> Automaton (ChangesetT s w m) a b
-> Automaton m (s, a) (w, b)
forall a b. (a -> b) -> a -> b
$ \a -> ChangesetT s w m (Result s b)
f (s
s, a
a) ->
  ChangesetT s w m (Result s b) -> s -> m (w, Result s b)
forall s w (m :: Type -> Type) a.
ChangesetT s w m a -> s -> m (w, a)
getChangesetT (a -> ChangesetT s w m (Result s b)
f a
a) s
s
    m (w, Result s b)
-> ((w, Result s b) -> Result s (w, b)) -> m (Result s (w, b))
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(w
w, Result s
s' b
b) -> s -> (w, b) -> Result s (w, b)
forall s a. s -> a -> Result s a
Result s
s' (w
w, b
b))

{- | Convert global accumulation state to internal state of an 'Automaton'.

The current state is output on every step.
-}
runChangesetS ::
  (Monad m, Monoid w, RightAction w s) =>
  -- | Initial state
  s ->
  -- | An automaton with a global accumulation state effect
  Automaton (ChangesetT s w m) a b ->
  Automaton m a (s, b)
runChangesetS :: forall (m :: Type -> Type) w s a b.
(Monad m, Monoid w, RightAction w s) =>
s -> Automaton (ChangesetT s w m) a b -> Automaton m a (s, b)
runChangesetS s
s Automaton (ChangesetT s w m) a b
automaton = s -> Automaton m (a, s) ((s, b), s) -> Automaton m a (s, b)
forall (m :: Type -> Type) c a b.
Functor m =>
c -> Automaton m (a, c) (b, c) -> Automaton m a b
feedback s
s (Automaton m (a, s) ((s, b), s) -> Automaton m a (s, b))
-> Automaton m (a, s) ((s, b), s) -> Automaton m a (s, b)
forall a b. (a -> b) -> a -> b
$ proc (a
a, s
s) -> do
  (w
w, b
b) <- Automaton (ChangesetT s w m) a b -> Automaton m (s, a) (w, b)
forall (m :: Type -> Type) s w a b.
Functor m =>
Automaton (ChangesetT s w m) a b -> Automaton m (s, a) (w, b)
getChangesetS Automaton (ChangesetT s w m) a b
automaton -< (s
s, a
a)
  let s' :: s
s' = s
s s -> w -> s
forall m s. RightAction m s => s -> m -> s
`actRight` w
w
  Automaton m ((s, b), s) ((s, b), s)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< ((s
s', b
b), s
s')

-- | Like 'runChangesetS', but don't output the current state.
runChangesetS_ :: (Monoid w, Monad m, RightAction w s) => s -> Automaton (ChangesetT s w m) a b -> Automaton m a b
runChangesetS_ :: forall w (m :: Type -> Type) s a b.
(Monoid w, Monad m, RightAction w s) =>
s -> Automaton (ChangesetT s w m) a b -> Automaton m a b
runChangesetS_ s
s Automaton (ChangesetT s w m) a b
automaton = s -> Automaton (ChangesetT s w m) a b -> Automaton m a (s, b)
forall (m :: Type -> Type) w s a b.
(Monad m, Monoid w, RightAction w s) =>
s -> Automaton (ChangesetT s w m) a b -> Automaton m a (s, b)
runChangesetS s
s Automaton (ChangesetT s w m) a b
automaton Automaton m a (s, b) -> Automaton m (s, b) b -> Automaton m a b
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((s, b) -> b) -> Automaton m (s, b) b
forall b c. (b -> c) -> Automaton m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (s, b) -> b
forall a b. (a, b) -> b
snd