foldl 1.4.0 → 1.4.1

raw patch · 6 files changed

+524/−41 lines, 6 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +1/−1
• foldl.cabal +4/−3
• src/Control/Foldl.hs +17/−37
• src/Control/Foldl/Internal.hs +5/−0
• src/Control/Scanl.hs +492/−0

@@ -1,3 +1,8 @@+1.4.1++* Add `Control.Scanl`+* Drop support for GHC 7.8 and older+ 1.4.0  * BREAKING CHANGE: Change type of `premapM` to accept a monadic function

@@ -1,4 +1,4 @@-# `foldl` v1.4.0+# `foldl` v1.4.1  Use this `foldl` library when you want to compute multiple folds over a collection in one pass over the data without space leaks.

@@ -1,5 +1,5 @@ Name: foldl-Version: 1.4.0+Version: 1.4.1 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3@@ -7,7 +7,7 @@ Copyright: 2013 Gabriel Gonzalez Author: Gabriel Gonzalez Maintainer: Gabriel439@gmail.com-Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1+Tested-With: GHC == 7.10.2, GHC == 8.0.1 Bug-Reports: https://github.com/Gabriel439/Haskell-Foldl-Library/issues Synopsis: Composable, streaming, and efficient left folds Description: This library provides strict left folds that stream in constant@@ -43,7 +43,8 @@     Exposed-Modules:         Control.Foldl,         Control.Foldl.ByteString,-        Control.Foldl.Text+        Control.Foldl.Text,+        Control.Scanl     Other-Modules:         Control.Foldl.Internal     GHC-Options: -O2 -Wall

@@ -36,7 +36,6 @@ -}  {-# LANGUAGE BangPatterns              #-}-{-# LANGUAGE CPP                       #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts          #-} {-# LANGUAGE RankNTypes                #-}@@ -51,11 +50,8 @@     , fold     , foldM     , scan-#if MIN_VERSION_base(4,8,0)     , prescan     , postscan-#else-#endif      -- * Folds     , Control.Foldl.mconcat@@ -141,7 +137,7 @@     ) where  import Control.Applicative-import Control.Foldl.Internal (Maybe'(..), lazy, Either'(..), hush)+import Control.Foldl.Internal (Maybe'(..), lazy, Either'(..), Pair(..), hush) import Control.Monad ((<=<)) import Control.Monad.Primitive (PrimMonad, RealWorld) import Control.Comonad@@ -157,6 +153,7 @@ import Data.Vector.Generic (Vector, Mutable) import Data.Vector.Generic.Mutable (MVector) import Data.Hashable (Hashable)+import Data.Traversable import System.Random.MWC (GenIO, createSystemRandom, uniformR) import Prelude hiding     ( head@@ -202,8 +199,6 @@   -- | @Fold @ @ step @ @ initial @ @ extract@   = forall x. Fold (x -> a -> x) x (x -> b) -data Pair a b = Pair !a !b- instance Functor (Fold a) where     fmap f (Fold step begin done) = Fold step begin (f . done)     {-# INLINE fmap #-}@@ -234,15 +229,15 @@         in  Fold step begin done     {-# INLINE (<*>) #-} -instance Monoid b => Semigroup (Fold a b) where-    (<>) = liftA2 mappend+instance Semigroup b => Semigroup (Fold a b) where+    (<>) = liftA2 (<>)     {-# INLINE (<>) #-}  instance Monoid b => Monoid (Fold a b) where     mempty = pure mempty     {-# INLINE mempty #-} -    mappend = (<>)+    mappend = liftA2 mappend     {-# INLINE mappend #-}  instance Num b => Num (Fold a b) where@@ -341,42 +336,31 @@   -- | @FoldM @ @ step @ @ initial @ @ extract@   forall x . FoldM (x -> a -> m x) (m x) (x -> m b) -instance Monad m => Functor (FoldM m a) where+instance Functor m => Functor (FoldM m a) where     fmap f (FoldM step start done) = FoldM step start done'       where-        done' x = do-            b <- done x-            return $! f b+        done' x = fmap f $! done x     {-# INLINE fmap #-} -instance Monad m => Applicative (FoldM m a) where-    pure b = FoldM (\() _ -> return ()) (return ()) (\() -> return b)+instance Applicative m => Applicative (FoldM m a) where+    pure b = FoldM (\() _ -> pure ()) (pure ()) (\() -> pure b)     {-# INLINE pure #-}      (FoldM stepL beginL doneL) <*> (FoldM stepR beginR doneR) =-        let step (Pair xL xR) a = do-                xL' <- stepL xL a-                xR' <- stepR xR a-                return $! Pair xL' xR'-            begin = do-                xL <- beginL-                xR <- beginR-                return $! Pair xL xR-            done (Pair xL xR) = do-                f <- doneL xL-                x <- doneR xR-                return $! f x+        let step (Pair xL xR) a = Pair <$> stepL xL a <*> stepR xR a+            begin = Pair <$> beginL <*> beginR+            done (Pair xL xR) = doneL xL <*> doneR xR         in  FoldM step begin done     {-# INLINE (<*>) #-} -instance Monad m => Profunctor (FoldM m) where+instance Functor m => Profunctor (FoldM m) where     rmap = fmap     lmap f (FoldM step begin done) = FoldM step' begin done       where         step' x a = step x (f a) -instance (Monoid b, Monad m) => Semigroup (FoldM m a b) where-    (<>) = liftA2 mappend+instance (Semigroup b, Monad m) => Semigroup (FoldM m a b) where+    (<>) = liftA2 (<>)     {-# INLINE (<>) #-}  instance (Monoid b, Monad m) => Monoid (FoldM m a b) where@@ -499,7 +483,6 @@     cons a k x = done x:(k $! step x a) {-# INLINE scan #-} -#if MIN_VERSION_base(4,8,0) {-| Convert a `Fold` into a prescan for any `Traversable` type      \"Prescan\" means that the last element of the scan is not included@@ -511,7 +494,7 @@       where         x' = step x a         b  = done x-    (_, bs) = List.mapAccumL step' begin as+    (_, bs) = mapAccumL step' begin as {-# INLINE prescan #-}  {-| Convert a `Fold` into a postscan for any `Traversable` type@@ -525,10 +508,8 @@       where         x' = step x a         b  = done x'-    (_, bs) = List.mapAccumL step' begin as+    (_, bs) = mapAccumL step' begin as {-# INLINE postscan #-}-#else-#endif  -- | Fold all values within a container using 'mappend' and 'mempty' mconcat :: Monoid a => Fold a a@@ -1060,7 +1041,6 @@     begin'    = runIdentity  begin     done' x   = runIdentity (done x) {-# INLINABLE simplify #-}-  {- | 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'.

@@ -9,6 +9,9 @@     -- * Strict Either     , Either'(..)     , hush++    -- * Strict Pair+    , Pair(..)     ) where  -- | A strict 'Maybe'@@ -34,3 +37,5 @@ hush (Left'  _) = Nothing hush (Right' b) = Just b {-# INLINABLE hush #-}++data Pair a b = Pair !a !b

@@ -0,0 +1,492 @@+{-| This module provides efficient and streaming left map-with-accumulator that you can combine+    using 'Applicative' style.++    Import this module qualified to avoid clashing with the Prelude:++>>> import qualified Control.Scanl as SL++    Use 'scan' to apply a 'Fold' to a list:+-}++{-# LANGUAGE BangPatterns              #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE RankNTypes                #-}+{-# LANGUAGE TupleSections             #-}++module Control.Scanl (+    -- * Scan Types+      Scan(..)+    , ScanM(..)++    -- * Scanning+    , scan+    , scanM++    , prescan+    , postscan++    -- * Utilities+    -- $utilities+    , purely+    , purely_+    , impurely+    , impurely_+    , generalize+    , simplify+    , hoists+    , arrM+    , premap+    , premapM+    ) where++import Control.Applicative+import Control.Arrow+import Control.Category+import Control.Foldl (Fold(..))+import Control.Foldl.Internal (Pair(..))+import Control.Monad ((<=<))+import Control.Monad.Trans.Class+import Control.Monad.Trans.State.Strict+import Data.Functor.Identity+import Data.Monoid hiding ((<>))+import Data.Profunctor+import Data.Semigroup (Semigroup(..))+import Data.Traversable+import Data.Tuple (swap)+import Prelude hiding ((.), id)++--import qualified Control.Foldl as L++{-| Efficient representation of a left map-with-accumulator that preserves the+    scan's step function and initial accumulator.++    This allows the 'Applicative' instance to assemble derived scans that+    traverse the container only once++    A \''Scan' a b\' processes elements of type __a__ replacing each with a+    value of type __b__.+-}+data Scan a b+  -- | @Scan @ @ step @ @ initial @+  = forall x. Scan (a -> State x b) x++instance Functor (Scan a) where+    fmap f (Scan step begin) = Scan (fmap f . step) begin+    {-# INLINE fmap #-}++instance Applicative (Scan a) where+    pure b    = Scan (\_ -> pure b) ()+    {-# INLINE pure #-}++    (Scan stepL beginL) <*> (Scan stepR beginR) =+        let step a (Pair xL xR) = (bL bR, (Pair xL' xR'))+              where (bL, xL') = runState (stepL a) xL+                    (bR, xR') = runState (stepR a) xR+            begin = Pair beginL beginR+        in  Scan (state . step) begin+    {-# INLINE (<*>) #-}++instance Profunctor Scan where+    lmap = premap+    rmap = fmap++instance Category Scan where+    id = Scan pure ()+    {-# INLINE id #-}+    (Scan s2 b2) . (Scan s1 b1) = Scan (state . step) (Pair b1 b2)+        where step a (Pair xL xR) = (c, Pair xL' xR')+                where (b, xL') = runState (s1 a) xL+                      (c, xR') = runState (s2 b) xR+    {-# INLINE (.) #-}++instance Arrow Scan where+    arr f = Scan (pure . f) ()+    {-# INLINE arr #-}+    first  (Scan step begin) = Scan+      (\(a,b) -> state $ \x -> first (,b) $ runState (step a) x)+      begin+    {-# INLINE first #-}+    second (Scan step begin) = Scan+      (\(b,a) -> state $ \x  -> first (b,) $ runState (step a) x)+      begin+    {-# INLINE second #-}++instance Semigroup b => Semigroup (Scan a b) where+    (<>) = liftA2 (<>)+    {-# INLINE (<>) #-}++instance Monoid b => Monoid (Scan a b) where+    mempty = pure mempty+    {-# INLINE mempty #-}++    mappend = liftA2 mappend+    {-# INLINE mappend #-}++instance Num b => Num (Scan a b) where+    fromInteger = pure . fromInteger+    {-# INLINE fromInteger #-}++    negate = fmap negate+    {-# INLINE negate #-}++    abs = fmap abs+    {-# INLINE abs #-}++    signum = fmap signum+    {-# INLINE signum #-}++    (+) = liftA2 (+)+    {-# INLINE (+) #-}++    (*) = liftA2 (*)+    {-# INLINE (*) #-}++    (-) = liftA2 (-)+    {-# INLINE (-) #-}++instance Fractional b => Fractional (Scan a b) where+    fromRational = pure . fromRational+    {-# INLINE fromRational #-}++    recip = fmap recip+    {-# INLINE recip #-}++    (/) = liftA2 (/)+    {-# INLINE (/) #-}++instance Floating b => Floating (Scan a b) where+    pi = pure pi+    {-# INLINE pi #-}++    exp = fmap exp+    {-# INLINE exp #-}++    sqrt = fmap sqrt+    {-# INLINE sqrt #-}++    log = fmap log+    {-# INLINE log #-}++    sin = fmap sin+    {-# INLINE sin #-}++    tan = fmap tan+    {-# INLINE tan #-}++    cos = fmap cos+    {-# INLINE cos #-}++    asin = fmap asin+    {-# INLINE asin #-}++    atan = fmap atan+    {-# INLINE atan #-}++    acos = fmap acos+    {-# INLINE acos #-}++    sinh = fmap sinh+    {-# INLINE sinh #-}++    tanh = fmap tanh+    {-# INLINE tanh #-}++    cosh = fmap cosh+    {-# INLINE cosh #-}++    asinh = fmap asinh+    {-# INLINE asinh #-}++    atanh = fmap atanh+    {-# INLINE atanh #-}++    acosh = fmap acosh+    {-# INLINE acosh #-}++    (**) = liftA2 (**)+    {-# INLINE (**) #-}++    logBase = liftA2 logBase+    {-# INLINE logBase #-}++{-| Like 'Scan', but monadic.++    A \''ScanM' m a b\' processes elements of type __a__ and+    results in a monadic value of type __m b__.+-}+data ScanM m a b =+  -- | @ScanM @ @ step @ @ initial @ @ extract@+  forall x . ScanM (a -> StateT x m b) (m x)++instance Functor m => Functor (ScanM m a) where+    fmap f (ScanM step begin) = ScanM (fmap f . step) begin+    {-# INLINE fmap #-}++instance Applicative m => Applicative (ScanM m a) where+    pure b    = ScanM (\_ -> StateT $ \() -> pure (b, ())) (pure ())+    {-# INLINE pure #-}++    (ScanM stepL beginL) <*> (ScanM stepR beginR) =+        let step a (Pair xL xR) =+              (\(bL, xL') (bR, xR') -> (bL bR, (Pair xL' xR')))+              <$> runStateT (stepL a) xL+              <*> runStateT (stepR a) xR+            begin = Pair <$> beginL <*> beginR+        in  ScanM (StateT . step) begin+    {-# INLINE (<*>) #-}++instance Functor m => Profunctor (ScanM m) where+    rmap = fmap+    lmap f (ScanM step begin) = ScanM (step . f) begin++instance Monad m => Category (ScanM m) where+    id = ScanM pure (pure ())+    {-# INLINE id #-}+    (ScanM s2 b2) . (ScanM s1 b1) = ScanM (StateT . step) (Pair <$> b1 <*> b2)+        where step a (Pair xL xR) = do+                (b, xL') <- runStateT (s1 a) xL+                (c, xR') <- runStateT (s2 b) xR+                pure (c, Pair xL' xR')+    {-# INLINE (.) #-}++instance Monad m => Arrow (ScanM m) where+    arr f = ScanM (lift . pure . f) (pure ())+    {-# INLINE arr #-}+    first  (ScanM step begin) = ScanM+      (\(a,b) -> StateT $ \x -> first (,b) <$> runStateT (step a) x)+      begin+    {-# INLINE first #-}+    second (ScanM step begin) = ScanM+      (\(b,a) -> StateT $ \x  -> first (b,) <$> runStateT (step a) x)+      begin+    {-# INLINE second #-}++instance (Monad m, Semigroup b) => Semigroup (ScanM m a b) where+    (<>) = liftA2 (<>)+    {-# INLINE (<>) #-}++instance (Monad m, Monoid b) => Monoid (ScanM m a b) where+    mempty = pure mempty+    {-# INLINE mempty #-}++    mappend = liftA2 mappend+    {-# INLINE mappend #-}++instance (Monad m, Num b) => Num (ScanM m a b) where+    fromInteger = pure . fromInteger+    {-# INLINE fromInteger #-}++    negate = fmap negate+    {-# INLINE negate #-}++    abs = fmap abs+    {-# INLINE abs #-}++    signum = fmap signum+    {-# INLINE signum #-}++    (+) = liftA2 (+)+    {-# INLINE (+) #-}++    (*) = liftA2 (*)+    {-# INLINE (*) #-}++    (-) = liftA2 (-)+    {-# INLINE (-) #-}++instance (Monad m, Fractional b) => Fractional (ScanM m a b) where+    fromRational = pure . fromRational+    {-# INLINE fromRational #-}++    recip = fmap recip+    {-# INLINE recip #-}++    (/) = liftA2 (/)+    {-# INLINE (/) #-}++instance (Monad m, Floating b) => Floating (ScanM m a b) where+    pi = pure pi+    {-# INLINE pi #-}++    exp = fmap exp+    {-# INLINE exp #-}++    sqrt = fmap sqrt+    {-# INLINE sqrt #-}++    log = fmap log+    {-# INLINE log #-}++    sin = fmap sin+    {-# INLINE sin #-}++    tan = fmap tan+    {-# INLINE tan #-}++    cos = fmap cos+    {-# INLINE cos #-}++    asin = fmap asin+    {-# INLINE asin #-}++    atan = fmap atan+    {-# INLINE atan #-}++    acos = fmap acos+    {-# INLINE acos #-}++    sinh = fmap sinh+    {-# INLINE sinh #-}++    tanh = fmap tanh+    {-# INLINE tanh #-}++    cosh = fmap cosh+    {-# INLINE cosh #-}++    asinh = fmap asinh+    {-# INLINE asinh #-}++    atanh = fmap atanh+    {-# INLINE atanh #-}++    acosh = fmap acosh+    {-# INLINE acosh #-}++    (**) = liftA2 (**)+    {-# INLINE (**) #-}++    logBase = liftA2 logBase+    {-# INLINE logBase #-}++-- | Apply a strict left 'Scan' to a 'Traversable' container+scan :: Traversable t => Scan a b -> t a -> t b+scan (Scan step begin) as = fst $ runState (traverse step as) begin+{-# INLINE scan #-}++-- | Like 'scan' but monadic+scanM :: (Traversable t, Monad m) => ScanM m a b -> t a -> m (t b)+scanM (ScanM step begin) as = fmap fst $ runStateT (traverse step as) =<< begin+{-# INLINE scanM #-}++{-| Convert a `Fold` into a prescan++    \"Prescan\" means that the last element of the scan is not included+-}+prescan :: Fold a b -> Scan a b+prescan (Fold step begin done) = Scan (state . step') begin+  where+    step' a x = (b, x')+      where+        x' = step x a+        b  = done x+{-# INLINE prescan #-}++{-| Convert a `Fold` into a postscan++    \"Postscan\" means that the first element of the scan is not included+-}+postscan :: Fold a b -> Scan a b+postscan (Fold step begin done) = Scan (state . step') begin+  where+    step' a x = (b, x')+      where+        x' = step x a+        b  = done x'+{-# INLINE postscan #-}++arrM :: Monad m => (b -> m c) -> ScanM m b c+arrM f = ScanM (lift . f) (pure ())+{-# INLINE arrM #-}++{- $utilities+-}++-- | Upgrade a scan to accept the 'Scan' type+purely :: (forall x . (a -> State x b) -> x -> r) -> Scan a b -> r+purely f (Scan step begin) = f step begin+{-# INLINABLE purely #-}++-- | Upgrade a more traditional scan to accept the `Scan` type+purely_ :: (forall x . (x -> a -> (x, b)) -> x -> r) -> Scan a b -> r+purely_ f (Scan step begin) = f (\s a -> swap $ runState (step a) s) begin+{-# INLINABLE purely_ #-}++-- | Upgrade a monadic scan to accept the 'ScanM' type+impurely+    :: (forall x . (a -> StateT x m b) -> m x -> r)+    -> ScanM m a b+    -> r+impurely f (ScanM step begin) = f step begin+{-# INLINABLE impurely #-}++-- | Upgrade a more traditional monadic scan to accept the `ScanM` type+impurely_+    :: Monad m+    => (forall x . (x -> a -> m (x, b)) -> m x -> r)+    -> ScanM m a b+    -> r+impurely_ f (ScanM step begin) = f (\s a -> swap <$> runStateT (step a) s) begin++{-| Generalize a `Scan` to a `ScanM`++> generalize (pure r) = pure r+>+> generalize (f <*> x) = generalize f <*> generalize x+-}+generalize :: Monad m => Scan a b -> ScanM m a b+generalize (Scan step begin) = hoists+  (\(Identity c) -> pure c)+  (ScanM step (Identity begin))+{-# INLINABLE generalize #-}++{-| Simplify a pure `ScanM` to a `Scan`++> simplify (pure r) = pure r+>+> simplify (f <*> x) = simplify f <*> simplify x+-}+simplify :: ScanM Identity a b -> Scan a b+simplify (ScanM step (Identity begin)) = Scan step begin+{-# INLINABLE simplify #-}++{- | Shift a 'ScanM' from one monad to another with a morphism such as 'lift' or 'liftIO';+     the effect is the same as 'Control.Monad.Morph.hoist'.+-}+hoists :: (forall x . m x -> n x) -> ScanM m a b -> ScanM n a b+hoists phi (ScanM step begin ) = ScanM+  (\a -> StateT $ phi . runStateT (step a))+  (phi begin)+{-# INLINABLE hoists #-}++{-| @(premap f scaner)@ returns a new 'Scan' where f is applied at each step++> scan (premap f scaner) list = scan scaner (map f list)++> premap id = id+>+> premap (f . g) = premap g . premap f++> premap k (pure r) = pure r+>+> premap k (f <*> x) = premap k f <*> premap k x+-}+premap :: (a -> b) -> Scan b r -> Scan a r+premap f (Scan step begin) = Scan (step . f) begin+{-# INLINABLE premap #-}++{-| @(premapM f scaner)@ returns a new 'ScanM' where f is applied to each input+    element++> premapM return = id+>+> premapM (f <=< g) = premap g . premap f++> premapM k (pure r) = pure r+>+> premapM k (f <*> x) = premapM k f <*> premapM k x+-}+premapM :: Monad m => (a -> m b) -> ScanM m b r -> ScanM m a r+premapM f (ScanM step begin) = ScanM (step <=< lift . f) begin+{-# INLINABLE premapM #-}