diff --git a/Data/Conduit/Parser.hs b/Data/Conduit/Parser.hs --- 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 @@ , 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 --- 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 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 @@ 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 @@ -- | 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,8 +136,11 @@ 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 foldMap f (Buffer (Just a)) = foldMap f a @@ -188,10 +172,6 @@ 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 @@ 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 --- 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 @@ 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 @@ 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 --- a/test/Main.hs +++ b/test/Main.hs @@ -28,26 +28,23 @@ , 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 @@ 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 @@ 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 @@ 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")