foldl-transduce 0.4.6.0 → 0.4.7.0

raw patch · 5 files changed

+178/−19 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +5/−0
• foldl-transduce.cabal +1/−1
• src/Control/Foldl/Transduce/Text.hs +151/−16
• src/Control/Foldl/Transduce/Textual.hs +1/−1
• tests/tests.hs +20/−1

@@ -1,3 +1,8 @@+# 0.4.7.0++- Added "sections" splitter.+- Deprecated Control.Foldl.Transduce.Textual+ # 0.4.6.0  - Deprecated Control.Foldl.Transduce.ByteString.IO 

@@ -1,5 +1,5 @@ Name: foldl-transduce-Version: 0.4.6.0+Version: 0.4.7.0 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3

@@ -21,26 +21,32 @@     ,   words     ,   lines     ,   paragraphs-        -- * Re-exports-        -- $reexports-    ,   module Control.Foldl.Transduce.Textual+    ,   sections+        -- * Textual+        -- $textual+    ,   textualSplit+    ,   textualBreak     ) where  import Prelude hiding (lines,words) import Data.Char-import Data.Monoid (mempty)+import Data.Bool+import Data.Maybe+import Data.List (unfoldr)+import Data.Monoid (mempty,(<>)) import Data.Foldable (foldMap,foldl') import qualified Data.ByteString as B import qualified Data.Text  import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T+import qualified Data.Monoid.Textual as MT+import qualified Data.Monoid.Null as MN import Control.Applicative import Control.Monad.Trans.Except 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(..)) import qualified Data.List import Data.List.Split@@ -337,7 +343,7 @@                 (SkippingAfterStreamStart, False) ->                      (,)                     SkippingAfterNewline-                    (prepend ["\n",T.stripStart i] outputs) +                    (continue ["\n",T.stripStart i] outputs)                  (SkippingAfterNewline, True) ->                      (,)                      SkippingAfterBlankLine @@ -345,7 +351,7 @@                 (SkippingAfterNewline, False) ->                      (,)                     SkippingAfterNewline-                    (prepend ["\n",T.stripStart i] outputs)+                    (continue ["\n",T.stripStart i] outputs)                 (SkippingAfterBlankLine, True) ->                      (,)                      SkippingAfterBlankLine @@ -353,11 +359,11 @@                 (SkippingAfterBlankLine, False) ->                      (,)                     SkippingAfterNewline-                    (prepend ["\n",T.stripStart i] (NonEmpty.cons [] outputs)) +                    (continue ["\n",T.stripStart i] (NonEmpty.cons [] outputs))                  (ContinuingNonemptyLine, _) ->                      (,)                     SkippingAfterNewline-                    (prepend ["\n",i] outputs)+                    (continue ["\n",i] outputs)         advanceLast                  :: (ParagraphsState, NonEmpty [T.Text])                  -> T.Text @@ -371,7 +377,7 @@                 (SkippingAfterStreamStart, False) ->                      (,)                     ContinuingNonemptyLine-                    (prepend [T.stripStart i] outputs)+                    (continue [T.stripStart i] outputs)                 (SkippingAfterNewline, True) ->                      (,)                      SkippingAfterNewline @@ -379,7 +385,7 @@                 (SkippingAfterNewline, False) ->                      (,)                     ContinuingNonemptyLine-                    (prepend [T.stripStart i] outputs)+                    (continue [T.stripStart i] outputs)                 (SkippingAfterBlankLine, True) ->                      (,)                     SkippingAfterBlankLine@@ -387,16 +393,145 @@                 (SkippingAfterBlankLine, False) ->                      (,)                     ContinuingNonemptyLine-                    (prepend [T.stripStart i] (NonEmpty.cons [] outputs))+                    (continue [T.stripStart i] (NonEmpty.cons [] outputs))                 (ContinuingNonemptyLine, _) ->                      (,)                     ContinuingNonemptyLine-                    (prepend [i] outputs)-        prepend :: [a] -> NonEmpty [a] -> NonEmpty [a]-        prepend as (as':| rest) = (as ++ as') :| rest+                    (continue [i] outputs) +{-| ++    Given a (possibly infinite) list of section headings, split the stream into+    sections and remove the headings. ++>>> map mconcat (L.fold (folds (sections (map T.pack ["#1\n","#2\n"])) L.list L.list) (map T.pack [" #1\naa\n#","2\nbb"]))+[" ","aa\n","bb"]++>>> map mconcat (L.fold (folds (sections (map T.pack ["1234"])) L.list L.list) (map T.pack [" 1","2","x","1","2","3","4","5"]))+[" 12x","5"]++    Used with 'L.transduce', it simply removes all headings.+-}+sections :: [T.Text] -> L.Transducer T.Text T.Text ()+sections seps = L.Transducer step (initialstate seps) done +    where+        step tstate txt =+            let (emitted,fmap snd -> states) = Data.List.unzip (unfoldWithState splitTextStep (txt,tstate))+                finalState = NonEmpty.last (tstate :| states)+                continuing :| following = NonEmpty.reverse (fmap Data.List.reverse (foldl' advance ([]:|[]) emitted))+            in (finalState, continuing, following)                        +        advance :: NonEmpty [x] -> ([x],Bool) -> NonEmpty [x]+        advance l (e,b) = bool id (separate []) b (continue e l)+        done Done = +            ((),[],[])+        done (Pending acc _ _) =+            ((),[acc],[])    +        initialstate [] = Done+        initialstate (x:xs) = Pending T.empty x xs+++continue :: [a] -> NonEmpty [a] -> NonEmpty [a]+continue as (as':| rest) = (as ++ as') :| rest++separate :: [x] -> NonEmpty [x] -> NonEmpty [x]+separate = NonEmpty.cons++data SectionsState = +      Done+    | Pending T.Text T.Text [T.Text] -- first is the accumulator+    deriving (Show)++{-| 		++>>> splitTextStep (T.pack "x",Done)+Just ((["x"],False),("",Done))++>>> splitTextStep (T.pack "aabbcc",Pending T.empty (T.pack "bb") [])+Just ((["aa"],True),("cc",Done))++>>> splitTextStep (T.pack "cc",Pending (T.pack "bb") (T.pack "bbcc") [T.pack "nextsep"])+Just (([""],True),("",Pending "" "nextsep" []))++>>> splitTextStep (T.pack "xx",Pending (T.pack "bb") (T.pack "bbcc") [])+Just ((["bbxx"],False),("",Pending "" "bbcc" []))++>>> splitTextStep (T.pack "xbb",Pending (T.pack "bbc") (T.pack "bbcccc") [])+Just ((["bbcx"],False),("",Pending "bb" "bbcccc" []))++-}+splitTextStep +    :: (T.Text, SectionsState) +    -> Maybe (([T.Text],Bool), (T.Text, SectionsState))+splitTextStep (txt, _) | T.null txt           = Nothing+splitTextStep (txt, Done)                     = Just (([txt],False),(T.empty,Done))+splitTextStep (txt, Pending acc sep nextseps) = Just $+    let (before,after) = T.breakOn sep (acc <> txt)+    in+    if T.null after +       then -- not present+          let (m0,m) = maxintersect before sep+          in+          (([m0],False),(T.empty, Pending m sep nextseps))+       else -- present+          let unprefixed = T.drop (T.length sep) after+              nextstate = case nextseps of+                  [] -> Done+                  z:zs -> Pending T.empty z zs+          in+          (([before],True),(unprefixed,nextstate))+                               +maxintersect :: T.Text -> T.Text -> (T.Text,T.Text)+maxintersect txt sep = +    let prefixes = (tail . reverse . tail . T.inits) sep +        partialmatches = filter (flip T.isSuffixOf txt) prefixes+        m = maybe T.empty id (listToMaybe partialmatches)+    in+    (T.take (T.length txt - T.length m) txt,m)+        +unfoldWithState :: (b -> Maybe (a, b)) -> b -> [(a, b)]+unfoldWithState f = unfoldr (fmap (\t@(_, b) -> (t, b)) . f)+ ------------------------------------------------------------------------------ -{- $reexports+{- $textual +    Transducers that work on 'Text' and other text-like types.+ -}++{-| ++>>> L.fold (folds (textualSplit (=='.')) L.list L.list) [".","bb.bb","c.c."]+[[""],["","bb"],["bb","c"],["c"],[""]]++-}++textualSplit :: MT.TextualMonoid m => (Char -> Bool) -> L.Transducer m m ()+textualSplit predicate = L.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 (textualBreak (=='.')) (reify id) ignore L.list) ["aa","bb.bb","cc"]+["aa","bb"]+-}+textualBreak :: MT.TextualMonoid m => (Char -> Bool) -> L.Transducer m m ()+textualBreak predicate = +    L.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

@@ -3,7 +3,7 @@ -- | -- -- This module has transducers that work on 'Text' and other text-like types.-module Control.Foldl.Transduce.Textual (+module Control.Foldl.Transduce.Textual {-# DEPRECATED "Use Control.Foldl.Transduce.Text instead." #-} (         -- * Splitters         textualSplit     ,   textualBreak

@@ -18,7 +18,6 @@ import qualified Control.Foldl as L import Control.Foldl.Transduce import Control.Foldl.Transduce.Text-import Control.Foldl.Transduce.Textual  {- $quickcheck @@ -132,6 +131,11 @@ paragraphsUnderTest txt =     map mconcat (L.fold (folds paragraphs L.list L.list) txt) +sectionsUnderTest+    :: [T.Text] -> [T.Text] -> [T.Text] +sectionsUnderTest stns txt =+    map mconcat (L.fold (folds (sections stns) L.list L.list) txt)+ paragraph01 :: T.Text paragraph01 =      T.pack @@ -220,6 +224,21 @@                         ==                         ignoreLastNewline (paragraphsBaseline (mconcat chunks)))             ]+        ],+        testGroup "sections"+        [+            testCaseEq "no separators at all"+                (map T.pack ["aaabbcc"])+                (sectionsUnderTest (map T.pack []) (map T.pack ["a","aa","bbc","c"])),+            testCaseEq "incomplete separator"+                (map T.pack ["123#_","aa","bb#"])+                (sectionsUnderTest (map T.pack ["1234","#"]) (map T.pack ["1","23","#_1234aa#b","b#"])),+            testCaseEq "small chunks"+                (map T.pack ["0","01","aa","a#bb","c"])+                (sectionsUnderTest (map T.pack ["_","_","##","##","##"]) (map T.pack ["0","_","0","1_","a","a","#","#a","#","b","b#","#","c"])),+            testCaseEq "big chunk with multiple seps"+                (map T.pack ["1x","aa","bb","cc1x","dd"])+                (sectionsUnderTest (map T.pack (cycle ["12"])) (map T.pack ["1","x12aa12bb12cc1","x1","2dd"]))         ],         testGroup "quiesceWith"           [