foldl 1.0.0 → 1.0.1
raw patch · 5 files changed
+495/−35 lines, 5 filesdep +bytestringdep +textdep ~base
Dependencies added: bytestring, text
Dependency ranges changed: base
Files
- foldl.cabal +12/−4
- src/Control/Foldl.hs +90/−31
- src/Control/Foldl/ByteString.hs +181/−0
- src/Control/Foldl/Internal.hs +36/−0
- src/Control/Foldl/Text.hs +176/−0
foldl.cabal view
@@ -1,5 +1,5 @@ Name: foldl-Version: 1.0.0+Version: 1.0.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-Bug-Reports: https://github.com/Gabriel439/Haskell-Fold-Library/issues+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 memory, and you can combine folds using @Applicative@ style to derive new@@ -20,6 +20,14 @@ Library HS-Source-Dirs: src- Build-Depends: base >= 4 && < 5- Exposed-Modules: Control.Foldl+ Build-Depends:+ base >= 4 && < 5 ,+ bytestring >= 0.9.2.1 && < 0.11,+ text >= 0.11.2.0 && < 1.1+ Exposed-Modules:+ Control.Foldl,+ Control.Foldl.ByteString,+ Control.Foldl.Text+ Other-Modules:+ Control.Foldl.Internal GHC-Options: -O2 -Wall
src/Control/Foldl.hs view
@@ -32,16 +32,21 @@ > L.Foldl step begin done -> ... -} -{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ExistentialQuantification, RankNTypes #-} -module Control.Foldl- ( -- * Fold Types+module Control.Foldl (+ -- * Fold Types Fold(..) , fold , FoldM(..) , foldM - -- * Folds+ -- * Utilities+ -- $utilities+ , purely+ , impurely++ -- * Folds , mconcat , foldMap , head@@ -63,12 +68,19 @@ , elemIndex , findIndex - -- * Generic Folds+ -- * Generic Folds , genericLength , genericIndex++ -- * Re-exports+ -- $reexports+ , module Data.Foldable ) where -import Control.Applicative (Applicative(pure, (<*>)))+import Control.Applicative (Applicative(pure, (<*>)),liftA2)+import Control.Foldl.Internal (Maybe'(..), lazy, Either'(..), hush)+import Data.Foldable (Foldable)+import qualified Data.Foldable as F import Data.Monoid (Monoid(mempty, mappend)) import Prelude hiding ( head@@ -95,9 +107,13 @@ -} data Fold a b = forall x . Fold (x -> a -> x) x (x -> b) --- | Apply a strict left 'Fold' to a list and extract the final result-fold :: Fold a b -> [a] -> b-fold (Fold step begin done) as = done (foldr step' id as begin)+{-| Apply a strict left 'Fold' to a 'Foldable' container++ Much slower than 'fold' on lists because 'Foldable' operations currently do+ not trigger @build/foldr@ fusion+-}+fold :: (Foldable f) => Fold a b -> f a -> b+fold (Fold step begin done) as = F.foldr step' done as begin where step' x k z = k $! step z x {-# INLINE fold #-}@@ -118,6 +134,12 @@ in Fold step begin done {-# INLINABLE (<*>) #-} +instance Monoid b => Monoid (Fold a b) where+ mempty = pure mempty+ {-# INLINABLE mempty #-}+ mappend = liftA2 mappend+ {-# INLINABLE mappend #-}+ -- | Like 'Fold', but monadic data FoldM m a b = forall x . FoldM (x -> a -> m x) (m x) (x -> m b) @@ -148,18 +170,58 @@ in FoldM step begin done {-# INLINABLE (<*>) #-} +instance (Monoid b, Monad m) => Monoid (FoldM m a b) where+ mempty = pure mempty+ {-# INLINABLE mempty #-}+ mappend = liftA2 mappend+ {-# INLINABLE mappend #-}+ -- | Like 'fold', but monadic-foldM :: (Monad m) => FoldM m a b -> [a] -> m b+foldM :: (Foldable f, Monad m) => FoldM m a b -> f a -> m b foldM (FoldM step begin done) as0 = do- x <- begin- loop as0 $! x+ x0 <- begin+ F.foldr step' done as0 $! x0 where- loop [] x = done x- loop (a:as) x = do+ step' a k x = do x' <- step x a- loop as $! x'-{-# INLINABLE foldM #-}+ k $! x'+{-# INLINE foldM #-} +{- $utilities+ 'purely' and 'impurely' allow you to write folds compatible with the @foldl@+ library without incurring a @foldl@ dependency. Write your fold to accept+ three parameters corresponding to the step function, initial+ accumulator, and extraction function and then users can upgrade your+ function to accept a 'Fold' or 'FoldM' using the 'purely' or 'impurely'+ combinators.++ For example, the @pipes@ library implements a @foldM@ function in+ @Pipes.Prelude@ with the following type:++> foldM+> :: (Monad m)+> => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m () -> m b++ @foldM@ is set up so that you can wrap it with 'impurely' to accept a+ 'FoldM' instead:++> impurely foldM :: (Monad m) => FoldM m a b -> Producer a m () -> m b+-}++-- | Upgrade a fold to accept the 'Fold' type+purely :: (forall x . (x -> a -> x) -> x -> (x -> b) -> r) -> Fold a b -> r+purely f (Fold step begin done) = f step begin done+{-# INLINABLE purely #-}++-- | Upgrade a monadic fold to accept the 'FoldM' type+impurely+ :: (Monad m)+ => (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+{-# INLINABLE impurely #-}+ -- | Fold all values within a container using 'mappend' and 'mempty' mconcat :: (Monoid a) => Fold a a mconcat = Fold mappend mempty id@@ -170,12 +232,6 @@ foldMap to from = Fold (\x a -> mappend x (to a)) mempty from {-# INLINABLE foldMap #-} -data Maybe' a = Just' !a | Nothing'--lazy :: Maybe' a -> Maybe a-lazy Nothing' = Nothing-lazy (Just' a') = Just a'- {-| Get the first element of a container or return 'Nothing' if the container is empty -}@@ -226,7 +282,7 @@ all predicate = Fold (\x a -> x && predicate a) True id {-# INLINABLE all #-} -{-| @(any predicate)@ returns 'True' is any element satisfies the predicate,+{-| @(any predicate)@ returns 'True' if any element satisfies the predicate, 'False' otherwise -} any :: (a -> Bool) -> Fold a Bool@@ -286,8 +342,6 @@ _ -> x {-# INLINABLE find #-} -data Either' a b = Left' !a | Right' !b- {-| @(index n)@ returns the @n@th element of the container, or 'Nothing' if the container has an insufficient number of elements -}@@ -306,13 +360,14 @@ satisfies the predicate, or 'Nothing' if no element satisfies the predicate -} findIndex :: (a -> Bool) -> Fold a (Maybe Int)-findIndex predicate = Fold step (Pair 0 False) done+findIndex predicate = Fold step (Left' 0) hush where- step x@(Pair i b) a =- if b then x- else if (predicate a) then Pair i True- else Pair (i + 1) False- done (Pair i b) = if b then Just i else Nothing+ step x a = case x of+ Left' i ->+ if predicate a+ then Right' i+ else Left' (i + 1)+ _ -> x {-# INLINABLE findIndex #-} -- | Like 'length', except with a more general 'Num' return value@@ -331,3 +386,7 @@ Left' _ -> Nothing Right' a -> Just a {-# INLINABLE genericIndex #-}++{- $reexports+ @Data.Foldable@ re-exports the 'Foldable' type+-}
+ src/Control/Foldl/ByteString.hs view
@@ -0,0 +1,181 @@+-- | Folds for byte streams++module Control.Foldl.ByteString (+ -- * Folds+ head+ , last+ , null+ , length+ , any+ , all+ , maximum+ , minimum+ , elem+ , notElem+ , find+ , index+ , elemIndex+ , findIndex++ -- * Re-exports+ -- $reexports+ , module Control.Foldl+ , module Data.ByteString+ , module Data.Word+ ) where++import Control.Foldl (Fold)+import Control.Foldl.Internal (Maybe'(..), lazy, strict, Either'(..), hush)+import qualified Control.Foldl as L+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as BU+import Data.Word (Word8)+import Prelude hiding (+ head, last, null, length, any, all, maximum, minimum, elem, notElem )++{-| Get the first byte of a byte stream or return 'Nothing' if the stream is+ empty+-}+head :: Fold ByteString (Maybe Word8)+head = L.Fold step Nothing' lazy+ where+ step mw8 bs =+ if B.null bs+ then mw8+ else case mw8 of+ Just' _ -> mw8+ Nothing' -> Just' (BU.unsafeHead bs)+{-# INLINABLE head #-}++{-| Get the last byte of a byte stream or return 'Nothing' if the byte stream is+ empty+-}+last :: Fold ByteString (Maybe Word8)+last = L.Fold step Nothing' lazy+ where+ step mw8 bs =+ if B.null bs+ then mw8+ else Just' (B.last bs)+ -- TODO: Use `unsafeLast` when Debian Stable Haskell Platform has it+{-# INLINABLE last #-}++-- | Returns 'True' if the byte stream is empty, 'False' otherwise+null :: Fold ByteString Bool+null = L.Fold step True id+ where+ step isNull bs = isNull && B.null bs+{-# INLINABLE null #-}++-- | Return the length of the byte stream in bytes+length :: (Num n) => Fold ByteString n+length = L.Fold (\n bs -> n + fromIntegral (B.length bs)) 0 id+{-# INLINABLE length #-}++{-| @(all predicate)@ returns 'True' if all bytes satisfy the predicate, 'False'+ otherwise+-}+all :: (Word8 -> Bool) -> Fold ByteString Bool+all predicate = L.Fold (\b bs -> b && B.all predicate bs) True id+{-# INLINABLE all #-}++{-| @(any predicate)@ returns 'True' if any byte satisfies the predicate,+ 'False' otherwise+-}+any :: (Word8 -> Bool) -> Fold ByteString Bool+any predicate = L.Fold (\b bs -> b || B.any predicate bs) False id+{-# INLINABLE any #-}++-- | Computes the maximum byte+maximum :: Fold ByteString (Maybe Word8)+maximum = L.Fold step Nothing' lazy+ where+ step mw8 bs =+ if B.null bs+ then mw8+ else Just' (case mw8 of+ Nothing' -> B.maximum bs+ Just' w8 -> max w8 (B.maximum bs) )+{-# INLINABLE maximum #-}++-- | Computes the minimum byte+minimum :: Fold ByteString (Maybe Word8)+minimum = L.Fold step Nothing' lazy+ where+ step mw8 bs =+ if B.null bs+ then mw8+ else Just' (case mw8 of+ Nothing' -> B.minimum bs+ Just' w8 -> min w8 (B.minimum bs) )+{-# INLINABLE minimum #-}++{-| @(elem w8)@ returns 'True' if the byte stream has a byte equal to @w8@,+ 'False' otherwise+-}+elem :: Word8 -> Fold ByteString Bool+elem w8 = any (w8 ==)+{-# INLINABLE elem #-}++{-| @(notElem w8)@ returns 'False' if the byte stream has a byte equal to @w8@,+ 'True' otherwise+-}+notElem :: Word8 -> Fold ByteString Bool+notElem w8 = all (w8 /=)+{-# INLINABLE notElem #-}++{-| @(find predicate)@ returns the first byte that satisfies the predicate or+ 'Nothing' if no byte satisfies the predicate+-}+find :: (Word8 -> Bool) -> Fold ByteString (Maybe Word8)+find predicate = L.Fold step Nothing' lazy+ where+ step mw8 bs = case mw8 of+ Nothing' -> strict (B.find predicate bs)+ Just' _ -> mw8+{-# INLINABLE find #-}++{-| @(index n)@ returns the @n@th byte of the byte stream, or 'Nothing' if the+ stream has an insufficient number of bytes+-}+index :: (Integral n) => n -> Fold ByteString (Maybe Word8)+index i = L.Fold step (Left' (fromIntegral i)) hush+ where+ step x bs = case x of+ Left' remainder ->+ let len = B.length bs+ in if remainder < len+ then Right' (BU.unsafeIndex bs remainder)+ else Left' (remainder - len)+ _ -> x+{-# INLINABLE index #-}++{-| @(elemIndex w8)@ returns the index of the first byte that equals @w8@, or+ 'Nothing' if no byte matches+-}+elemIndex :: (Num n) => Word8 -> Fold ByteString (Maybe n)+elemIndex w8 = findIndex (w8 ==)+{-# INLINABLE elemIndex #-}++{-| @(findIndex predicate)@ returns the index of the first byte that satisfies+ the predicate, or 'Nothing' if no byte satisfies the predicate+-}+findIndex :: (Num n) => (Word8 -> Bool) -> Fold ByteString (Maybe n)+findIndex predicate = L.Fold step (Left' 0) hush+ where+ step x bs = case x of+ Left' m -> case B.findIndex predicate bs of+ Nothing -> Left' (m + fromIntegral (B.length bs))+ Just n -> Right' (m + fromIntegral n)+ _ -> x+{-# INLINABLE findIndex #-}++{- $reexports++ "Control.Foldl" re-exports the 'Fold' type++ @Data.ByteString@ re-exports the 'ByteString' type++ @Data.Word@ re-exports the 'Word8' type+-}
+ src/Control/Foldl/Internal.hs view
@@ -0,0 +1,36 @@+-- | Strict data types for use as internal accumulators that don't space leak++module Control.Foldl.Internal (+ -- * Strict maybe+ Maybe'(..)+ , lazy+ , strict++ -- * Strict Either+ , Either'(..)+ , hush+ ) where++-- | A strict 'Maybe'+data Maybe' a = Just' !a | Nothing'++-- | Convert 'Maybe'' to 'Maybe'+lazy :: Maybe' a -> Maybe a+lazy Nothing' = Nothing+lazy (Just' a) = Just a+{-# INLINABLE lazy #-}++-- | Convert 'Maybe' to 'Maybe''+strict :: Maybe a -> Maybe' a+strict Nothing = Nothing'+strict (Just a ) = Just' a+{-# INLINABLE strict #-}++-- | A strict 'Either'+data Either' a b = Left' !a | Right' !b++-- | Convert 'Either'' to 'Maybe'+hush :: Either' a b -> Maybe b+hush (Left' _) = Nothing+hush (Right' b) = Just b+{-# INLINABLE hush #-}
+ src/Control/Foldl/Text.hs view
@@ -0,0 +1,176 @@+-- | Folds for text streams++module Control.Foldl.Text (+ -- * Folds+ head+ , last+ , null+ , length+ , any+ , all+ , maximum+ , minimum+ , elem+ , notElem+ , find+ , index+ , elemIndex+ , findIndex++ -- * Re-exports+ -- $reexports+ , module Control.Foldl+ , module Data.Text+ ) where++import Control.Foldl (Fold)+import Control.Foldl.Internal (Maybe'(..), lazy, strict, Either'(..), hush)+import qualified Control.Foldl as L+import Data.Text (Text)+import qualified Data.Text as T+import Prelude hiding (+ head, last, null, length, any, all, maximum, minimum, elem, notElem )++{-| Get the first character of a text stream or return 'Nothing' if the stream+ is empty+-}+head :: Fold Text (Maybe Char)+head = L.Fold step Nothing' lazy+ where+ step mc txt =+ if T.null txt+ then mc+ else case mc of+ Just' _ -> mc+ Nothing' -> Just' (T.head txt)+{-# INLINABLE head #-}++{-| Get the last character of a text stream or return 'Nothing' if the text+ stream is empty+-}+last :: Fold Text (Maybe Char)+last = L.Fold step Nothing' lazy+ where+ step mc txt =+ if T.null txt+ then mc+ else Just' (T.last txt)+ -- TODO: Use `unsafeLast` when Debian Stable Haskell Platform has it+{-# INLINABLE last #-}++-- | Returns 'True' if the text stream is empty, 'False' otherwise+null :: Fold Text Bool+null = L.Fold step True id+ where+ step isNull txt = isNull && T.null txt +{-# INLINABLE null #-}++-- | Return the length of the text stream in characters+length :: (Num n) => Fold Text n+length = L.Fold (\n txt -> n + fromIntegral (T.length txt)) 0 id+{-# INLINABLE length #-}++{-| @(all predicate)@ returns 'True' if all characters satisfy the predicate,+ 'False' otherwise+-}+all :: (Char -> Bool) -> Fold Text Bool+all predicate = L.Fold (\b txt -> b && T.all predicate txt) True id+{-# INLINABLE all #-}++{-| @(any predicate)@ returns 'True' if any character satisfies the predicate,+ 'False' otherwise+-}+any :: (Char -> Bool) -> Fold Text Bool+any predicate = L.Fold (\b txt -> b || T.any predicate txt) False id+{-# INLINABLE any #-}++-- | Computes the maximum character+maximum :: Fold Text (Maybe Char)+maximum = L.Fold step Nothing' lazy+ where+ step mc txt =+ if T.null txt+ then mc+ else Just' (case mc of+ Nothing' -> T.maximum txt+ Just' c -> max c (T.maximum txt) )+{-# INLINABLE maximum #-}++-- | Computes the minimum character+minimum :: Fold Text (Maybe Char)+minimum = L.Fold step Nothing' lazy+ where+ step mc txt =+ if T.null txt+ then mc+ else Just' (case mc of+ Nothing' -> T.minimum txt+ Just' c -> min c (T.minimum txt) )+{-# INLINABLE minimum #-}++{-| @(elem c)@ returns 'True' if the text stream has a character equal to @c@,+ 'False' otherwise+-}+elem :: Char -> Fold Text Bool+elem c = any (c ==)+{-# INLINABLE elem #-}++{-| @(notElem c)@ returns 'False' if the text stream has a character equal to+ @c@, 'True' otherwise+-}+notElem :: Char -> Fold Text Bool+notElem c = all (c /=)+{-# INLINABLE notElem #-}++{-| @(find predicate)@ returns the first character that satisfies the predicate+ or 'Nothing' if no character satisfies the predicate+-}+find :: (Char -> Bool) -> Fold Text (Maybe Char)+find predicate = L.Fold step Nothing' lazy+ where+ step mc txt = case mc of+ Nothing' -> strict (T.find predicate txt)+ Just' _ -> mc+{-# INLINABLE find #-}++{-| @(index n)@ returns the @n@th character of the text stream, or 'Nothing' if+ the stream has an insufficient number of characters+-}+index :: (Integral n) => n -> Fold Text (Maybe Char)+index i = L.Fold step (Left' (fromIntegral i)) hush+ where+ step x txt = case x of+ Left' remainder ->+ let len = T.length txt+ in if remainder < len+ then Right' (T.index txt remainder)+ else Left' (remainder - len)+ _ -> x+{-# INLINABLE index #-}++{-| @(elemIndex c)@ returns the index of the first character that equals @c@,+ or 'Nothing' if no character matches+-}+elemIndex :: (Num n) => Char -> Fold Text (Maybe n)+elemIndex c = findIndex (c ==)+{-# INLINABLE elemIndex #-}++{-| @(findIndex predicate)@ returns the index of the first character that+ satisfies the predicate, or 'Nothing' if no character satisfies the+ predicate+-}+findIndex :: (Num n) => (Char -> Bool) -> Fold Text (Maybe n)+findIndex predicate = L.Fold step (Left' 0) hush+ where+ step x txt = case x of+ Left' m -> case T.findIndex predicate txt of+ Nothing -> Left' (m + fromIntegral (T.length txt))+ Just n -> Right' (m + fromIntegral n)+ _ -> x+{-# INLINABLE findIndex #-}++{- $reexports+ "Control.Foldl" re-exports the 'Fold' type++ @Data.Text@ re-exports the 'Text' type+-}