{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} #ifndef MIN_VERSION_profunctors #define MIN_VERSION_profunctors(x,y,z) 0 #endif ----------------------------------------------------------------------------- -- | -- 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> ---------------------------------------------------------------------------- module Data.Machine.Mealy ( Mealy(..) , unfoldMealy , logMealy ) where import Control.Applicative import Control.Arrow import Control.Category import Data.Distributive import Data.Functor.Extend import Data.Functor.Rep as Functor import Data.List.NonEmpty as NonEmpty import Data.Machine.Plan import Data.Machine.Type import Data.Machine.Process import Data.Profunctor.Closed import Data.Profunctor import Data.Profunctor.Sieve import Data.Profunctor.Rep as Profunctor import Data.Pointed import Data.Semigroup import Data.Sequence as Seq import Prelude hiding ((.),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')] -- newtype Mealy a b = Mealy { Mealy a b -> a -> (b, Mealy a b) runMealy :: a -> (b, Mealy a b) } instance Functor (Mealy a) where fmap :: (a -> b) -> Mealy a a -> Mealy a b fmap a -> 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 -> case a -> (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f Mealy a a n) {-# INLINE fmap #-} a b <$ :: a -> Mealy a b -> Mealy a a <$ Mealy a b _ = a -> Mealy a a forall (f :: * -> *) a. Applicative f => a -> f a pure a b {-# INLINE (<$) #-} instance Applicative (Mealy a) where pure :: a -> Mealy a a pure a b = Mealy a a r where r :: 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)) {-# INLINE pure #-} Mealy a -> (a -> b, Mealy a (a -> b)) m <*> :: 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 -> case a -> (a -> b, Mealy a (a -> b)) m a a of (a -> b f, Mealy a (a -> b) m') -> case a -> (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Mealy a a n') Mealy a a m <* :: Mealy a a -> Mealy a b -> Mealy a a <* Mealy a b _ = Mealy a a m {-# INLINE (<*) #-} Mealy a a _ *> :: Mealy a a -> Mealy a b -> Mealy a b *> Mealy a b n = Mealy a b n {-# INLINE (*>) #-} instance Pointed (Mealy a) where point :: a -> Mealy a a point a b = Mealy a a r where r :: 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)) {-# INLINE point #-} instance Extend (Mealy a) where duplicated :: 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 -> case a -> (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 (w :: * -> *) a. Extend w => w a -> w (w a) duplicated Mealy a a b) -- | A 'Mealy' machine modeled with explicit state. unfoldMealy :: (s -> a -> (b, s)) -> s -> Mealy a b unfoldMealy :: (s -> a -> (b, s)) -> s -> Mealy a b unfoldMealy s -> a -> (b, s) f = s -> Mealy a b go where go :: 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 -> case s -> a -> (b, s) f s s a a of (b b, s t) -> (b b, s -> Mealy a b go s t) {-# INLINE unfoldMealy #-} instance Profunctor Mealy where rmap :: (b -> c) -> Mealy a b -> Mealy a c rmap = (b -> c) -> Mealy a b -> Mealy a c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap {-# INLINE rmap #-} lmap :: (a -> b) -> Mealy b c -> Mealy a c lmap a -> b f = Mealy b c -> Mealy a c go where go :: 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 -> case b -> (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) {-# INLINE lmap #-} #if MIN_VERSION_profunctors(3,1,1) dimap :: (a -> b) -> (c -> d) -> Mealy b c -> Mealy a d dimap a -> b f c -> d g = Mealy b c -> Mealy a d go where go :: 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 -> case b -> (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) {-# INLINE dimap #-} #endif instance Automaton Mealy where auto :: 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 where go :: Mealy a o -> PlanT (k a) o m b go (Mealy a -> (o, Mealy a o) f) = PlanT (k a) o m 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \a a -> case a -> (o, Mealy a o) f a a of (o b, Mealy a o m) -> do o -> 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 {-# INLINE auto #-} instance Category Mealy where id :: 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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a id)) Mealy b -> (c, Mealy b c) bc . :: 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 -> case a -> (b, Mealy a b) ab a a of (b b, Mealy a b nab) -> case b -> (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 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) instance Arrow Mealy where arr :: (b -> c) -> Mealy b c arr b -> c f = Mealy b c r where r :: 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)) {-# INLINE arr #-} first :: 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) -> case b -> (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 (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first Mealy b c n) instance ArrowChoice Mealy where left :: 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 -> case Either b d a of Left b l -> case Mealy 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 Left c b, 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) left Mealy b c m') Right d r -> (d -> Either c d forall a b. b -> Either a b Right d r, 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) left Mealy b c m) right :: 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 -> case Either d b a of Left d l -> (d -> Either d c forall a b. a -> Either a b Left d l, 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 Mealy b c m) Right b r -> case Mealy 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 Right c b, 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 Mealy b c m') Mealy b c m +++ :: 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 -> case Either b b' a of Left b b -> case Mealy 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 Left c c, Mealy b c m' 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) Right b' b -> case Mealy 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 Right c' c, Mealy b c m 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 ||| :: 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 -> case Either b c a of Left b b -> case Mealy 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 (a :: * -> * -> *) b d c. ArrowChoice a => a b d -> a c d -> a (Either b c) d ||| Mealy c d n) Right c b -> case Mealy 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 (a :: * -> * -> *) b d c. ArrowChoice a => a b d -> a c d -> a (Either b c) d ||| Mealy c d n') #if MIN_VERSION_profunctors(3,2,0) instance Strong Mealy where first' :: Mealy a b -> Mealy (a, c) (b, c) first' = Mealy a b -> Mealy (a, c) (b, c) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first instance Choice Mealy where left' :: Mealy a b -> Mealy (Either a c) (Either b c) left' = Mealy a b -> Mealy (Either a c) (Either b c) forall (a :: * -> * -> *) b c d. ArrowChoice a => a b c -> a (Either b d) (Either c d) left right' :: Mealy a b -> Mealy (Either c a) (Either c b) right' = Mealy a b -> Mealy (Either c a) (Either c b) forall (a :: * -> * -> *) b c d. ArrowChoice a => a b c -> a (Either d b) (Either d c) right #endif -- | Fast forward a mealy machine forward driveMealy :: Mealy a b -> Seq a -> a -> (b, Mealy a b) driveMealy :: Mealy a b -> Seq a -> a -> (b, Mealy a b) driveMealy Mealy a b m Seq a xs a z = case Seq a -> ViewL a forall a. Seq a -> ViewL a viewl Seq a xs of a y :< Seq a ys -> case 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 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 :: Semigroup a => Mealy a a logMealy :: 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) where h :: 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 -> let c :: 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) {-# INLINE logMealy #-} instance ArrowApply Mealy where app :: 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.empty where go :: 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) -> case 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 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)) {-# INLINE app #-} instance Distributive (Mealy a) where distribute :: 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 -> let fp :: f (a, Mealy a a) fp = (Mealy a a -> (a, Mealy a a)) -> f (Mealy a a) -> f (a, Mealy a a) 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (a, Mealy a a) -> a forall a b. (a, b) -> a fst f (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) collect (a, Mealy a a) -> Mealy a a forall a b. (a, b) -> b snd f (a, Mealy a a) fp) collect :: (a -> Mealy a b) -> f a -> Mealy a (f b) collect a -> 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 -> let fp :: f (b, Mealy a b) fp = (a -> (b, Mealy a b)) -> f a -> f (b, Mealy a 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (b, Mealy a b) -> b forall a b. (a, b) -> a fst f (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) collect (b, Mealy a b) -> Mealy a b forall a b. (a, b) -> b snd f (b, Mealy a b) fp) instance Functor.Representable (Mealy a) where type Rep (Mealy a) = NonEmpty a index :: Mealy a a -> Rep (Mealy a) -> a index = Mealy a a -> Rep (Mealy a) -> a forall (p :: * -> * -> *) (f :: * -> *) a b. Cosieve p f => p a b -> f a -> b cosieve tabulate :: (Rep (Mealy a) -> a) -> Mealy a a tabulate = (Rep (Mealy a) -> a) -> Mealy a a forall (p :: * -> * -> *) d c. Corepresentable p => (Corep p d -> c) -> p d c cotabulate instance Cosieve Mealy NonEmpty where cosieve :: Mealy a b -> NonEmpty a -> b cosieve Mealy a b m0 (a a0 :| [a] as0) = Mealy a b -> a -> [a] -> b forall t p. Mealy t p -> t -> [t] -> p go Mealy a b m0 a a0 [a] as0 where go :: Mealy t p -> t -> [t] -> p go (Mealy t -> (p, Mealy t p) m) t a [t] as = case t -> (p, Mealy t p) m t a of (p b, Mealy t p m') -> case [t] as of [] -> p b t a':[t] as' -> Mealy t p -> t -> [t] -> p go Mealy t p m' t a' [t] as' instance Costrong Mealy where unfirst :: 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 unfirstCorep unsecond :: 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 unsecondCorep instance Profunctor.Corepresentable Mealy where type Corep Mealy = NonEmpty cotabulate :: (Corep Mealy d -> c) -> Mealy d c cotabulate Corep 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 where go :: [a] -> (NonEmpty a -> b) -> (b, Mealy a b) go [a] as NonEmpty a -> b f = (NonEmpty a -> b f ([a] -> NonEmpty a forall a. [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 ba -> [a] -> [a] forall a. a -> [a] -> [a] :[a] as) NonEmpty a -> b f) instance Closed Mealy where closed :: 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 (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 (p :: * -> * -> *) (f :: * -> *) a b. Cosieve p f => p a b -> f a -> b cosieve Mealy a b m (((x -> a) -> a) -> NonEmpty (x -> a) -> NonEmpty a 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) instance Semigroup b => Semigroup (Mealy a b) where Mealy 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 instance Monoid b => Monoid (Mealy a b) where mempty :: 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)) mappend f g = Mealy $ \x -> runMealy f x `mappend` runMealy g x #endif