pipes-category 0.2.0.1 → 0.3.0.0

raw patch · 3 files changed

+12/−20 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• pipes-category.cabal +2/−2
• src/Pipes/Shaft.hs +2/−10
• test/Spec.hs +8/−8

@@ -1,7 +1,7 @@ name:                pipes-category-version:             0.2.0.1+version:             0.3.0.0 synopsis:            Allows instances for Category, Arrow and ArrowChoice for Pipes.-description:         Allows instances for Category, Arrow and ArrowChoice for Pipes.+description:         Allows Category, Arrow, and ArrowChoice instances for Pipes.Pipe, using newtype wrapper 'Shaft' homepage:            https://github.com/louispan/pipes-category#readme license:             BSD3 license-file:        LICENSE

@@ -17,20 +17,17 @@ import qualified Pipes.Lift as PL import qualified Pipes.Prelude as PP -newtype Shaft r m b c = Shaft { runShaft :: P.Pipe b c m r }+newtype Shaft r m b c = Shaft { fromShaft :: P.Pipe b c m r }  makeWrapped ''Shaft  instance Monad m => Category (Shaft r m) where   id = Shaft P.cat-  {-# INLINABLE id #-}    (Shaft a) . (Shaft b) = Shaft (b P.>-> a)-  {-# INLINABLE (.) #-}  instance Monad m => Arrow (Shaft r m) where   arr f = Shaft (PE.arr f)-  {-# INLINABLE arr #-}    -- | Send the first component of the input through the argument arrow, and copy the rest unchanged to the output.   -- first :: Monad m => Shaft r m b c -> Shaft r m (b, d) (c, d)@@ -58,16 +55,14 @@       a <- P.await       put $ f a       P.yield a-  {-# INLINABLE first #-}    -- | A mirror image of 'first'.   -- second :: Monad m => Shaft r m b c -> Shaft r m (d, b) (d, c)   -- Don't use *** as an optimization, as it will require running first twice.   second (Shaft bc) = Shaft $ PP.map swap-    P.>-> runShaft (first $ Shaft bc)+    P.>-> fromShaft (first $ Shaft bc)     -- P.>->  (_Unwrapping Shaft %~ first $ bc)     P.>-> PP.map swap-  {-# INLINABLE second #-}    -- Note: The following works, but may not actually be more optimal than default (***)   -- So maybe it's better to reduce the amount of code to maintain.@@ -103,10 +98,7 @@  instance Monad m => ArrowChoice (Shaft r m) where   left (Shaft a) = Shaft (PE.left a)-  {-# INLINABLE left #-}    right (Shaft a) = Shaft (PE.right a)-  {-# INLINABLE right #-}    (Shaft a) +++ (Shaft b) = Shaft (a PE.+++ b)-  {-# INLINABLE (+++) #-}

@@ -42,34 +42,34 @@               let xs = PP.toList                       (sig1                        P.>-> PP.map duplicate-                       P.>-> PS.runShaft (first $ PS.Shaft (PP.map (+ 10))))+                       P.>-> PS.fromShaft (first $ PS.Shaft (PP.map (+ 10))))               xs `shouldBe` zip ((+ 10) <$> data1) data1            it "second" $ do               let xs = PP.toList                        (sig1                         P.>-> PP.map duplicate-                        P.>-> PS.runShaft (second $ PS.Shaft (PP.map (+ 10))))+                        P.>-> PS.fromShaft (second $ PS.Shaft (PP.map (+ 10))))               xs `shouldBe` zip data1 ((+ 10) <$> data1)            it "***" $ do               let xs = PP.toList                        (sig1                         P.>-> PP.map duplicate-                        P.>-> PS.runShaft (PS.Shaft (PP.map (+ 10)) *** PS.Shaft (PP.map (+ 20))))+                        P.>-> PS.fromShaft (PS.Shaft (PP.map (+ 10)) *** PS.Shaft (PP.map (+ 20))))               xs `shouldBe` zip ((+ 10) <$> data1) ((+ 20)<$> data1)            it "&&&" $ do               let xs = PP.toList                        (sig1-                        P.>-> PS.runShaft (PS.Shaft (PP.map (+ 10)) &&& PS.Shaft (PP.map (+ 20))))+                        P.>-> PS.fromShaft (PS.Shaft (PP.map (+ 10)) &&& PS.Shaft (PP.map (+ 20))))               xs `shouldBe` zip ((+ 10) <$> data1) ((+ 20)<$> data1)        describe "ArrowChoice" $ do           it "left" $ do               let xs = PP.toList                        (sig2-                        P.>-> PS.runShaft (left $ PS.Shaft (PP.map (+ 10))))+                        P.>-> PS.fromShaft (left $ PS.Shaft (PP.map (+ 10))))               xs `shouldBe` ((\a -> case a of                                      Left a' -> Left (a' + 10)                                      Right a' -> Right a') <$> data2)@@ -77,7 +77,7 @@           it "right" $ do               let xs = PP.toList                        (sig2-                        P.>-> PS.runShaft (right $ PS.Shaft (PP.map (++ "!"))))+                        P.>-> PS.fromShaft (right $ PS.Shaft (PP.map (++ "!"))))               xs `shouldBe` ((\a -> case a of                                      Left a' -> Left a'                                      Right a' -> Right (a' ++ "!")) <$> data2)@@ -85,7 +85,7 @@           it "+++" $ do               let xs = PP.toList                        (sig2-                        P.>-> PS.runShaft (PS.Shaft (PP.map (+ 10)) +++ PS.Shaft (PP.map (++ "!"))))+                        P.>-> PS.fromShaft (PS.Shaft (PP.map (+ 10)) +++ PS.Shaft (PP.map (++ "!"))))               xs `shouldBe` ((\a -> case a of                                      Left a' -> Left (a' + 10)                                      Right a' -> Right (a' ++ "!")) <$> data2)@@ -94,7 +94,7 @@           it "|||" $ do               let xs = PP.toList                        (sig2-                        P.>-> PS.runShaft (PS.Shaft (PP.map (show . (+ 10))) ||| PS.Shaft (PP.map (++ "!"))))+                        P.>-> PS.fromShaft (PS.Shaft (PP.map (show . (+ 10))) ||| PS.Shaft (PP.map (++ "!"))))               xs `shouldBe` ((\a -> case a of                                      Left a' -> show (a' + 10)                                      Right a' -> a' ++ "!") <$> data2)