foldl-transduce 0.4.1.0 → 0.4.2.0

raw patch · 7 files changed

+103/−6 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +5/−1
• foldl-transduce.cabal +2/−1
• src/Control/Foldl/Transduce.hs +12/−4
• src/Control/Foldl/Transduce/Text.hs +9/−0
• src/Control/Foldl/Transduce/Textual.hs +60/−0
• tests/doctests.hs +1/−0
• tests/tests.hs +14/−0

@@ -1,8 +1,12 @@+# 0.4.2.0++- Added "trip" fold.+- Added Control.Foldl.Transduce.Textual.+ # 0.4.1.0  - Added module Control.Foldl.Transduce.ByteString.IO, to   avoid having to depend on other packages for simple I/O tasks.- - Added "unit" fold.  # 0.4.0.0

@@ -1,5 +1,5 @@ Name: foldl-transduce-Version: 0.4.1.0+Version: 0.4.2.0 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3@@ -37,6 +37,7 @@     Exposed-Modules:         Control.Foldl.Transduce,         Control.Foldl.Transduce.Text,+        Control.Foldl.Transduce.Textual,         Control.Foldl.Transduce.ByteString.IO,         Control.Foldl.Transduce.Internal     GHC-Options: -O2 -Wall

@@ -75,6 +75,7 @@     ,   quiesceWith     ,   hoistFold     ,   unit+    ,   trip     ,   ToFold(..)     ,   ToFoldM(..)         -- * Re-exports@@ -578,6 +579,13 @@ unit :: Fold a () unit = pure ()  +{-| A fold that fails if it receives any input at all. The received input is+    used as the error.		++-}+trip :: Monad m => FoldM (ExceptT a m) a ()+trip = FoldM (\_ x -> throwE x) (return ()) (\_ -> return mempty)+ ------------------------------------------------------------------------------  {-| An unending machine that eats @u@ values and returns @@ -658,7 +666,7 @@        -> t b c () -- ^ infinite list of transductions        -> Transduction a c  groups splitter transductions oldfold = -        fmap snd (groups' splitter transductions L.mconcat oldfold)+        fmap snd (groups' splitter transductions unit oldfold)  {-| Use a different 'Transduction' for the first detected group.		 @@ -743,7 +751,7 @@                -> t b c ()                -> TransductionM m a c groupsM splitter transductions oldfold = -        fmap snd (groupsM' splitter transductions L.mconcat oldfold)+        fmap snd (groupsM' splitter transductions unit oldfold)   {-| Monadic version of 'bisect'.		@@ -828,7 +836,7 @@        -> f b c         -> Transduction' a c s folds' splitter (toFold -> innerfold) somefold = -    fmap (bimap fst id) (groups' splitter innertrans L.mconcat somefold)+    fmap (bimap fst id) (groups' splitter innertrans unit somefold)     where     innertrans = reify' $ \x -> fmap ((,) ()) (transduce (condense innerfold) x) @@ -849,7 +857,7 @@         -> f b c          -> TransductionM' m a c s foldsM' splitter (toFoldM -> innerfold) somefold = -    fmap (bimap fst id) (groupsM' splitter innertrans L.mconcat somefold)+    fmap (bimap fst id) (groupsM' splitter innertrans unit somefold)     where     innertrans = reifyM' $ \x -> fmap ((,) ()) (transduceM (condenseM innerfold) x) 

@@ -19,6 +19,9 @@         -- * Splitters     ,   lines     ,   words+        -- * Re-exports+        -- $reexports+    ,   module Control.Foldl.Transduce.Textual     ) where  import Prelude hiding (lines,words)@@ -35,6 +38,7 @@ import Control.Monad.IO.Class import Control.Exception.Base  import qualified Control.Foldl.Transduce as L+import Control.Foldl.Transduce.Textual import Control.Foldl.Transduce.Internal (Pair(..))  {- $setup@@ -271,3 +275,8 @@                 in (nextstate,oldgroup,newgroups)         done _ = ((),[],[]) +------------------------------------------------------------------------------++{- $reexports++-}

@@ -0,0 +1,60 @@+{-# LANGUAGE ViewPatterns #-}++-- |+--+-- This module has transducers that work on 'Text' and other text-like types.+module Control.Foldl.Transduce.Textual (+        textualSplit+    ,   textualSplitWhen+    ) where++import Data.Monoid (mempty)+import qualified Data.Monoid.Textual as MT+import qualified Data.Monoid.Null as MN+import Control.Foldl.Transduce+++{- $setup++>>> import Control.Applicative+>>> import qualified Control.Foldl as L+>>> import Control.Foldl.Transduce++-}++{-| ++>>> L.fold (folds (textualSplit (=='.')) L.list L.list) [".","bb.bb","c.c."]+[[""],["","bb"],["bb","c"],["c"],[""]]+-}+textualSplit :: MT.TextualMonoid m => (Char -> Bool) -> Transducer m m ()+textualSplit predicate = Transducer step () done +  where+    step _ txt = case MT.split predicate txt of+        x:xs -> ((),[x],map (:[]) xs)+        _ -> error "never happens"+    done _ = mempty+++data SplitWhenWhenState = +      SplitWhenConditionEncountered +    | SplitWhenConditionPending+++{-| 		++>>> L.fold (bisect (textualSplitWhen (=='.')) (reify id) ignore L.list) ["aa","bb.bb","cc"]+["aa","bb"]+-}+textualSplitWhen :: MT.TextualMonoid m => (Char -> Bool) -> Transducer m m ()+textualSplitWhen predicate = +    Transducer step SplitWhenConditionPending done +    where+        step SplitWhenConditionPending (MT.break (const False) predicate -> (i0,i1)) = +            if MN.null i1+               then (SplitWhenConditionPending,[i0],[])+               else (SplitWhenConditionEncountered,[i0],[[i1]])+        step SplitWhenConditionEncountered i = +               (SplitWhenConditionEncountered,[i],[])+        done = mempty+

@@ -6,5 +6,6 @@ main = doctest      [         "src/Control/Foldl/Transduce.hs",+        "src/Control/Foldl/Transduce/Textual.hs",         "src/Control/Foldl/Transduce/Text.hs"     ]

@@ -13,6 +13,7 @@ import qualified Control.Foldl as L import Control.Foldl.Transduce import Control.Foldl.Transduce.Text+import Control.Foldl.Transduce.Textual  main :: IO () main = defaultMain tests@@ -46,6 +47,19 @@                     ([[1,2,3],[4,5,6],[7]]::[[Int]])                     (L.fold (folds (chunksOf 3) L.list L.list) [1..7])         ]+        ,+        testGroup "textualSplitWhen" $ +        [+            testCase "beginwithdot" $+                assertEqual mempty+                    ".bb"+                    (L.fold (bisect (textualSplitWhen (=='.')) ignore (reify id) L.mconcat) ["aa",".bb"])+            ,+            testCase "endwithdot" $+                assertEqual mempty+                    "."+                    (L.fold (bisect (textualSplitWhen (=='.')) ignore (reify id) L.mconcat) ["aa","bb."])+        ]            ,         testGroup "newline" $          [