Hello community, here is the log from the commit of package ghc-foldl for openSUSE:Factory checked in at 2017-03-20 17:06:23 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-foldl (Old) and /work/SRC/openSUSE:Factory/.ghc-foldl.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-foldl" Mon Mar 20 17:06:23 2017 rev:5 rq:453297 version:1.2.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-foldl/ghc-foldl.changes 2016-07-21 08:09:57.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-foldl.new/ghc-foldl.changes 2017-03-20 17:06:24.564585668 +0100 @@ -1,0 +2,10 @@ +Wed Jan 18 09:00:19 UTC 2017 - [email protected] + +- Update to version 1.2.3 with cabal2obs. + +------------------------------------------------------------------- +Sun Jan 8 21:14:05 UTC 2017 - [email protected] + +- Update to version 1.2.2 with cabal2obs. + +------------------------------------------------------------------- Old: ---- foldl-1.2.1.tar.gz New: ---- foldl-1.2.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-foldl.spec ++++++ --- /var/tmp/diff_new_pack.ejBwk5/_old 2017-03-20 17:06:25.416465383 +0100 +++ /var/tmp/diff_new_pack.ejBwk5/_new 2017-03-20 17:06:25.424464253 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-foldl # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,15 +18,14 @@ %global pkg_name foldl Name: ghc-%{pkg_name} -Version: 1.2.1 +Version: 1.2.3 Release: 0 Summary: Composable, streaming, and efficient left folds License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-bytestring-devel BuildRequires: ghc-comonad-devel BuildRequires: ghc-containers-devel @@ -39,7 +38,6 @@ BuildRequires: ghc-transformers-devel BuildRequires: ghc-vector-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build -# End cabal-rpm deps %description This library provides strict left folds that stream in constant memory, and you @@ -61,15 +59,12 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %post devel %ghc_pkg_recache @@ -82,5 +77,6 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) +%doc CHANGELOG.md README.md %changelog ++++++ foldl-1.2.1.tar.gz -> foldl-1.2.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foldl-1.2.1/CHANGELOG.md new/foldl-1.2.3/CHANGELOG.md --- old/foldl-1.2.1/CHANGELOG.md 1970-01-01 01:00:00.000000000 +0100 +++ new/foldl-1.2.3/CHANGELOG.md 2017-01-01 01:23:55.000000000 +0100 @@ -0,0 +1,103 @@ +1.2.2 + +* Add numerically stable `mean`, `variance`, and `std` folds +* Add `Control.Foldl.{Text,ByteString}.foldM` +* Add `foldOver`/`foldOverM` + +1.2.1 + +* Performance improvements +* Re-export `filtered` + +1.2.0 + +* Breaking change: Fix `handles` to fold things in the correct order (was + previously folding things backwards and also leaking space as a result). No + change to behavior of `handlesM`, which was folding things in the right order +* Breaking change: Change the `Monoid` used by `Handler`/`HandlerM` +* Add `folded` + +1.1.6 + +* Add `maximumBy` and `minimumBy` + +1.1.5 + +* Increase lower bound on `base` from `< 4` to `< 4.5` + +1.1.4 + +* Increase upper bound on `comonad` from `< 5` to `< 6` + +1.1.3 + +* Increase upper bound on `profunctors` from `< 5.2` to `< 5.3` +* Add `mapM_`, `hoists`, `purely`, and `impurely` + +1.1.2 + +* Add `lastN`, `randomN`, `sink`, and `duplicateM` +* Add `Comonad` instance for `Fold` +* Add `Profunctor` instance for `FoldM` + +1.1.1 + +* Increase upper bound on `vector` from `< 0.11` to `< 0.12` + +1.1.0 + +* Breaking change: Rename `pretraverse`/`pretraverseM` to `handles`/`handlesM` +* Add `Handler` +* Export `EndoM` + +1.0.11 + +* Add `Profunctor` instance for `Fold` + +1.0.10 + +* Add `random` and `_Fold1` + +1.0.9 + +* Increase upper bound on `primitive` from `< 0.6` to `< 0.7` + +1.0.8 + +* Add `revList` + +1.0.7 + +* Add `Num` and `Fractional` instances for `Fold`/`FoldM` +* Add `count` fold for `Text` and `ByteString` + +1.0.6 + +* Add `pretraverse` and `pretraverseM` + +1.0.5 + +* Add `lastDef` + +1.0.4 + +* Increase upper bounds on `transformers` from `< 0.4` to `< 0.6` +* Add `nub`, `eqNub`, and `set` + +1.0.3 + +* Add `scan`, `generalize`, `simplify`, and `premapM` + +1.0.2 + +* Add `list` and `vector` folds +* Add `fold` function for `Text` and `ByteString` + +1.0.1 + +* Add support for `ByteString` and `Text` folds +* Add `Monoid` instance for `Fold`/`FoldM` + +1.0.0 + +* Initial release diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foldl-1.2.1/README.md new/foldl-1.2.3/README.md --- old/foldl-1.2.1/README.md 1970-01-01 01:00:00.000000000 +0100 +++ new/foldl-1.2.3/README.md 2017-01-08 14:21:41.000000000 +0100 @@ -0,0 +1,173 @@ +# `foldl` v1.2.3 + +Use this `foldl` library when you want to compute multiple folds over a +collection in one pass over the data without space leaks. + +For example, suppose that you want to simultaneously compute the sum of the list +and the length of the list. Many Haskell beginners might write something like +this: + +```haskell +sumAndLength :: Num a => [a] -> (a, Int) +sumAndLength xs = (sum xs, length xs) + +``` + +However, this solution will leak space because it 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`. + +Usually people work around this by hand-writing a strict left fold that looks +something like this: + +```haskell +{-# LANGUAGE BangPatterns #-} + +import Data.List (foldl') + +sumAndLength :: Num a => [a] -> (a, Int) +sumAndLength xs = foldl' step (0, 0) xs + where + step (x, y) n = (x + n, y + 1) +``` + +That now goes over the list in one pass, but will still leak space because the +tuple is not strict in both fields! You have to define a strict `Pair` type to +fix this: + +```haskell +{-# LANGUAGE BangPatterns #-} + +import Data.List (foldl') + +data Pair a b = Pair !a !b + +sumAndLength :: Num a => [a] -> (a, Int) +sumAndLength xs = done (foldl' step (Pair 0 0) xs) + where + step (Pair x y) n = Pair (x + n) (y + 1) + + done (Pair x y) = (x, y) +``` + + +However, this is not satisfactory because you have to reimplement the guts of +every fold that you care about and also define a custom strict data type for +your fold. Hand-writing the step function, accumulator, and strict data type +for every fold that you want to use gets tedious fast. For example, +implementing something like reservoir sampling over and over is very error +prone. + +What if you just stored the step function and accumulator for each individual +fold and let some high-level library do the combining for you? That's exactly +what this library does! Using this library you can instead write: + +```haskell +import qualified Control.Foldl as Fold + +sumAndLength :: Num a => [a] -> (a, Int) +sumAndLength xs = Fold.fold ((,) <$> Fold.sum <*> Fold.length) xs + +-- or, more concisely: +sumAndLength = Fold.fold ((,) <$> Fold.sum <*> Fold.length) +``` + +To see how this works, the `Fold.sum` value is just a datatype storing the step +function and the starting state (and a final extraction function): + +```haskell +sum :: Num a => Fold a a +sum = Fold (+) 0 id +``` + +Same thing for the `Fold.length` value: + +```haskell +length :: Fold a Int +length = Fold (\n _ -> n + 1) 0 id +``` + +... and the `Applicative` operators combine them into a new datatype storing +the composite step function and starting state: + +```haskell +(,) <$> Fold.sum <*> Fold.length = Fold step (Pair 0 0) done + where + step (Pair x y) = Pair (x + n) (y + 1) + + done (Pair x y) = (x, y) +``` + +... and then `fold` just transforms that to a strict left fold: + +```haskell +fold (Fold step begin done) = done (foldl' step begin) +``` + +Since we preserve the step function and accumulator, we can use the `Fold` type to +fold things other than pure collections. For example, we can fold a `Producer` +from `pipes` using the same `Fold`: + +```haskell +Fold.purely Pipes.Prelude.fold ((,) <$> sum <*> length) + :: (Monad m, Num a) => Producer a m () -> m (a, Int) +``` + +To learn more about this library, read the documentation in +[the main `Control.Foldl` module](http://hackage.haskell.org/package/foldl/docs/Control-Foldl.html). + +## Quick start + +Install [the `stack` tool](http://haskellstack.org/) and then run: + +```bash +$ stack setup +$ stack ghci foldl +Prelude> import qualified Control.Foldl as Fold +Prelude Fold> Fold.fold ((,) <$> Fold.sum <*> Fold.length) [1..1000000] +(500000500000,1000000) +``` + +## How to contribute + +Contribute a pull request if you have a `Fold` that you believe other people +would find useful. + +## Development Status + +[](https://travis-ci.org/Gabriel439/Haskell-Foldl-Library) + +The `foldl` library is pretty stable at this point. I don't expect there to be +breaking changes to the API from this point forward unless people discover new +bugs. + +## License (BSD 3-clause) + +Copyright (c) 2016 Gabriel 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 Gabriel 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. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foldl-1.2.1/bench/benchmarks.hs new/foldl-1.2.3/bench/benchmarks.hs --- old/foldl-1.2.1/bench/benchmarks.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/foldl-1.2.3/bench/benchmarks.hs 2016-12-23 19:01:15.000000000 +0100 @@ -0,0 +1,40 @@ +module Main (main) where + +import Control.Foldl +import Criterion.Main +import qualified Data.List +import Prelude hiding (length, sum) +import qualified Prelude + +main :: IO () +main = defaultMain + [ env (return [1..10000 :: Int]) $ \ns -> + bgroup "[1..10000 :: Int]" + [ bgroup "sum" $ map ($ ns) + [ bench "fold sum" . + whnf (fold sum) + , bench "foldM (generalize sum)" . + whnfIO . foldM (generalize sum) + , bench "Prelude.sum" . + whnf Prelude.sum + , bench "Data.List.foldl' (+) 0" . + whnf (Data.List.foldl' (+) 0) + ] + , bgroup "filtered" $ map ($ ns) + [ bench "fold (handles (filtered even) list)" . + nf (fold (handles (filtered even) list)) + , bench "foldM (handlesM (filtered even) (generalize list))" . + nfIO . foldM (handlesM (filtered even) (generalize list)) + , bench "filter even" . + nf (filter even) + ] + , bgroup "length" $ map ($ ns) + [ bench "fold length" . + whnf (fold length) + , bench "foldM (generalize length)" . + whnfIO . foldM (generalize length) + , bench "Prelude.length" . + whnf Prelude.length + ] + ] + ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foldl-1.2.1/foldl.cabal new/foldl-1.2.3/foldl.cabal --- old/foldl-1.2.1/foldl.cabal 2016-05-28 08:46:25.000000000 +0200 +++ new/foldl-1.2.3/foldl.cabal 2017-01-08 14:21:45.000000000 +0100 @@ -1,5 +1,5 @@ Name: foldl -Version: 1.2.1 +Version: 1.2.3 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3 @@ -15,6 +15,9 @@ folds. Derived folds still traverse the container just once and are often as efficient as hand-written folds. Category: Control +Extra-Source-Files: + CHANGELOG.md + README.md Source-Repository head Type: git Location: https://github.com/Gabriel439/Haskell-Foldl-Library @@ -28,7 +31,7 @@ primitive < 0.7 , text >= 0.11.2.0 && < 1.3 , transformers >= 0.2.0.0 && < 0.6 , - vector >= 0.7 && < 0.12, + vector >= 0.7 && < 0.13, containers < 0.6 , contravariant < 1.5 , profunctors < 5.3 , @@ -40,3 +43,13 @@ Other-Modules: Control.Foldl.Internal GHC-Options: -O2 -Wall + +Benchmark benchmarks + Type: exitcode-stdio-1.0 + HS-Source-Dirs: bench + Main-Is: benchmarks.hs + Build-Depends: + base, + criterion, + foldl + GHC-Options: -O2 -Wall -rtsopts diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foldl-1.2.1/src/Control/Foldl/ByteString.hs new/foldl-1.2.3/src/Control/Foldl/ByteString.hs --- old/foldl-1.2.1/src/Control/Foldl/ByteString.hs 2015-05-06 06:13:54.000000000 +0200 +++ new/foldl-1.2.3/src/Control/Foldl/ByteString.hs 2016-12-23 19:01:15.000000000 +0100 @@ -3,6 +3,7 @@ module Control.Foldl.ByteString ( -- * Folding fold + , foldM -- * Folds , head @@ -28,7 +29,7 @@ , module Data.Word ) where -import Control.Foldl (Fold) +import Control.Foldl (Fold, FoldM) import Control.Foldl.Internal (Maybe'(..), lazy, strict, Either'(..), hush) import qualified Control.Foldl as L import Data.ByteString (ByteString) @@ -44,6 +45,17 @@ fold (L.Fold step begin done) as = done (Lazy.foldlChunks step begin as) {-# INLINABLE fold #-} +-- | Apply a strict monadic left 'FoldM' to a lazy bytestring +foldM :: Monad m => FoldM m ByteString a -> Lazy.ByteString -> m a +foldM (L.FoldM step begin done) as = do + x <- Lazy.foldlChunks step' begin as + done x + where + step' mx bs = do + x <- mx + x `seq` step x bs +{-# INLINABLE foldM #-} + {-| Get the first byte of a byte stream or return 'Nothing' if the stream is empty -} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foldl-1.2.1/src/Control/Foldl/Text.hs new/foldl-1.2.3/src/Control/Foldl/Text.hs --- old/foldl-1.2.1/src/Control/Foldl/Text.hs 2014-09-13 19:18:28.000000000 +0200 +++ new/foldl-1.2.3/src/Control/Foldl/Text.hs 2016-12-23 19:01:15.000000000 +0100 @@ -3,6 +3,7 @@ module Control.Foldl.Text ( -- * Folding fold + , foldM -- * Folds , head @@ -27,7 +28,7 @@ , module Data.Text ) where -import Control.Foldl (Fold) +import Control.Foldl (Fold, FoldM) import Control.Foldl.Internal (Maybe'(..), lazy, strict, Either'(..), hush) import qualified Control.Foldl as L import Data.Text (Text) @@ -41,6 +42,17 @@ fold (L.Fold step begin done) as = done (Lazy.foldlChunks step begin as) {-# INLINABLE fold #-} +-- | Apply a strict monadic left 'FoldM' to lazy text +foldM :: Monad m => FoldM m Text a -> Lazy.Text -> m a +foldM (L.FoldM step begin done) as = do + x <- Lazy.foldlChunks step' begin as + done x + where + step' mx bs = do + x <- mx + x `seq` step x bs +{-# INLINABLE foldM #-} + {-| Get the first character of a text stream or return 'Nothing' if the stream is empty -} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foldl-1.2.1/src/Control/Foldl.hs new/foldl-1.2.3/src/Control/Foldl.hs --- old/foldl-1.2.1/src/Control/Foldl.hs 2016-05-28 08:22:59.000000000 +0200 +++ new/foldl-1.2.3/src/Control/Foldl.hs 2017-01-08 13:50:22.000000000 +0100 @@ -31,6 +31,8 @@ >>> L.fold ((,) <$> L.minimum <*> L.maximum) [1..10000000] (Just 1,Just 10000000) + You might want to try enabling the @-flate-dmd-anal@ flag when compiling + executables that use this library to further improve performance. -} {-# LANGUAGE ExistentialQuantification #-} @@ -63,6 +65,9 @@ , any , sum , product + , mean + , variance + , std , maximum , maximumBy , minimum @@ -71,6 +76,7 @@ , notElem , find , index + , lookup , elemIndex , findIndex , random @@ -105,9 +111,11 @@ , premapM , Handler , handles + , foldOver , EndoM(..) , HandlerM , handlesM + , foldOverM , folded , filtered @@ -147,6 +155,7 @@ , minimum , elem , notElem + , lookup ) import qualified Data.Foldable as F @@ -181,10 +190,10 @@ instance Comonad (Fold a) where extract (Fold _ begin done) = done begin - {-# INLINABLE extract #-} + {-# INLINE extract #-} duplicate (Fold step begin done) = Fold step begin (\x -> Fold step x done) - {-# INLINABLE duplicate #-} + {-# INLINE duplicate #-} instance Applicative (Fold a) where pure b = Fold (\() _ -> ()) () (\() -> b) @@ -199,97 +208,97 @@ instance Monoid b => Monoid (Fold a b) where mempty = pure mempty - {-# INLINABLE mempty #-} + {-# INLINE mempty #-} mappend = liftA2 mappend - {-# INLINABLE mappend #-} + {-# INLINE mappend #-} instance Num b => Num (Fold a b) where fromInteger = pure . fromInteger - {-# INLINABLE fromInteger #-} + {-# INLINE fromInteger #-} negate = fmap negate - {-# INLINABLE negate #-} + {-# INLINE negate #-} abs = fmap abs - {-# INLINABLE abs #-} + {-# INLINE abs #-} signum = fmap signum - {-# INLINABLE signum #-} + {-# INLINE signum #-} (+) = liftA2 (+) - {-# INLINABLE (+) #-} + {-# INLINE (+) #-} (*) = liftA2 (*) - {-# INLINABLE (*) #-} + {-# INLINE (*) #-} (-) = liftA2 (-) - {-# INLINABLE (-) #-} + {-# INLINE (-) #-} instance Fractional b => Fractional (Fold a b) where fromRational = pure . fromRational - {-# INLINABLE fromRational #-} + {-# INLINE fromRational #-} recip = fmap recip - {-# INLINABLE recip #-} + {-# INLINE recip #-} (/) = liftA2 (/) - {-# INLINABLE (/) #-} + {-# INLINE (/) #-} instance Floating b => Floating (Fold a b) where pi = pure pi - {-# INLINABLE pi #-} + {-# INLINE pi #-} exp = fmap exp - {-# INLINABLE exp #-} + {-# INLINE exp #-} sqrt = fmap sqrt - {-# INLINABLE sqrt #-} + {-# INLINE sqrt #-} log = fmap log - {-# INLINABLE log #-} + {-# INLINE log #-} sin = fmap sin - {-# INLINABLE sin #-} + {-# INLINE sin #-} tan = fmap tan - {-# INLINABLE tan #-} + {-# INLINE tan #-} cos = fmap cos - {-# INLINABLE cos #-} + {-# INLINE cos #-} asin = fmap sin - {-# INLINABLE asin #-} + {-# INLINE asin #-} atan = fmap atan - {-# INLINABLE atan #-} + {-# INLINE atan #-} acos = fmap acos - {-# INLINABLE acos #-} + {-# INLINE acos #-} sinh = fmap sinh - {-# INLINABLE sinh #-} + {-# INLINE sinh #-} tanh = fmap tanh - {-# INLINABLE tanh #-} + {-# INLINE tanh #-} cosh = fmap cosh - {-# INLINABLE cosh #-} + {-# INLINE cosh #-} asinh = fmap asinh - {-# INLINABLE asinh #-} + {-# INLINE asinh #-} atanh = fmap atanh - {-# INLINABLE atanh #-} + {-# INLINE atanh #-} acosh = fmap acosh - {-# INLINABLE acosh #-} + {-# INLINE acosh #-} (**) = liftA2 (**) - {-# INLINABLE (**) #-} + {-# INLINE (**) #-} logBase = liftA2 logBase - {-# INLINABLE logBase #-} + {-# INLINE logBase #-} {-| Like 'Fold', but monadic. @@ -306,11 +315,11 @@ done' x = do b <- done x return $! f b - {-# INLINABLE fmap #-} + {-# INLINE fmap #-} instance Monad m => Applicative (FoldM m a) where pure b = FoldM (\() _ -> return ()) (return ()) (\() -> return b) - {-# INLINABLE pure #-} + {-# INLINE pure #-} (FoldM stepL beginL doneL) <*> (FoldM stepR beginR doneR) = let step (Pair xL xR) a = do @@ -326,7 +335,7 @@ x <- doneR xR return $! f x in FoldM step begin done - {-# INLINABLE (<*>) #-} + {-# INLINE (<*>) #-} instance Monad m => Profunctor (FoldM m) where rmap = fmap @@ -334,97 +343,97 @@ instance (Monoid b, Monad m) => Monoid (FoldM m a b) where mempty = pure mempty - {-# INLINABLE mempty #-} + {-# INLINE mempty #-} mappend = liftA2 mappend - {-# INLINABLE mappend #-} + {-# INLINE mappend #-} instance (Monad m, Num b) => Num (FoldM m a b) where fromInteger = pure . fromInteger - {-# INLINABLE fromInteger #-} + {-# INLINE fromInteger #-} negate = fmap negate - {-# INLINABLE negate #-} + {-# INLINE negate #-} abs = fmap abs - {-# INLINABLE abs #-} + {-# INLINE abs #-} signum = fmap signum - {-# INLINABLE signum #-} + {-# INLINE signum #-} (+) = liftA2 (+) - {-# INLINABLE (+) #-} + {-# INLINE (+) #-} (*) = liftA2 (*) - {-# INLINABLE (*) #-} + {-# INLINE (*) #-} (-) = liftA2 (-) - {-# INLINABLE (-) #-} + {-# INLINE (-) #-} instance (Monad m, Fractional b) => Fractional (FoldM m a b) where fromRational = pure . fromRational - {-# INLINABLE fromRational #-} + {-# INLINE fromRational #-} recip = fmap recip - {-# INLINABLE recip #-} + {-# INLINE recip #-} (/) = liftA2 (/) - {-# INLINABLE (/) #-} + {-# INLINE (/) #-} instance (Monad m, Floating b) => Floating (FoldM m a b) where pi = pure pi - {-# INLINABLE pi #-} + {-# INLINE pi #-} exp = fmap exp - {-# INLINABLE exp #-} + {-# INLINE exp #-} sqrt = fmap sqrt - {-# INLINABLE sqrt #-} + {-# INLINE sqrt #-} log = fmap log - {-# INLINABLE log #-} + {-# INLINE log #-} sin = fmap sin - {-# INLINABLE sin #-} + {-# INLINE sin #-} tan = fmap tan - {-# INLINABLE tan #-} + {-# INLINE tan #-} cos = fmap cos - {-# INLINABLE cos #-} + {-# INLINE cos #-} asin = fmap sin - {-# INLINABLE asin #-} + {-# INLINE asin #-} atan = fmap atan - {-# INLINABLE atan #-} + {-# INLINE atan #-} acos = fmap acos - {-# INLINABLE acos #-} + {-# INLINE acos #-} sinh = fmap sinh - {-# INLINABLE sinh #-} + {-# INLINE sinh #-} tanh = fmap tanh - {-# INLINABLE tanh #-} + {-# INLINE tanh #-} cosh = fmap cosh - {-# INLINABLE cosh #-} + {-# INLINE cosh #-} asinh = fmap asinh - {-# INLINABLE asinh #-} + {-# INLINE asinh #-} atanh = fmap atanh - {-# INLINABLE atanh #-} + {-# INLINE atanh #-} acosh = fmap acosh - {-# INLINABLE acosh #-} + {-# INLINE acosh #-} (**) = liftA2 (**) - {-# INLINABLE (**) #-} + {-# INLINE (**) #-} logBase = liftA2 logBase - {-# INLINABLE logBase #-} + {-# INLINE logBase #-} -- | Apply a strict left 'Fold' to a 'Foldable' container fold :: Foldable f => Fold a b -> f a -> b @@ -543,11 +552,43 @@ sum = Fold (+) 0 id {-# INLINABLE sum #-} --- | Computes the product all elements +-- | Computes the product of all elements product :: Num a => Fold a a product = Fold (*) 1 id {-# INLINABLE product #-} +-- | Compute a numerically stable arithmetic mean of all elements +mean :: Fractional a => Fold a a +mean = Fold step begin done + where + begin = Pair 0 0 + step (Pair x n) y = Pair ((x * n + y) / (n + 1)) (n + 1) + done (Pair x _) = x +{-# INLINABLE mean #-} + +-- | Compute a numerically stable (population) variance over all elements +variance :: Fractional a => Fold a a +variance = Fold step begin done + where + begin = Pair3 0 0 0 + + step (Pair3 n mean_ m2) x = Pair3 n' mean' m2' + where + n' = n + 1 + mean' = (n * mean_ + x) / (n + 1) + delta = x - mean_ + m2' = m2 + delta * delta * n / (n + 1) + + done (Pair3 n _ m2) = m2 / n +{-# INLINABLE variance #-} + +{-| Compute a numerically stable (population) standard deviation over all + elements +-} +std :: Floating a => Fold a a +std = sqrt variance +{-# INLINABLE std #-} + -- | Computes the maximum element maximum :: Ord a => Fold a (Maybe a) maximum = _Fold1 max @@ -633,6 +674,20 @@ _ -> x {-# INLINABLE findIndex #-} + +{-| @(lookup a)@ returns the element paired with the first matching item, or + 'Nothing' if none matches +-} +lookup :: Eq a => a -> Fold (a,b) (Maybe b) +lookup a0 = Fold step Nothing' lazy + where + step x (a,b) = case x of + Nothing' -> if a == a0 + then Just' b + else Nothing' + _ -> x +{-# INLINABLE lookup #-} + data Pair3 a b c = Pair3 !a !b !c -- | Pick a random element, using reservoir sampling @@ -853,8 +908,7 @@ -- | Upgrade a monadic fold to accept the 'FoldM' type impurely - :: Monad m - => (forall x . (x -> a -> m x) -> m x -> (x -> m b) -> r) + :: (forall x . (x -> a -> m x) -> m x -> (x -> m b) -> r) -> FoldM m a b -> r impurely f (FoldM step begin done) = f step begin done @@ -901,8 +955,9 @@ {- | Shift a 'FoldM' from one monad to another with a morphism such as 'lift' or 'liftIO'; the effect is the same as 'Control.Monad.Morph.hoist'. -} -hoists :: Monad m => (forall x . m x -> n x) -> FoldM m a b -> FoldM n a b +hoists :: (forall x . m x -> n x) -> FoldM m a b -> FoldM n a b hoists phi (FoldM step begin done) = FoldM (\a b -> phi (step a b)) (phi begin) (phi . done) +{-# INLINABLE hoists #-} {-| Allows to continue feeding a 'FoldM' even after passing it to a function that closes it. @@ -925,6 +980,7 @@ step_ mx a = Just' (case mx of Nothing' -> a Just' x -> step x a) +{-# INLINABLE _Fold1 #-} {-| @(premap f folder)@ returns a new 'Fold' where f is applied at each step @@ -1010,6 +1066,26 @@ step' = flip (appEndo . getDual . getConst . k (Const . Dual . Endo . flip step)) {-# INLINABLE handles #-} +{- | @{foldOver f folder xs} folds all values from a Lens, Traversal, Prism or Fold with the given folder + +>>> foldOver (_Just . both) L.sum (Just (2, 3)) +5 + +>>> foldOver (_Just . both) L.sum Nothing +0 + +> L.foldOver f folder xs == L.fold folder (xs^..f) + +> L.foldOver (folded.f) folder == L.fold (handles f folder) + +> L.foldOver folded == L.fold + +-} +foldOver :: Handler s a -> Fold a b -> s -> b +foldOver l (Fold step begin done) = + done . flip appEndo begin . getDual . getConst . l (Const . Dual . Endo . flip step) +{-# INLINABLE foldOver #-} + {-| > instance Monad m => Monoid (EndoM m a) where > mempty = EndoM return @@ -1019,7 +1095,10 @@ instance Monad m => Monoid (EndoM m a) where mempty = EndoM return + {-# INLINE mempty #-} + mappend (EndoM f) (EndoM g) = EndoM (f <=< g) + {-# INLINE mappend #-} {-| A Handler for the upstream input of `FoldM` @@ -1046,12 +1125,26 @@ > > handlesM t (f <*> x) = handlesM t f <*> handlesM t x -} -handlesM :: Monad m => HandlerM m a b -> FoldM m b r -> FoldM m a r +handlesM :: HandlerM m a b -> FoldM m b r -> FoldM m a r handlesM k (FoldM step begin done) = FoldM step' begin done where step' = flip (appEndoM . getDual . getConst . k (Const . Dual . EndoM . flip step)) {-# INLINABLE handlesM #-} +{- | @{foldOverM f folder xs} folds all values from a Lens, Traversal, Prism or Fold monadically with the given folder + +> L.foldOverM (folded.f) folder == L.foldM (handlesM f folder) + +> L.foldOverM folded == L.foldM + +-} +foldOverM :: Monad m => HandlerM m s a -> FoldM m a b -> s -> m b +foldOverM l (FoldM step begin done) s = do + b <- begin + r <- (flip appEndoM b . getDual . getConst . l (Const . Dual . EndoM . flip step)) s + done r +{-# INLINABLE foldOverM #-} + {-| > folded :: Foldable t => Fold (t a) a > @@ -1061,6 +1154,7 @@ :: (Contravariant f, Applicative f, Foldable t) => (a -> f a) -> (t a -> f (t a)) folded k ts = contramap (\_ -> ()) (F.traverse_ k ts) +{-# INLINABLE folded #-} {-| >>> fold (handles (filtered even) sum) [1..10]
