#ifndef MIN_VERSION_profunctors
#define MIN_VERSION_profunctors(x,y,z) 0
#endif
module Data.Machine.Moore
( Moore(..)
, logMoore
, unfoldMoore
) where
import Control.Applicative
import Control.Comonad
import Data.Copointed
import Data.Machine.Plan
import Data.Machine.Type
import Data.Machine.Process
import Data.Monoid
import Data.Pointed
import Data.Profunctor
data Moore a b = Moore b (a -> Moore a b)
logMoore :: Monoid m => Moore m m
logMoore = h mempty where
h m = Moore m (\a -> h (m <> a))
unfoldMoore :: (s -> (b, a -> s)) -> s -> Moore a b
unfoldMoore f = go where
go s = case f s of
(b, g) -> Moore b (go . g)
instance Automaton Moore where
auto = construct . go where
go (Moore b f) = do
yield b
await >>= go . f
instance Functor (Moore a) where
fmap f (Moore b g) = Moore (f b) (fmap f . g)
a <$ _ = return a
instance Profunctor Moore where
rmap = fmap
lmap f = go where
go (Moore b g) = Moore b (go . g . f)
#if MIN_VERSION_profunctors(3,1,1)
dimap f g = go where
go (Moore b h) = Moore (g b) (go . h . f)
#endif
instance Applicative (Moore a) where
pure a = r where r = Moore a (const r)
Moore f ff <*> Moore a fa = Moore (f a) (\i -> ff i <*> fa i)
m <* _ = m
_ *> n = n
instance Pointed (Moore a) where
point a = r where r = Moore a (const r)
instance Monad (Moore a) where
return a = r where r = Moore a (const r)
k >>= f = j (fmap f k) where
j (Moore a g) = Moore (extract a) (\x -> j $ fmap (\(Moore _ h) -> h x) (g x))
_ >> m = m
instance Copointed (Moore a) where
copoint (Moore b _) = b
instance Comonad (Moore a) where
extract (Moore b _) = b
extend f w@(Moore _ g) = Moore (f w) (extend f . g)
instance ComonadApply (Moore a) where
Moore f ff <@> Moore a fa = Moore (f a) (\i -> ff i <@> fa i)
m <@ _ = m
_ @> n = n