packages feed

foldl-transduce-attoparsec (empty) → 0.1.0.0

raw patch · 8 files changed

+322/−0 lines, 8 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, doctest, foldl, foldl-transduce, foldl-transduce-attoparsec, monoid-subclasses, tasty, tasty-hunit, text, transformers

Files

+ CHANGELOG view
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2015, Daniel Díaz Carrete+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 foldl-transduce nor the names of its+  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 HOLDER 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.+
+ README.md view
@@ -0,0 +1,1 @@+Attoparsec and foldl-transduce integration.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ foldl-transduce-attoparsec.cabal view
@@ -0,0 +1,63 @@+Name: foldl-transduce-attoparsec+Version: 0.1.0.0+Cabal-Version: >=1.8.0.2+Build-Type: Simple+License: BSD3+License-File: LICENSE+Copyright: 2015 Daniel Diaz+Author: Daniel Diaz+Maintainer: diaz_carrete@yahoo.com+Bug-Reports: https://github.com/danidiaz/foldl-transduce-attoparsec/issues+Synopsis: Attoparsec and foldl-transduce integration.+Description: Attoparsec and foldl-transduce integration.+Category: Control++Extra-Source-Files:+    README.md+    CHANGELOG++Source-Repository head+    Type: git+    Location: git@github.com:danidiaz/foldl-transduce-attoparsec.git++Library+    HS-Source-Dirs: src+    Build-Depends:+        base >= 4 && < 5,+        bytestring    >= 0.9.2.1  && < 0.11,+        text          >= 0.11.2.0 && < 1.3 ,+        foldl-transduce == 0.4.*,+        attoparsec == 0.13.*,+        transformers  >= 0.2.0.0  && < 0.5 ,+        monoid-subclasses == 0.4.*+    Exposed-Modules:+        Control.Foldl.Transduce.Attoparsec+    GHC-Options: -O2 -Wall++test-suite tests+  type:           exitcode-stdio-1.0+  ghc-options:    -Wall -threaded+  hs-source-dirs: tests+  main-is:        tests.hs+  build-depends:+        base >= 4.4 && < 5  ,+        text                ,+        tasty >= 0.10.1.1   ,+        tasty-hunit >= 0.9.2,+        transformers  >= 0.4.0.0  && < 0.5,+        foldl               ,+        foldl-transduce     ,+        foldl-transduce-attoparsec,+        attoparsec    == 0.13.*++test-suite doctests+  type:           exitcode-stdio-1.0+  ghc-options:    -Wall -threaded+  hs-source-dirs: tests+  main-is:        doctests.hs++  build-depends:+        base          >= 4.4 && < 5,+        text          >= 0.11.2.0 && < 1.3,+        attoparsec    == 0.13.*,+        doctest       >= 0.10.1
+ src/Control/Foldl/Transduce/Attoparsec.hs view
@@ -0,0 +1,141 @@+module Control.Foldl.Transduce.Attoparsec (+        stripParse+    ,   parses+    ,   ParserInput+    ,   ParsingError+    ) where++import qualified Data.ByteString as B+import qualified Data.Text as T+import Data.Attoparsec.Types+import Data.Attoparsec.ByteString+import Data.Attoparsec.Text+import qualified Data.Monoid.Null as MN+import qualified Data.Monoid.Factorial as MF+import Control.Monad.Trans.Except++import Control.Foldl.Transduce++{- $setup++>>> import qualified Control.Foldl as L+>>> import qualified Data.Text as T+>>> import Control.Foldl.Transduce+>>> import Control.Foldl.Transduce.Attoparsec+>>> import qualified Data.Attoparsec.Text as A+>>> import Control.Applicative+>>> import Control.Monad.Trans.Except++-}++data StripState a b +    = Parsed b+    | Continue (a -> IResult a b)++{-| Strips from the stream the prefix that matches the parser.		++    The parsed value becomes the return value of the 'TransducerM'.+++>>> runExcept $ L.foldM (transduceM (stripParse (many (A.char 'a'))) (L.generalize L.mconcat)) (map T.pack ["aa","aa","bb"])+Right "bb"++>>> runExcept $ L.foldM (transduceM' (stripParse (many (A.char 'a'))) (L.generalize L.mconcat)) (map T.pack ["aa","aa","bb"])+Right ("aaaa","bb")++>>> runExcept $ L.foldM (transduceM' (stripParse (A.char 'z')) (L.generalize L.mconcat)) (map T.pack ["aa","aa","bb"])+Left ("aa",["'z'"],"Failed reading: satisfy")+-}+stripParse :: (ParserInput a,Monad m) +           => Data.Attoparsec.Types.Parser a b+           -> TransducerM (ExceptT (ParsingError a) m) a a b +stripParse atto = TransducerM step (initial (_parse atto mempty)) done+    where+    initial iresult = case iresult of+        Fail l es e -> throwE (l,es,e)+        Done _ r -> return (Parsed r) -- there can't be leftovers here!+        Partial c -> return (Continue c)++    step x i +        | MN.null i =+            return (x,[],[])+        | otherwise = case x of+            Parsed _ -> +                return (x,[i],[])+            Continue c -> +                case c i of+                    Fail l es e -> throwE (l,es,e)+                    Done l r -> return (Parsed r,[l],[]) +                    Partial c' -> return (Continue c',[],[])++    done x = case x of+        Parsed r -> return (r,[],[])+        Continue c -> case c mempty of+            Fail l es e -> throwE (l,es,e)+            Done l r -> return (r,[l],[]) +            Partial _ -> error "never happens"+++data ParsesState a b +    = BetweenParses+    | DuringParse (a -> IResult a b)++{-| Feeds a 'FoldM' with the results of repeatedly applying a parser.		+++>>> runExcept $ L.foldM (transduceM (parses (A.decimal <* A.char ' ')) (L.generalize L.list)) (map T.pack ["1 1","1 3 77 "])+Right [1,11,3,77]++-}+parses :: (ParserInput a,Monad m) +       => Data.Attoparsec.Types.Parser a b+       -> TransducerM (ExceptT (ParsingError a) m) a b ()+parses atto = TransducerM step (return BetweenParses) done+    where +    step x i = do+        (x',rs) <- step' [] x i+        return (x',reverse rs,[])+        +    step' acc xx i +        | MN.null i =+            return (xx,acc)+        | otherwise =+           case xx of+               BetweenParses -> case _parse atto mempty of+                   Fail l es e -> throwE (l,es,e)+                   Done _ _ -> throwE (mempty,[],"Parser doesn't consume!")+                   Partial c -> step' acc (DuringParse c) i++               DuringParse c -> case c i of +                   Fail l es e -> throwE (l,es,e)+                   Done l r -> step' (r:acc) BetweenParses l+                   Partial c' -> return (DuringParse c',acc)++    done x = case x of+        BetweenParses -> return mempty+        DuringParse c -> case c mempty of +            Fail l es e -> throwE (l,es,e)+            Done _ r -> return ((),[r],[]) -- there shouldn't be leftovers, I think.+            Partial _ -> error "never happens"++-- From the attoparsec docs:+-- http://hackage.haskell.org/package/attoparsec-0.13.0.1/docs/Data-Attoparsec-Text.html+-- "To indicate that you have no more input, supply the Partial continuation with an empty Text."++class (Eq a,MF.StableFactorialMonoid a) => ParserInput a where+    _parse :: Data.Attoparsec.Types.Parser a b -> a -> IResult a b++instance ParserInput B.ByteString where+    _parse  = Data.Attoparsec.ByteString.parse+    {-# INLINE _parse #-}++-- | Strict 'Text'.+instance ParserInput T.Text where+    _parse  = Data.Attoparsec.Text.parse+    {-# INLINE _parse #-}++{-| A triplet of (leftovers,error contexts,error message)++-}+type ParsingError a = (a,[String],String)+
+ tests/doctests.hs view
@@ -0,0 +1,9 @@+module Main where++import Test.DocTest++main :: IO ()+main = doctest +    [+        "src/Control/Foldl/Transduce/Attoparsec.hs"+    ]
+ tests/tests.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.Monoid+import Data.Bifunctor+import Data.Either+import Test.Tasty+import Test.Tasty.HUnit++import Control.Monad+import Control.Applicative+import Control.Monad.Trans.Except++import qualified Data.Text as T+import qualified Data.Attoparsec.Text as A++import qualified Control.Foldl as L+import Control.Foldl.Transduce+import Control.Foldl.Transduce.Attoparsec++++main :: IO ()+main = defaultMain tests++stripping :: A.Parser r -> [T.Text] -> Either (ParsingError T.Text) (r,T.Text)+stripping parser ts = +     runExcept (L.foldM (transduceM' (stripParse parser) (L.generalize L.mconcat)) ts)++parsing :: A.Parser r -> [T.Text] -> Either (ParsingError T.Text) [r]+parsing parser ts = +     runExcept (fmap snd (L.foldM (transduceM' (parses parser) (L.generalize L.list)) ts))++tests :: TestTree+tests = +    testGroup "Tests" +    [+        testGroup "stripPrefix" +        [ testCase "empty"  +              (assertEqual mempty+                  (Right ((),""))+                  (stripping (pure ()) [""]))+        , testCase "empty2"  +              (assertEqual mempty+                  (Right ([],""))+                  (stripping (many (A.char 'c')) [""]))+        , testCase "empty3"  +              (assertBool mempty+                  (isLeft (stripping (A.char 'c') [""])))+        , testCase "acrossChunks"  +              (assertEqual mempty+                  (Right (1111::Int,"aaabb"))+                  (stripping (A.skipSpace *> A.decimal) [" "," 11", "11aaa", "bb"]))+        , testCase "whole"  +              (assertEqual mempty+                  (Right ("cccc",""))+                  (stripping (many (A.char 'c')) ["cc","","cc"]))+        , testCase "atEnd"  +              (assertEqual mempty+                  (Right (1111::Int,""))+                  (stripping (A.skipSpace *> A.decimal) [" "," 11", "", "11"]))+        ]   +    ,   testGroup "parses" +        [ testCase "empty"  +              (assertEqual mempty+                  (Right ([]::[Int]))+                  (parsing (A.skipSpace *> A.decimal) []))+        , testCase "chunks"  +              (assertEqual mempty+                  (Right ([1,22,3,4,5]::[Int]))+                  (parsing (A.skipSpace *> A.decimal) [""," ","1 2","","2",""," 3 4 5"]))+        , testCase "whole"  +              (assertEqual mempty+                  (Right ([1111]::[Int]))+                  (parsing (A.skipSpace *> A.decimal) [" 1111"]))+        ]   +    ]