Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

FinalC arrow instance, and cleanup

  • Loading branch information...
commit 29f81199f8823752e6305acee75386b268d7c8fb 1 parent 2e89564
@cdsmith authored
Showing with 12 additions and 4 deletions.
  1. +12 −4 Pipes.hs
View
16 Pipes.hs
@@ -11,6 +11,7 @@ module Pipes (
NoLeftovers,
Pipe,
(>+>),
+ (<+<),
simulatePipe,
runPipe,
PipeC(..),
@@ -37,7 +38,7 @@ module Pipes (
import Prelude hiding (id, (.))
import Control.Applicative
-import Control.Arrow (first)
+import Control.Arrow hiding (left)
import Control.Category
import Control.Monad
import Control.Monad.Trans
@@ -101,6 +102,9 @@ p >+> Await f = upstream p
upstream (Await g ) = Await (upstream . g)
upstream (UnAwait x q) = UnAwait x (upstream q)
+(<+<) :: Monad m => Pipe NoLeftovers b c s m t -> Pipe lo a b r m s -> Pipe lo a c r m t
+(<+<) = flip (>+>)
+
simulatePipe :: (Monad m, MonadTrans t, Monad (t m))
=> t m (Either u a)
-> (b -> t m ())
@@ -139,6 +143,10 @@ instance Monad m => Category (FinalC a m) where
id = FinalC idP
(FinalC p) . (FinalC q) = FinalC (q >+> p)
+instance Monad m => Arrow (FinalC a m) where
+ arr f = FinalC (fmap f idP)
+ first (FinalC p) = FinalC $ (,) <$> fmap fst idP >+> p <*> fmap snd idP
+
instance MonadStream m => MonadStream (EitherT e m) where
type Upstream (EitherT e m) = Upstream m
type Downstream (EitherT e m) = Downstream m
@@ -200,8 +208,8 @@ leftP p = undefined
rightP :: Monad m => Pipe lo a b r m s -> Pipe lo (Either c a) (Either c b) r m s
rightP p = undefined
-collectLeftovers :: MonadIO m => Pipe Leftovers a b u m r -> Pipe NoLeftovers a b u m (r, [a])
+collectLeftovers :: Monad m => Pipe Leftovers a b u m r -> Pipe NoLeftovers a b u m (r, [a])
collectLeftovers = undefined
-discardLeftovers :: MonadIO m => Pipe Leftovers a b u m r -> Pipe NoLeftovers a b u m r
-discardLeftovers = undefined
+discardLeftovers :: Monad m => Pipe Leftovers a b u m r -> Pipe NoLeftovers a b u m r
+discardLeftovers = fmap fst . collectLeftovers
Please sign in to comment.
Something went wrong with that request. Please try again.