packages feed

gambler (empty) → 0.0.0.0

raw patch · 34 files changed

+1883/−0 lines, 34 filesdep +basedep +criteriondep +gambler

Dependencies added: base, criterion, gambler, hspec

Files

+ benchmark/Main.hs view
@@ -0,0 +1,73 @@+module Main (main) where++import Criterion.Main++import Data.Functor ((<$>))+import Control.Applicative (pure, (<*>))+import Data.Function ((.), ($))+import Data.Int (Int)+import Prelude ((+), Num)+import System.IO (IO)++import qualified Data.List as List+import qualified Prelude+import qualified Data.Foldable as Foldable++import qualified Fold.Pure+import qualified Fold.Effectful++main :: IO ()+main = defaultMain+  [ env (pure [1..10000 :: Int]) $ \ns ->+      bgroup "[1..10000 :: Int]"+        [ bgroup "sum" $ List.map ($ ns)+            [ bench "Fold.Pure.run sum" .+                whnf (Fold.Pure.run Fold.Pure.sum)+            , bench "Fold.Effectful.run (fold sum)" .+                whnfIO . Fold.Effectful.run (Fold.Effectful.fold Fold.Pure.sum)+            , bench "Prelude.sum" .+                whnf Prelude.sum+            , bench "Data.List.foldl' (+) 0" .+                whnf (List.foldl' (+) 0)+            ]+        , bgroup "length" $ List.map ($ ns)+            [ bench "Fold.Pure.run length" .+                whnf (Fold.Pure.run Fold.Pure.length)+            , bench "Fold.Effectful.run (generalize length)" .+                whnfIO . Fold.Effectful.run (Fold.Effectful.fold Fold.Pure.length)+            , bench "Prelude.length" .+                whnf Prelude.length+            ]+        , bgroup "sumAndLength" $ List.map ($ ns)+            [ bench "naive sumAndLength" .+                nf sumAndLength+            , bench "foldl' sumAndLength" .+                nf sumAndLength'+            , bench "strict pair sumAndLength" .+                nf sumAndLength_Pair+            , bench "foldl sumAndLength" .+                nf sumAndLength_foldl+            ]+        ]+  ]+++sumAndLength :: Num a => [a] -> (a, Int)+sumAndLength xs = (Prelude.sum xs, Prelude.length xs)++sumAndLength' :: Num a => [a] -> (a, Int)+sumAndLength' xs = Foldable.foldl' step (0, 0) xs+  where+    step (x, y) n = (x + n, y + 1)++data Pair a b = Pair !a !b++sumAndLength_Pair :: Num a => [a] -> (a, Int)+sumAndLength_Pair xs = done (Foldable.foldl' step (Pair 0 0) xs)+  where+    step (Pair x y) n = Pair (x + n) (y + 1)++    done (Pair x y) = (x, y)++sumAndLength_foldl :: Num a => [a] -> (a, Int)+sumAndLength_foldl = Fold.Pure.run ((,) <$> Fold.Pure.sum <*> Fold.Pure.length)
+ changelog.md view
@@ -0,0 +1,1 @@+0.0.0.0 - Initial release
+ gambler.cabal view
@@ -0,0 +1,95 @@+cabal-version: 3.0++name: gambler+version: 0.0.0.0++category: Streaming+synopsis: Composable, streaming, and efficient left folds+description: This library provides strict left folds that stream in constant+    memory, and you can combine folds using @Applicative@ style to derive new+    folds that still traverse the list only once.++author: Gabriella Gonzalez+maintainer: Chris Martin, Julie Moronuki++license: BSD-3-Clause+license-file: license.txt+copyright: 2013-2016 Gabriella Gonzalez++bug-reports: https://github.com/typeclasses/gambler/issues++extra-source-files: *.md++common base+    default-language: GHC2021+    ghc-options:+        -Wall+    default-extensions:+        NoImplicitPrelude+    build-depends:+      , base ^>= 4.16 || ^>= 4.17++library+    import: base+    hs-source-dirs: source+    exposed-modules:+        Fold+        Fold.Types++        Fold.Pure+        Fold.Pure.Conversion+        Fold.Pure.Examples+        Fold.Pure.Nonempty+        Fold.Pure.Run+        Fold.Pure.Type+        Fold.Pure.Utilities++        Fold.Effectful+        Fold.Effectful.Conversion+        Fold.Effectful.Examples+        Fold.Effectful.Nonempty+        Fold.Effectful.Pure+        Fold.Effectful.Run+        Fold.Effectful.Type+        Fold.Effectful.Utilities++        Fold.Nonempty+        Fold.Nonempty.Conversion+        Fold.Nonempty.Examples+        Fold.Nonempty.Pure+        Fold.Nonempty.Run+        Fold.Nonempty.Type+        Fold.Nonempty.Utilities++    other-modules:+        Strict++test-suite test-gambler+    import: base+    hs-source-dirs: test+    type: exitcode-stdio-1.0+    main-is: Main.hs+    other-modules:+        Spec.Pure+        Spec.Nonempty+        Spec.Effectful+    ghc-options:+        -threaded+    default-extensions:+        BlockArguments+        OverloadedLists+    build-depends:+      , gambler+      , hspec ^>= 2.10++benchmark benchmark-gambler+    import: base+    hs-source-dirs: benchmark+    type: exitcode-stdio-1.0+    main-is: Main.hs+    build-depends:+      , criterion ^>= 1.6+      , gambler+    ghc-options:+        -rtsopts+        -with-rtsopts=-T
+ license.txt view
@@ -0,0 +1,24 @@+Copyright (c) 2013-2016 Gabriella Gonzalez+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:+    * Redistributions of source code must retain the above copyright notice,+      this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright notice,+      this list of conditions and the following disclaimer in the documentation+      and/or other materials provided with the distribution.+    * Neither the name of Gabriella Gonzalez nor the names of other contributors+      may be used to endorse or promote products derived from this software+      without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ readme.md view
@@ -0,0 +1,203 @@+This package defines the `Fold`, `NonemptyFold`, and `EffectfulFold` types and+provides an assortment of ways to construct, combine, and use them.++> Every gambler knows that the secret to surviving<br>+> Is knowing what to throw away and knowing what to keep++> You got to know when to hold 'em, know when to fold 'em<br>+> Know when to walk away, and know when to run++— *The Gambler* by Don Schlitz, popularized by Kenny Rogers+++## Intro to Fold++The `foldl'` function in the `base` package is used when we want a strictly+evaluated result from traversing a list.++```haskell+foldl' :: Foldable t => (b -> a -> b) -> b -> t a -> b+```++For example, to sum a list of numbers:++```ghci+λ> import qualified Data.List as List++λ> List.foldl' (+) 0 [1..100]+5050+```++What if we put the first two parameters to `List.foldl'` into a datatype?++```haskell+data Fold a b = Fold+    { initial :: b+    , step :: b -> a -> b }+```++Or, better yet, we can use a trick to turn the datatype into a `Functor` (which+will become important when we discuss the `Applicative` a bit later):++```haskell+data Fold a b = forall x. Fold+    { initial :: x+    , step :: x -> a -> x+    , extract :: x -> b }+```++We can then express the concept of numeric summation as:++```haskell+sum :: Num a => Fold a a+sum = Fold{ initial = 0, step = (+), extract = id }+```++This `Fold` can be used to sum lists and other `Foldable` collections, but it+can also be used to sum effectful streams. So even without any further+mechanism, just having this datatype gives us some useful expressive power.+There is no need for each streaming library to duplicate all the work of+defining its own copies of `sum`, `product`, `all`, `any`, `and`, `or`,+`minimum`, `maximum`, etc.; a library that provides some kind of `Stream` type+needs only define a function to apply a fold to a stream ...++```haskell+foldStream :: Fold a b -> Stream m a -> m b+```++... and then users can make use of any library of folds that they may find or+concoct. `gambler` itself contains much of the functionality of the standard+`Data.List` module, but there are more things in heaven and earth than are+dreamt of in this package.+++## Intro to NonemptyFold++There are some kinds of folding that only work if the input it nonempty.+Suppose, for example, we want the greatest of all the items. If there are no+items, there is no greatest item. We express this sort of thing with a slight+modification to `Fold`:++```haskell+data NonemptyFold a b = forall x. NonemptyFold+    { initial :: a -> x+    , step :: x -> a -> x+    , extract :: x -> b }+```++The only thing that's different is the type of the `initial` field has changed+from `x` to `a -> x`; it is now parameterized on the first item.++The notion of selecting greatest item can now be expressed as:++```haskell+maximum = NonemptyFold{ initial = id, step = max, extract = id }+```++A `NonemptyFold` can be converted to a `Fold` using `Fold.Pure.nonemptyFold`.+The conversion changes the fold's return type from `b` to `Maybe b` to+accommodate the possibility of empty input.+++## Intro to EffectfulFold++There is a related function in `base` that does the same thing as `foldl'` but+in a monadic context:++```haskell+foldM :: Foldable t => Monad m => (b -> a -> m b) -> b -> t a -> m b+```++This allows us to perform effects as we fold.++```+λ> import qualified Control.Monad as Monad++λ> Monad.foldM (\x a -> putStrLn ("* " <> show a) $> (x + a)) 0 [1..5]+* 1+* 2+* 3+* 4+* 5+15+```++The type we define corresponding to the arguments of `Monad.foldM` is:++```haskell+data EffectfulFold m a b = forall x. EffectfulFold+    { initial :: m x+    , step :: x -> a -> m x+    , extract :: x -> m b }+```++A regular `Fold` can be converted to an `EffectfulFold` of any monad using+`Fold.Effectful.fold`.+++## The Applicative instances++The `Fold` and `EffectfulFold` applicatives are great for computing multiple folds+over a collection in one pass over the data. For example, suppose that you want+to compute both the sum and the length of a list. The following approach works,+but it uses space inefficiently:++```haskell+import qualified Data.List as List++sumAndLength :: Num a => [a] -> (a, Natural)+sumAndLength xs = (List.sum xs, List.genericLength xs)+```++The problem is this goes over the list in two passes. If you demand the result+of `sum`, the Haskell runtime will materialize the entire list. However, the+runtime cannot garbage collect the list because the list is still required for+the call to `length`. The space requirement of `sumAndLength` is therefore+linear with respect to the size of the list. We can do much better.++With `gambler`, we can instead write:++```haskell+import qualified Fold++sumAndLength :: Num a => [a] -> (a, Natural)+sumAndLength = Fold.runFold $ (,) <$> Fold.sum <*> Fold.length+```++This achieves the same result using constant space.+++## Quick start++To get quickly playing around with `gambler`, launch GHCi using `cabal`:++```bash+cabal repl --build-depends gambler+```++The example from the previous section can be run as follows:++```haskell+λ> import qualified Fold+```++```haskell+λ> Fold.runFold ((,) <$> Fold.sum <*> Fold.length) [1..1000000]+(500000500000,1000000)+```+++## Related packages++This `gambler` package is mostly a copy of [foldl], with some features removed+to minimize its dependency set. What remains in `gambler` is essentially the+same as what can be found in `foldl` version `1.4.13`, subject only to+reorganization, renaming, and minor modifications.++  [foldl]: https://hackage.haskell.org/package/foldl+++## Future plans++Once the `Foldable1` class has been added to `base`, the type of+`Fold.Nonempty.run` may be generalized to accommodate it.
+ source/Fold.hs view
@@ -0,0 +1,110 @@+module Fold+  (+    {- * Fold types -} Fold (Fold), NonemptyFold (NonemptyFold),+            EffectfulFold (EffectfulFold),+    {- * Running -} runFold, runNonemptyFold, runEffectfulFold,+    {- * Search -} element, notElement, find, lookup,+    {- * Arithmetic folds -} sum, product, mean, variance, standardDeviation,+    {- * Working with indices -} index, findIndex, elementIndex,+    {- * Counting inputs -} null, length,+    {- * Boolean folds -} and, or, all, any,+    {- * Min/max -} maximum, minimum, maximumBy, minimumBy,+    {- * First/last -} first, last,+    {- * General folds -} magma, semigroup, monoid, effect, effectMonoid,+    {- * List folds -} list, reverseList, nonemptyList, reverseNonemptyList,+    {- * Fold conversions -} emptyToNonempty, nonemptyToEmpty, pureToEffectful,+            effectfulToPure, nonemptyToEffectful, effectfulToNonempty,+    {- * Hoist -} hoist,+    {- * Duplicate -} duplicateFold, duplicateNonemptyFold, duplicateEffectfulFold,+  )+  where++import Fold.Effectful.Type+import Fold.Nonempty.Type+import Fold.Pure.Type++import Fold.Effectful.Examples+import Fold.Nonempty.Examples hiding (list, reverseList)+import Fold.Pure.Examples++import Fold.Effectful.Utilities++import qualified Fold.Effectful.Conversion as ConvertTo.Effectful+import qualified Fold.Nonempty.Conversion as ConvertTo.Nonempty+import qualified Fold.Pure.Conversion as ConvertTo.Pure++import qualified Fold.Effectful as Effectful+import qualified Fold.Nonempty as Nonempty+import qualified Fold.Pure as Pure++import Control.Applicative (Applicative)+import Control.Monad (Monad)+import Data.Foldable (Foldable)+import Data.Functor.Identity (Identity)+import Data.List.NonEmpty (NonEmpty)+import Data.Maybe (Maybe)++{-| Fold a listlike container to a single summary result -}+runFold :: Foldable f => Fold a b -> f a -> b+runFold = Pure.run++{-| Fold a nonempty listlike container to a single summary result -}+runNonemptyFold :: NonemptyFold a b -> NonEmpty a -> b+runNonemptyFold = Nonempty.run++{-| Fold an listlike container to an action that produces a single summary+result -}+runEffectfulFold :: Foldable f => Monad m => EffectfulFold m a b -> f a -> m b+runEffectfulFold = Effectful.run++{-| Turn a regular fold that allows empty input into a fold that+requires at least one input -}+emptyToNonempty :: Fold a b -> NonemptyFold a b+emptyToNonempty = ConvertTo.Nonempty.fold++{-| Turn an effectful fold into a pure fold that requires at least+one input -}+effectfulToNonempty :: EffectfulFold Identity a b -> NonemptyFold a b+effectfulToNonempty = ConvertTo.Nonempty.effectfulFold++{-| Turn a fold that requires at least one input into a fold that returns+'Data.Maybe.Nothing' when there are no inputs -}+nonemptyToEmpty :: NonemptyFold a b -> Fold a (Maybe b)+nonemptyToEmpty = ConvertTo.Pure.nonemptyFold++{-| Generalize a pure fold to an effectful fold -}+pureToEffectful :: Monad m => Fold a b -> EffectfulFold m a b+pureToEffectful = ConvertTo.Effectful.fold++{-| Turn an effectful fold into a pure fold -}+effectfulToPure :: EffectfulFold Identity a b -> Fold a b+effectfulToPure = ConvertTo.Pure.effectfulFold++{-| Turn a nonempty fold that requires at least one input into a fold that+returns 'Data.Maybe.Nothing' when there are no inputs -}+nonemptyToEffectful :: Monad m =>+    NonemptyFold a b -> EffectfulFold m a (Maybe b)+nonemptyToEffectful = ConvertTo.Effectful.nonemptyFold++{-| All the inputs from a nonempty fold -}+nonemptyList :: NonemptyFold a (NonEmpty a)+nonemptyList = Nonempty.list++{-| All the inputs from a nonempty fold, in reverse order -}+reverseNonemptyList :: NonemptyFold a (NonEmpty a)+reverseNonemptyList = Nonempty.reverseList++{-| Allows to continue feeding a fold even after passing it to a function+that closes it -}+duplicateFold :: Fold a b -> Fold a (Fold a b)+duplicateFold = Pure.duplicate++{-| Allows to continue feeding a fold even after passing it to a function+that closes it -}+duplicateNonemptyFold :: NonemptyFold a b -> NonemptyFold a (Fold a b)+duplicateNonemptyFold = Nonempty.duplicate++{-| Allows to continue feeding an effectful fold even after passing it to a+function that closes it -}+duplicateEffectfulFold :: Applicative m => EffectfulFold m a b -> EffectfulFold m a (EffectfulFold m a b)+duplicateEffectfulFold = Effectful.duplicate
+ source/Fold/Effectful.hs view
@@ -0,0 +1,34 @@+module Fold.Effectful+  (+    {- * Type -} EffectfulFold (..),++    {- * Run -} run,++    {- * Examples -}+    {- ** General -} effect, effectMonoid,+    {- ** Pure -}+    {- *** Monoid -} monoid,+    {- *** Length -} null, length,+    {- *** Boolean -} and, or, all, any,+    {- *** Numeric -} sum, product, mean, variance, standardDeviation,+    {- *** Search -} element, notElement, find, lookup,+    {- *** Index -} index, findIndex, elementIndex,+    {- *** List -} list, reverseList,+    {- ** Nonempty -}+    {- *** General -} magma, semigroup,+    {- *** Endpoints -} first, last,+    {- *** Extrema -} maximum, minimum, maximumBy, minimumBy,++    {- * Conversion -} fold, nonemptyFold,++    {- * Utilities -} hoist, duplicate, premap, prefilter, drop,+  )+  where++import Fold.Effectful.Conversion+import Fold.Effectful.Examples+import Fold.Effectful.Nonempty+import Fold.Effectful.Pure+import Fold.Effectful.Run+import Fold.Effectful.Type+import Fold.Effectful.Utilities
+ source/Fold/Effectful/Conversion.hs view
@@ -0,0 +1,25 @@+-- | Getting an 'EffectfulFold' from some other type of fold+module Fold.Effectful.Conversion where++import Fold.Effectful.Type++import Control.Monad (Monad)+import Data.Maybe (Maybe)+import Fold.Nonempty.Type (NonemptyFold)++import qualified Control.Applicative as Applicative+import qualified Fold.Pure.Conversion as Pure+import qualified Fold.Pure.Type as Pure++{-| Generalize a pure fold to an effectful fold -}+fold :: Monad m => Pure.Fold a b -> EffectfulFold m a b+fold Pure.Fold{ Pure.initial, Pure.step, Pure.extract } = EffectfulFold+    { initial =         Applicative.pure ( initial   )+    , step    = \x a -> Applicative.pure ( step x a  )+    , extract = \x   -> Applicative.pure ( extract x )+    }++{-| Turn a nonempty fold that requires at least one input into a fold that+returns 'Data.Maybe.Nothing' when there are no inputs -}+nonemptyFold :: Monad m => NonemptyFold a b -> EffectfulFold m a (Maybe b)+nonemptyFold x = fold (Pure.nonemptyFold x)
+ source/Fold/Effectful/Examples.hs view
@@ -0,0 +1,25 @@+-- | Some interesting examples of effectful folds+module Fold.Effectful.Examples where++import Fold.Effectful.Type++import Control.Monad (Monad)+import Data.Functor (void)+import Data.Monoid (Monoid, mempty)+import Data.Semigroup ((<>))+import Prelude (($!))++import qualified Control.Applicative as Applicative++{-| Performs an action for each input, discarding the result -}+effect :: Monad m => (a -> m b) -> EffectfulFold m a ()+effect f = effectMonoid (\a -> void (f a))++{-| Performs an action for each input, monoidally combining the results+from all the actions. -}+effectMonoid ::  (Monoid w, Monad m) => (a -> m w) -> EffectfulFold m a w+effectMonoid act = EffectfulFold+    { initial = Applicative.pure mempty+    , step = \m a -> do{ m' <- act a; Applicative.pure $! (<>) m m' }+    , extract = Applicative.pure+    }
+ source/Fold/Effectful/Nonempty.hs view
@@ -0,0 +1,50 @@+-- | Folds from "Fold.Pure.Nonempty" trivially lifted into 'EffectfulFold'+module Fold.Effectful.Nonempty+  (+    {- * General -} magma, semigroup,+    {- * Endpoints -} first, last,+    {- * Extrema -} maximum, minimum, maximumBy, minimumBy,+  )+  where++import Control.Monad (Monad)+import Data.Maybe (Maybe)+import Data.Ord (Ord, Ordering)+import Data.Semigroup (Semigroup)+import Fold.Effectful.Conversion (fold)+import Fold.Effectful.Type (EffectfulFold)++import qualified Fold.Pure.Nonempty as Pure++{-| Start with the first input, append each new input on the right+with the given function -}+magma :: (a -> a -> a) -> Monad m => EffectfulFold m a (Maybe a)+magma step = fold (Pure.magma step)++{-| Append each new input on the right with ('<>') -}+semigroup :: Semigroup a => Monad m => EffectfulFold m a (Maybe a)+semigroup = fold Pure.semigroup++{-| The first input -}+first :: Monad m => EffectfulFold m a (Maybe a)+first = fold Pure.first++{-| The last input -}+last :: Monad m => EffectfulFold m a (Maybe a)+last = fold Pure.last++{-| The greatest input -}+maximum :: Ord a => Monad m => EffectfulFold m a (Maybe a)+maximum = fold Pure.maximum++{-| The greatest input with respect to the given comparison function -}+maximumBy :: (a -> a -> Ordering) -> Monad m => EffectfulFold m a (Maybe a)+maximumBy cmp = fold (Pure.maximumBy cmp)++{-| The least input -}+minimum :: Ord a => Monad m => EffectfulFold m a (Maybe a)+minimum = fold Pure.minimum++{-| The least input with respect to the given comparison function -}+minimumBy :: (a -> a -> Ordering) -> Monad m => EffectfulFold m a (Maybe a)+minimumBy cmp = fold (Pure.minimumBy cmp)
+ source/Fold/Effectful/Pure.hs view
@@ -0,0 +1,108 @@+-- | Folds from "Fold.Pure.Examples" trivially lifted into 'EffectfulFold'+module Fold.Effectful.Pure+  (+    {- * Monoid -} monoid,+    {- * Length -} null, length,+    {- * Boolean -} and, or, all, any,+    {- * Numeric -} sum, product, mean, variance, standardDeviation,+    {- * Search -} element, notElement, find, lookup,+    {- * Index -} index, findIndex, elementIndex,+    {- * List -} list, reverseList,+  )+  where++import Control.Monad (Monad)+import Data.Bool (Bool)+import Data.Eq (Eq)+import Data.Maybe (Maybe)+import Data.Monoid (Monoid)+import Fold.Effectful.Conversion (fold)+import Fold.Effectful.Type (EffectfulFold)+import Numeric.Natural (Natural)+import Prelude (Floating, Fractional, Num)++import qualified Fold.Pure.Examples as Pure++{-| Start with 'mempty', append each input on the right with ('<>') -}+monoid :: Monoid a => Monad m => EffectfulFold m a a+monoid = fold Pure.monoid++{-| 'True' if the input contains no inputs -}+null :: Monad m => EffectfulFold m a Bool+null = fold Pure.null++{-| The number of inputs -}+length :: Monad m => EffectfulFold m a Natural+length = fold Pure.length++{-| 'True' if all inputs are 'True' -}+and :: Monad m => EffectfulFold m Bool Bool+and = fold Pure.and++{-| 'True' if any input is 'True' -}+or :: Monad m => EffectfulFold m Bool Bool+or = fold Pure.or++{-| 'True' if all inputs satisfy the predicate -}+all :: Monad m => (a -> Bool) -> EffectfulFold m a Bool+all predicate = fold (Pure.all predicate)++{-| 'True' if any input satisfies the predicate -}+any :: Monad m => (a -> Bool) -> EffectfulFold m a Bool+any predicate = fold (Pure.any predicate)++{-| Adds the inputs -}+sum :: Num a => Monad m => EffectfulFold m a a+sum = fold Pure.sum++{-| Multiplies the inputs -}+product :: Num a => Monad m => EffectfulFold m a a+product = fold Pure.product++{-| Numerically stable arithmetic mean of the inputs -}+mean :: Fractional a => Monad m => EffectfulFold m a a+mean = fold Pure.mean++{-| Numerically stable (population) variance over the inputs -}+variance :: Fractional a => Monad m => EffectfulFold m a a+variance = fold Pure.variance++{-| Numerically stable (population) standard deviation over the inputs -}+standardDeviation :: Floating a => Monad m => EffectfulFold m a a+standardDeviation = fold Pure.standardDeviation++{-| 'True' if any input is equal to the given value -}+element :: Eq a => Monad m => a -> EffectfulFold m a Bool+element a = fold (Pure.element a)++{-| 'False' if any input is equal to the given value -}+notElement :: Eq a => Monad m => a -> EffectfulFold m a Bool+notElement a = fold (Pure.notElement a)++{-| The first input that satisfies the predicate, if any -}+find :: Monad m => (a -> Bool) -> EffectfulFold m a (Maybe a)+find ok = fold (Pure.find ok)++{-| The /n/th input, where n=0 is the first input, if the index is in bounds -}+index :: Monad m => Natural -> EffectfulFold m a (Maybe a)+index i = fold (Pure.index i)++{-| The index of the first input that matches the given value, if any -}+elementIndex :: Eq a => Monad m => a -> EffectfulFold m a (Maybe Natural)+elementIndex a = fold (Pure.elementIndex a)++{-| The index of the first input that satisfies the predicate, if any -}+findIndex :: Monad m => (a -> Bool) -> EffectfulFold m a (Maybe Natural)+findIndex ok = fold (Pure.findIndex ok)++{-| The @b@ from the first tuple where @a@ equals the given value, if any -}+lookup :: Eq a => Monad m => a -> EffectfulFold m (a, b) (Maybe b)+lookup a = fold (Pure.lookup a)++{-| All the inputs -}+list :: Monad m => EffectfulFold m a [a]+list = fold Pure.list++{-| All the inputs in reverse order -}+reverseList :: Monad m => EffectfulFold m a [a]+reverseList = fold Pure.reverseList
+ source/Fold/Effectful/Run.hs view
@@ -0,0 +1,16 @@+module Fold.Effectful.Run where++import Fold.Effectful.Type++import Control.Monad (Monad)+import Data.Foldable (Foldable)+import Prelude (($!))++import qualified Data.Foldable as F++{-| Fold an listlike container to an action that produces a single summary+result -}+run :: Foldable f => Monad m => EffectfulFold m a b -> f a -> m b+run EffectfulFold{ initial, step, extract } as0 = do+    x0 <- initial+    F.foldr (\a k x -> do{ x' <- step x a; k $! x' }) extract as0 $! x0
+ source/Fold/Effectful/Type.hs view
@@ -0,0 +1,42 @@+module Fold.Effectful.Type where++import Control.Applicative (Applicative, liftA2, pure, (<*>))+import Control.Monad (Monad)+import Data.Functor (Functor, fmap, (<$>))+import Data.Monoid (Monoid, mempty)+import Data.Semigroup (Semigroup, (<>))+import Prelude (($!))++import qualified Strict++{- | Processes inputs of type @a@ and results in an effectful value of type @m b@ -}+data EffectfulFold m a b = forall x. EffectfulFold+    { initial :: m x+    , step :: x -> a -> m x+    , extract :: x -> m b+    }++instance Functor m => Functor (EffectfulFold m a) where+    fmap f EffectfulFold{ initial, step, extract } = EffectfulFold+        { initial+        , step+        , extract = \x -> fmap f $! extract x+        }++instance Applicative m => Applicative (EffectfulFold m a) where+    pure b = EffectfulFold{ initial = pure (), step = \() _ -> pure (), extract = \() -> pure b }++    (<*>)+        EffectfulFold{ initial = initialL, step = stepL, extract = extractL }+        EffectfulFold{ initial = initialR, step = stepR, extract = extractR } =+          EffectfulFold+            { initial = Strict.Tuple2 <$> initialL <*> initialR+            , step = \(Strict.Tuple2 xL xR) a -> Strict.Tuple2 <$> stepL xL a <*> stepR xR a+            , extract = \(Strict.Tuple2 xL xR) -> extractL xL <*> extractR xR+            }++instance (Semigroup b, Monad m) => Semigroup (EffectfulFold m a b) where+    (<>) = liftA2 (<>)++instance (Monoid b, Monad m) => Monoid (EffectfulFold m a b) where+    mempty = pure mempty
+ source/Fold/Effectful/Utilities.hs view
@@ -0,0 +1,51 @@+module Fold.Effectful.Utilities where++import Fold.Effectful.Type++import Control.Applicative (Applicative, pure)+import Control.Monad (Monad, (>>=))+import Data.Bool (Bool)+import Data.Functor (fmap)+import Numeric.Natural (Natural)+import Prelude ((-))++{-| Shift an effectful fold from one monad to another with a morphism such as+@lift@ or @liftIO@ -}+hoist :: (forall x . m x -> n x) -> EffectfulFold m a b -> EffectfulFold n a b+hoist f EffectfulFold{ initial, step, extract } = EffectfulFold+    { initial = f initial+    , step = \a b -> f (step a b)+    , extract = \x -> f (extract x)+    }++{-| Allows to continue feeding an effectful fold even after passing it to a+function that closes it -}+duplicate :: Applicative m => EffectfulFold m a b -> EffectfulFold m a (EffectfulFold m a b)+duplicate EffectfulFold{ initial, step, extract } = EffectfulFold+    { initial+    , step+    , extract = \x -> pure EffectfulFold{ initial = pure x, step, extract }+    }++{-| Apply a function to each input -}+premap :: Monad m => (a -> m b) -> EffectfulFold m b r -> EffectfulFold m a r+premap f EffectfulFold{ initial, step, extract } =+    EffectfulFold{ initial, step = \x a -> f a >>= step x, extract }++{-| Consider only inputs that match an effectful predicate -}+prefilter :: (Monad m) => (a -> m Bool) -> EffectfulFold m a r -> EffectfulFold m a r+prefilter f EffectfulFold{ initial, step, extract } = EffectfulFold+    { initial+    , step = \x a -> do{ use <- f a; if use then step x a else pure x }+    , extract+    }++{-| Ignore the first /n/ inputs -}+drop :: Monad m => Natural -> EffectfulFold m a b -> EffectfulFold m a b+drop n EffectfulFold{ initial, step, extract } = EffectfulFold+    { initial = fmap (\s -> (n, s)) initial+    , step = \(n', s) x -> case n' of+          0 -> fmap (\s' -> (0, s')) (step s x)+          _ -> pure (n' - 1, s)+    , extract = \(_,  s) -> extract s+    }
+ source/Fold/Nonempty.hs view
@@ -0,0 +1,31 @@+module Fold.Nonempty+  (+    {- * Type -} NonemptyFold (..),++    {- * Run -} run,++    {- * Examples -}+    {- ** General -} magma, semigroup,+    {- ** Endpoints -} first, last,+    {- ** Extrema -} maximum, minimum, maximumBy, minimumBy,+    {- ** Pure -}+    {- *** Monoid -} monoid,+    {- *** Length -} null, length,+    {- *** Boolean -} and, or, all, any,+    {- *** Numeric -} sum, product, mean, variance, standardDeviation,+    {- *** Search -} element, notElement, find, lookup,+    {- *** Index -} index, findIndex, elementIndex,+    {- *** List -} list, reverseList,++    {- * Conversion -} fold,++    {- * Utilities -} duplicate, premap, nest,+  )+  where++import Fold.Nonempty.Conversion+import Fold.Nonempty.Examples+import Fold.Nonempty.Pure hiding (list, reverseList)+import Fold.Nonempty.Run+import Fold.Nonempty.Type+import Fold.Nonempty.Utilities
+ source/Fold/Nonempty/Conversion.hs view
@@ -0,0 +1,23 @@+-- | Getting a 'NonemptyFold' from some other type of fold+module Fold.Nonempty.Conversion where++import Fold.Nonempty.Type++import Fold.Effectful.Type (EffectfulFold)+import Fold.Pure.Type (Fold (Fold))++import qualified Fold.Pure.Type as Fold+import qualified Fold.Pure.Conversion as Fold.Conversion++import Data.Functor.Identity (Identity)++{-| Turn a regular fold that allows empty input into a fold that+requires at least one input -}+fold :: Fold a b -> NonemptyFold a b+fold Fold{ Fold.step, Fold.initial, Fold.extract } =+    NonemptyFold{ initial = step initial, step, extract }++{-| Turn an effectful fold into a pure fold that requires at least+one input -}+effectfulFold :: EffectfulFold Identity a b -> NonemptyFold a b+effectfulFold x = fold (Fold.Conversion.effectfulFold x)
+ source/Fold/Nonempty/Examples.hs view
@@ -0,0 +1,66 @@+module Fold.Nonempty.Examples+  (+    {- * General -} magma, semigroup,+    {- * Endpoints -} first, last,+    {- * Extrema -} maximum, minimum, maximumBy, minimumBy,+    {- * List -} list, reverseList,+  )+  where++import Fold.Nonempty.Type++import Data.Function (id, const, flip, (.))+import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Ord (Ord, Ordering (GT), max, min)+import Data.Semigroup (Semigroup, (<>))++import qualified Strict++{-| Start with the first input, append each new input on the right+with the given function -}+magma :: (a -> a -> a) -> NonemptyFold a a+magma step = NonemptyFold{ initial = id, step, extract = id }++{-| Append each new input on the right with ('<>') -}+semigroup :: Semigroup a => NonemptyFold a a+semigroup = magma (<>)++{-| The first input -}+first :: NonemptyFold a a+first = magma const++{-| The last input -}+last :: NonemptyFold a a+last = magma (flip const)++{-| The greatest input -}+maximum :: Ord a => NonemptyFold a a+maximum = magma max++{-| The greatest input with respect to the given comparison function -}+maximumBy :: (a -> a -> Ordering) -> NonemptyFold a a+maximumBy cmp = magma (\x y -> case cmp x y of { GT -> x; _ -> y })++{-| The least input -}+minimum :: Ord a => NonemptyFold a a+minimum = magma min++{-| The least input with respect to the given comparison function -}+minimumBy :: (a -> a -> Ordering) -> NonemptyFold a a+minimumBy cmp = magma (\x y -> case cmp x y of { GT -> y; _ -> x })++{-| All the inputs -}+list :: NonemptyFold a (NonEmpty a)+list = NonemptyFold+    { initial = \a -> Strict.Tuple2 a id+    , step = \(Strict.Tuple2 a0 x) a -> Strict.Tuple2 a0 (x . (a :))+    , extract = \(Strict.Tuple2 a0 x) -> a0 :| (x [])+    }++{-| All the inputs in reverse order -}+reverseList :: NonemptyFold a (NonEmpty a)+reverseList = NonemptyFold+    { initial = (:| [])+    , step = \(b :| x) a -> a :| b : x+    , extract = id+    }
+ source/Fold/Nonempty/Pure.hs view
@@ -0,0 +1,107 @@+-- | Folds from "Fold.Pure.Examples" trivially lifted into 'NonemptyFold'+module Fold.Nonempty.Pure+  (+    {- * Monoid -} monoid,+    {- * Length -} null, length,+    {- * Boolean -} and, or, all, any,+    {- * Numeric -} sum, product, mean, variance, standardDeviation,+    {- * Search -} element, notElement, find, lookup,+    {- * Index -} index, findIndex, elementIndex,+    {- * List -} list, reverseList,+  )+  where++import qualified Fold.Pure.Examples as Pure++import Data.Bool (Bool)+import Data.Eq (Eq)+import Data.Maybe (Maybe)+import Data.Monoid (Monoid)+import Fold.Nonempty.Conversion (fold)+import Fold.Nonempty.Type (NonemptyFold)+import Numeric.Natural (Natural)+import Prelude (Floating, Fractional, Num)++{-| Start with 'mempty', append each input on the right with ('<>') -}+monoid :: Monoid a => NonemptyFold a a+monoid = fold Pure.monoid++{-| 'True' if the input contains no inputs -}+null :: NonemptyFold a Bool+null = fold Pure.null++{-| The number of inputs -}+length :: NonemptyFold a Natural+length = fold Pure.length++{-| 'True' if all inputs are 'True' -}+and :: NonemptyFold Bool Bool+and = fold Pure.and++{-| 'True' if any input is 'True' -}+or :: NonemptyFold Bool Bool+or = fold Pure.or++{-| 'True' if all inputs satisfy the predicate -}+all :: (a -> Bool) -> NonemptyFold a Bool+all predicate = fold (Pure.all predicate)++{-| 'True' if any input satisfies the predicate -}+any :: (a -> Bool) -> NonemptyFold a Bool+any predicate = fold (Pure.any predicate)++{-| Adds the inputs -}+sum :: Num a => NonemptyFold a a+sum = fold Pure.sum++{-| Multiplies the inputs -}+product :: Num a => NonemptyFold a a+product = fold Pure.product++{-| Numerically stable arithmetic mean of the inputs -}+mean :: Fractional a => NonemptyFold a a+mean = fold Pure.mean++{-| Numerically stable (population) variance over the inputs -}+variance :: Fractional a => NonemptyFold a a+variance = fold Pure.variance++{-| Numerically stable (population) standard deviation over the inputs -}+standardDeviation :: Floating a => NonemptyFold a a+standardDeviation = fold Pure.standardDeviation++{-| 'True' if any input is equal to the given value -}+element :: Eq a => a -> NonemptyFold a Bool+element a = fold (Pure.element a)++{-| 'False' if any input is equal to the given value -}+notElement :: Eq a => a -> NonemptyFold a Bool+notElement a = fold (Pure.notElement a)++{-| The first input that satisfies the predicate, if any -}+find :: (a -> Bool) -> NonemptyFold a (Maybe a)+find ok = fold (Pure.find ok)++{-| The /n/th input, where n=0 is the first input, if the index is in bounds -}+index :: Natural -> NonemptyFold a (Maybe a)+index i = fold (Pure.index i)++{-| The index of the first input that matches the given value, if any -}+elementIndex :: Eq a => a -> NonemptyFold a (Maybe Natural)+elementIndex a = fold (Pure.elementIndex a)++{-| The index of the first input that satisfies the predicate, if any -}+findIndex :: (a -> Bool) -> NonemptyFold a (Maybe Natural)+findIndex ok = fold (Pure.findIndex ok)++{-| The @b@ from the first tuple where @a@ equals the given value, if any -}+lookup :: Eq a => a -> NonemptyFold (a, b) (Maybe b)+lookup a = fold (Pure.lookup a)++{-| All the inputs -}+list :: NonemptyFold a [a]+list = fold Pure.list++{-| All the inputs in reverse order -}+reverseList :: NonemptyFold a [a]+reverseList = fold Pure.reverseList
+ source/Fold/Nonempty/Run.hs view
@@ -0,0 +1,15 @@+module Fold.Nonempty.Run where++import Fold.Nonempty.Type++import Data.List.NonEmpty (NonEmpty ((:|)))+import Prelude (($!))++import qualified Data.Foldable as F++{-| Fold a nonempty listlike container to a single summary result -}+run :: NonemptyFold a b -> NonEmpty a -> b+run NonemptyFold{ initial, step, extract } (z :| as) =+    F.foldr cons extract as (initial z)+  where+    cons a k x = k $! step x a
+ source/Fold/Nonempty/Type.hs view
@@ -0,0 +1,37 @@+module Fold.Nonempty.Type where++import Control.Applicative (Applicative, liftA2, pure, (<*>))+import Data.Functor (Functor, fmap)+import Data.Monoid (Monoid, mempty)+import Data.Semigroup (Semigroup, (<>))++import qualified Strict++{- | Processes at least one input of type @a@ and results in a value of type @b@ -}+data NonemptyFold a b = forall x. NonemptyFold+    { initial :: a -> x+    , step :: x -> a -> x+    , extract :: x -> b+    }++instance Functor (NonemptyFold a) where+    fmap f NonemptyFold{ step, initial, extract } =+        NonemptyFold{ initial, step, extract = \x -> f (extract x) }++instance Applicative (NonemptyFold a) where+    pure b = NonemptyFold{ initial = \_ -> (), step = \() _ -> (), extract = \() -> b }++    (<*>)+        NonemptyFold{ initial = initialL, step = stepL, extract = extractL }+        NonemptyFold{ initial = initialR, step = stepR, extract = extractR } =+          NonemptyFold+            { initial = \a -> Strict.Tuple2 (initialL a) (initialR a)+            , step = \(Strict.Tuple2 xL xR) a -> Strict.Tuple2 (stepL xL a) (stepR xR a)+            , extract = \(Strict.Tuple2 xL xR) -> extractL xL (extractR xR)+            }++instance Semigroup b => Semigroup (NonemptyFold a b) where+    (<>) = liftA2 (<>)++instance Monoid b => Monoid (NonemptyFold a b) where+    mempty = pure mempty
+ source/Fold/Nonempty/Utilities.hs view
@@ -0,0 +1,27 @@+module Fold.Nonempty.Utilities where++import Fold.Nonempty.Type++import Control.Applicative (Applicative, liftA2)+import Data.Functor (fmap)+import Fold.Pure.Type (Fold (Fold))++import qualified Fold.Pure.Type as Pure++{-| Allows to continue feeding a fold even after passing it to a function+that closes it -}+duplicate :: NonemptyFold a b -> NonemptyFold a (Fold a b)+duplicate NonemptyFold{ initial, step, extract } =+    NonemptyFold{ initial, step, extract = \x -> Fold+        { Pure.initial = x, Pure.step, Pure.extract } }++{-| @(premap f folder)@ returns a new fold where @f@ is applied at each step -}+premap :: (a -> b) -> NonemptyFold b r -> NonemptyFold a r+premap f NonemptyFold{ initial, step, extract } =+    NonemptyFold{ initial = \a -> initial (f a),+        step = \x a -> step x (f a), extract }++{-| Nest a fold in an applicative -}+nest :: Applicative f => NonemptyFold a b -> NonemptyFold (f a) (f b)+nest NonemptyFold{ initial, step, extract } = NonemptyFold+    { initial = fmap initial, step = liftA2 step, extract = fmap extract }
+ source/Fold/Pure.hs view
@@ -0,0 +1,31 @@+module Fold.Pure+  (+    {- * Type -} Fold (..),++    {- * Run -} run, scan, prescan, postscan,++    {- * Examples -}+    {- ** Monoid -} monoid,+    {- ** Length -} null, length,+    {- ** Boolean -} and, or, all, any,+    {- ** Numeric -} sum, product, mean, variance, standardDeviation,+    {- ** Search -} element, notElement, find, lookup,+    {- ** Index -} index, findIndex, elementIndex,+    {- ** List -} list, reverseList,+    {- ** Nonempty -}+    {- *** General -} magma, semigroup,+    {- *** Endpoints -} first, last,+    {- *** Extrema -} maximum, minimum, maximumBy, minimumBy,++    {- * Conversion -} effectfulFold, nonemptyFold,++    {- * Utilities -} duplicate, premap, prefilter, predropWhile, drop, nest,+  )+  where++import Fold.Pure.Conversion+import Fold.Pure.Examples+import Fold.Pure.Nonempty+import Fold.Pure.Run+import Fold.Pure.Type+import Fold.Pure.Utilities
+ source/Fold/Pure/Conversion.hs view
@@ -0,0 +1,38 @@+-- | Getting a 'Fold' from some other type of fold+module Fold.Pure.Conversion where++import Fold.Pure.Type++import Data.Function (($))+import Data.Functor ((<$>))+import Data.Functor.Identity (Identity, runIdentity)+import Data.Maybe (Maybe)+import Fold.Effectful.Type (EffectfulFold (EffectfulFold))+import Fold.Nonempty.Type (NonemptyFold (NonemptyFold))++import qualified Fold.Effectful.Type as Effectful+import qualified Fold.Nonempty.Type as Nonempty+import qualified Strict++{-| Turn an effectful fold into a pure fold -}+effectfulFold :: EffectfulFold Identity a b -> Fold a b+effectfulFold+  EffectfulFold{ Effectful.initial, Effectful.step, Effectful.extract } =+    Fold+      { initial =         runIdentity ( initial   )+      , step    = \x a -> runIdentity ( step x a  )+      , extract = \x   -> runIdentity ( extract x )+      }++{-| Turn a fold that requires at least one input into a fold that returns+'Data.Maybe.Nothing' when there are no inputs -}+nonemptyFold :: NonemptyFold a b -> Fold a (Maybe b)+nonemptyFold+  NonemptyFold{ Nonempty.initial, Nonempty.step, Nonempty.extract } =+    Fold+      { initial = Strict.Nothing+      , step = \xm a -> Strict.Just $ case xm of+            Strict.Nothing -> initial a+            Strict.Just x -> step x a+      , extract = \xm -> extract <$> Strict.lazy xm+      }
+ source/Fold/Pure/Examples.hs view
@@ -0,0 +1,152 @@+module Fold.Pure.Examples+  (+    {- * Monoid -} monoid,+    {- * Length -} null, length,+    {- * Boolean -} and, or, all, any,+    {- * Numeric -} sum, product, mean, variance, standardDeviation,+    {- * Search -} element, notElement, find, lookup,+    {- * Index -} index, findIndex, elementIndex,+    {- * List -} list, reverseList,+  )+  where++import Fold.Pure.Type++import Data.Bool (Bool (False, True), (&&), (||))+import Data.Eq (Eq, (/=), (==))+import Data.Function (id, ($), (.))+import Data.Functor ((<$>))+import Data.Maybe (Maybe)+import Data.Monoid (Monoid, mempty)+import Data.Semigroup ((<>))+import Numeric.Natural (Natural)+import Prelude (Floating, Fractional, Num, sqrt, (*), (+), (-), (/))++import qualified Strict++{-| Start with 'mempty', append each input on the right with ('<>') -}+monoid :: Monoid a => Fold a a+monoid = Fold{ initial = mempty, step = (<>), extract = id }++{-| 'True' if the input contains no inputs -}+null :: Fold a Bool+null = Fold{ initial = True, step = \_ _ -> False, extract = id }++{-| The number of inputs -}+length :: Fold a Natural+length = Fold{ initial = 0, step = \n _ -> n + 1, extract = id }++{-| 'True' if all inputs are 'True' -}+and :: Fold Bool Bool+and = Fold{ initial = True, step = (&&), extract = id }++{-| 'True' if any input is 'True' -}+or :: Fold Bool Bool+or = Fold{ initial = False, step = (||), extract = id }++{-| 'True' if all inputs satisfy the predicate -}+all :: (a -> Bool) -> Fold a Bool+all predicate =+    Fold{ initial = True, step = \x a -> x && predicate a, extract = id }++{-| 'True' if any input satisfies the predicate -}+any :: (a -> Bool) -> Fold a Bool+any predicate =+    Fold{ initial = False, step = \x a -> x || predicate a, extract = id }++{-| Adds the inputs -}+sum :: Num a => Fold a a+sum = Fold{ initial = 0, step = (+), extract = id }++{-| Multiplies the inputs -}+product :: Num a => Fold a a+product = Fold{ initial = 1, step = (*), extract = id }++{-| Numerically stable arithmetic mean of the inputs -}+mean :: Fractional a => Fold a a+mean = Fold+    { initial = Strict.Tuple2 0 0+    , step = \(Strict.Tuple2 x n) y ->+        let n' = n + 1 in+        Strict.Tuple2 (x + (y - x) / n') n'+    , extract = \(Strict.Tuple2 x _) -> x+    }++{-| Numerically stable (population) variance over the inputs -}+variance :: Fractional a => Fold a a+variance = Fold+    { initial = Strict.Tuple3 0 0 0+    , step = \(Strict.Tuple3 n mean_ m2) x ->+        let+          n'     = n + 1+          mean'  = (n * mean_ + x) / (n + 1)+          delta  = x - mean_+          m2'    = m2 + delta * delta * n / (n + 1)+        in+          Strict.Tuple3 n' mean' m2'+    , extract = \(Strict.Tuple3 n _ m2) -> m2 / n+    }++{-| Numerically stable (population) standard deviation over the inputs -}+standardDeviation :: Floating a => Fold a a+standardDeviation = sqrt <$> variance++{-| 'True' if any input is equal to the given value -}+element :: Eq a => a -> Fold a Bool+element a = any (a ==)++{-| 'False' if any input is equal to the given value -}+notElement :: Eq a => a -> Fold a Bool+notElement a = all (a /=)++{-| The first input that satisfies the predicate, if any -}+find :: (a -> Bool) -> Fold a (Maybe a)+find ok = Fold+    { initial = Strict.Nothing+    , step = \x a -> case x of+        Strict.Nothing -> if ok a then Strict.Just a else Strict.Nothing+        _ -> x+    , extract = Strict.lazy+    }++{-| The /n/th input, where n=0 is the first input, if the index is in bounds -}+index :: Natural -> Fold a (Maybe a)+index i = Fold+    { initial = Strict.Left 0+    , step = \x a -> case x of+        Strict.Left j -> if i == j then Strict.Right a else Strict.Left (j + 1)+        _ -> x+    , extract = Strict.hush+    }++{-| The index of the first input that matches the given value, if any -}+elementIndex :: Eq a => a -> Fold a (Maybe Natural)+elementIndex a = findIndex (a ==)++{-| The index of the first input that satisfies the predicate, if any -}+findIndex :: (a -> Bool) -> Fold a (Maybe Natural)+findIndex ok = Fold+    { initial = Strict.Left 0+    , step = \x a -> case x of+        Strict.Left i -> if ok a then Strict.Right i else Strict.Left (i + 1)+        _ -> x+    , extract = Strict.hush+    }++{-| The @b@ from the first tuple where @a@ equals the given value, if any -}+lookup :: Eq a => a -> Fold (a, b) (Maybe b)+lookup a0 = Fold+    { initial = Strict.Nothing+    , step = \x (a, b) -> case x of+        Strict.Nothing -> if a == a0 then Strict.Just b else Strict.Nothing+        _ -> x+    , extract = Strict.lazy+    }++{-| All the inputs -}+list :: Fold a [a]+list = Fold{ initial = id, step = \x a -> x . (a :), extract = ($ []) }++{-| All the inputs in reverse order -}+reverseList :: Fold a [a]+reverseList = Fold{ initial = [], step = \x a -> a : x, extract = id }
+ source/Fold/Pure/Nonempty.hs view
@@ -0,0 +1,49 @@+-- | Folds from "Fold.Nonempty.Examples" trivially lifted into 'Fold'+module Fold.Pure.Nonempty+  (+    {- * General -} magma, semigroup,+    {- * Endpoints -} first, last,+    {- * Extrema -} maximum, minimum, maximumBy, minimumBy,+  )+  where++import Data.Maybe (Maybe)+import Data.Ord (Ord, Ordering)+import Data.Semigroup (Semigroup)+import Fold.Pure.Conversion (nonemptyFold)+import Fold.Pure.Type (Fold)++import qualified Fold.Nonempty.Examples as Nonempty++{-| Start with the first input, append each new input on the right+with the given function -}+magma :: (a -> a -> a) -> Fold a (Maybe a)+magma step = nonemptyFold (Nonempty.magma step)++{-| Append each new input on the right with ('<>') -}+semigroup :: Semigroup a => Fold a (Maybe a)+semigroup = nonemptyFold Nonempty.semigroup++{-| The first input -}+first :: Fold a (Maybe a)+first = nonemptyFold Nonempty.first++{-| The last input -}+last :: Fold a (Maybe a)+last = nonemptyFold Nonempty.last++{-| The greatest input -}+maximum :: Ord a => Fold a (Maybe a)+maximum = nonemptyFold Nonempty.maximum++{-| The greatest input with respect to the given comparison function -}+maximumBy :: (a -> a -> Ordering) -> Fold a (Maybe a)+maximumBy cmp = nonemptyFold (Nonempty.maximumBy cmp)++{-| The least input -}+minimum :: Ord a => Fold a (Maybe a)+minimum = nonemptyFold Nonempty.minimum++{-| The least input with respect to the given comparison function -}+minimumBy :: (a -> a -> Ordering) -> Fold a (Maybe a)+minimumBy cmp = nonemptyFold (Nonempty.minimumBy cmp)
+ source/Fold/Pure/Run.hs view
@@ -0,0 +1,59 @@+module Fold.Pure.Run where++import Fold.Pure.Type++import Data.Foldable (Foldable)+import Data.Traversable (Traversable, mapAccumL)+import Prelude (($!))++import qualified Data.Foldable as F++{-| Fold a listlike container to a single summary result++@+run 'Fold.Pure.Examples.monoid' ["a", "b", "c"] = "abc"+@ -}+run :: Foldable f => Fold a b -> f a -> b+run Fold{ initial, step, extract } as = F.foldr cons extract as initial+  where+    cons a k x = k $! step x a++{-| Rather than only obtain a single final result, scanning gives a running+total that shows the intermediate result at each step along the way++@+scan 'Fold.Pure.Examples.monoid' ["a", "b", "c"] = ["","a","ab","abc"]+@ -}+scan :: Foldable f => Fold a b -> f a -> [b]+scan Fold{ initial, step, extract } as = F.foldr cons nil as initial+  where+    nil x = extract x : []+    cons a k x = extract x : (k $! step x a)++{-| Scan where the last input is excluded++@+prescan 'Fold.Pure.Examples.monoid' ["a", "b", "c"] = ["","a","ab"]+@ -}+prescan :: Traversable t => Fold a b -> t a -> t b+prescan Fold{ initial, step, extract } as = bs+  where+    step' x a = (x', b)+      where+        x' = step x a+        b  = extract x+    (_, bs) = mapAccumL step' initial as++{-| Scan where the first input is excluded++@+postscan 'Fold.Pure.Examples.monoid' ["a", "b", "c"] = ["a","ab","abc"]+@ -}+postscan :: Traversable t => Fold a b -> t a -> t b+postscan Fold{ initial, step, extract } as = bs+  where+    step' x a = (x', b)+      where+        x' = step x a+        b  = extract x'+    (_, bs) = mapAccumL step' initial as
+ source/Fold/Pure/Type.hs view
@@ -0,0 +1,37 @@+module Fold.Pure.Type where++import Control.Applicative (Applicative, liftA2, pure, (<*>))+import Data.Functor (Functor, fmap)+import Data.Monoid (Monoid, mempty)+import Data.Semigroup (Semigroup, (<>))++import qualified Strict++{- | Processes inputs of type @a@ and results in a value of type @b@ -}+data Fold a b = forall x. Fold+    { initial :: x+    , step :: x -> a -> x+    , extract :: x -> b+    }++instance Functor (Fold a) where+    fmap f Fold{ initial, step, extract } =+        Fold{ initial, step, extract = \x -> f (extract x) }++instance Applicative (Fold a) where+    pure b = Fold{ initial = (), step = \() _ -> (), extract = \() -> b }++    (<*>)+        Fold{ initial = initialL, step = stepL, extract = extractL }+        Fold{ initial = initialR, step = stepR, extract = extractR } =+          Fold+            { initial = Strict.Tuple2 initialL initialR+            , step = \(Strict.Tuple2 xL xR) a -> Strict.Tuple2 (stepL xL a) (stepR xR a)+            , extract = \(Strict.Tuple2 xL xR) -> extractL xL (extractR xR)+            }++instance Semigroup b => Semigroup (Fold a b) where+    (<>) = liftA2 (<>)++instance Monoid b => Monoid (Fold a b) where+    mempty = pure mempty
+ source/Fold/Pure/Utilities.hs view
@@ -0,0 +1,53 @@+module Fold.Pure.Utilities where++import Fold.Pure.Type++import Control.Applicative (Applicative, liftA2, pure)+import Data.Bool (Bool (False, True), (&&))+import Data.Functor (fmap)+import Numeric.Natural (Natural)+import Prelude ((-))++import qualified Strict++{-| Allows to continue feeding a fold even after passing it to a function+that closes it -}+duplicate :: Fold a b -> Fold a (Fold a b)+duplicate Fold{ initial, step, extract } =+    Fold{ initial, step, extract = \x -> Fold{ initial = x, step, extract } }++{-| Applies a function to each input before processing -}+premap :: (a -> b) -> Fold b r -> Fold a r+premap f Fold{ initial, step, extract } =+    Fold{ initial, step = \x a -> step x (f a), extract }++{-| Consider only inputs that match a predicate -}+prefilter :: (a -> Bool) -> Fold a r -> Fold a r+prefilter f Fold{ step, initial, extract } =+    Fold{ initial, step = \x a -> if f a then step x a else x, extract }++{-| Ignores inputs until they stop satisfying a predicate -}+predropWhile :: (a -> Bool) -> Fold a r -> Fold a r+predropWhile f Fold{ initial, step, extract } = Fold+    { initial = Strict.Tuple2 True initial+    , step = \(Strict.Tuple2 dropping x) a ->+          if dropping && f a+          then Strict.Tuple2 True x+          else Strict.Tuple2 False (step x a)+    , extract = \(Strict.Tuple2 _ state) -> extract state+    }++{-| Ignores the first /n/ inputs -}+drop :: Natural -> Fold a b -> Fold a b+drop n Fold{ initial, step, extract } = Fold+    { initial = (n, initial)+    , step = \(n', s) x -> case n' of+          0 -> (0, step s x)+          _ -> (n' - 1, s)+    , extract = \(_,  s) -> extract s+    }++{-| Nest a fold in an applicative -}+nest :: Applicative f => Fold a b -> Fold (f a) (f b)+nest Fold{ initial, step, extract } = Fold+    { initial = pure initial, step = liftA2 step, extract = fmap extract }
+ source/Fold/Types.hs view
@@ -0,0 +1,3 @@+module Fold.Types (Fold, NonemptyFold, EffectfulFold) where++import Fold
+ source/Strict.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE StrictData #-}++-- | Strict data types for use as internal+-- accumulators to achieve constant space usage.+module Strict+  (+    {- * Maybe -} Maybe (..), lazy, strict,+    {- * Either -} Either (..), hush,+    {- * Tuples -} Tuple2 (..), Tuple3 (..),+  )+  where++import Data.Semigroup (Semigroup, (<>))+import Data.Monoid (Monoid, mempty)++import qualified Data.Maybe as Lazy++data Maybe a = Just a | Nothing++instance Semigroup a => Semigroup (Maybe a) where+    Nothing <> x = x+    x <> Nothing = x+    Just x <> Just y = Just (x <> y)++instance Semigroup a => Monoid (Maybe a) where+    mempty = Nothing++lazy :: Maybe a -> Lazy.Maybe a+lazy Nothing = Lazy.Nothing+lazy (Just a) = Lazy.Just a++strict :: Lazy.Maybe a -> Maybe a+strict Lazy.Nothing = Nothing+strict (Lazy.Just a) = Just a++data Either a b = Left a | Right b++hush :: Either a b -> Lazy.Maybe b+hush (Left _) = Lazy.Nothing+hush (Right b) = Lazy.Just b++data Tuple2 a b = Tuple2 a b++data Tuple3 a b c = Tuple3 a b c
+ test/Main.hs view
@@ -0,0 +1,15 @@+module Main (main) where++import Prelude++import Test.Hspec++import qualified Spec.Pure+import qualified Spec.Nonempty+import qualified Spec.Effectful++main :: IO ()+main = hspec do+    Spec.Pure.spec+    Spec.Nonempty.spec+    Spec.Effectful.spec
+ test/Spec/Effectful.hs view
@@ -0,0 +1,85 @@+module Spec.Effectful where++import Fold.Effectful++import Test.Hspec++import Control.Applicative (pure, (<*>))+import Control.Monad ((<=<))+import Data.Foldable (traverse_)+import Data.Function (id, on, (.), (&))+import Data.Functor ((<$>))+import Data.Functor.Identity (Identity (Identity), runIdentity)+import Data.Monoid (mempty)+import Data.Semigroup (Sum (Sum), (<>))+import Prelude ((>), String, Integer, (+), (*))++import qualified Data.List as List++spec :: SpecWith ()+spec = describe "EffectfulFold" do++    describe "drop" do+        it "run (drop n f) xs = run f (List.drop n xs)" do+            let xs = [10, 20, 30, 1, 2, 3] :: [Integer]+                f = sum :: EffectfulFold Identity Integer Integer+            [0 .. 8] & traverse_ @[] \n ->+                run (drop n f) xs `shouldBe` run f (List.genericDrop n xs)++    describe "effectMonoid" do+        it "If <> is commutative, \+            \effectMonoid (f <> g) = effectMonoid f <> effectMonoid g" do+            let xs = [(1, 3), (5, 4), (11, 23)] :: [(Integer, Integer)]+                f (x, _) = pure (Sum x)+                g (_, x) = pure (Sum x)+                (===) = shouldBe `on` \fo ->+                    runIdentity (run fo xs)+            effectMonoid (f <> g)+                === (effectMonoid f <> effectMonoid g)++        it "effectMonoid mempty = mempty" do+            let xs = ["one", "two", "three"] :: [String]+                (===) = shouldBe `on` \fo ->+                    runIdentity (run fo xs) :: Sum Integer+            effectMonoid mempty === mempty++    describe "premap" do+        it "premap pure = id" do+            let xs = [5, 13, 1] :: [Integer]+                (===) = shouldBe `on` \f ->+                    runIdentity (run (f sum) xs) :: Integer+            premap pure === id++        it "premap (f <=< g) = premap g . premap f" do+            let xs = [5, 13, 1] :: [Integer]+                f = Identity . (+ 13)+                g = Identity . (* 7)+                (===) = shouldBe `on` \h ->+                    runIdentity (run (h list) xs) :: [Integer]+            premap (f <=< g) === (premap g . premap f)++        it "premap k (pure r) = pure r" do+            let xs = [5, 13, 1] :: [Integer]+                k = Identity . (+ 13)+                r = "Hi." :: String+                (===) = shouldBe `on` \fo ->+                    runIdentity (run fo xs) :: String+            premap k (pure r) === pure r++        it "premap k (f <*> x) = premap k f <*> premap k x" do+            let xs = [1..10] :: [Integer]+                k = Identity . (+ 7)+                f = (+) <$> sum+                x = product+                (===) = shouldBe `on` \fo ->+                    runIdentity (run fo xs)+            premap k (f <*> x) === (premap k f <*> premap k x)++    describe "prefilter" do+        it "considers only inputs that match an effectful predicate" do+            let xs = [1..10] :: [Integer]+                p = (> 5)+                f = sum+            shouldBe @(Identity Integer)+                (run (prefilter (Identity . p) f) xs)+                (run f (List.filter p xs))
+ test/Spec/Nonempty.hs view
@@ -0,0 +1,36 @@+module Spec.Nonempty where++import Fold.Nonempty++import Test.Hspec++import Data.List.NonEmpty (NonEmpty ((:|)))+import Prelude (String, Integer)++spec :: SpecWith ()+spec = describe "NonemptyFold" do++    describe "semigroup" do+        it "folds all inputs using (<>)" do+            let xs = "Hello" :| " " : "world" : [] :: NonEmpty String+            run semigroup xs `shouldBe` "Hello world"++    describe "minimum" do+        it "produces the least input" do+            let xs = [5, 3, 7, 2, 9, 4] :: NonEmpty Integer+            run minimum xs `shouldBe` 2++    describe "maximum" do+        it "produces the greatest input" do+            let xs = [5, 3, 7, 2, 9, 4] :: NonEmpty Integer+            run maximum xs `shouldBe` 9++    describe "listing functions" do+        let xs = [1 .. 4] :: NonEmpty Integer++        describe "list" do+            it "gets all inputs" do+                run list xs `shouldBe` xs+        describe "reverseList" do+            it "gets all inputs in reverse" do+                run reverseList xs `shouldBe` [4, 3, 2, 1]
+ test/Spec/Pure.hs view
@@ -0,0 +1,118 @@+module Spec.Pure where++import Fold.Pure++import Test.Hspec++import Control.Applicative (pure, (<*>))+import Data.Foldable (traverse_)+import Data.Function (id, on, (.), (&))+import Data.Functor ((<$>))+import Data.Maybe (Maybe (Just, Nothing))+import Data.Monoid (mempty)+import Data.Semigroup (Sum (Sum))+import Prelude ((>), String, Integer, (+), (*))++import qualified Data.Foldable as Foldable+import qualified Data.List as List++spec :: SpecWith ()+spec = describe "Fold" do++    describe "scanning functions" do+        let xs = [1 .. 5] :: [Integer]++        describe "scan" do+            it "gives all the intermediate states" do+                scan length xs `shouldBe` [0 .. 5]+        describe "prescan" do+            it "excludes the final state" do+                prescan length xs `shouldBe` [0 .. 4]+        describe "postscan" do+            it "excludes the initial state" do+                postscan length xs `shouldBe` [1 .. 5]++    describe "premap" do+        let xs = [1 .. 10] :: [Integer]++        it "applies f to each input" do+            let f = Sum+                fold = monoid+                z = Foldable.foldMap Sum xs+            run (premap f fold) xs `shouldBe` z+            run fold (List.map f xs)    `shouldBe` z+        it "premap id = id" do+            let fold = sum+                (===) = shouldBe `on` \f -> run (f fold) xs+            premap id === id+        it "premap (f . g) = premap g . premap f" do+            let fold = sum+                f = (+ 1)+                g = (* 2)+                (===) = shouldBe `on` \r -> run (r fold) xs+            premap (f . g) === (premap g . premap f)+        it "premap k (pure r) = pure r" do+            let r = 5 :: Integer+                k = (+ 1)+                (===) = shouldBe `on` \fold -> run fold xs+            premap k (pure r) === pure r+        it "premap k (f <*> x) = premap k f <*> premap k x" do+            let k = (+ 1)+                f = (+) <$> product+                x = sum+                (===) = shouldBe `on` \fold -> run fold xs+            premap k (f <*> x) === (premap k f <*> premap k x)++    describe "prefilter" do+        it "run (prefilter p f) xs = run f (List.filter p xs)" do+            let xs = [1 .. 10] :: [Integer]+                p = (> 5)+                f = sum+            run (prefilter p f) xs `shouldBe` run f (List.filter p xs)++    describe "predropWhile" do+        it "run (predropWhile p f) xs = run f (List.dropWhile p xs)" do+            let xs = [10, 9, 5, 9] :: [Integer]+                fo = sum+                p = (> 5)+            run (predropWhile p fo) xs `shouldBe` run fo (List.dropWhile p xs)++    describe "drop" do+        it "run (drop n f) xs = run f (List.drop n xs)" do+            let xs = [10, 20, 30, 1, 2, 3] :: [Integer]+                f = sum :: Fold Integer Integer+            [0 .. 8] & traverse_ @[] \n ->+                run (drop n f) xs `shouldBe` run f (List.genericDrop n xs)++    describe "sum" do+        it "computes the sum of all inputs" do+            let xs = [1 .. 10] :: [Integer]+            run sum xs `shouldBe` 55++    describe "product" do+        it "computes the product of all inputs" do+            let xs = [1 .. 5] :: [Integer]+            run product xs `shouldBe` 120++    describe "monoid" do+        it "folds all inputs using (<>) and mempty" do+            let xs = ["Hello", " ", "world"] :: [String]+            run monoid xs `shouldBe` "Hello world"+        it "returns mempty when there are no inputs" do+            run monoid ([] :: [String]) `shouldBe` mempty++    describe "index" do+        let xs = [4, 5, 6] :: [Integer]+        it "0" do run (index 0) xs `shouldBe` Just 4+        it "1" do run (index 1) xs `shouldBe` Just 5+        it "2" do run (index 2) xs `shouldBe` Just 6+        it "3" do run (index 3) xs `shouldBe` Nothing++    describe "listing functions" do+        let xs = [1 .. 4] :: [Integer]++        describe "list" do+            it "gets all inputs" do run list xs `shouldBe` xs+        describe "reverseList" do+            it "gets all inputs in reverse" do+                run reverseList xs `shouldBe` [4, 3, 2, 1]