{-# LANGUAGE CPP #-}{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE MultiParamTypeClasses #-}------------------------------------------------------------------------------- |-- Module : Data.Machine.Moore-- 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/Moore_machine>----------------------------------------------------------------------------moduleData.Machine.Moore(Moore (..),logMoore ,unfoldMoore )whereimportControl.ApplicativeimportControl.ComonadimportControl.Monad.FiximportControl.Monad.Reader.ClassimportControl.Monad.ZipimportData.CopointedimportData.DistributiveimportData.Functor.RepasFunctorimportData.Machine.Plan importData.Machine.Type importData.Machine.Process importData.SemigroupimportData.PointedimportData.Profunctor.ClosedimportData.ProfunctorimportData.Profunctor.SieveimportData.Profunctor.RepasProfunctorimportPrelude-- | 'Moore' machinesdataMoore a b =Moore b (a ->Moore a b )-- | Accumulate the input as a sequence.logMoore ::Monoidm =>Moore m m logMoore :: forall m. Monoid m => Moore m m
logMoore =m -> Moore m m
forall {t}. Monoid t => t -> Moore t t
h m
forall a. Monoid a => a
memptywhereh :: t -> Moore t t
h t
m =t -> (t -> Moore t t) -> Moore t t
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore t
m (\t
a ->t -> Moore t t
h (t
m t -> t -> t
forall a. Monoid a => a -> a -> a
`mappend`t
a )){-# INLINElogMoore #-}-- | Construct a Moore machine from a state valuation and transition functionunfoldMoore ::(s ->(b ,a ->s ))->s ->Moore a b unfoldMoore :: forall s b a. (s -> (b, a -> s)) -> s -> Moore a b
unfoldMoore s -> (b, a -> s)
f =s -> Moore a b
go wherego :: s -> Moore a b
go s
s =cases -> (b, a -> s)
f s
s of(b
b ,a -> s
g )->b -> (a -> Moore a b) -> Moore a b
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore b
b (s -> Moore a b
go (s -> Moore a b) -> (a -> s) -> a -> Moore a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> s
g ){-# INLINEunfoldMoore #-}instanceAutomaton Moore whereauto :: forall a b. Moore a b -> Process a b
auto Moore 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
$Moore a b -> PlanT (Is a) b m Any
forall {k :: * -> * -> *} {a} {o} {m :: * -> *} {b}.
Category k =>
Moore a o -> PlanT (k a) o m b
go Moore a b
x wherego :: Moore a o -> PlanT (k a) o m b
go (Moore o
b a -> Moore a o
f )=doo -> Plan (k a) o ()
forall o (k :: * -> *). o -> Plan k o ()
yield o
b 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
>>=Moore a o -> PlanT (k a) o m b
go (Moore a o -> PlanT (k a) o m b)
-> (a -> Moore a o) -> a -> PlanT (k a) o m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Moore a o
f {-# INLINEauto #-}instanceFunctor(Moore a )wherefmap :: forall a b. (a -> b) -> Moore a a -> Moore a b
fmapa -> b
f (Moore a
b a -> Moore a a
g )=b -> (a -> Moore a b) -> Moore a b
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore (a -> b
f a
b )((a -> b) -> Moore a a -> Moore a b
forall a b. (a -> b) -> Moore a a -> Moore a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapa -> b
f (Moore a a -> Moore a b) -> (a -> Moore a a) -> a -> Moore a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Moore a a
g ){-# INLINEfmap#-}a
a <$ :: forall a b. a -> Moore a b -> Moore a a
<$ Moore a b
_=a -> Moore a a
forall a. a -> Moore a a
forall (m :: * -> *) a. Monad m => a -> m a
returna
a {-# INLINE(<$)#-}instanceProfunctorMoore wherermap :: forall b c a. (b -> c) -> Moore a b -> Moore a c
rmap =(b -> c) -> Moore a b -> Moore a c
forall a b. (a -> b) -> Moore a a -> Moore a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap{-# INLINErmap#-}lmap :: forall a b c. (a -> b) -> Moore b c -> Moore a c
lmap a -> b
f =Moore b c -> Moore a c
go wherego :: Moore b c -> Moore a c
go (Moore c
b b -> Moore b c
g )=c -> (a -> Moore a c) -> Moore a c
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore c
b (Moore b c -> Moore a c
go (Moore b c -> Moore a c) -> (a -> Moore b c) -> a -> Moore a c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.b -> Moore b c
g (b -> Moore b c) -> (a -> b) -> a -> Moore b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> b
f ){-# INLINElmap#-}dimap :: forall a b c d. (a -> b) -> (c -> d) -> Moore b c -> Moore a d
dimap a -> b
f c -> d
g =Moore b c -> Moore a d
go wherego :: Moore b c -> Moore a d
go (Moore c
b b -> Moore b c
h )=d -> (a -> Moore a d) -> Moore a d
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore (c -> d
g c
b )(Moore b c -> Moore a d
go (Moore b c -> Moore a d) -> (a -> Moore b c) -> a -> Moore a d
forall b c a. (b -> c) -> (a -> b) -> a -> c
.b -> Moore b c
h (b -> Moore b c) -> (a -> b) -> a -> Moore b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> b
f ){-# INLINEdimap#-}instanceApplicative(Moore a )wherepure :: forall a. a -> Moore a a
purea
a =Moore a a
r wherer :: Moore a a
r =a -> (a -> Moore a a) -> Moore a a
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore a
a (Moore a a -> a -> Moore a a
forall a b. a -> b -> a
constMoore a a
r ){-# INLINEpure#-}Moore a -> b
f a -> Moore a (a -> b)
ff <*> :: forall a b. Moore a (a -> b) -> Moore a a -> Moore a b
<*>Moore a
a a -> Moore a a
fa =b -> (a -> Moore a b) -> Moore a b
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore (a -> b
f a
a )(\a
i ->a -> Moore a (a -> b)
ff a
i Moore a (a -> b) -> Moore a a -> Moore a b
forall a b. Moore a (a -> b) -> Moore a a -> Moore a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>a -> Moore a a
fa a
i )Moore a a
m <* :: forall a b. Moore a a -> Moore a b -> Moore a a
<* Moore a b
_=Moore a a
m {-# INLINE(<*)#-}Moore a a
_*> :: forall a b. Moore a a -> Moore a b -> Moore a b
*>Moore a b
n =Moore a b
n {-# INLINE(*>)#-}instancePointed(Moore a )wherepoint :: forall a. a -> Moore a a
point a
a =Moore a a
r wherer :: Moore a a
r =a -> (a -> Moore a a) -> Moore a a
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore a
a (Moore a a -> a -> Moore a a
forall a b. a -> b -> a
constMoore a a
r ){-# INLINEpoint#-}-- | slow diagonalizationinstanceMonad(Moore a )wherereturn :: forall a. a -> Moore a a
return=a -> Moore a a
forall a. a -> Moore a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure{-# INLINEreturn#-}Moore a a
k >>= :: forall a b. Moore a a -> (a -> Moore a b) -> Moore a b
>>=a -> Moore a b
f =Moore a (Moore a b) -> Moore a b
forall {a} {b}. Moore a (Moore a b) -> Moore a b
j ((a -> Moore a b) -> Moore a a -> Moore a (Moore a b)
forall a b. (a -> b) -> Moore a a -> Moore a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapa -> Moore a b
f Moore a a
k )wherej :: Moore a (Moore a b) -> Moore a b
j (Moore Moore a b
a a -> Moore a (Moore a b)
g )=b -> (a -> Moore a b) -> Moore a b
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore (Moore a b -> b
forall a. Moore a a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extractMoore a b
a )(\a
x ->Moore a (Moore a b) -> Moore a b
j (Moore a (Moore a b) -> Moore a b)
-> Moore a (Moore a b) -> Moore a b
forall a b. (a -> b) -> a -> b
$(Moore a b -> Moore a b)
-> Moore a (Moore a b) -> Moore a (Moore a b)
forall a b. (a -> b) -> Moore a a -> Moore a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(\(Moore b
_a -> Moore a b
h )->a -> Moore a b
h a
x )(a -> Moore a (Moore a b)
g a
x ))>> :: forall a b. Moore a a -> Moore a b -> Moore a b
(>>)=Moore a a -> Moore a b -> Moore a b
forall a b. Moore a a -> Moore a b -> Moore a b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)instanceCopointed(Moore a )wherecopoint :: forall a. Moore a a -> a
copoint (Moore a
b a -> Moore a a
_)=a
b {-# INLINEcopoint#-}instanceComonad(Moore a )whereextract :: forall a. Moore a a -> a
extract(Moore a
b a -> Moore a a
_)=a
b {-# INLINEextract#-}extend :: forall a b. (Moore a a -> b) -> Moore a a -> Moore a b
extend Moore a a -> b
f w :: Moore a a
w @(Moore a
_a -> Moore a a
g )=b -> (a -> Moore a b) -> Moore a b
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore (Moore a a -> b
f Moore a a
w )((Moore a a -> b) -> Moore a a -> Moore a b
forall a b. (Moore a a -> b) -> Moore a a -> Moore a b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extendMoore a a -> b
f (Moore a a -> Moore a b) -> (a -> Moore a a) -> a -> Moore a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Moore a a
g )instanceComonadApply(Moore a )whereMoore a -> b
f a -> Moore a (a -> b)
ff <@> :: forall a b. Moore a (a -> b) -> Moore a a -> Moore a b
<@> Moore a
a a -> Moore a a
fa =b -> (a -> Moore a b) -> Moore a b
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore (a -> b
f a
a )(\a
i ->a -> Moore a (a -> b)
ff a
i Moore a (a -> b) -> Moore a a -> Moore a b
forall a b. Moore a (a -> b) -> Moore a a -> Moore a b
forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
<@>a -> Moore a a
fa a
i )Moore a a
m <@ :: forall a b. Moore a a -> Moore a b -> Moore a a
<@ Moore a b
_=Moore a a
m {-# INLINE(<@)#-}Moore a a
_@> :: forall a b. Moore a a -> Moore a b -> Moore a b
@> Moore a b
n =Moore a b
n {-# INLINE(@>)#-}instanceDistributive(Moore a )wheredistribute :: forall (f :: * -> *) a. Functor f => f (Moore a a) -> Moore a (f a)
distribute f (Moore a a)
m =f a -> (a -> Moore a (f a)) -> Moore a (f a)
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore ((Moore a a -> a) -> f (Moore 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
fmapMoore a a -> a
forall a. Moore a a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extractf (Moore a a)
m )(f (Moore a a) -> Moore a (f a)
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
forall (f :: * -> *) a. Functor f => f (Moore a a) -> Moore a (f a)
distribute(f (Moore a a) -> Moore a (f a))
-> (a -> f (Moore a a)) -> a -> Moore a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Moore a a -> a -> Moore a a)
-> f (Moore a a) -> a -> f (Moore a 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 -> a -> b) -> f a -> a -> f b
collect(\(Moore a
_a -> Moore a a
k )->a -> Moore a a
k )f (Moore a a)
m )instanceFunctor.Representable(Moore a )wheretypeRep(Moore a )=[a ]index :: forall a. Moore a a -> Rep (Moore a) -> a
index =Moore a a -> [a] -> a
Moore a a -> Rep (Moore a) -> a
forall a b. Moore a b -> [a] -> b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosievetabulate :: forall a. (Rep (Moore a) -> a) -> Moore a a
tabulate =(Rep (Moore a) -> a) -> Moore a a
(Corep Moore a -> a) -> Moore a a
forall d c. (Corep Moore d -> c) -> Moore d c
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate{-# INLINEtabulate#-}instanceCosieveMoore []wherecosieve :: forall a b. Moore a b -> [a] -> b
cosieve(Moore b
b a -> Moore a b
_)[]=b
b cosieve(Moore b
_a -> Moore a b
k )(a
a :[a]
as )=Moore a b -> [a] -> b
forall a b. Moore a b -> [a] -> b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve(a -> Moore a b
k a
a )[a]
as instanceCostrongMoore whereunfirst :: forall a d b. Moore (a, d) (b, d) -> Moore a b
unfirst =Moore (a, d) (b, d) -> Moore a b
forall (p :: * -> * -> *) a d b.
Corepresentable p =>
p (a, d) (b, d) -> p a b
unfirstCorepunsecond :: forall d a b. Moore (d, a) (d, b) -> Moore a b
unsecond =Moore (d, a) (d, b) -> Moore a b
forall (p :: * -> * -> *) d a b.
Corepresentable p =>
p (d, a) (d, b) -> p a b
unsecondCorepinstanceProfunctor.CorepresentableMoore wheretypeCorepMoore =[]cotabulate :: forall d c. (Corep Moore d -> c) -> Moore d c
cotabulateCorep Moore d -> c
f =c -> (d -> Moore d c) -> Moore d c
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore (Corep Moore d -> c
f [])((d -> Moore d c) -> Moore d c) -> (d -> Moore d c) -> Moore d c
forall a b. (a -> b) -> a -> b
$\d
a ->(Corep Moore d -> c) -> Moore d c
forall d c. (Corep Moore d -> c) -> Moore d c
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate([d] -> c
Corep Moore d -> c
f ([d] -> c) -> ([d] -> [d]) -> [d] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(d
a d -> [d] -> [d]
forall a. a -> [a] -> [a]
:))instanceMonadFix(Moore a )wheremfix :: forall a. (a -> Moore a a) -> Moore a a
mfix=(a -> Moore a a) -> Moore a a
forall (f :: * -> *) a. Representable f => (a -> f a) -> f a
mfixRepinstanceMonadZip(Moore a )wheremzipWith :: forall a b c. (a -> b -> c) -> Moore a a -> Moore a b -> Moore a c
mzipWith =(a -> b -> c) -> Moore a a -> Moore a b -> Moore a c
forall (f :: * -> *) a b c.
Representable f =>
(a -> b -> c) -> f a -> f b -> f c
mzipWithRepmunzip :: forall a b. Moore a (a, b) -> (Moore a a, Moore a b)
munzip Moore a (a, b)
m =(((a, b) -> a) -> Moore a (a, b) -> Moore a a
forall a b. (a -> b) -> Moore a a -> Moore a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(a, b) -> a
forall a b. (a, b) -> a
fstMoore a (a, b)
m ,((a, b) -> b) -> Moore a (a, b) -> Moore a b
forall a b. (a -> b) -> Moore a a -> Moore a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(a, b) -> b
forall a b. (a, b) -> b
sndMoore a (a, b)
m )instanceMonadReader[a ](Moore a )whereask :: Moore a [a]
ask =Moore a [a]
Moore a (Rep (Moore a))
forall (f :: * -> *). Representable f => f (Rep f)
askReplocal :: forall a. ([a] -> [a]) -> Moore a a -> Moore a a
local =([a] -> [a]) -> Moore a a -> Moore a a
(Rep (Moore a) -> Rep (Moore a)) -> Moore a a -> Moore a a
forall (f :: * -> *) a.
Representable f =>
(Rep f -> Rep f) -> f a -> f a
localRepinstanceClosedMoore whereclosed :: forall a b x. Moore a b -> Moore (x -> a) (x -> b)
closed Moore a b
m =(Corep Moore (x -> a) -> x -> b) -> Moore (x -> a) (x -> b)
forall d c. (Corep Moore d -> c) -> Moore d c
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate((Corep Moore (x -> a) -> x -> b) -> Moore (x -> a) (x -> b))
-> (Corep Moore (x -> a) -> x -> b) -> Moore (x -> a) (x -> b)
forall a b. (a -> b) -> a -> b
$\Corep Moore (x -> a)
fs x
x ->Moore a b -> [a] -> b
forall a b. Moore a b -> [a] -> b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieveMoore a b
m (((x -> a) -> a) -> [x -> a] -> [a]
forall a b. (a -> b) -> [a] -> [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 )[x -> a]
Corep Moore (x -> a)
fs )instanceSemigroupb =>Semigroup(Moore a b )whereMoore b
x a -> Moore a b
f <> :: Moore a b -> Moore a b -> Moore a b
<>Moore b
y a -> Moore a b
g =b -> (a -> Moore a b) -> Moore a b
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore (b
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<>b
y )(a -> Moore a b
f (a -> Moore a b) -> (a -> Moore a b) -> a -> Moore a b
forall a. Semigroup a => a -> a -> a
<>a -> Moore a b
g )instanceMonoidb =>Monoid(Moore a b )wheremempty :: Moore a b
mempty=b -> (a -> Moore a b) -> Moore a b
forall a b. b -> (a -> Moore a b) -> Moore a b
Moore b
forall a. Monoid a => a
memptya -> Moore a b
forall a. Monoid a => a
mempty
#if !(MIN_VERSION_base(4,11,0))
Moorexf`mappend`Mooreyg=Moore(x`mappend`y)(f`mappend`g)
#endif