potoki-core 0.9.2 → 0.10

raw patch · 9 files changed

+80/−18 lines, 9 filesdep +acquiredep −managedPVP ok

version bump matches the API change (PVP)

Dependencies added: acquire

Dependencies removed: managed

API changes (from Hackage documentation)

Files

• library/Potoki/Core/Consume.hs +3/−2
• library/Potoki/Core/Fetch.hs +8/−0
• library/Potoki/Core/IO.hs +4/−3
• library/Potoki/Core/Prelude.hs +2/−2
• library/Potoki/Core/Produce.hs +27/−7
• library/Potoki/Core/Transform.hs +21/−0
• library/Potoki/Core/Types.hs +2/−2
• potoki-core.cabal +2/−2
• tests/Main.hs +11/−0

@@ -11,6 +11,7 @@ import Potoki.Core.Prelude hiding (sum) import Potoki.Core.Types import qualified Potoki.Core.Fetch as A+import qualified Acquire.IO as B   instance Profunctor Consume where@@ -86,5 +87,5 @@  {-# INLINABLE transform #-} transform :: Transform input output -> Consume output sinkOutput -> Consume input sinkOutput-transform (Transform transformManaged) (Consume sink) =-  Consume (\ fetch -> with (fmap ($ fetch) transformManaged) sink)+transform (Transform transformAcquire) (Consume sink) =+  Consume (\ fetch -> B.acquire (fmap ($ fetch) transformAcquire) sink)

@@ -11,6 +11,7 @@   eitherFetchingRight,   signaling,   ioMaybe,+  ioFetch, ) where @@ -174,3 +175,10 @@ ioMaybe :: IO (Maybe a) -> Fetch a ioMaybe io =   Fetch $ \nil just -> maybe nil just <$> io++{-# INLINABLE ioFetch #-}+ioFetch :: IO (Fetch a) -> Fetch a+ioFetch io =+  Fetch $ \ nil just -> do+    Fetch fetchIO <- io+    fetchIO nil just

@@ -4,19 +4,20 @@ import Potoki.Core.Types import qualified Potoki.Core.Produce as A import qualified Potoki.Core.Consume as B+import qualified Acquire.IO as C   produceAndConsume :: Produce input -> Consume input output -> IO output produceAndConsume (Produce produceManaged) (Consume consume) =-  with produceManaged consume+  C.acquire produceManaged consume  produceAndTransformAndConsume :: Produce input -> Transform input anotherInput -> Consume anotherInput output -> IO output produceAndTransformAndConsume (Produce produceManaged) (Transform transformManaged) (Consume consume) =-  with (($) <$> transformManaged <*> produceManaged) consume+  C.acquire (($) <$> transformManaged <*> produceManaged) consume  produce :: Produce input -> forall x. IO x -> (input -> IO x) -> IO x produce (Produce produceManaged) stop emit =-  with produceManaged $ \ (Fetch fetchIO) -> +  C.acquire produceManaged $ \ (Fetch fetchIO) ->    fix (\ loop -> join (fetchIO stop (\ element -> emit element >> loop)))  consume :: (forall x. x -> (input -> x) -> IO x) -> Consume input output -> IO output

@@ -78,6 +78,6 @@ ------------------------- import Control.Concurrent.STM as Exports --- managed+-- acquire --------------------------import Control.Monad.Managed as Exports+import Acquire.Acquire as Exports

@@ -9,6 +9,7 @@ import Potoki.Core.Prelude import Potoki.Core.Types import qualified Potoki.Core.Fetch as A+import qualified Acquire.IO as B   deriving instance Functor Produce@@ -17,15 +18,34 @@   pure x = Produce $ do     refX <- liftIO (newIORef (Just x))     return (A.maybeRef refX)-  (<*>) (Produce leftManaged) (Produce rightManaged) =-    Produce ((<*>) <$> leftManaged <*> rightManaged)+  (<*>) (Produce leftAcquire) (Produce rightAcquire) =+    Produce ((<*>) <$> leftAcquire <*> rightAcquire)  instance Alternative Produce where   empty =     Produce (pure empty)-  (<|>) (Produce leftManaged) (Produce rightManaged) =-    Produce ((<|>) <$> leftManaged <*> rightManaged)+  (<|>) (Produce leftAcquire) (Produce rightAcquire) =+    Produce ((<|>) <$> leftAcquire <*> rightAcquire) +instance Monad Produce where+  return = pure+  (>>=) (Produce (Acquire io1)) k2 =+    Produce $ Acquire $ do+      (fetch1, release1) <- io1+      release2Ref <- newIORef (return ())+      let+        fetch2 input1 =+          case k2 input1 of+            Produce (Acquire io2) ->+              A.ioFetch $ do+                join (readIORef release2Ref)+                (fetch2, release2) <- io2+                writeIORef release2Ref release2+                return fetch2+        release3 =+          join (readIORef release2Ref) >> release1+        in return (fetch1 >>= fetch2, release3)+ {-# INLINABLE list #-} list :: [input] -> Produce input list list =@@ -33,8 +53,8 @@  {-# INLINE transform #-} transform :: Transform input output -> Produce input -> Produce output-transform (Transform transformManaged) (Produce produceManaged) =+transform (Transform transformAcquire) (Produce produceAcquire) =   Produce $ do-    fetch <- produceManaged-    newFetch <- transformManaged+    fetch <- produceAcquire+    newFetch <- transformAcquire     return (newFetch fetch)

@@ -2,6 +2,7 @@ (   Transform(..),   consume,+  produce,   mapFetch,   executeIO,   take,@@ -97,6 +98,26 @@                   writeIORef stoppedRef False                   return stop             else return (yield output)++{-# INLINABLE produce #-}+produce :: (input -> Produce output) -> Transform input output+produce inputToProduce =+  Transform $ do+    stateRef <- liftIO (newIORef Nothing)+    return $ \ (Fetch inputFetchIO) -> Fetch $ \ nil just -> fix $ \ loop -> do+      state <- readIORef stateRef+      case state of+        Just (Fetch outputFetchIO, kill) ->+          join $ outputFetchIO+            (kill >> writeIORef stateRef Nothing >> loop)+            (return . just)+        Nothing ->+          join $ inputFetchIO (return nil) $ \ !input -> do+            case inputToProduce input of+              Produce (Acquire produceIO) -> do+                fetchAndKill <- produceIO+                writeIORef stateRef (Just fetchAndKill)+                loop  {-# INLINE mapFetch #-} mapFetch :: (Fetch a -> Fetch b) -> Transform a b

@@ -18,7 +18,7 @@ and resource management. -} newtype Produce element =-  Produce (Managed (Fetch element))+  Produce (Acquire (Fetch element))  {-| Active consumer of input into output.@@ -34,4 +34,4 @@   Consume (Fetch input -> IO output)  newtype Transform input output =-  Transform (Managed (Fetch input -> Fetch output))+  Transform (Acquire (Fetch input -> Fetch output))

@@ -1,7 +1,7 @@ name:   potoki-core version:-  0.9.2+  0.10 synopsis:   Low-level components of "potoki" description:@@ -52,8 +52,8 @@     Potoki.Core.Types     Potoki.Core.Prelude   build-depends:+    acquire >=0.2 && <0.3,     base >=4.7 && <5,-    managed >=1.0.5 && <2,     profunctors >=5.2 && <6,     stm >=2.4 && <3 

@@ -30,10 +30,21 @@ transform =   testGroup "Transform" $   [+    transformProduce+    ,     transformChoice     ,     transformArrowLaws   ]++transformProduce =+  testCase "Produce" $ do+    let list = [1, 2, 3] :: [Int]+    result <- C.produceAndTransformAndConsume+      (E.list list)+      (A.produce (E.list . \ n -> flip replicate n n))+      (D.list)+    assertEqual "" [1, 2, 2, 3, 3, 3] result  transformChoice =   testGroup "Choice" $