packages feed

machines 0.2.2 → 0.2.3

raw patch · 7 files changed

+105/−7 lines, 7 filesdep ~mtl

Dependency ranges changed: mtl

Files

machines.cabal view
@@ -1,6 +1,6 @@ name:          machines category:      Control, Enumerator-version:       0.2.2+version:       0.2.3 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE@@ -31,13 +31,13 @@   build-depends:     base         == 4.*,     comonad      >= 3,-    containers   >= 0.3   && < 0.6,+    containers   >= 0.3 && < 0.6,     free         >= 3.1.1,     pointed      >= 3,     profunctors  >= 3,     semigroups   >= 0.8.3,     transformers == 0.3.*,-    mtl          >= 2.1.1 && < 2.2+    mtl          >= 2 && < 2.2    exposed-modules:     Data.Machine
src/Data/Machine/Is.hs view
@@ -26,17 +26,23 @@  instance Eq (Is a b) where   Refl == Refl = True+  {-# INLINE (==) #-}  instance Ord (Is a b) where   Refl `compare` Refl = EQ+  {-# INLINE compare #-}  instance (a ~ b) => Monoid (Is a b) where   mempty = Refl+  {-# INLINE mempty #-}   mappend Refl Refl = Refl+  {-# INLINE mappend #-}  instance (a ~ b) => Read (Is a b) where   readsPrec d = readParen (d > 10) (\r -> [(Refl,s) | ("Refl",s) <- lex r ])  instance Category Is where   id = Refl+  {-# INLINE id #-}   Refl . Refl = Refl+  {-# INLINE (.) #-}
src/Data/Machine/Mealy.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE CPP #-}++#ifndef MIN_VERSION_profunctors+#define MIN_VERSION_profunctors(x,y,z) 0+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Machine.Mealy@@ -34,35 +39,55 @@ instance Functor (Mealy a) where   fmap f (Mealy m) = Mealy $ \a -> case m a of     (b, n) -> (f b, fmap f n)+  {-# INLINE fmap #-}+  b <$ _ = pure b+  {-# INLINE (<$) #-}  instance Applicative (Mealy a) where   pure b = r where r = Mealy (const (b, r))+  {-# INLINE pure #-}   Mealy m <*> Mealy n = Mealy $ \a -> case m a of     (f, m') -> case n a of        (b, n') -> (f b, m' <*> n')   m <* _ = m+  {-# INLINE (<*) #-}   _ *> n = n+  {-# INLINE (*>) #-}  instance Pointed (Mealy a) where   point b = r where r = Mealy (const (b, r))+  {-# INLINE point #-}  -- | A 'Mealy' machine modeled with explicit state. unfoldMealy :: (s -> a -> (b, s)) -> s -> Mealy a b unfoldMealy f = go where   go s = Mealy $ \a -> case f s a of     (b, t) -> (b, go t)+{-# INLINE unfoldMealy #-}  -- | slow diagonalization instance Monad (Mealy a) where   return b = r where r = Mealy (const (b, r))+  {-# INLINE return #-}   m >>= f = Mealy $ \a -> case runMealy m a of     (b, m') -> (fst (runMealy (f b) a), m' >>= f)+  {-# INLINE (>>=) #-}   _ >> n = n+  {-# INLINE (>>) #-}  instance Profunctor Mealy where   rmap = fmap-  lmap f (Mealy m) = Mealy $ \a -> case m (f a) of-    (b, n) -> (b, lmap f n)+  {-# INLINE rmap #-}+  lmap f = go where+    go (Mealy m) = Mealy $ \a -> case m (f a) of+      (b, n) -> (b, go n)+  {-# INLINE lmap #-}+#if MIN_VERSION_profunctors(3,1,1)+  dimap f g = go where+    go (Mealy m) = Mealy $ \a -> case m (f a) of+      (b, n) -> (g b, go n)+  {-# INLINE dimap #-}+#endif  instance Automaton Mealy where   auto = construct . go where@@ -70,6 +95,7 @@       (b, m) -> do          yield b          go m+  {-# INLINE auto #-}  instance Category Mealy where   id = Mealy (\a -> (a, id))@@ -79,6 +105,7 @@  instance Arrow Mealy where   arr f = r where r = Mealy (\a -> (f a, r))+  {-# INLINE arr #-}   first (Mealy m) = Mealy $ \(a,c) -> case m a of     (b, n) -> ((b, c), first n) @@ -113,8 +140,10 @@ logMealy :: Semigroup a => Mealy a a logMealy = Mealy $ \a -> (a, h a) where   h a = Mealy $ \b -> let c = a <> b in (c, h c)+{-# INLINE logMealy #-}  instance ArrowApply Mealy where   app = go Seq.empty where     go xs = Mealy $ \(m,x) -> case driveMealy m xs x of       (c, _) -> (c, go (xs |> x))+  {-# INLINE app #-}
src/Data/Machine/Moore.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE CPP #-}++#ifndef MIN_VERSION_profunctors+#define MIN_VERSION_profunctors(x,y,z) 0+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Machine.Moore@@ -34,50 +39,73 @@ logMoore :: Monoid m => Moore m m logMoore = h mempty where   h m = Moore m (\a -> h (m <> a))+{-# INLINE logMoore #-}  -- | Construct a Moore machine from a state valuation and transition function 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)+{-# INLINE unfoldMoore #-}  instance Automaton Moore where   auto = construct . go where     go (Moore b f) = do       yield b       await >>= go . f+  {-# INLINE auto #-}  instance Functor (Moore a) where   fmap f (Moore b g) = Moore (f b) (fmap f . g)+  {-# INLINE fmap #-}+  a <$ _ = return a+  {-# INLINE (<$) #-}  instance Profunctor Moore where   rmap = fmap-  lmap f (Moore b g) = Moore b (lmap f . g . f)+  {-# INLINE rmap #-}+  lmap f = go where+    go (Moore b g) = Moore b (go . g . f)+  {-# INLINE lmap #-}+#if MIN_VERSION_profunctors(3,1,1)+  dimap f g = go where+    go (Moore b h) = Moore (g b) (go . h . f)+  {-# INLINE dimap #-}+#endif  instance Applicative (Moore a) where   pure a = r where r = Moore a (const r)+  {-# INLINE pure #-}   Moore f ff <*> Moore a fa  = Moore (f a) (\i -> ff i <*> fa i)   m <* _ = m+  {-# INLINE (<*) #-}   _ *> n = n+  {-# INLINE (*>) #-}  instance Pointed (Moore a) where   point a = r where r = Moore a (const r)+  {-# INLINE point #-}  -- | slow diagonalization instance Monad (Moore a) where   return a = r where r = Moore a (const r)+  {-# INLINE return #-}   Moore a k >>= f = case f a of     Moore b _ -> Moore b (k >=> f)   _ >> m = m  instance Copointed (Moore a) where   copoint (Moore b _) = b+  {-# INLINE copoint #-}  instance Comonad (Moore a) where   extract (Moore b _) = b+  {-# INLINE extract #-}   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)+  Moore f ff <@> Moore a fa = Moore (f a) (\i -> ff i <@> fa i)   m <@ _ = m+  {-# INLINE (<@) #-}   _ @> n = n+  {-# INLINE (@>) #-}
src/Data/Machine/Plan.hs view
@@ -1,7 +1,11 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}+#ifndef MIN_VERSION_mtl+#define MIN_VERSION_mtl(x,y,z) 0+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Machine.Plan@@ -82,45 +86,66 @@   (\o (Identity r) -> Identity (ke o r))   (\f k (Identity r) -> Identity (kr (runIdentity . f) k r))   (Identity kf)+{-# INLINE runPlan #-}  instance Functor (PlanT k o m) where   fmap f (PlanT m) = PlanT $ \k -> m (k . f)+  {-# INLINE fmap #-}  instance Applicative (PlanT k o m) where   pure a = PlanT (\kp _ _ _ -> kp a)+  {-# INLINE pure #-}   (<*>) = ap+  {-# INLINE (<*>) #-}  instance Alternative (PlanT k o m) where   empty = PlanT $ \_ _ _ kf -> kf+  {-# INLINE empty #-}   PlanT m <|> PlanT n = PlanT $ \kp ke kr kf -> m kp ke (\ks kir _ -> kr ks kir (n kp ke kr kf)) (n kp ke kr kf)+  {-# INLINE (<|>) #-}  instance Monad (PlanT k o m) where   return a = PlanT (\kp _ _ _ -> kp a)+  {-# INLINE return #-}   PlanT m >>= f = PlanT (\kp ke kr kf -> m (\a -> runPlanT (f a) kp ke kr kf) ke kr kf)   fail _ = PlanT (\_ _ _ kf -> kf)+  {-# INLINE (>>=) #-}  instance MonadPlus (PlanT k o m) where   mzero = empty+  {-# INLINE mzero #-}   mplus = (<|>)+  {-# INLINE mplus #-}  instance MonadTrans (PlanT k o) where   lift m = PlanT (\kp _ _ _ -> m >>= kp)+  {-# INLINE lift #-}  instance MonadIO m => MonadIO (PlanT k o m) where   liftIO m = PlanT (\kp _ _ _ -> liftIO m >>= kp)+  {-# INLINE liftIO #-}  instance MonadState s m => MonadState s (PlanT k o m) where   get = lift get+  {-# INLINE get #-}   put = lift . put+  {-# INLINE put #-}+#ifdef MIN_VERSION_mtl(2,1,0)   state f = PlanT $ \kp _ _ _ -> state f >>= kp+  {-# INLINE state #-}+#endif  instance MonadReader e m => MonadReader e (PlanT k o m) where   ask = lift ask+#ifdef MIN_VERSION_mtl(2,1,0)   reader = lift . reader+#endif   local f m = PlanT $ \kp ke kr kf -> local f (runPlanT m kp ke kr kf)  instance MonadWriter w m  => MonadWriter w (PlanT k o m) where+#ifdef MIN_VERSION_mtl(2,1,0)   writer = lift . writer+#endif   tell   = lift . tell    listen m = PlanT $ \kp ke kr kf -> runPlanT m ((kp =<<) . listen . return) ke kr kf
src/Data/Machine/Tee.hs view
@@ -60,20 +60,25 @@ -- | Precompose a pipe onto the left input of a tee. addL :: Monad m => ProcessT m a b -> TeeT m b c d -> TeeT m a c d addL p = tee p echo+{-# INLINE addL #-}  -- | Precompose a pipe onto the right input of a tee. addR :: Monad m => ProcessT m b c -> TeeT m a c d -> TeeT m a b d addR = tee echo+{-# INLINE addR #-}  -- | Tie off one input of a tee by connecting it to a known source. capL :: Monad m => SourceT m a -> TeeT m a b c -> ProcessT m b c capL s t = fit cappedT $ addL s t+{-# INLINE capL #-}  -- | Tie off one input of a tee by connecting it to a known source. capR :: Monad m => SourceT m b -> TeeT m a b c -> ProcessT m a c capR s t = fit cappedT $ addR s t+{-# INLINE capR #-}  -- | Natural transformation used by 'capL' and 'capR'. cappedT :: T a a b -> Is a b cappedT R = Refl cappedT L = Refl+{-# INLINE cappedT #-}
src/Data/Machine/Wye.hs view
@@ -83,21 +83,26 @@ -- | Precompose a pipe onto the left input of a wye. addX :: Monad m => ProcessT m a b -> WyeT m b c d -> WyeT m a c d addX p = wye p echo+{-# INLINE addX #-}  -- | Precompose a pipe onto the right input of a tee. addY :: Monad m => ProcessT m b c -> WyeT m a c d -> WyeT m a b d addY = wye echo+{-# INLINE addY #-}  -- | Tie off one input of a tee by connecting it to a known source. capX :: Monad m => SourceT m a -> WyeT m a b c -> ProcessT m b c capX s t = process (capped Right) (addX s t)+{-# INLINE capX #-}  -- | Tie off one input of a tee by connecting it to a known source. capY :: Monad m => SourceT m b -> WyeT m a b c -> ProcessT m a c capY s t = process (capped Left) (addY s t)+{-# INLINE capY #-}  -- | Natural transformation used by 'capX' and 'capY' capped :: (a -> Either a a) -> Y a a b -> a -> b capped _ X = id capped _ Y = id capped f Z = f+{-# INLINE capped #-}