summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorkoral <>2018-03-13 15:47:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-03-13 15:47:00 (GMT)
commit1ddb23c614bf972fae1fdb8b05bf27f2dcbaddef (patch)
tree6a467f0222f992effe565a841a328f0911622677
parent3c8e26579214f0e7b482066fe912ded9f14914f5 (diff)
version 0.2.0.00.2.0.0
-rw-r--r--Data/Conduit/Parser.hs9
-rw-r--r--Data/Conduit/Parser/Internal.hs66
-rw-r--r--conduit-parse.cabal11
-rw-r--r--test/Main.hs43
4 files changed, 21 insertions, 108 deletions
diff --git a/Data/Conduit/Parser.hs b/Data/Conduit/Parser.hs
index 9a5c1ee..995507b 100644
--- a/Data/Conduit/Parser.hs
+++ b/Data/Conduit/Parser.hs
@@ -3,12 +3,11 @@
-- 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
@@ -16,12 +15,6 @@ module Data.Conduit.Parser
, peek
-- * Exception
, ConduitParserException(..)
- -- * Utilities
- , parseC
- , parseOrSkipC
- , lastRequired
- , lastDef
- , embed
) where
import Data.Conduit.Parser.Internal
diff --git a/Data/Conduit/Parser/Internal.hs b/Data/Conduit/Parser/Internal.hs
index d50ab76..5fa8d22 100644
--- a/Data/Conduit/Parser/Internal.hs
+++ b/Data/Conduit/Parser/Internal.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -21,26 +18,22 @@ import Control.Monad.Trans.State
import Data.Bifunctor
import Data.Conduit hiding (await, leftover)
-import qualified Data.Conduit as Conduit
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)
+newtype ConduitParser i m a = ConduitParser (ExceptT ConduitParserException (StateT ([Text], Buffer i) (ConduitT i Void m)) a)
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)
deriving instance (MonadThrow m) => MonadThrow (ConduitParser i m)
@@ -100,18 +93,6 @@ instance (Monad m) => Parsing (ConduitParser i m) where
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)
@@ -119,7 +100,7 @@ named name = flip (<?>) (unpack name)
-- | Run a 'ConduitParser'.
-- Any parsing failure will be thrown as an exception.
-runConduitParser :: (MonadThrow m) => ConduitParser i m a -> Sink i m a
+runConduitParser :: (MonadThrow m) => ConduitParser i m a -> ConduitT i Void m a
runConduitParser (ConduitParser p) = either throwM return . fst =<< runStateT (runExceptT p) (mempty, mempty)
-- | Return the ordered list of names (assigned through ('<?>')) for the current parser stack. First element is the most nested parser.
@@ -155,7 +136,10 @@ backtrack = mapM_ leftover =<< withBuffer resetBuffer
newtype Buffer i = Buffer (Maybe (DList i)) deriving(Monoid)
deriving instance (Show i) => Show (Buffer i)
-deriving instance Functor Buffer
+
+instance Functor Buffer where
+ fmap _ (Buffer Nothing) = Buffer mempty
+ fmap f (Buffer (Just a)) = Buffer $ Just $ fmap f a
instance Foldable Buffer where
foldMap _ (Buffer Nothing) = mempty
@@ -188,10 +172,6 @@ await = do
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
@@ -218,37 +198,3 @@ instance Exception ConduitParserException where
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
diff --git a/conduit-parse.cabal b/conduit-parse.cabal
index f175dc7..30b2335 100644
--- a/conduit-parse.cabal
+++ b/conduit-parse.cabal
@@ -1,5 +1,5 @@
name: conduit-parse
-version: 0.1.2.2
+version: 0.2.0.0
synopsis: Parsing framework based on conduit.
description: Please refer to README.
homepage: https://github.com/k0ral/conduit-parse
@@ -28,13 +28,12 @@ library
Data.Conduit.Parser.Internal
build-depends:
base >= 4.8 && < 5
- , conduit
- , conduit-combinators
+ , conduit >= 1.3
, dlist
- , safe-exceptions
, mtl
, parsers
, safe
+ , safe-exceptions
, text
, transformers
default-language: Haskell2010
@@ -46,12 +45,12 @@ test-suite tests
main-is: Main.hs
build-depends:
base >= 4.8 && < 5
- , conduit
+ , conduit >= 1.3
, conduit-parse
- , safe-exceptions
, mtl
, parsers
, resourcet
+ , safe-exceptions
, tasty
, tasty-hunit
-- , tasty-quickcheck
diff --git a/test/Main.hs b/test/Main.hs
index a76ecca..936dd04 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -28,26 +28,23 @@ unitTests = testGroup "Unit tests"
, alternativeCase
, catchCase
, parsingCase
- , parseConduitCase
- , parseConduitErrorCase
- -- , parseOrSkipCase
]
awaitCase :: TestTree
awaitCase = testCase "await" $ do
- i <- runResourceT . runConduit $ sourceList [1 :: Int] =$= runConduitParser parser
+ i <- runResourceT . runConduit $ sourceList [1 :: Int] .| runConduitParser parser
i @=? (1, Nothing)
where parser = (,) <$> await <*> optional await
peekCase :: TestTree
peekCase = testCase "peek" $ do
- result <- runResourceT . runConduit $ sourceList [1 :: Int, 2] =$= runConduitParser parser
+ result <- runResourceT . runConduit $ sourceList [1 :: Int, 2] .| runConduitParser parser
result @=? (Just 1, 1, 2, Nothing)
where parser = (,,,) <$> peek <*> await <*> await <*> peek
leftoverCase :: TestTree
leftoverCase = testCase "leftover" $ do
- result <- runResourceT . runConduit $ sourceList [1 :: Int, 2, 3] =$= runConduitParser parser
+ result <- runResourceT . runConduit $ sourceList [1 :: Int, 2, 3] .| runConduitParser parser
result @?= (3, 2, 1)
where parser = do
(a, b, c) <- (,,) <$> await <*> await <*> await
@@ -56,9 +53,9 @@ leftoverCase = testCase "leftover" $ do
errorCase :: TestTree
errorCase = testCase "error" $ do
- 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 <- 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")
@@ -67,7 +64,7 @@ errorCase = testCase "error" $ do
alternativeCase :: TestTree
alternativeCase = testCase "alternative" $ do
- result <- runResourceT . runConduit $ sourceList [1 :: Int, 2, 3] =$= runConduitParser parser
+ result <- runResourceT . runConduit $ sourceList [1 :: Int, 2, 3] .| runConduitParser parser
result @?= (1, 2, Nothing)
where parser = do
a <- parseInt 1 <|> parseInt 2
@@ -83,34 +80,12 @@ alternativeCase = testCase "alternative" $ do
catchCase :: TestTree
catchCase = testCase "catch" $ do
- result <- runResourceT . runConduit $ sourceList [1 :: Int, 2] =$= runConduitParser parser
+ result <- runResourceT . runConduit $ sourceList [1 :: Int, 2] .| runConduitParser parser
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 <- runResourceT . runConduit $ sourceList [1 :: Int, 2] .| runConduitParser parser
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")