folds-common 0.1.1.0 → 0.2.0.0
raw patch · 9 files changed
+383/−98 lines, 9 filesdep ~basedep ~containers
Dependency ranges changed: base, containers
Files
- folds-common.cabal +25/−3
- src/Data/Fold/Common.hs +44/−9
- src/Data/Fold/Common/L'.hs +7/−4
- src/Data/Fold/Common/M.hs +34/−19
- src/Data/Fold/Common/R.hs +93/−0
- test/L'.hs +74/−0
- test/M.hs +64/−0
- test/Main.hs +0/−63
- test/R.hs +42/−0
folds-common.cabal view
@@ -1,5 +1,5 @@ name: folds-common-version: 0.1.1.0+version: 0.2.0.0 synopsis: A playground of common folds for folds description: In an effort to make @folds@ a more usable package this package provides a battery of common folds. These can be@@ -20,17 +20,39 @@ exposed-modules: Data.Fold.Common , Data.Fold.Common.L' , Data.Fold.Common.M+ , Data.Fold.Common.R build-depends: base >=4.0 && <5 , containers >= 0.5 , folds >= 0.5 hs-source-dirs: src default-language: Haskell2010 -Test-Suite properties+Test-Suite left-properties type: exitcode-stdio-1.0- main-is: Main.hs+ main-is: L'.hs hs-source-dirs: test build-depends: folds-common+ , containers+ , tasty+ , tasty-quickcheck+ , base > 4.0 && < 5+ default-language: Haskell2010+Test-Suite monoid-properties+ type: exitcode-stdio-1.0+ main-is: M.hs+ hs-source-dirs: test+ build-depends: folds-common+ , containers+ , tasty+ , tasty-quickcheck+ , base > 4.0 && < 5+ default-language: Haskell2010+Test-Suite right-properties+ type: exitcode-stdio-1.0+ main-is: R.hs+ hs-source-dirs: test+ build-depends: folds-common+ , containers , tasty , tasty-quickcheck , base > 4.0 && < 5
src/Data/Fold/Common.hs view
@@ -1,9 +1,5 @@--- | This module exports a few common folds. Some of these are defined--- as @L'@ folds if they cannot short-circuit. The rest are defined--- as monoidal folds. Since you may want to combine a monoidal and--- strict left fold, 'strictify' is an operation that drops laziness--- and reassociates an 'M'. This may result in a slow down in--- performance though.+{-# LANGUAGE Safe #-}+-- | This module exports a bunch of common folds. -- -- For the classic example --@@ -16,12 +12,51 @@ -- > main :: IO () -- > main = print $ C.run [1 .. 10000000] avg ----- This will run in constant memory as we'd hope.+-- This will run in constant memory as we'd hope. In general the+-- rules for keeping memory usage low while using @folds@ are --+-- * Don't try to consume a left fold lazily+-- * Don't try to consume a right fold strictly+-- * Never use '>>='+-- * Never use 'prefix' on right folds+-- * Never use 'postfix' on left folds+--+-- Also note that monoidal folds can be combined with strict left ones+-- with 'strictify'. module Data.Fold.Common ( module Data.Fold- , module Data.Fold.Common.L'- , module Data.Fold.Common.M) where+ -- * Left Folds+ , sum+ , product+ , count+ , mconcat+ , minimum+ , maximum+ , nub+ , slowNub+ , intoSet+ , last+ , nth+ -- * Monoidal Folds+ , any+ , all+ , and+ , or+ , elem+ , notElem+ , find+ , head+ , null+ , strictify+ -- * Right Folds+ , intoList+ , take+ , drop+ , indexOf+ , chunk+ , concat) where+import Prelude () import Data.Fold import Data.Fold.Common.L' import Data.Fold.Common.M+import Data.Fold.Common.R
src/Data/Fold/Common/L'.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE Safe #-} -- | A collection of common left folds. Note that all of these are -- strict and do not short circuit. These are useful for operations -- that require inspecting the entire list to calculate the final@@ -92,9 +93,10 @@ -- >>> run [1, 2, 1] slowNub -- [1, 2] slowNub :: Eq a => L' a [a]-slowNub = L' id step []- where step as a | a `elem` as = as- | otherwise = a : as+slowNub = L' (\(Pair' _ xs) -> xs []) step (Pair' [] id)+ where step (Pair' set as) a | a `elem` set = Pair' set as+ | otherwise = Pair' (a : set) (as . (a :))+ -- Note that this is just a subset of Diff lists -- | Collect all members into a @Set@. --@@ -121,8 +123,9 @@ -- -- >>> run [1 .. 10] (nth 20) -- Nothing-nth :: (Eq b, Num b) => b -> L' a (Maybe a)+nth :: (Eq b, Ord b, Num b) => b -> L' a (Maybe a) nth b = L' (\(Pair' e _) -> maybe' Nothing Just e) step (Pair' Nothing' b) where step st@(Pair' (Just' _) _) _ = st+ step (Pair' _ n) _ | n < 0 = Pair' Nothing' n step (Pair' _ 0) a = Pair' (Just' a) 0 step (Pair' _ n) _ = Pair' Nothing' (n - 1)
src/Data/Fold/Common/M.hs view
@@ -1,11 +1,11 @@--- | A collection of right folds. These are all short circuiting and+{-# LANGUAGE Safe #-}+-- | A collection of monoidal folds. These are all short circuiting and -- are designed to handle certain infinite cases properly. These are -- useful for operations which don't require the full list to -- calculate the output. module Data.Fold.Common.M where import Prelude hiding (any, all) import Data.Fold-import Data.Fold.Internal hiding (First) import Data.Monoid -- | Check that if predicate holds for any inputs to the fold.@@ -26,7 +26,7 @@ -- >>> run [1, 2, 3, 4] (all (> 1)) -- False all :: (a -> Bool) -> M a Bool-all p = M getAll (All . p) (<>) (All False)+all p = M getAll (All . p) (<>) (All True) -- | Check whether all elements are 'True'. --@@ -47,6 +47,25 @@ or :: M Bool Bool or = any id +-- | Check whether an element is fed into the fold.+--+-- >>> run [1, 2, 3] (elem 3)+-- True+--+-- >>> run [] (elem 1)+-- False+elem :: Eq a => a -> M a Bool+elem a = any (== a)++-- | Check whther an element isn't fed into the fold.+-- >>> run [1, 2, 3] (notElem 3)+-- False+--+-- >>> run [] (notElem 1)+-- True+notElem :: Eq a => a -> M a Bool+notElem a = all (/= a)+ -- | Find the first element for which a predicate holds. -- -- >>> run [1, 2, 3, 4] (find even)@@ -58,20 +77,6 @@ find p = M getFirst to (<>) (First Nothing) where to a = First $ if p a then Just a else Nothing --- | Find the first index for which a predicate holds.------ >>> run [1, 2, 3, 4] (indexOf (== 4))--- Just 3------ >>> run [1, 2, 3, 4] (indexOf (> 4))--- Nothing-indexOf :: Enum e => (a -> Bool) -> M a (Maybe e)-indexOf p = M (maybe' Nothing Just) to m Nothing'- where to a = if p a then Just' (toEnum 0) else Nothing'- m (Just' a) _ = Just' (succ a)- m _ (Just' a) = Just' (succ a)- m _ _ = Nothing'- -- | Grab the first inputted element. -- -- >>> run [1 ..] head@@ -82,6 +87,16 @@ head :: M a (Maybe a) head = M getFirst (First . Just) (<>) (First Nothing) +-- | Check whether a fold was fed any elements.+--+-- >>> run [] null+-- True+--+-- >>> run [1..] null+-- False+null :: M a Bool+null = M id (const False) (&&) True+ -- | Occasionally we want to use a short-circuiting fold with other, -- nonlazy folds. This function drops laziness on the floor for a @L'@ -- fold. This is dangerous because it can potentially effect@@ -93,8 +108,8 @@ -- >>> run (repeat False) (strictify and) -- ... diverges ... ----- This means it is only advisable to use when combining a monoidal--- fold with something that requires left folding.+-- This is generally an advantage when we want to combine a monoidal+-- fold with a left one. -- -- >>> run [1.0, 2, 3, 4] $ (/) <$> strictify head <*> maximum -- 0.25
+ src/Data/Fold/Common/R.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE Safe #-}+-- | A series of common right folds. These tend to be list centric+-- since since lists provide such a lousy monoid.+module Data.Fold.Common.R where+import Data.Fold+import Data.Fold.Internal++-- | An extremely boring fold. You can almost view this as an identity+-- fold across lists.+--+-- >>> run [1 .. 10] intoLists+-- [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]+intoList :: R a [a]+intoList = R id (:) []++-- | Take the first @n@ inputs to the fold. If less then @n@ inputs+-- are fed in total then take as many as possible.+--+-- >>> run [1 .. 10] (take 3)+-- [1, 2, 3]+--+-- >>> run [1, 2, 3] (take 100)+-- [1, 2, 3]+take :: (Eq b, Ord b, Num b) => b -> R a [a]+take b = R ($ b) step (\_ -> [])+ where step x xs n | n <= 0 = []+ | otherwise = x : xs (n - 1)++-- | Drop the first @n@ items. If less then @n@ items are supplied+-- then return the empty list.+--+-- >>> run [1, 2, 3] (drop 1)+-- [2, 3]+--+-- >>> run [1, 2, 3] (drop 100)+-- []+drop :: (Eq b, Ord b, Num b) => b -> R a [a]+drop b = R ($ b) step (\_ -> [])+ where step x xs n | n <= 0 = x : xs 0+ | otherwise = xs (n - 1)+ -- Note, this costs an integer comparison + thunks along the+ -- list. Is this really OK? It's still perfectly lazy at+ -- least.++-- | Find the first index for which a predicate holds.+--+-- >>> run [1, 2, 3, 4] (indexOf (== 4))+-- Just 3+--+-- >>> run [1, 2, 3, 4] (indexOf (> 4))+-- Nothing+indexOf :: Enum e => (a -> Bool) -> R a (Maybe e)+indexOf p = R (maybe' Nothing Just) step Nothing'+ where step a _ | p a = Just' (toEnum 0)+ step _ Nothing' = Nothing'+ step _ (Just' a) = Just' (succ a)+++-- | Chunk the input into partitions according to a function. While+-- the values from the function are equal elements are collected into+-- a chunk. Note that partitioning according to a predicate is just a+-- special case of this.+--+-- >>> run [1, 1, 2, 3] (chunk id)+-- [[1, 1], [2], [3]]+--+-- >>> run [1, -1, 2, 1] (chunk abs)+-- [[1, -1], 2, [1]]+--+-- >>> run [1, 2, 4, 6, 5] (chunk even)+-- [[1], [2, 4, 6], 5]+chunk :: (Show b, Eq b) => (a -> b) -> R a [[a]]+chunk f = R (\(Pair' _ xs) -> xs) step (Pair' Nothing' [])+ where step a (Pair' Nothing' l) = Pair' (Just' $ f a) [[a]]+ step a (Pair' (Just' b) (as : ass)) =+ let b' = f a+ in if b == b'+ then Pair' (Just' b') ((a : as) : ass)+ else Pair' (Just' b') ([a] : as : ass)++-- | Lazily produce a flattened list of the inputted lists.+--+-- >>> run [[1], [2], [3]] concat+-- [1, 2, 3]+--+-- >>> head $ run (map return [1..]) concat+-- 1+--+-- Note: The right fold ensures that all applications of '++'+-- associate to the right. This makes this fold ideal for streaming+-- but slow when completely forced.+concat :: R [a] [a]+concat = R id (++) []
+ test/L'.hs view
@@ -0,0 +1,74 @@+module Main where+import qualified Data.Fold.Common as C+import Data.Monoid+import Data.List+import qualified Data.Set as S+import Test.Tasty+import Test.Tasty.QuickCheck++propSum :: TestTree+propSum = testProperty "Sum Works"+ $ \l -> C.run l C.sum == (sum l :: Int)++propProduct :: TestTree+propProduct = testProperty "Product Works"+ $ \l -> C.run l C.product == (product l :: Int)++propCount :: TestTree+propCount = testProperty "Count Works"+ $ \l -> C.run l C.count == length (l :: [Int])++propMconcat :: TestTree+propMconcat = testProperty "Mconcat Works"+ $ \l -> C.run (map Sum l) C.mconcat+ == mconcat (map Sum l :: [Sum Int])++propMinimum :: TestTree+propMinimum = testProperty "Minimum Works"+ $ \l -> C.run l C.minimum == mminimum (l :: [Int])+ where mminimum [] = Nothing+ mminimum xs = Just (minimum xs)++propMaximum :: TestTree+propMaximum = testProperty "Maximum Works"+ $ \l -> C.run l C.maximum == mmaximum (l :: [Int])+ where mmaximum [] = Nothing+ mmaximum xs = Just (maximum xs)++propNub :: TestTree+propNub = testProperty "Nub Works"+ $ \l -> C.run l C.nub == nub (l :: [Int])++propSlowNub :: TestTree+propSlowNub = testProperty "SlowNub Works"+ $ \l -> C.run l C.slowNub == nub (l :: [Int])++propIntoSet :: TestTree+propIntoSet = testProperty "IntoSet Works"+ $ \l -> C.run l C.intoSet == S.fromList (l :: [Int])+++propLast :: TestTree+propLast = testProperty "Last works"+ $ \l -> C.run l C.last == (mlast l :: Maybe Int)+ where mlast [] = Nothing+ mlast xs = Just (last xs)++propNth :: TestTree+propNth = testProperty "Nth works"+ $ \i l -> C.run l (C.nth i) == (nth i l :: Maybe Int)+ where nth n xs | length xs <= n || n < 0 = Nothing+ nth n xs = Just (xs !! n)++main :: IO ()+main = defaultMain $ testGroup "Left Folds" [ propSum+ , propProduct+ , propCount+ , propMconcat+ , propMinimum+ , propMaximum+ , propNub+ , propSlowNub+ , propIntoSet+ , propLast+ , propNth]
+ test/M.hs view
@@ -0,0 +1,64 @@+module Main where+import qualified Data.Fold.Common as C+import Data.List+import Test.Tasty+import Test.Tasty.QuickCheck++propAny :: TestTree+propAny = testProperty "Any Works"+ $ \l -> C.run l (C.any even) == any even (l :: [Int])++propAll :: TestTree+propAll = testProperty "All Works"+ $ \l -> C.run l (C.all even) == all even (l :: [Int])++propAnd :: TestTree+propAnd = testProperty "And Works"+ $ \l -> C.run l C.and == and (l :: [Bool])++propOr :: TestTree+propOr = testProperty "Or Works"+ $ \l -> C.run l C.or == or (l :: [Bool])++propElem :: TestTree+propElem = testProperty "Elem Works"+ $ \l i -> C.run l (C.elem i) == elem i (l :: [Int])++propNotElem :: TestTree+propNotElem = testProperty "NotElem Works"+ $ \l i -> C.run l (C.notElem i) == notElem i (l :: [Int])+++propFind :: TestTree+propFind = testProperty "Find Works"+ $ \l -> C.run l (C.find even) == find even (l :: [Int])++propNull :: TestTree+propNull = testProperty "Null Works"+ $ \l -> C.run l C.null == null (l :: [Int])++propHead :: TestTree+propHead = testProperty "Head Works"+ $ \l -> C.run l C.head == mhead (l :: [Int])+ where mhead [] = Nothing+ mhead (x : xs) = Just x++propStrictify :: TestTree+propStrictify = testGroup "Strictify Works" [ s "any" $ C.any even+ , s "all" $ C.all even+ , s "find" $ C.find even]+ where s name f =+ testProperty name+ $ \l -> C.run (l :: [Int]) f == C.run l (C.strictify f)++main :: IO ()+main = defaultMain $ testGroup "Monoidal Folds" [ propAny+ , propAll+ , propAnd+ , propOr+ , propElem+ , propNotElem+ , propFind+ , propHead+ , propNull+ , propStrictify]
− test/Main.hs
@@ -1,63 +0,0 @@-module Main where-import qualified Data.Fold.Common as C-import Data.List-import Test.Tasty-import Test.Tasty.QuickCheck---propSum :: TestTree-propSum = testProperty "Sum Works"- $ \l -> C.run l C.sum == (sum l :: Int)--propProduct :: TestTree-propProduct = testProperty "Product Works"- $ \l -> C.run l C.product == (product l :: Int)--propCount :: TestTree-propCount = testProperty "Count Works"- $ \l -> C.run l C.count == length (l :: [Int])--propNub :: TestTree-propNub = testProperty "Nub Works"- $ \l -> C.run l C.nub == nub (l :: [Int])--leftFolds :: TestTree-leftFolds = testGroup "Left Folds" [ propSum- , propProduct- , propCount- , propNub]--propAny :: TestTree-propAny = testProperty "Any Works"- $ \l -> C.run l (C.any even) == any even (l :: [Int])--propAll :: TestTree-propAll = testProperty "All Works"- $ \l -> C.run l (C.all even) == all even (l :: [Int])--propFind :: TestTree-propFind = testProperty "Find Works"- $ \l -> C.run l (C.find even) == find even (l :: [Int])--propIndexOf :: TestTree-propIndexOf = testProperty "IndexOf Works"- $ \l -> C.run l (C.indexOf even) == findIndex even (l :: [Int])--propStrictify :: TestTree-propStrictify = testGroup "Strictify Works" [ s "any" $ C.any even- , s "all" $ C.all even- , s "find" $ C.find even]- where s name f =- testProperty name- $ \l -> C.run (l :: [Int]) f == C.run l (C.strictify f)---monoidFolds :: TestTree-monoidFolds = testGroup "Monoidal Folds" [ propAny- , propAll- , propFind- , propIndexOf- , propStrictify]--main :: IO ()-main = defaultMain $ testGroup "Folds" [leftFolds]
+ test/R.hs view
@@ -0,0 +1,42 @@+module Main where+import qualified Data.Fold.Common as C+import Data.List+import Test.Tasty+import Test.Tasty.QuickCheck+++propIntoList :: TestTree+propIntoList = testProperty "intoList Works"+ $ \l -> C.run l C.intoList == (l :: [Int])++propTake :: TestTree+propTake = testProperty "Take Works"+ $ \l i -> C.run l (C.take i) == (take i l :: [Int])++propDrop :: TestTree+propDrop = testProperty "Drop Works"+ $ \l i -> C.run l (C.drop i) == (drop i l :: [Int])+++propIndexOf :: TestTree+propIndexOf = testProperty "IndexOf Works"+ $ \l -> C.run l (C.indexOf even) == findIndex even (l :: [Int])++propChunk :: TestTree+propChunk = testProperty "Chunk Works"+ $ \l -> C.run l (C.chunk id) == chunk (l :: [Int])+ where chunk [] = []+ chunk (x : xs) =+ (x : takeWhile (== x) xs) : chunk (dropWhile (== x) xs)++propConcat :: TestTree+propConcat = testProperty "Concat Works"+ $ \l -> C.run l C.concat == concat (l :: [[Int]])++main :: IO ()+main = defaultMain $ testGroup "Right Folds" [ propIntoList+ , propTake+ , propDrop+ , propIndexOf+ , propChunk+ , propConcat]