potoki-core 0.11 → 0.12

raw patch · 6 files changed

+43/−47 lines, 6 files

Files

• library/Potoki/Core/Consume.hs +3/−3
• library/Potoki/Core/IO.hs +6/−6
• library/Potoki/Core/Produce.hs +1/−2
• library/Potoki/Core/Transform.hs +31/−34
• library/Potoki/Core/Types.hs +1/−1
• potoki-core.cabal +1/−1

@@ -93,6 +93,6 @@      in build 0  {-# INLINABLE transform #-}-transform :: Transform input output -> Consume output sinkOutput -> Consume input sinkOutput-transform (Transform transformAcquire) (Consume sink) =-  Consume $ \ fetch -> B.acquire (fmap ($ fetch) transformAcquire) sink+transform :: Transform input1 input2 -> Consume input2 output -> Consume input1 output+transform (Transform transformAcquire) (Consume consumeIO) =+  Consume $ \ fetch -> B.acquire (transformAcquire fetch) consumeIO

@@ -8,12 +8,12 @@   produceAndConsume :: Produce input -> Consume input output -> IO output-produceAndConsume (Produce produceAcquire) (Consume consumeFunc) =-  C.acquire produceAcquire consumeFunc+produceAndConsume (Produce produceAcquire) (Consume consumeIO) =+  C.acquire produceAcquire consumeIO  produceAndTransformAndConsume :: Produce input -> Transform input anotherInput -> Consume anotherInput output -> IO output-produceAndTransformAndConsume (Produce produceAcquire) (Transform transformAcquire) (Consume consumeFunc) =-  C.acquire (($) <$> transformAcquire <*> produceAcquire) consumeFunc+produceAndTransformAndConsume (Produce produceAcquire) (Transform transformAcquire) (Consume consumeIO) =+  C.acquire (produceAcquire >>= transformAcquire) consumeIO  produce :: Produce input -> forall x. IO x -> (input -> IO x) -> IO x produce (Produce produceAcquire) stop emit =@@ -25,8 +25,8 @@         Just element -> emit element >> doLoop  consume :: IO (Maybe input) -> Consume input output -> IO output-consume fetchIO (Consume consumeFunc) =-  consumeFunc $ Fetch fetchIO+consume fetchIO (Consume consumeIO) =+  consumeIO $ Fetch fetchIO  {-| Fetch all the elements running the provided handler on them -} fetchAndHandleAll :: Fetch element -> IO () -> (element -> IO ()) -> IO ()

@@ -59,5 +59,4 @@ transform (Transform transformAcquire) (Produce produceAcquire) =   Produce $ do     fetch <- produceAcquire-    newFetch <- transformAcquire-    return $ newFetch fetch+    transformAcquire fetch

@@ -16,47 +16,44 @@  instance Category Transform where   id =-    Transform (return id)-  (.) (Transform leftVal) (Transform rightVal) =-    Transform ((.) <$> leftVal <*> rightVal)+    Transform (return)+  (.) (Transform left) (Transform right) =+    Transform (left <=< right)  instance Profunctor Transform where   dimap inputMapping outputMapping (Transform acquire) =-    Transform $ do-      newFetch <- acquire-      return $ \ oldFetch -> fmap outputMapping (newFetch $ fmap inputMapping oldFetch)+    Transform $ \ oldFetch -> do+      newFetch <- acquire (fmap inputMapping oldFetch)+      return $ fmap outputMapping newFetch  instance Choice Transform where   right' :: Transform a b -> Transform (Either c a) (Either c b)   right' (Transform rightTransformAcquire) =-    Transform $ do-      rightInFetchToOutFetch <- rightTransformAcquire+    Transform $ \ inFetch -> do       fetchedLeftMaybeRef <- liftIO $ newIORef Nothing-      return $ \ inFetch ->-        let-          Fetch rightFetchIO = rightInFetchToOutFetch $ A.rightHandlingLeft (writeIORef fetchedLeftMaybeRef . Just) inFetch-         in Fetch $ do-           rightFetch <- rightFetchIO-           case rightFetch of-             Nothing    -> do-               fetchedLeftMaybe <- readIORef fetchedLeftMaybeRef-               case fetchedLeftMaybe of-                 Nothing          -> return Nothing-                 Just fetchedLeft -> do-                   writeIORef fetchedLeftMaybeRef Nothing-                   return $ Just (Left fetchedLeft)-             Just element -> return $ Just (Right element)+      Fetch rightFetchIO <- rightTransformAcquire (A.rightHandlingLeft (writeIORef fetchedLeftMaybeRef . Just) inFetch)+      return $ Fetch $ do+          rightFetch <- rightFetchIO+          case rightFetch of+            Nothing    -> do+              fetchedLeftMaybe <- readIORef fetchedLeftMaybeRef+              case fetchedLeftMaybe of+                Nothing          -> return Nothing+                Just fetchedLeft -> do+                  writeIORef fetchedLeftMaybeRef Nothing+                  return $ Just (Left fetchedLeft)+            Just element -> return $ Just (Right element)  instance Strong Transform where   first' (Transform firstTransformAcquire) =-    Transform $ do+    Transform $ \ inFetch -> do       cacheRef <- liftIO $ newIORef undefined-      firstInFetchToOutFetch <- firstTransformAcquire-      return $ A.bothFetchingFirst cacheRef . firstInFetchToOutFetch . A.firstCachingSecond cacheRef+      outFetch <- firstTransformAcquire (A.firstCachingSecond cacheRef inFetch)+      return $ A.bothFetchingFirst cacheRef outFetch  instance Arrow Transform where   arr fn =-    Transform (return (fmap fn))+    Transform (return . fmap fn)   first =     first' @@ -67,9 +64,9 @@ {-# INLINE consume #-} consume :: Consume input output -> Transform input output consume (Consume runFetch) =-  Transform $ do+  Transform $ \ (Fetch inputIO) -> do     stoppedRef <- liftIO $ newIORef False-    return $ \ (Fetch inputIO) -> Fetch $ do+    return $ Fetch $ do       stopped <- readIORef stoppedRef       if stopped         then do@@ -100,9 +97,9 @@ {-# INLINABLE produce #-} produce :: (input -> Produce output) -> Transform input output produce inputToProduce =-  Transform $ do+  Transform $ \ (Fetch inputFetchIO) -> do     stateRef <- liftIO $ newIORef Nothing-    return $ \ (Fetch inputFetchIO) -> Fetch $ fix $ \ doLoop -> do+    return $ Fetch $ fix $ \ doLoop -> do       state <- readIORef stateRef       case state of         Just (Fetch outputFetchIO, kill) ->@@ -129,7 +126,7 @@ {-# INLINE mapFetch #-} mapFetch :: (Fetch a -> Fetch b) -> Transform a b mapFetch mapping =-  Transform $ return mapping+  Transform $ return . mapping  {-| Execute the IO action.@@ -143,11 +140,11 @@ take :: Int -> Transform input input take amount   | amount <= 0 =-    Transform $ return $ \ _ -> Fetch $ return Nothing+    Transform $ \ _ -> return $ Fetch $ return Nothing   | otherwise   =-    Transform $ do+    Transform $ \ (Fetch fetchIO) -> do       countRef <- liftIO $ newIORef amount-      return $ \ (Fetch fetchIO) -> Fetch $ do+      return $ Fetch $ do         count <- readIORef countRef         if count > 0           then do

@@ -31,4 +31,4 @@   Consume (Fetch input -> IO output)  newtype Transform input output =-  Transform (Acquire (Fetch input -> Fetch output))+  Transform (Fetch input -> Acquire (Fetch output))

@@ -1,7 +1,7 @@ name:   potoki-core version:-  0.11+  0.12 synopsis:   Low-level components of "potoki" description: