{-# LANGUAGE TypeOperators #-}
module Mealy where
import Control.Applicative
import Control.Comonad
import Control.Arrow ((&&&),(***))
data Lead a b = b :>- Follow a b
newtype Follow a b = Follow { runFollow :: a -> Lead a b }
type (:>-) = Lead
type (:->) = Follow
instance Show b => Show (Lead a b) where
show (b :>- c) = show b ++ ":>- ..."
instance Functor (Lead a) where
fmap f (a :>- b) = f a :>- fmap f b
instance Applicative (Lead a) where
pure a = a :>- pure a
(f :>- pf) <*> (a :>- pa) = f a :>- (pf <*> pa)
instance Functor (Follow a) where
fmap f (Follow h) = Follow (fmap f . h)
instance Applicative (Follow a) where
pure = Follow . const . pure
h <*> k = Follow $ \a -> runFollow h a <*> runFollow k a
instance Copointed (Lead a) where
extract (a :>- _) = a
instance Comonad (Lead a) where
duplicate (a :>- f) = (a :>- f) :>- Follow (duplicate . runFollow f)
dance :: (a :>- b) -> (b :-> a) -> [(b, a)]
dance (b :>- Follow f) g = (b,c) : dance (f c) h where
c :>- h = runFollow g b
lead :: (b :-> a) -> [b] -> [a]
lead _ [] = []
lead (Follow f) (x:xs) = y: lead f' xs
where y :>- f' = f x
from :: Enum a => a -> Lead b a
from n = n :>- (Follow $ const $ from $ succ n)
echo :: Follow a a
echo = Follow (:>- echo)