{-# LANGUAGE CPP #-}{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE MultiParamTypeClasses #-}------------------------------------------------------------------------------- |-- Module : Data.Machine.Mealy-- Copyright : (C) 2012 Edward Kmett-- License : BSD-style (see the file LICENSE)---- Maintainer : Edward Kmett <ekmett@gmail.com>-- Stability : provisional-- Portability : portable---- <http://en.wikipedia.org/wiki/Mealy_machine>----------------------------------------------------------------------------moduleData.Machine.Mealy(Mealy (..),unfoldMealy ,logMealy )whereimportControl.ApplicativeimportControl.ArrowimportControl.CategoryimportData.DistributiveimportData.Functor.ExtendimportData.Functor.RepasFunctorimportData.List.NonEmptyasNonEmptyimportData.Machine.Plan importData.Machine.Type importData.Machine.Process importData.Profunctor.ClosedimportData.ProfunctorimportData.Profunctor.SieveimportData.Profunctor.RepasProfunctorimportData.PointedimportData.SemigroupimportData.SequenceasSeqimportPreludehiding((.),id)-- $setup-- >>> import Data.Machine-- | 'Mealy' machines---- ==== Examples---- We can enumerate inputs:---- >>> let countingMealy = unfoldMealy (\i x -> ((i, x), i + 1)) 0-- >>> run (auto countingMealy <~ source "word")-- [(0,'w'),(1,'o'),(2,'r'),(3,'d')]--newtypeMealy a b =Mealy {forall a b. Mealy a b -> a -> (b, Mealy a b)
runMealy ::a ->(b ,Mealy a b )}instanceFunctor(Mealy a )wherefmap :: forall a b. (a -> b) -> Mealy a a -> Mealy a b
fmapa -> b
f (Mealy a -> (a, Mealy a a)
m )=(a -> (b, Mealy a b)) -> Mealy a b
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a -> (b, Mealy a b)) -> Mealy a b)
-> (a -> (b, Mealy a b)) -> Mealy a b
forall a b. (a -> b) -> a -> b
$\a
a ->casea -> (a, Mealy a a)
m a
a of(a
b ,Mealy a a
n )->(a -> b
f a
b ,(a -> b) -> Mealy a a -> Mealy a b
forall a b. (a -> b) -> Mealy a a -> Mealy a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapa -> b
f Mealy a a
n ){-# INLINEfmap#-}a
b <$ :: forall a b. a -> Mealy a b -> Mealy a a
<$ Mealy a b
_=a -> Mealy a a
forall a. a -> Mealy a a
forall (f :: * -> *) a. Applicative f => a -> f a
purea
b {-# INLINE(<$)#-}instanceApplicative(Mealy a )wherepure :: forall a. a -> Mealy a a
purea
b =Mealy a a
r wherer :: Mealy a a
r =(a -> (a, Mealy a a)) -> Mealy a a
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a, Mealy a a) -> a -> (a, Mealy a a)
forall a b. a -> b -> a
const(a
b ,Mealy a a
r )){-# INLINEpure#-}Mealy a -> (a -> b, Mealy a (a -> b))
m <*> :: forall a b. Mealy a (a -> b) -> Mealy a a -> Mealy a b
<*>Mealy a -> (a, Mealy a a)
n =(a -> (b, Mealy a b)) -> Mealy a b
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a -> (b, Mealy a b)) -> Mealy a b)
-> (a -> (b, Mealy a b)) -> Mealy a b
forall a b. (a -> b) -> a -> b
$\a
a ->casea -> (a -> b, Mealy a (a -> b))
m a
a of(a -> b
f ,Mealy a (a -> b)
m' )->casea -> (a, Mealy a a)
n a
a of(a
b ,Mealy a a
n' )->(a -> b
f a
b ,Mealy a (a -> b)
m' Mealy a (a -> b) -> Mealy a a -> Mealy a b
forall a b. Mealy a (a -> b) -> Mealy a a -> Mealy a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>Mealy a a
n' )Mealy a a
m <* :: forall a b. Mealy a a -> Mealy a b -> Mealy a a
<* Mealy a b
_=Mealy a a
m {-# INLINE(<*)#-}Mealy a a
_*> :: forall a b. Mealy a a -> Mealy a b -> Mealy a b
*>Mealy a b
n =Mealy a b
n {-# INLINE(*>)#-}instancePointed(Mealy a )wherepoint :: forall a. a -> Mealy a a
point a
b =Mealy a a
r wherer :: Mealy a a
r =(a -> (a, Mealy a a)) -> Mealy a a
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a, Mealy a a) -> a -> (a, Mealy a a)
forall a b. a -> b -> a
const(a
b ,Mealy a a
r )){-# INLINEpoint#-}instanceExtend(Mealy a )whereduplicated :: forall a. Mealy a a -> Mealy a (Mealy a a)
duplicated (Mealy a -> (a, Mealy a a)
m )=(a -> (Mealy a a, Mealy a (Mealy a a))) -> Mealy a (Mealy a a)
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a -> (Mealy a a, Mealy a (Mealy a a))) -> Mealy a (Mealy a a))
-> (a -> (Mealy a a, Mealy a (Mealy a a))) -> Mealy a (Mealy a a)
forall a b. (a -> b) -> a -> b
$\a
a ->casea -> (a, Mealy a a)
m a
a of(a
_,Mealy a a
b )->(Mealy a a
b ,Mealy a a -> Mealy a (Mealy a a)
forall a. Mealy a a -> Mealy a (Mealy a a)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicatedMealy a a
b )-- | A 'Mealy' machine modeled with explicit state.unfoldMealy ::(s ->a ->(b ,s ))->s ->Mealy a b unfoldMealy :: forall s a b. (s -> a -> (b, s)) -> s -> Mealy a b
unfoldMealy s -> a -> (b, s)
f =s -> Mealy a b
go wherego :: s -> Mealy a b
go s
s =(a -> (b, Mealy a b)) -> Mealy a b
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a -> (b, Mealy a b)) -> Mealy a b)
-> (a -> (b, Mealy a b)) -> Mealy a b
forall a b. (a -> b) -> a -> b
$\a
a ->cases -> a -> (b, s)
f s
s a
a of(b
b ,s
t )->(b
b ,s -> Mealy a b
go s
t ){-# INLINEunfoldMealy #-}instanceProfunctorMealy wherermap :: forall b c a. (b -> c) -> Mealy a b -> Mealy a c
rmap =(b -> c) -> Mealy a b -> Mealy a c
forall a b. (a -> b) -> Mealy a a -> Mealy a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap{-# INLINErmap#-}lmap :: forall a b c. (a -> b) -> Mealy b c -> Mealy a c
lmap a -> b
f =Mealy b c -> Mealy a c
go wherego :: Mealy b c -> Mealy a c
go (Mealy b -> (c, Mealy b c)
m )=(a -> (c, Mealy a c)) -> Mealy a c
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a -> (c, Mealy a c)) -> Mealy a c)
-> (a -> (c, Mealy a c)) -> Mealy a c
forall a b. (a -> b) -> a -> b
$\a
a ->caseb -> (c, Mealy b c)
m (a -> b
f a
a )of(c
b ,Mealy b c
n )->(c
b ,Mealy b c -> Mealy a c
go Mealy b c
n ){-# INLINElmap#-}dimap :: forall a b c d. (a -> b) -> (c -> d) -> Mealy b c -> Mealy a d
dimap a -> b
f c -> d
g =Mealy b c -> Mealy a d
go wherego :: Mealy b c -> Mealy a d
go (Mealy b -> (c, Mealy b c)
m )=(a -> (d, Mealy a d)) -> Mealy a d
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a -> (d, Mealy a d)) -> Mealy a d)
-> (a -> (d, Mealy a d)) -> Mealy a d
forall a b. (a -> b) -> a -> b
$\a
a ->caseb -> (c, Mealy b c)
m (a -> b
f a
a )of(c
b ,Mealy b c
n )->(c -> d
g c
b ,Mealy b c -> Mealy a d
go Mealy b c
n ){-# INLINEdimap#-}instanceAutomaton Mealy whereauto :: forall a b. Mealy a b -> Process a b
auto Mealy a b
x =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)
-> PlanT (Is a) b m Any -> MachineT m (Is a) b
forall a b. (a -> b) -> a -> b
$Mealy a b -> PlanT (Is a) b m Any
forall {k :: * -> * -> *} {a} {o} {m :: * -> *} {b}.
Category k =>
Mealy a o -> PlanT (k a) o m b
go Mealy a b
x wherego :: Mealy a o -> PlanT (k a) o m b
go (Mealy a -> (o, Mealy a o)
f )=PlanT (k a) o m a
Plan (k a) o a
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await PlanT (k a) o m a -> (a -> PlanT (k a) o m b) -> PlanT (k a) o m b
forall a b.
PlanT (k a) o m a -> (a -> PlanT (k a) o m b) -> PlanT (k a) o m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=\a
a ->casea -> (o, Mealy a o)
f a
a of(o
b ,Mealy a o
m )->doo -> Plan (k a) o ()
forall o (k :: * -> *). o -> Plan k o ()
yield o
b Mealy a o -> PlanT (k a) o m b
go Mealy a o
m {-# INLINEauto #-}instanceCategoryMealy whereid :: forall a. Mealy a a
id =(a -> (a, Mealy a a)) -> Mealy a a
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy (\a
a ->(a
a ,Mealy a a
forall a. Mealy a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id))Mealy b -> (c, Mealy b c)
bc . :: forall b c a. Mealy b c -> Mealy a b -> Mealy a c
. Mealy a -> (b, Mealy a b)
ab =(a -> (c, Mealy a c)) -> Mealy a c
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a -> (c, Mealy a c)) -> Mealy a c)
-> (a -> (c, Mealy a c)) -> Mealy a c
forall a b. (a -> b) -> a -> b
$\a
a ->casea -> (b, Mealy a b)
ab a
a of(b
b ,Mealy a b
nab )->caseb -> (c, Mealy b c)
bc b
b of(c
c ,Mealy b c
nbc )->(c
c ,Mealy b c
nbc Mealy b c -> Mealy a b -> Mealy a c
forall b c a. Mealy b c -> Mealy a b -> Mealy a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Mealy a b
nab )instanceArrowMealy wherearr :: forall b c. (b -> c) -> Mealy b c
arrb -> c
f =Mealy b c
r wherer :: Mealy b c
r =(b -> (c, Mealy b c)) -> Mealy b c
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy (\b
a ->(b -> c
f b
a ,Mealy b c
r )){-# INLINEarr#-}first :: forall b c d. Mealy b c -> Mealy (b, d) (c, d)
first(Mealy b -> (c, Mealy b c)
m )=((b, d) -> ((c, d), Mealy (b, d) (c, d))) -> Mealy (b, d) (c, d)
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy (((b, d) -> ((c, d), Mealy (b, d) (c, d))) -> Mealy (b, d) (c, d))
-> ((b, d) -> ((c, d), Mealy (b, d) (c, d))) -> Mealy (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$\(b
a ,d
c )->caseb -> (c, Mealy b c)
m b
a of(c
b ,Mealy b c
n )->((c
b ,d
c ),Mealy b c -> Mealy (b, d) (c, d)
forall b c d. Mealy b c -> Mealy (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
firstMealy b c
n )instanceArrowChoiceMealy whereleft :: forall b c d. Mealy b c -> Mealy (Either b d) (Either c d)
left Mealy b c
m =(Either b d -> (Either c d, Mealy (Either b d) (Either c d)))
-> Mealy (Either b d) (Either c d)
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((Either b d -> (Either c d, Mealy (Either b d) (Either c d)))
 -> Mealy (Either b d) (Either c d))
-> (Either b d -> (Either c d, Mealy (Either b d) (Either c d)))
-> Mealy (Either b d) (Either c d)
forall a b. (a -> b) -> a -> b
$\Either b d
a ->caseEither b d
a ofLeftb
l ->caseMealy b c -> b -> (c, Mealy b c)
forall a b. Mealy a b -> a -> (b, Mealy a b)
runMealy Mealy b c
m b
l of(c
b ,Mealy b c
m' )->(c -> Either c d
forall a b. a -> Either a b
Leftc
b ,Mealy b c -> Mealy (Either b d) (Either c d)
forall b c d. Mealy b c -> Mealy (Either b d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
leftMealy b c
m' )Rightd
r ->(d -> Either c d
forall a b. b -> Either a b
Rightd
r ,Mealy b c -> Mealy (Either b d) (Either c d)
forall b c d. Mealy b c -> Mealy (Either b d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
leftMealy b c
m )right :: forall b c d. Mealy b c -> Mealy (Either d b) (Either d c)
right Mealy b c
m =(Either d b -> (Either d c, Mealy (Either d b) (Either d c)))
-> Mealy (Either d b) (Either d c)
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((Either d b -> (Either d c, Mealy (Either d b) (Either d c)))
 -> Mealy (Either d b) (Either d c))
-> (Either d b -> (Either d c, Mealy (Either d b) (Either d c)))
-> Mealy (Either d b) (Either d c)
forall a b. (a -> b) -> a -> b
$\Either d b
a ->caseEither d b
a ofLeftd
l ->(d -> Either d c
forall a b. a -> Either a b
Leftd
l ,Mealy b c -> Mealy (Either d b) (Either d c)
forall b c d. Mealy b c -> Mealy (Either d b) (Either d c)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
rightMealy b c
m )Rightb
r ->caseMealy b c -> b -> (c, Mealy b c)
forall a b. Mealy a b -> a -> (b, Mealy a b)
runMealy Mealy b c
m b
r of(c
b ,Mealy b c
m' )->(c -> Either d c
forall a b. b -> Either a b
Rightc
b ,Mealy b c -> Mealy (Either d b) (Either d c)
forall b c d. Mealy b c -> Mealy (Either d b) (Either d c)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
rightMealy b c
m' )Mealy b c
m +++ :: forall b c b' c'.
Mealy b c -> Mealy b' c' -> Mealy (Either b b') (Either c c')
+++ Mealy b' c'
n =(Either b b' -> (Either c c', Mealy (Either b b') (Either c c')))
-> Mealy (Either b b') (Either c c')
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((Either b b' -> (Either c c', Mealy (Either b b') (Either c c')))
 -> Mealy (Either b b') (Either c c'))
-> (Either b b'
 -> (Either c c', Mealy (Either b b') (Either c c')))
-> Mealy (Either b b') (Either c c')
forall a b. (a -> b) -> a -> b
$\Either b b'
a ->caseEither b b'
a ofLeftb
b ->caseMealy b c -> b -> (c, Mealy b c)
forall a b. Mealy a b -> a -> (b, Mealy a b)
runMealy Mealy b c
m b
b of(c
c ,Mealy b c
m' )->(c -> Either c c'
forall a b. a -> Either a b
Leftc
c ,Mealy b c
m' Mealy b c -> Mealy b' c' -> Mealy (Either b b') (Either c c')
forall b c b' c'.
Mealy b c -> Mealy b' c' -> Mealy (Either b b') (Either c c')
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++Mealy b' c'
n )Rightb'
b ->caseMealy b' c' -> b' -> (c', Mealy b' c')
forall a b. Mealy a b -> a -> (b, Mealy a b)
runMealy Mealy b' c'
n b'
b of(c'
c ,Mealy b' c'
n' )->(c' -> Either c c'
forall a b. b -> Either a b
Rightc'
c ,Mealy b c
m Mealy b c -> Mealy b' c' -> Mealy (Either b b') (Either c c')
forall b c b' c'.
Mealy b c -> Mealy b' c' -> Mealy (Either b b') (Either c c')
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++Mealy b' c'
n' )Mealy b d
m ||| :: forall b d c. Mealy b d -> Mealy c d -> Mealy (Either b c) d
|||Mealy c d
n =(Either b c -> (d, Mealy (Either b c) d)) -> Mealy (Either b c) d
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((Either b c -> (d, Mealy (Either b c) d)) -> Mealy (Either b c) d)
-> (Either b c -> (d, Mealy (Either b c) d))
-> Mealy (Either b c) d
forall a b. (a -> b) -> a -> b
$\Either b c
a ->caseEither b c
a ofLeftb
b ->caseMealy b d -> b -> (d, Mealy b d)
forall a b. Mealy a b -> a -> (b, Mealy a b)
runMealy Mealy b d
m b
b of(d
d ,Mealy b d
m' )->(d
d ,Mealy b d
m' Mealy b d -> Mealy c d -> Mealy (Either b c) d
forall b d c. Mealy b d -> Mealy c d -> Mealy (Either b c) d
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
|||Mealy c d
n )Rightc
b ->caseMealy c d -> c -> (d, Mealy c d)
forall a b. Mealy a b -> a -> (b, Mealy a b)
runMealy Mealy c d
n c
b of(d
d ,Mealy c d
n' )->(d
d ,Mealy b d
m Mealy b d -> Mealy c d -> Mealy (Either b c) d
forall b d c. Mealy b d -> Mealy c d -> Mealy (Either b c) d
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
|||Mealy c d
n' )instanceStrongMealy wherefirst' :: forall b c d. Mealy b c -> Mealy (b, d) (c, d)
first' =Mealy a b -> Mealy (a, c) (b, c)
forall b c d. Mealy b c -> Mealy (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
firstinstanceChoiceMealy whereleft' :: forall b c d. Mealy b c -> Mealy (Either b d) (Either c d)
left' =Mealy a b -> Mealy (Either a c) (Either b c)
forall b c d. Mealy b c -> Mealy (Either b d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
leftright' :: forall b c d. Mealy b c -> Mealy (Either d b) (Either d c)
right' =Mealy a b -> Mealy (Either c a) (Either c b)
forall b c d. Mealy b c -> Mealy (Either d b) (Either d c)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right-- | Fast forward a mealy machine forwarddriveMealy ::Mealy a b ->Seqa ->a ->(b ,Mealy a b )driveMealy :: forall a b. Mealy a b -> Seq a -> a -> (b, Mealy a b)
driveMealy Mealy a b
m Seq a
xs a
z =caseSeq a -> ViewL a
forall a. Seq a -> ViewL a
viewlSeq a
xs ofa
y :<Seq a
ys ->caseMealy a b -> a -> (b, Mealy a b)
forall a b. Mealy a b -> a -> (b, Mealy a b)
runMealy Mealy a b
m a
y of(b
_,Mealy a b
n )->Mealy a b -> Seq a -> a -> (b, Mealy a b)
forall a b. Mealy a b -> Seq a -> a -> (b, Mealy a b)
driveMealy Mealy a b
n Seq a
ys a
z ViewL a
EmptyL->Mealy a b -> a -> (b, Mealy a b)
forall a b. Mealy a b -> a -> (b, Mealy a b)
runMealy Mealy a b
m a
z -- | Accumulate history.logMealy ::Semigroupa =>Mealy a a logMealy :: forall a. Semigroup a => Mealy a a
logMealy =(a -> (a, Mealy a a)) -> Mealy a a
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a -> (a, Mealy a a)) -> Mealy a a)
-> (a -> (a, Mealy a a)) -> Mealy a a
forall a b. (a -> b) -> a -> b
$\a
a ->(a
a ,a -> Mealy a a
forall {t}. Semigroup t => t -> Mealy t t
h a
a )whereh :: t -> Mealy t t
h t
a =(t -> (t, Mealy t t)) -> Mealy t t
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((t -> (t, Mealy t t)) -> Mealy t t)
-> (t -> (t, Mealy t t)) -> Mealy t t
forall a b. (a -> b) -> a -> b
$\t
b ->letc :: t
c =t
a t -> t -> t
forall a. Semigroup a => a -> a -> a
<>t
b in(t
c ,t -> Mealy t t
h t
c ){-# INLINElogMealy #-}instanceArrowApplyMealy whereapp :: forall b c. Mealy (Mealy b c, b) c
app=Seq b -> Mealy (Mealy b c, b) c
forall {a} {b}. Seq a -> Mealy (Mealy a b, a) b
go Seq b
forall a. Seq a
Seq.emptywherego :: Seq a -> Mealy (Mealy a b, a) b
go Seq a
xs =((Mealy a b, a) -> (b, Mealy (Mealy a b, a) b))
-> Mealy (Mealy a b, a) b
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy (((Mealy a b, a) -> (b, Mealy (Mealy a b, a) b))
 -> Mealy (Mealy a b, a) b)
-> ((Mealy a b, a) -> (b, Mealy (Mealy a b, a) b))
-> Mealy (Mealy a b, a) b
forall a b. (a -> b) -> a -> b
$\(Mealy a b
m ,a
x )->caseMealy a b -> Seq a -> a -> (b, Mealy a b)
forall a b. Mealy a b -> Seq a -> a -> (b, Mealy a b)
driveMealy Mealy a b
m Seq a
xs a
x of(b
c ,Mealy a b
_)->(b
c ,Seq a -> Mealy (Mealy a b, a) b
go (Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|>a
x )){-# INLINEapp#-}instanceDistributive(Mealy a )wheredistribute :: forall (f :: * -> *) a. Functor f => f (Mealy a a) -> Mealy a (f a)
distribute f (Mealy a a)
fm =(a -> (f a, Mealy a (f a))) -> Mealy a (f a)
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a -> (f a, Mealy a (f a))) -> Mealy a (f a))
-> (a -> (f a, Mealy a (f a))) -> Mealy a (f a)
forall a b. (a -> b) -> a -> b
$\a
a ->letfp :: f (a, Mealy a a)
fp =(Mealy a a -> (a, Mealy a a)) -> f (Mealy a a) -> f (a, Mealy a a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(Mealy a a -> a -> (a, Mealy a a)
forall a b. Mealy a b -> a -> (b, Mealy a b)
`runMealy` a
a )f (Mealy a a)
fm in(((a, Mealy a a) -> a) -> f (a, Mealy a a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(a, Mealy a a) -> a
forall a b. (a, b) -> a
fstf (a, Mealy a a)
fp ,((a, Mealy a a) -> Mealy a a) -> f (a, Mealy a a) -> Mealy a (f a)
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
forall (f :: * -> *) a b.
Functor f =>
(a -> Mealy a b) -> f a -> Mealy a (f b)
collect(a, Mealy a a) -> Mealy a a
forall a b. (a, b) -> b
sndf (a, Mealy a a)
fp )collect :: forall (f :: * -> *) a b.
Functor f =>
(a -> Mealy a b) -> f a -> Mealy a (f b)
collecta -> Mealy a b
k f a
fa =(a -> (f b, Mealy a (f b))) -> Mealy a (f b)
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a -> (f b, Mealy a (f b))) -> Mealy a (f b))
-> (a -> (f b, Mealy a (f b))) -> Mealy a (f b)
forall a b. (a -> b) -> a -> b
$\a
a ->letfp :: f (b, Mealy a b)
fp =(a -> (b, Mealy a b)) -> f a -> f (b, Mealy a b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(\a
x ->Mealy a b -> a -> (b, Mealy a b)
forall a b. Mealy a b -> a -> (b, Mealy a b)
runMealy (a -> Mealy a b
k a
x )a
a )f a
fa in(((b, Mealy a b) -> b) -> f (b, Mealy a b) -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(b, Mealy a b) -> b
forall a b. (a, b) -> a
fstf (b, Mealy a b)
fp ,((b, Mealy a b) -> Mealy a b) -> f (b, Mealy a b) -> Mealy a (f b)
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
forall (f :: * -> *) a b.
Functor f =>
(a -> Mealy a b) -> f a -> Mealy a (f b)
collect(b, Mealy a b) -> Mealy a b
forall a b. (a, b) -> b
sndf (b, Mealy a b)
fp )instanceFunctor.Representable(Mealy a )wheretypeRep(Mealy a )=NonEmptya index :: forall a. Mealy a a -> Rep (Mealy a) -> a
index =Mealy a a -> NonEmpty a -> a
Mealy a a -> Rep (Mealy a) -> a
forall a b. Mealy a b -> NonEmpty a -> b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosievetabulate :: forall a. (Rep (Mealy a) -> a) -> Mealy a a
tabulate =(Rep (Mealy a) -> a) -> Mealy a a
(Corep Mealy a -> a) -> Mealy a a
forall d c. (Corep Mealy d -> c) -> Mealy d c
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulateinstanceCosieveMealy NonEmptywherecosieve :: forall a b. Mealy a b -> NonEmpty a -> b
cosieveMealy a b
m0 (a
a0 :|[a]
as0 )=Mealy a b -> a -> [a] -> b
forall {t} {b}. Mealy t b -> t -> [t] -> b
go Mealy a b
m0 a
a0 [a]
as0 wherego :: Mealy t b -> t -> [t] -> b
go (Mealy t -> (b, Mealy t b)
m )t
a [t]
as =caset -> (b, Mealy t b)
m t
a of(b
b ,Mealy t b
m' )->case[t]
as of[]->b
b t
a' :[t]
as' ->Mealy t b -> t -> [t] -> b
go Mealy t b
m' t
a' [t]
as' instanceCostrongMealy whereunfirst :: forall a d b. Mealy (a, d) (b, d) -> Mealy a b
unfirst =Mealy (a, d) (b, d) -> Mealy a b
forall (p :: * -> * -> *) a d b.
Corepresentable p =>
p (a, d) (b, d) -> p a b
unfirstCorepunsecond :: forall d a b. Mealy (d, a) (d, b) -> Mealy a b
unsecond =Mealy (d, a) (d, b) -> Mealy a b
forall (p :: * -> * -> *) d a b.
Corepresentable p =>
p (d, a) (d, b) -> p a b
unsecondCorepinstanceProfunctor.CorepresentableMealy wheretypeCorepMealy =NonEmptycotabulate :: forall d c. (Corep Mealy d -> c) -> Mealy d c
cotabulateCorep Mealy d -> c
f0 =(d -> (c, Mealy d c)) -> Mealy d c
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((d -> (c, Mealy d c)) -> Mealy d c)
-> (d -> (c, Mealy d c)) -> Mealy d c
forall a b. (a -> b) -> a -> b
$\d
a ->[d] -> (NonEmpty d -> c) -> (c, Mealy d c)
forall {a} {b}. [a] -> (NonEmpty a -> b) -> (b, Mealy a b)
go [d
a ]NonEmpty d -> c
Corep Mealy d -> c
f0 wherego :: [a] -> (NonEmpty a -> b) -> (b, Mealy a b)
go [a]
as NonEmpty a -> b
f =(NonEmpty a -> b
f ([a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList([a] -> [a]
forall a. [a] -> [a]
Prelude.reverse[a]
as )),(a -> (b, Mealy a b)) -> Mealy a b
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a -> (b, Mealy a b)) -> Mealy a b)
-> (a -> (b, Mealy a b)) -> Mealy a b
forall a b. (a -> b) -> a -> b
$\a
b ->[a] -> (NonEmpty a -> b) -> (b, Mealy a b)
go (a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as )NonEmpty a -> b
f )instanceClosedMealy whereclosed :: forall a b x. Mealy a b -> Mealy (x -> a) (x -> b)
closed Mealy a b
m =(Corep Mealy (x -> a) -> x -> b) -> Mealy (x -> a) (x -> b)
forall d c. (Corep Mealy d -> c) -> Mealy d c
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate((Corep Mealy (x -> a) -> x -> b) -> Mealy (x -> a) (x -> b))
-> (Corep Mealy (x -> a) -> x -> b) -> Mealy (x -> a) (x -> b)
forall a b. (a -> b) -> a -> b
$\Corep Mealy (x -> a)
fs x
x ->Mealy a b -> NonEmpty a -> b
forall a b. Mealy a b -> NonEmpty a -> b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieveMealy a b
m (((x -> a) -> a) -> NonEmpty (x -> a) -> NonEmpty a
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((x -> a) -> x -> a
forall a b. (a -> b) -> a -> b
$x
x )NonEmpty (x -> a)
Corep Mealy (x -> a)
fs )instanceSemigroupb =>Semigroup(Mealy a b )whereMealy a b
f <> :: Mealy a b -> Mealy a b -> Mealy a b
<>Mealy a b
g =(a -> (b, Mealy a b)) -> Mealy a b
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy ((a -> (b, Mealy a b)) -> Mealy a b)
-> (a -> (b, Mealy a b)) -> Mealy a b
forall a b. (a -> b) -> a -> b
$\a
x ->Mealy a b -> a -> (b, Mealy a b)
forall a b. Mealy a b -> a -> (b, Mealy a b)
runMealy Mealy a b
f a
x (b, Mealy a b) -> (b, Mealy a b) -> (b, Mealy a b)
forall a. Semigroup a => a -> a -> a
<>Mealy a b -> a -> (b, Mealy a b)
forall a b. Mealy a b -> a -> (b, Mealy a b)
runMealy Mealy a b
g a
x instanceMonoidb =>Monoid(Mealy a b )wheremempty :: Mealy a b
mempty=(a -> (b, Mealy a b)) -> Mealy a b
forall a b. (a -> (b, Mealy a b)) -> Mealy a b
Mealy a -> (b, Mealy a b)
forall a. Monoid a => a
mempty
#if !(MIN_VERSION_base(4,11,0))
mappendfg=Mealy$\x->runMealyfx`mappend`runMealygx
#endif