{-# LANGUAGE TupleSections #-}------------------------------------------------------------------------------- |-- Module : Data.Machine.MealyT-- License : BSD-style (see the file LICENSE)---- <http://en.wikipedia.org/wiki/Mealy_machine>-- <https://github.com/ivanperez-keera/dunai/blob/develop/src/Data/MonadicStreamFunction/Core.hs#L35>-- <https://hackage.haskell.org/package/auto-0.4.3.0/docs/Control-Auto.html>-- <https://hackage.haskell.org/package/varying-0.6.0.0/docs/Control-Varying-Core.html>----------------------------------------------------------------------------moduleData.Machine.MealyT(MealyT (..),arrPure ,arrM ,upgrade ,scanMealyT ,scanMealyTM )whereimportData.Machine importControl.ArrowimportControl.ApplicativeimportControl.Monad.TransimportData.PointedimportControl.Monad.IdentityimportData.ProfunctorimportData.SemigroupimportqualifiedControl.CategoryasCimportPrelude-- | 'Mealy' machine, with applicative effectsnewtypeMealyT m a b =MealyT {forall (m :: * -> *) a b. MealyT m a b -> a -> m (b, MealyT m a b)
runMealyT ::a ->m (b ,MealyT m a b )}instanceFunctorm =>Functor(MealyT m a )where{-# INLINEfmap#-}fmap :: forall a b. (a -> b) -> MealyT m a a -> MealyT m a b
fmapa -> b
f (MealyT a -> m (a, MealyT m a a)
m )=(a -> m (b, MealyT m a b)) -> MealyT m a b
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT ((a -> m (b, MealyT m a b)) -> MealyT m a b)
-> (a -> m (b, MealyT m a b)) -> MealyT m a b
forall a b. (a -> b) -> a -> b
$\a
a ->((a, MealyT m a a) -> (b, MealyT m a b))
-> m (a, MealyT m a a) -> m (b, MealyT m a b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(\(a
x ,MealyT m a a
y )->(a -> b
f a
x ,(a -> b) -> MealyT m a a -> MealyT m a b
forall a b. (a -> b) -> MealyT m a a -> MealyT m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapa -> b
f MealyT m a a
y ))(a -> m (a, MealyT m a a)
m a
a )instancePointedm =>Pointed(MealyT m a )where{-# INLINEpoint#-}point :: forall a. a -> MealyT m a a
pointa
b =MealyT m a a
forall {a}. MealyT m a a
r wherer :: MealyT m a a
r =(a -> m (a, MealyT m a a)) -> MealyT m a a
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT (m (a, MealyT m a a) -> a -> m (a, MealyT m a a)
forall a b. a -> b -> a
const((a, MealyT m a a) -> m (a, MealyT m a a)
forall a. a -> m a
forall (p :: * -> *) a. Pointed p => a -> p a
point(a
b ,MealyT m a a
r )))instanceApplicativem =>Applicative(MealyT m a )where{-# INLINEpure#-}pure :: forall a. a -> MealyT m a a
purea
b =MealyT m a a
forall {a}. MealyT m a a
r wherer :: MealyT m a a
r =(a -> m (a, MealyT m a a)) -> MealyT m a a
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT (m (a, MealyT m a a) -> a -> m (a, MealyT m a a)
forall a b. a -> b -> a
const((a, MealyT m a a) -> m (a, MealyT m a a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure(a
b ,MealyT m a a
r )))-- Stolen from PointedMealyT a -> m (a -> b, MealyT m a (a -> b))
m <*> :: forall a b. MealyT m a (a -> b) -> MealyT m a a -> MealyT m a b
<*>MealyT a -> m (a, MealyT m a a)
n =(a -> m (b, MealyT m a b)) -> MealyT m a b
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT ((a -> m (b, MealyT m a b)) -> MealyT m a b)
-> (a -> m (b, MealyT m a b)) -> MealyT m a b
forall a b. (a -> b) -> a -> b
$\a
a ->(\(a -> b
mb ,MealyT m a (a -> b)
mm )(a
nb ,MealyT m a a
nm )->(a -> b
mb a
nb ,MealyT m a (a -> b)
mm MealyT m a (a -> b) -> MealyT m a a -> MealyT m a b
forall a b. MealyT m a (a -> b) -> MealyT m a a -> MealyT m a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>MealyT m a a
nm ))((a -> b, MealyT m a (a -> b))
 -> (a, MealyT m a a) -> (b, MealyT m a b))
-> m (a -> b, MealyT m a (a -> b))
-> m ((a, MealyT m a a) -> (b, MealyT m a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>a -> m (a -> b, MealyT m a (a -> b))
m a
a m ((a, MealyT m a a) -> (b, MealyT m a b))
-> m (a, MealyT m a a) -> m (b, MealyT m a b)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>a -> m (a, MealyT m a a)
n a
a instanceFunctorm =>Profunctor(MealyT m )wherermap :: forall b c a. (b -> c) -> MealyT m a b -> MealyT m a c
rmap =(b -> c) -> MealyT m a b -> MealyT m a c
forall a b. (a -> b) -> MealyT m a a -> MealyT m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap{-# INLINErmap#-}lmap :: forall a b c. (a -> b) -> MealyT m b c -> MealyT m a c
lmap a -> b
f =MealyT m b c -> MealyT m a c
forall {m :: * -> *} {b}. Functor m => MealyT m b b -> MealyT m a b
go wherego :: MealyT m b b -> MealyT m a b
go (MealyT b -> m (b, MealyT m b b)
m )=(a -> m (b, MealyT m a b)) -> MealyT m a b
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT ((a -> m (b, MealyT m a b)) -> MealyT m a b)
-> (a -> m (b, MealyT m a b)) -> MealyT m a b
forall a b. (a -> b) -> a -> b
$\a
a ->((b, MealyT m b b) -> (b, MealyT m a b))
-> m (b, MealyT m b b) -> m (b, MealyT m a b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(\(b
b ,MealyT m b b
n )->(b
b ,MealyT m b b -> MealyT m a b
go MealyT m b b
n ))(b -> m (b, MealyT m b b)
m (a -> b
f a
a )){-# INLINElmap#-}dimap :: forall a b c d.
(a -> b) -> (c -> d) -> MealyT m b c -> MealyT m a d
dimap a -> b
f c -> d
g =MealyT m b c -> MealyT m a d
forall {m :: * -> *}. Functor m => MealyT m b c -> MealyT m a d
go wherego :: MealyT m b c -> MealyT m a d
go (MealyT b -> m (c, MealyT m b c)
m )=(a -> m (d, MealyT m a d)) -> MealyT m a d
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT ((a -> m (d, MealyT m a d)) -> MealyT m a d)
-> (a -> m (d, MealyT m a d)) -> MealyT m a d
forall a b. (a -> b) -> a -> b
$\a
a ->((c, MealyT m b c) -> (d, MealyT m a d))
-> m (c, MealyT m b c) -> m (d, MealyT m a d)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(\(c
b ,MealyT m b c
n )->(c -> d
g c
b ,MealyT m b c -> MealyT m a d
go MealyT m b c
n ))(b -> m (c, MealyT m b c)
m (a -> b
f a
a )){-# INLINEdimap#-}instanceMonadm =>C.Category(MealyT m )where{-# INLINEid#-}id :: forall a. MealyT m a a
id=(a -> m (a, MealyT m a a)) -> MealyT m a a
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT ((a -> m (a, MealyT m a a)) -> MealyT m a a)
-> (a -> m (a, MealyT m a a)) -> MealyT m a a
forall a b. (a -> b) -> a -> b
$\a
a ->(a, MealyT m a a) -> m (a, MealyT m a a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return(a
a ,MealyT m a a
forall a. MealyT m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
C.id)MealyT b -> m (c, MealyT m b c)
bc . :: forall b c a. MealyT m b c -> MealyT m a b -> MealyT m a c
. MealyT a -> m (b, MealyT m a b)
ab =(a -> m (c, MealyT m a c)) -> MealyT m a c
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT ((a -> m (c, MealyT m a c)) -> MealyT m a c)
-> (a -> m (c, MealyT m a c)) -> MealyT m a c
forall a b. (a -> b) -> a -> b
$\a
a ->do(b
b ,MealyT m a b
nab )<-a -> m (b, MealyT m a b)
ab a
a (c
c ,MealyT m b c
nbc )<-b -> m (c, MealyT m b c)
bc b
b (c, MealyT m a c) -> m (c, MealyT m a c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return(c
c ,MealyT m b c
nbc MealyT m b c -> MealyT m a b -> MealyT m a c
forall b c a. MealyT m b c -> MealyT m a b -> MealyT m a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
C..MealyT m a b
nab )instanceMonadm =>Arrow(MealyT m )where{-# INLINEarr#-}arr :: forall b c. (b -> c) -> MealyT m b c
arrb -> c
f =MealyT m b c
r wherer :: MealyT m b c
r =(b -> m (c, MealyT m b c)) -> MealyT m b c
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT (\b
a ->(c, MealyT m b c) -> m (c, MealyT m b c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return(b -> c
f b
a ,MealyT m b c
r ))first :: forall b c d. MealyT m b c -> MealyT m (b, d) (c, d)
first(MealyT b -> m (c, MealyT m b c)
m )=((b, d) -> m ((c, d), MealyT m (b, d) (c, d)))
-> MealyT m (b, d) (c, d)
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT (((b, d) -> m ((c, d), MealyT m (b, d) (c, d)))
 -> MealyT m (b, d) (c, d))
-> ((b, d) -> m ((c, d), MealyT m (b, d) (c, d)))
-> MealyT m (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$\(b
a ,d
c )->do(c
b ,MealyT m b c
n )<-b -> m (c, MealyT m b c)
m b
a ((c, d), MealyT m (b, d) (c, d))
-> m ((c, d), MealyT m (b, d) (c, d))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return((c
b ,d
c ),MealyT m b c -> MealyT m (b, d) (c, d)
forall b c d. MealyT m b c -> MealyT m (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
firstMealyT m b c
n )arrPure ::(a ->b )->MealyT Identitya b arrPure :: forall a b. (a -> b) -> MealyT Identity a b
arrPure =(a -> b) -> MealyT Identity a b
forall a b. (a -> b) -> MealyT Identity a b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arrarrM ::Functorm =>(a ->m b )->MealyT m a b arrM :: forall (m :: * -> *) a b. Functor m => (a -> m b) -> MealyT m a b
arrM a -> m b
f =MealyT m a b
r wherer :: MealyT m a b
r =(a -> m (b, MealyT m a b)) -> MealyT m a b
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT ((a -> m (b, MealyT m a b)) -> MealyT m a b)
-> (a -> m (b, MealyT m a b)) -> MealyT m a b
forall a b. (a -> b) -> a -> b
$\a
a ->(b -> (b, MealyT m a b)) -> m b -> m (b, MealyT m a b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(,MealyT m a b
r )(a -> m b
f a
a )upgrade ::Applicativem =>Mealy a b ->MealyT m a b upgrade :: forall (m :: * -> *) a b.
Applicative m =>
Mealy a b -> MealyT m a b
upgrade (Mealy a -> (b, Mealy a b)
f )=(a -> m (b, MealyT m a b)) -> MealyT m a b
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT ((a -> m (b, MealyT m a b)) -> MealyT m a b)
-> (a -> m (b, MealyT m a b)) -> MealyT m a b
forall a b. (a -> b) -> a -> b
$\a
a ->let(b
r ,Mealy a b
g )=a -> (b, Mealy a b)
f a
a in(b, MealyT m a b) -> m (b, MealyT m a b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure(b
r ,Mealy a b -> MealyT m a b
forall (m :: * -> *) a b.
Applicative m =>
Mealy a b -> MealyT m a b
upgrade Mealy a b
g )scanMealyT ::Applicativem =>(a ->b ->a )->a ->MealyT m b a scanMealyT :: forall (m :: * -> *) a b.
Applicative m =>
(a -> b -> a) -> a -> MealyT m b a
scanMealyT a -> b -> a
f a
a =(b -> m (a, MealyT m b a)) -> MealyT m b a
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT (\b
b ->(a, MealyT m b a) -> m (a, MealyT m b a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure(a
a ,(a -> b -> a) -> a -> MealyT m b a
forall (m :: * -> *) a b.
Applicative m =>
(a -> b -> a) -> a -> MealyT m b a
scanMealyT a -> b -> a
f (a -> b -> a
f a
a b
b )))scanMealyTM ::Functorm =>(a ->b ->m a )->a ->MealyT m b a scanMealyTM :: forall (m :: * -> *) a b.
Functor m =>
(a -> b -> m a) -> a -> MealyT m b a
scanMealyTM a -> b -> m a
f a
a =(b -> m (a, MealyT m b a)) -> MealyT m b a
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT ((b -> m (a, MealyT m b a)) -> MealyT m b a)
-> (b -> m (a, MealyT m b a)) -> MealyT m b a
forall a b. (a -> b) -> a -> b
$\b
b ->(\a
x ->(a
a ,(a -> b -> m a) -> a -> MealyT m b a
forall (m :: * -> *) a b.
Functor m =>
(a -> b -> m a) -> a -> MealyT m b a
scanMealyTM a -> b -> m a
f a
x ))(a -> (a, MealyT m b a)) -> m a -> m (a, MealyT m b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>a -> b -> m a
f a
a b
b autoMealyTImpl ::Monadm =>MealyT m a b ->ProcessT m a b autoMealyTImpl :: forall (m :: * -> *) a b. Monad m => MealyT m a b -> ProcessT m a b
autoMealyTImpl =PlanT (Is a) b m Any -> MachineT m (Is a) b
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
construct (PlanT (Is a) b m Any -> MachineT m (Is a) b)
-> (MealyT m a b -> PlanT (Is a) b m Any)
-> MealyT m a b
-> MachineT m (Is a) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MealyT m a b -> PlanT (Is a) b m Any
forall {k :: * -> * -> *} {m :: * -> *} {a} {o} {b}.
(Category k, Monad m) =>
MealyT m a o -> PlanT (k a) o m b
go wherego :: MealyT m a o -> PlanT (k a) o m b
go (MealyT a -> m (o, MealyT m a o)
f )=doa
a <-PlanT (k a) o m a
Plan (k a) o a
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await (o
b ,MealyT m a o
m )<-m (o, MealyT m a o) -> PlanT (k a) o m (o, MealyT m a o)
forall (m :: * -> *) a. Monad m => m a -> PlanT (k a) o m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(m (o, MealyT m a o) -> PlanT (k a) o m (o, MealyT m a o))
-> m (o, MealyT m a o) -> PlanT (k a) o m (o, MealyT m a o)
forall a b. (a -> b) -> a -> b
$a -> m (o, MealyT m a o)
f a
a o -> Plan (k a) o ()
forall o (k :: * -> *). o -> Plan k o ()
yield o
b MealyT m a o -> PlanT (k a) o m b
go MealyT m a o
m instanceAutomatonM MealyT whereautoT :: forall (m :: * -> *) a b. Monad m => MealyT m a b -> ProcessT m a b
autoT =MealyT m a b -> ProcessT m a b
forall (m :: * -> *) a b. Monad m => MealyT m a b -> ProcessT m a b
autoMealyTImpl instance(Semigroupb ,Applicativem )=>Semigroup(MealyT m a b )whereMealyT m a b
f <> :: MealyT m a b -> MealyT m a b -> MealyT m a b
<>MealyT m a b
g =(a -> m (b, MealyT m a b)) -> MealyT m a b
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT ((a -> m (b, MealyT m a b)) -> MealyT m a b)
-> (a -> m (b, MealyT m a b)) -> MealyT m a b
forall a b. (a -> b) -> a -> b
$\a
x ->(\(b
fx ,MealyT m a b
f' )(b
gx ,MealyT m a b
g' )->(b
fx b -> b -> b
forall a. Semigroup a => a -> a -> a
<>b
gx ,MealyT m a b
f' MealyT m a b -> MealyT m a b -> MealyT m a b
forall a. Semigroup a => a -> a -> a
<>MealyT m a b
g' ))((b, MealyT m a b) -> (b, MealyT m a b) -> (b, MealyT m a b))
-> m (b, MealyT m a b)
-> m ((b, MealyT m a b) -> (b, MealyT m a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>MealyT m a b -> a -> m (b, MealyT m a b)
forall (m :: * -> *) a b. MealyT m a b -> a -> m (b, MealyT m a b)
runMealyT MealyT m a b
f a
x m ((b, MealyT m a b) -> (b, MealyT m a b))
-> m (b, MealyT m a b) -> m (b, MealyT m a b)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>MealyT m a b -> a -> m (b, MealyT m a b)
forall (m :: * -> *) a b. MealyT m a b -> a -> m (b, MealyT m a b)
runMealyT MealyT m a b
g a
x instance(Semigroupb ,Monoidb ,Applicativem )=>Monoid(MealyT m a b )wheremempty :: MealyT m a b
mempty=(a -> m (b, MealyT m a b)) -> MealyT m a b
forall (m :: * -> *) a b.
(a -> m (b, MealyT m a b)) -> MealyT m a b
MealyT ((a -> m (b, MealyT m a b)) -> MealyT m a b)
-> (a -> m (b, MealyT m a b)) -> MealyT m a b
forall a b. (a -> b) -> a -> b
$\a
_->(b, MealyT m a b) -> m (b, MealyT m a b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure(b, MealyT m a b)
forall a. Monoid a => a
memptymappend :: MealyT m a b -> MealyT m a b -> MealyT m a b
mappend=MealyT m a b -> MealyT m a b -> MealyT m a b
forall a. Semigroup a => a -> a -> a
(<>)