conduit-parse 0.1.2.0 → 0.1.2.1

raw patch · 4 files changed

+104/−17 lines, 4 filesdep +conduit-combinatorsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: conduit-combinators

API changes (from Hackage documentation)

Files

• Data/Conduit/Parser.hs +8/−1
• Data/Conduit/Parser/Internal.hs +61/−7
• conduit-parse.cabal +3/−2
• test/Main.hs +32/−7

@@ -3,11 +3,12 @@ -- You probably want to import the "Text.Parser.Combinators" module together with this module. module Data.Conduit.Parser   ( -- * Conduit parser monad-    ConduitParser()+    ConduitParser(..)   , runConduitParser   , named     -- * Primitives   , await+  , anyOne   , leftover   , getParserNames   , getParserName@@ -15,6 +16,12 @@   , peek     -- * Exception   , ConduitParserException(..)+    -- * Utilities+  , parseC+  , parseOrSkipC+  , lastRequired+  , lastDef+  , embed   ) where  import           Data.Conduit.Parser.Internal

@@ -1,14 +1,19 @@+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE ExistentialQuantification  #-}+{-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE RankNTypes                 #-} {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE StandaloneDeriving         #-}-module Data.Conduit.Parser.Internal where+module Data.Conduit.Parser.Internal (module Data.Conduit.Parser.Internal) where  -- {{{ Imports+import qualified Conduit+ import           Control.Applicative-import           Control.Exception.Safe+import           Control.Exception.Safe    as Exception import           Control.Monad import           Control.Monad.Error.Class import           Control.Monad.Except@@ -20,18 +25,20 @@ import qualified Data.Conduit.List         as Conduit import           Data.DList                (DList (..), append, cons) import           Data.Maybe                (fromMaybe)+import           Data.Monoid import           Data.Text                 as Text (Text, pack, unpack)  import           Safe +import           Text.Parser.Char import           Text.Parser.Combinators   as Parser -- }}}  -- | Core type of the package. This is basically a 'Sink' with a parsing state. newtype ConduitParser i m a = ConduitParser (ExceptT ConduitParserException (StateT ([Text], Buffer i) (Sink i m)) a) -deriving instance Applicative (ConduitParser i m) deriving instance Functor (ConduitParser i m)+deriving instance Applicative (ConduitParser i m) deriving instance Monad (ConduitParser i m) deriving instance (MonadCatch m) => MonadCatch (ConduitParser i m) deriving instance (MonadIO m) => MonadIO (ConduitParser i m)@@ -93,6 +100,18 @@     name <- getParserName     forM_ result $ \_ -> throwError $ UnexpectedFollowedBy name +-- instance LookAheadParsing (ConduitParser i m) where+--   lookAhead parser = do+++instance (Monad m) => CharParsing (ConduitParser Char m) where+  satisfy f = do+    c <- await+    if f c+    then return c+    else unexpected $ "Unexpected character '" <> [c] <> "'"++ -- | Flipped version of ('<?>'). named :: (Monad m) => Text -> ConduitParser i m a -> ConduitParser i m a named name = flip (<?>) (unpack name)@@ -136,10 +155,7 @@ newtype Buffer i = Buffer (Maybe (DList i)) deriving(Monoid)  deriving instance (Show i) => Show (Buffer i)--instance Functor Buffer where-  fmap _ (Buffer Nothing)  = Buffer mempty-  fmap f (Buffer (Just a)) = Buffer $ Just $ fmap f a+deriving instance Functor Buffer  instance Foldable Buffer where   foldMap _ (Buffer Nothing)  = mempty@@ -172,6 +188,10 @@   withBuffer $ prependItem e   return e +-- | Synonym for 'await'+anyOne :: (Monad m) => ConduitParser i m i+anyOne = await+ -- | 'Conduit.leftover' wrapped as a 'ConduitParser'. leftover :: i -> ConduitParser i m () leftover = ConduitParser . lift . lift . Conduit.leftover@@ -198,3 +218,37 @@   displayException UnexpectedEndOfInput = "Unexpected end of input."   displayException (UnexpectedFollowedBy t) = "Should not be followed by " ++ unpack t   displayException (Unexpected t) = unpack t+++data Result a = Parsed a | Skipped | Invalid | EndOfInput++-- | Turn a parser into a regular 'Conduit' that yields parsed items as long as the parser succeeds.+-- Once the parser fails, the conduit stops consuming input and won't yield any more.+parseC :: (MonadThrow m) => ConduitParser i m a -> Conduit i m a+parseC parser = fix $ \recurse -> do+  result <- toConsumer $ runConduitParser $ (Parsed <$> parser) <|> (EndOfInput <$ eof) <|> pure Invalid++  case result of+    Parsed item -> yield item >> recurse+    _           -> return ()++parseOrSkipC :: (MonadThrow m) => ConduitParser i m a -> ConduitParser i m b -> Conduit i m a+parseOrSkipC parser skip = fix $ \recurse -> do+  result <- toConsumer $ runConduitParser $ (Parsed <$> parser) <|> (EndOfInput <$ eof) <|> (Skipped <$ skip) <|> pure Invalid++  case result of+    Parsed item -> yield item >> recurse+    Skipped     -> recurse+    _           -> return ()+++lastRequired :: MonadThrow m => Text -> Consumer a m a+lastRequired name = maybe (throw $ Unexpected $ "Missing element: " <> name) return =<< Conduit.lastC++lastDef :: MonadThrow m => a -> Consumer a m a+lastDef value = fromMaybe value <$> Conduit.lastC++embed :: (MonadCatch m) => Sink i m a -> ConduitParser i m a+embed sink = do+  e <- await+  ConduitParser $ lift $ lift $ yield e =$= sink

@@ -1,9 +1,9 @@ name:                conduit-parse-version:             0.1.2.0+version:             0.1.2.1 synopsis:            Parsing framework based on conduit. description:         Please refer to README. homepage:            https://github.com/k0ral/conduit-parse-license:             OtherLicense+license:             PublicDomain license-file:        LICENSE author:              koral <koral@mailoo.org> maintainer:          koral <koral@mailoo.org>@@ -24,6 +24,7 @@   build-depends:       base >= 4.8 && < 5     , conduit+    , conduit-combinators     , dlist     , safe-exceptions     , mtl

@@ -35,6 +35,9 @@   , alternativeCase   , catchCase   , parsingCase+  , parseConduitCase+  , parseConduitErrorCase+  -- , parseOrSkipCase   ]  hlint :: TestTree@@ -57,7 +60,7 @@ leftoverCase :: TestTree leftoverCase = testCase "leftover" $ do   result <- runResourceT . runConduit $ sourceList [1 :: Int, 2, 3] =$= runConduitParser parser-  result @=? (3, 2, 1)+  result @?= (3, 2, 1)   where parser = do           (a, b, c) <- (,,) <$> await <*> await <*> await           leftover a >> leftover b >> leftover c@@ -68,16 +71,16 @@   result1 <- Exception.try . runResourceT . runConduit $ sourceList [] =$= runConduitParser parser   result2 <- Exception.try . runResourceT . runConduit $ sourceList [] =$= runConduitParser (parser <?> "Name1")   result3 <- Exception.try . runResourceT . runConduit $ sourceList [] =$= runConduitParser ((parser <?> "Name1") <?> "Name2")-  result1 @=? Left (Unexpected "ERROR")-  result2 @=? Left (NamedParserException "Name1" $ Unexpected "ERROR")-  result3 @=? Left (NamedParserException "Name2" $ NamedParserException "Name1" $ Unexpected "ERROR")+  result1 @?= Left (Unexpected "ERROR")+  result2 @?= Left (NamedParserException "Name1" $ Unexpected "ERROR")+  result3 @?= Left (NamedParserException "Name2" $ NamedParserException "Name1" $ Unexpected "ERROR")   where parser = unexpected "ERROR" >> return (1 :: Int)   alternativeCase :: TestTree alternativeCase = testCase "alternative" $ do   result <- runResourceT . runConduit $ sourceList [1 :: Int, 2, 3] =$= runConduitParser parser-  result @=? (1, 2, Nothing)+  result @?= (1, 2, Nothing)   where parser = do           a <- parseInt 1 <|> parseInt 2           b <- parseInt 1 <|> parseInt 2@@ -93,11 +96,33 @@ catchCase :: TestTree catchCase = testCase "catch" $ do   result <- runResourceT . runConduit $ sourceList [1 :: Int, 2] =$= runConduitParser parser-  result @=? (1, 2)+  result @?= (1, 2)   where parser = catchError (await >> await >> throwError (Unexpected "ERROR")) . const $ (,) <$> await <*> await  parsingCase :: TestTree parsingCase = testCase "parsing" $ do   result <- runResourceT . runConduit $ sourceList [1 :: Int, 2] =$= runConduitParser parser-  result @=? (1, 2)+  result @?= (1, 2)   where parser = (,) <$> await <*> await <* notFollowedBy await <* eof++-- parseOrSkipCase :: TestTree+-- parseOrSkipCase = testCase "parseOrSkip" $ do+--   result <- runResourceT . runConduit $ sourceList [1 :: Int, 10, 2, 9, 3, 8, 4, 7, 5, 6] =$= parser `parseOrSkip` anyOne =$= consume+--   result @?= [10, 9, 8, 7, 6]+--   where parser = do+--           integer <- await+--           if integer >= 6 then return integer else unexpected "Invalid integer"++parseConduitCase :: TestTree+parseConduitCase = testCase "parseConduit" $ do+  result <- runResourceT . runConduit $ sourceList [1 :: Int, 2, 3, 4, 5, 6, 7, 8, 9, 10] =$= parseC parser =$= consume+  result @?= [Left 1, Right 2, Left 3, Right 4, Left 5, Right 6, Left 7, Right 8, Left 9, Right 10]+  where parser = do+          integer <- await+          return $ (if odd integer then Left else Right) integer++parseConduitErrorCase :: TestTree+parseConduitErrorCase = testCase "parseConduitError" $ do+  result <- Exception.try . runResourceT . runConduit $ sourceList [1 :: Int, 2, 3, 4, 5, 6, 7, 8, 9, 10] =$= parseC parser =$= consume+  result @?= (Left (Unexpected "Wrong integer") :: Either ConduitParserException [Int])+  where parser = await >> throw (Unexpected "Wrong integer")