attoparsec-conduit 0.4.0.1 → 0.5.0

raw patch · 3 files changed

+184/−64 lines, 3 filesdep +attoparsec-conduitdep +resourcetdep −QuickCheckdep −blaze-builderdep ~attoparsecdep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: attoparsec-conduit, resourcet

Dependencies removed: QuickCheck, blaze-builder

Dependency ranges changed: attoparsec, base, bytestring, conduit, text, transformers

API changes (from Hackage documentation)

Files

• Data/Conduit/Attoparsec.hs +118/−30
• attoparsec-conduit.cabal +8/−8
• test/main.hs +58/−26

@@ -5,35 +5,62 @@ -- Copyright: 2011 Michael Snoyman, 2010 John Millikin -- License: MIT ----- Turn an Attoparsec parser into a 'C.Sink'.+-- Consume attoparsec parsers via conduit. -- -- This code was taken from attoparsec-enumerator and adapted for conduits. module Data.Conduit.Attoparsec-    ( ParseError (..)+    ( -- * Sink+      sinkParser+      -- * Conduit+    , conduitParser+      -- * Types+    , ParseError (..)+    , Position (..)+    , PositionRange (..)+      -- * Classes     , AttoparsecInput-    , sinkParser     ) where +import           Prelude hiding (lines) import           Control.Exception (Exception) import           Data.Typeable (Typeable) import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8 import qualified Data.Text as T-import Control.Monad.Trans.Class (lift)+import           Control.Monad.Trans.Class (lift)+import           Control.Monad (unless)  import qualified Data.Attoparsec.ByteString import qualified Data.Attoparsec.Text import qualified Data.Attoparsec.Types as A-import qualified Data.Conduit as C+import           Data.Conduit hiding (Pipe, Sink, Conduit, Source)  -- | The context and message from a 'A.Fail' value. data ParseError = ParseError     { errorContexts :: [String]-    , errorMessage :: String+    , errorMessage  :: String+    , errorPosition :: Position     } | DivergentParser     deriving (Show, Typeable)  instance Exception ParseError +data Position = Position+    { posLine :: Int+    , posCol  :: Int+    }+    deriving (Eq, Ord)+instance Show Position where+    show (Position l c) = show l ++ ':' : show c++data PositionRange = PositionRange+    { posRangeStart :: Position+    , posRangeEnd   :: Position+    }+    deriving (Eq, Ord)+instance Show PositionRange where+    show (PositionRange s e) = show s ++ '-' : show e+ -- | A class of types which may be consumed by an Attoparsec parser. class AttoparsecInput a where     parseA :: A.Parser a b -> a -> A.IResult a b@@ -41,6 +68,9 @@     empty :: a     isNull :: a -> Bool     notEmpty :: [a] -> [a]+    getLinesCols :: a -> (Int, Int)+    take' :: Int -> a -> a+    length' :: a -> Int  instance AttoparsecInput B.ByteString where     parseA = Data.Attoparsec.ByteString.parse@@ -48,6 +78,16 @@     empty = B.empty     isNull = B.null     notEmpty = filter (not . B.null)+    getLinesCols b =+        (lines, cols)+      where+        lines = B.count 10 b+        cols =+            case B8.lines b of+                [] -> 0+                ls -> B.length $ last ls+    take' = B.take+    length' = B.length  instance AttoparsecInput T.Text where     parseA = Data.Attoparsec.Text.parse@@ -55,35 +95,83 @@     empty = T.empty     isNull = T.null     notEmpty = filter (not . T.null)+    getLinesCols t =+        (lines, cols)+      where+        lines = T.count (T.pack "\n") t+        cols =+            case T.lines t of+                [] -> 0+                ls -> T.length $ last ls+    take' = T.take+    length' = T.length --- | Convert an Attoparsec 'A.Parser' into a 'C.Sink'. The parser will+-- | Convert an Attoparsec 'A.Parser' into a 'Sink'. The parser will -- be streamed bytes until it returns 'A.Done' or 'A.Fail'. ----- If parsing fails, a 'ParseError' will be thrown with 'C.monadThrow'.-sinkParser :: (AttoparsecInput a, C.MonadThrow m) => A.Parser a b -> C.Sink a m b-sinkParser =-    sink . parseA-  where-    sink parser = C.NeedInput (push parser) (close parser)--    push parser c | isNull c = sink parser-    push parser c = go (parser c) sink+-- If parsing fails, a 'ParseError' will be thrown with 'monadThrow'.+--+-- Since 0.5.0+sinkParser :: (AttoparsecInput a, MonadThrow m) => A.Parser a b -> GLSink a m b+sinkParser = fmap snd . sinkParserPos (Position 1 1) -    close parser = go-        (feedA (parser empty) empty)-        (const $ C.PipeM exc $ lift exc)+-- | Consume a stream of parsed tokens, returning both the token and the+-- position it appears at.+--+-- Since 0.5.0+conduitParser :: (AttoparsecInput a, MonadThrow m) => A.Parser a b -> GLInfConduit a m (PositionRange, b)+conduitParser parser =+    conduit $ Position 1 0+  where+    conduit pos =+        awaitE >>= either return go       where-        exc = C.monadThrow DivergentParser+        go x = do+            leftover x+            (pos', res) <- sinkParserPos pos parser+            yield (PositionRange pos pos', res)+            conduit pos' -    go (A.Done leftover x) _ =-        C.Done lo x-      where-        lo-            | isNull leftover = Nothing-            | otherwise = Just leftover-    go (A.Fail _ contexts msg) _ =-        C.PipeM exc $ lift exc+sinkParserPos :: (AttoparsecInput a, MonadThrow m) => Position -> A.Parser a b -> GLSink a m (Position, b)+sinkParserPos pos0 =+    sink empty pos0 . parseA+  where+    sink prev pos parser = do+        await >>= maybe close push       where-        exc = C.monadThrow $ ParseError contexts msg -    go (A.Partial parser') onPartial = onPartial parser'+        push c+            | isNull c  = sink prev pos parser+            | otherwise = go False c $ parser c++        close = go True prev (feedA (parser empty) empty)++        go end c (A.Done lo x) = do+            let pos'+                    | end       = pos+                    | otherwise = addLinesCols prev pos+                y = take' (length' c - length' lo) c+                pos'' = addLinesCols y pos'+            unless (isNull lo) $ leftover lo+            return (pos'', x)+        go end c (A.Fail rest contexts msg) =+            let x = take' (length' c - length' rest) c+                pos'+                    | end       = pos+                    | otherwise = addLinesCols prev pos+                pos'' = addLinesCols x pos'+             in lift $ monadThrow $ ParseError contexts msg pos''+        go end c (A.Partial parser')+            | end       = lift $ monadThrow DivergentParser+            | otherwise =+                sink c pos' parser'+              where+                pos' = addLinesCols prev pos++    addLinesCols :: AttoparsecInput a => a -> Position -> Position+    addLinesCols x (Position lines cols) =+        lines' `seq` cols' `seq` Position lines' cols'+      where+        (dlines, dcols) = getLinesCols x+        lines' = lines + dlines+        cols' = (if dlines > 0 then 1 else cols) + dcols

@@ -1,7 +1,7 @@ Name:                attoparsec-conduit-Version:             0.4.0.1-Synopsis:            Turn attoparsec parsers into sinks.-Description:         Turn attoparsec parsers into sinks.+Version:             0.5.0+Synopsis:            Consume attoparsec parsers via conduit.+Description:         Consume attoparsec parsers via conduit. License:             BSD3 License-file:        LICENSE Author:              Michael Snoyman@@ -19,7 +19,7 @@                      , bytestring               >= 0.9                      , attoparsec               >= 0.10                      , text                     >= 0.11-                     , conduit                  >= 0.4          && < 0.5+                     , conduit                  >= 0.5          && < 0.6   ghc-options:     -Wall  test-suite test@@ -31,11 +31,11 @@                    , base                    , hspec                    , HUnit-                   , QuickCheck-                   , bytestring-                   , blaze-builder-                   , transformers                    , text+                   , resourcet+                   , attoparsec+                   , attoparsec-conduit+                   , conduit     ghc-options:     -Wall  source-repository head

@@ -1,35 +1,67 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} import Test.Hspec.Monadic-{- import Test.Hspec.HUnit ()-import Test.Hspec.QuickCheck (prop) import Test.HUnit+import Control.Exception (fromException) -import qualified Data.Conduit as C+import Data.Conduit+import Data.Conduit.Attoparsec import qualified Data.Conduit.List as CL-import qualified Data.Conduit.Lazy as CLazy-import qualified Data.Conduit.Text as CT-import Data.Conduit.Blaze (builderToByteString)-import Data.Conduit (runResourceT)-import Control.Monad.ST (runST)-import Data.Monoid-import qualified Data.ByteString as S-import qualified Data.IORef as I-import Blaze.ByteString.Builder (fromByteString, toLazyByteString, insertLazyByteString)-import qualified Data.ByteString.Lazy as L-import Data.ByteString.Lazy.Char8 ()-import Data.Maybe (catMaybes)-import Control.Monad.Trans.Writer (Writer)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TLE-import Control.Monad.Trans.Resource (runExceptionT_, withIO, resourceForkIO)-import Control.Concurrent (threadDelay, killThread)-import Control.Monad.IO.Class (liftIO)-import Control.Applicative (pure, (<$>), (<*>))--}+import qualified Data.Attoparsec.Text+import qualified Data.Attoparsec.ByteString.Char8+import Control.Applicative ((<|>))+import Control.Monad.Trans.Resource  main :: IO ()-main = hspecX $ do-    return ()+main = hspec $ do+    describe "error position" $ do+        it "works for text" $ do+            let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]+                badLine = 4+                badCol = 6+                parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser)+                sink = sinkParser parser+            ea <- runExceptionT $ CL.sourceList input $$ sink+            case ea of+                Left e ->+                    case fromException e of+                        Just pe -> do+                            errorPosition pe @?= Position badLine badCol+        it "works for bytestring" $ do+            let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]+                badLine = 4+                badCol = 6+                parser = Data.Attoparsec.ByteString.Char8.endOfInput <|> (Data.Attoparsec.ByteString.Char8.notChar 'b' >> parser)+                sink = sinkParser parser+            ea <- runExceptionT $ CL.sourceList input $$ sink+            case ea of+                Left e ->+                    case fromException e of+                        Just pe -> do+                            errorPosition pe @?= Position badLine badCol+        it "works in last chunk" $ do+            let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]+                badLine = 6+                badCol = 5+                parser = Data.Attoparsec.Text.char 'c' <|> (Data.Attoparsec.Text.anyChar >> parser)+                sink = sinkParser parser+            ea <- runExceptionT $ CL.sourceList input $$ sink+            case ea of+                Left e ->+                    case fromException e of+                        Just pe -> do+                            errorPosition pe @?= Position badLine badCol+        it "works in last chunk" $ do+            let input = ["aaa\na", "aaa\n\n", "aaa", "aa\n\naaaab"]+                badLine = 6+                badCol = 6+                parser = Data.Attoparsec.Text.string "bc" <|> (Data.Attoparsec.Text.anyChar >> parser)+                sink = sinkParser parser+            ea <- runExceptionT $ CL.sourceList input $$ sink+            case ea of+                Left e ->+                    case fromException e of+                        Just pe -> do+                            errorPosition pe @?= Position badLine badCol