packages feed

folds-common (empty) → 0.1.0.0

raw patch · 7 files changed

+257/−0 lines, 7 filesdep +basedep +containersdep +foldssetup-changed

Dependencies added: base, containers, folds, folds-common, tasty, tasty-quickcheck

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Danny Gratzer++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ folds-common.cabal view
@@ -0,0 +1,37 @@+name:                folds-common+version:             0.1.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+                     plugged together easily and efficiently to cover many+                     common usages.+license:             MIT+license-file:        LICENSE+author:              Danny Gratzer+maintainer:          jozefg@cmu.edu+category:            Data+build-type:          Simple+cabal-version:       >=1.10+source-repository head+  type:     git+  location: http://github.com/jozefg/folds-common++library+  exposed-modules:     Data.Fold.Common+                     , Data.Fold.Common.L'+                     , Data.Fold.Common.M+  build-depends:       base >=4.0 && <5+                     , containers >= 0.5+                     , folds >= 0.5+  hs-source-dirs:      src+  default-language:    Haskell2010++Test-Suite properties+  type:               exitcode-stdio-1.0+  main-is:            Main.hs+  hs-source-dirs:     test+  build-depends:      folds-common+                    , tasty+                    , tasty-quickcheck+                    , base > 4.0 && < 5+  default-language:    Haskell2010
+ src/Data/Fold/Common.hs view
@@ -0,0 +1,27 @@+-- | 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.+--+-- For the classic example+--+-- > import           Control.Applicative+-- > import qualified Data.Fold.Common as C+-- >+-- > avg :: C.L' Double Double+-- > avg = (/) <$> C.sum <*> C.count+-- >+-- > main :: IO ()+-- > main = print $ C.run [1 .. 10000000] avg+--+-- This will run in constant memory as we'd hope.+--+module Data.Fold.Common+       ( module Data.Fold+       , module Data.Fold.Common.L'+       , module Data.Fold.Common.M) where+import Data.Fold+import Data.Fold.Common.L'+import Data.Fold.Common.M
+ src/Data/Fold/Common/L'.hs view
@@ -0,0 +1,64 @@+module Data.Fold.Common.L' where+import Data.Fold+import Data.Fold.Internal+import Data.Monoid+import qualified Data.Set as S++-- | Sum of the inputs+sum :: Num a => L' a a+sum = L' id (+) 0++-- | Product of the input+product :: Num a => L' a a+product = L' id (*) 1++-- | Count the number of elements fed to a fold+count :: Enum e => L' a e+count = L' id (\c _ -> succ c) (toEnum 0)++-- | 'mappend' all the elements of a sequence together.+msum :: Monoid m => L' m m+msum = L' id mappend mempty++-- | Minimum of all inputs. If no inputs are supplied this returns+-- 'Nothing'.+minimum :: Ord a => L' a (Maybe a)+minimum = L' id comp Nothing+  where comp Nothing a  = Just a+        comp (Just b) a = Just (min a b)++-- | Maximum of all inputs. If no inputs are supplied this returns+-- 'Nothing'.+maximum :: Ord a => L' a (Maybe a)+maximum = L' id comp Nothing+  where comp Nothing a  = Just a+        comp (Just b) a = Just (max a b)++-- | De-duplicate all the inputs while preserving order. @O(n log(n))@+nub :: Ord a => L' a [a]+nub = L' (\(Pair' _ l) -> reverse l) step (Pair' S.empty [])+  where step st@(Pair' s as) a | S.member a s = st+                               | otherwise = Pair' (S.insert a s) (a : as)++-- | De-duplicate all the inputs while preserving order. @O(n^2)@+slowNub :: Eq a => L' a [a]+slowNub = L' id step []+  where step as a | a `elem` as = as+                  | otherwise = a : as++-- | Collect all members into a @Set@.+intoSet :: Ord a => L' a (S.Set a)+intoSet = L' id (flip S.insert) S.empty++-- | Grab the last element inputted+last :: L' a (Maybe a)+last = L' id step Nothing+  where step Nothing = Just+        step x = const x++-- | Grab the nth element inputted+nth :: (Eq 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' _ 0) a = Pair' (Just' a) 0+        step (Pair' _ n) _ = Pair' Nothing' (n - 1)
+ src/Data/Fold/Common/M.hs view
@@ -0,0 +1,44 @@+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.+any :: (a -> Bool) -> M a Bool+any p = M getAny (Any . p) (<>) (Any False)++-- | Check that if predicate holds for all inputs to the fold.+all :: (a -> Bool) -> M a Bool+all p = M getAll (All . p) (<>) (All False)++-- | Check whether all elements are 'True'+and :: M Bool Bool+and = all id++-- | Check whether any elements are 'True'+or :: M Bool Bool+or = any id++-- | Find the first element for which a predicate holds.+find :: (a -> Bool) -> M a (Maybe a)+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.+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+head :: M a (Maybe a)+head = M getFirst (First . Just) (<>) (First Nothing)++-- | Occasionally we want to use a short-circuiting fold with other,+-- nonlazy folds. This function drops laziness on the floor for a+-- 'L\'' fold.+strictify :: M a b -> L' a b+strictify (M p to m z) = L' p (\z a -> z `m` to a) z
+ test/Main.hs view
@@ -0,0 +1,63 @@+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]