potoki-core 1.3 → 1.4

raw patch · 7 files changed

+87/−26 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• library/Potoki/Core/Consume.hs +6/−0
• library/Potoki/Core/Fetch.hs +22/−0
• library/Potoki/Core/Produce.hs +9/−0
• library/Potoki/Core/Transform.hs +16/−19
• library/Potoki/Core/Transform/Types.hs +9/−0
• potoki-core.cabal +4/−3
• tests/Main.hs +21/−4

@@ -2,6 +2,7 @@  import Potoki.Core.Prelude import qualified Potoki.Core.Fetch as A+import qualified Potoki.Core.Transform.Types as B   {-|@@ -87,3 +88,8 @@           (pure acc)           (\ !element -> build (element + acc)))     in build 0++{-# INLINABLE transform #-}+transform :: B.Transform input output -> Consume output sinkOutput -> Consume input sinkOutput+transform (B.Transform transform) (Consume sink) =+  Consume (transform >=> sink)

@@ -96,3 +96,25 @@   Fetch $ \ nil just -> atomicModifyIORef' unsentListRef $ \ case     (!head) : tail -> (tail, just head)     _ -> ([], nil)++{-# INLINABLE firstCachingSecond #-}+firstCachingSecond :: IORef (Maybe b) -> Fetch (a, b) -> Fetch a+firstCachingSecond cacheRef (Fetch bothFetchIO) =+  Fetch $ \ nil just ->+  join $+  bothFetchIO+    (atomicModifyIORef' cacheRef (\ cache -> (cache, nil)))+    (\ (!first, !second) -> atomicModifyIORef' cacheRef (const (Just second, just first)))++{-# INLINABLE bothFetchingFirst #-}+bothFetchingFirst :: IORef (Maybe b) -> Fetch a -> Fetch (a, b)+bothFetchingFirst cacheRef (Fetch firstFetchIO) =+  Fetch $ \ nil just ->+  join $+  firstFetchIO+    (atomicModifyIORef' cacheRef (\ cache -> (cache, nil)))+    (\ !firstFetched -> +      atomicModifyIORef' cacheRef+        (\ case+          Just secondCached -> (Nothing, just (firstFetched, secondCached))+          Nothing -> (Nothing, nil)))

@@ -2,6 +2,7 @@  import Potoki.Core.Prelude import qualified Potoki.Core.Fetch as A+import qualified Potoki.Core.Transform.Types as B   {-|@@ -38,3 +39,11 @@   Produce $ do     unsentListRef <- newIORef list     return (A.list unsentListRef, return ())++{-# INLINE transform #-}+transform :: B.Transform input output -> Produce input -> Produce output+transform (B.Transform transformIO) (Produce produceIO) =+  Produce $ do+    (fetch, kill) <- produceIO+    newFetch <- transformIO fetch+    return (newFetch, kill)

@@ -1,15 +1,22 @@-module Potoki.Core.Transform where+module Potoki.Core.Transform+(+  Transform(..),+  consume,+  produce,+  mapFetch,+  executeIO,+  take,+)+where -import Potoki.Core.Prelude+import Potoki.Core.Prelude hiding (take)+import Potoki.Core.Transform.Types import qualified Potoki.Core.Fetch as A import qualified Potoki.Core.Consume as C import qualified Potoki.Core.Produce as D import qualified Deque as B  -newtype Transform input output =-  Transform (A.Fetch input -> IO (A.Fetch output))- instance Category Transform where   id =     Transform return@@ -45,20 +52,10 @@  instance Strong Transform where   first' (Transform firstTransformIO) =-    Transform $ \ (A.Fetch bothFetchIO) -> do-      secondFetchedDequeRef <- newIORef mempty-      A.Fetch firstFetchIO <--        firstTransformIO $ A.Fetch $ \ nil just ->-        join $ bothFetchIO (return nil) $ \ (!firstFetched, !secondFetched) -> do-          modifyIORef' secondFetchedDequeRef (B.snoc secondFetched)-          return (just firstFetched)-      return $ A.Fetch $ \ nil just -> join $ firstFetchIO (return nil) $ \ !firstFetched -> do-        secondFetchedDeque <- readIORef secondFetchedDequeRef-        case B.uncons secondFetchedDeque of-          Just (!secondFetched, !secondFetchedDequeTail) -> do-            writeIORef secondFetchedDequeRef secondFetchedDequeTail-            return (just (firstFetched, secondFetched))-          Nothing -> return nil+    Transform $ \ bothFetch -> do+      cacheRef <- newIORef Nothing+      firstFetch <- firstTransformIO (A.firstCachingSecond cacheRef bothFetch)+      return $ A.bothFetchingFirst cacheRef firstFetch  instance Arrow Transform where   arr fn =

@@ -0,0 +1,9 @@+module Potoki.Core.Transform.Types+where++import Potoki.Core.Prelude+import qualified Potoki.Core.Fetch as A+++newtype Transform input output =+  Transform (A.Fetch input -> IO (A.Fetch output))

@@ -1,7 +1,7 @@ name:   potoki-core version:-  1.3+  1.4 synopsis:   Low-level components of "potoki" description:@@ -39,7 +39,7 @@   hs-source-dirs:     library   default-extensions:-    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples   default-language:     Haskell2010   exposed-modules:@@ -49,6 +49,7 @@     Potoki.Core.IO     Potoki.Core.Transform   other-modules:+    Potoki.Core.Transform.Types     Potoki.Core.Prelude   build-depends:     -- @@ -67,7 +68,7 @@   main-is:     Main.hs   default-extensions:-    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples   default-language:     Haskell2010   build-depends:

@@ -21,8 +21,8 @@     testProperty "list to list" $ \ (list :: [Int]) ->     list === unsafePerformIO (C.produceAndConsume (E.list list) D.list)     ,-    testProperty "Dual consumption" $ \ (list :: [Int]) ->-    (list, list) === unsafePerformIO (C.produceAndConsume (E.list list) ((,) <$> D.list <*> D.list))+    testProperty "consecutive consumers" $ \ (list :: [Int], amount) ->+    list === unsafePerformIO (C.produceAndConsume (E.list list) ((++) <$> D.transform (A.take amount) D.list <*> D.list))     ,     transform   ]@@ -74,6 +74,23 @@ transformArrowLaws =   testGroup "Arrow laws"   [+    testGroup "Strong"+    [+      testCase "1" $ do+        let+          input = [(1,'a'),(2,'b'),(3,'c'),(4,'d')]+          transform = first transform1+        result <- C.produceAndTransformAndConsume (E.list input) transform D.list+        assertEqual "" [(6,'c'),(4,'d')] result+      ,+      testCase "Lack of elements" $ do+        let+          input = [(1,'a'),(2,'b')]+          transform = first transform1+        result <- C.produceAndTransformAndConsume (E.list input) transform D.list+        assertEqual "" [(3,'b')] result+    ]+    ,     transformProperty "arr id = id"       (arr id :: A.Transform Int Int)       id@@ -129,8 +146,8 @@   where     f = (+24) :: Int -> Int     g = (*3) :: Int -> Int-    transform1 = A.take 3 >>> A.consume D.sum :: A.Transform Int Int-    transform2 = A.take 4 >>> A.consume D.sum :: A.Transform Int Int+    transform1 = A.consume (D.transform (A.take 3) D.sum) :: A.Transform Int Int+    transform2 = A.consume (D.transform (A.take 4) D.sum) :: A.Transform Int Int     assoc ((a,b),c) = (a,(b,c))     assocsum (Left (Left x)) = Left x     assocsum (Left (Right y)) = Right (Left y)