conduit-parse 0.1.1.1 → 0.1.2.0
raw patch · 4 files changed
+41/−30 lines, 4 filesdep +safedep +safe-exceptionsdep −exceptionsPVP ok
version bump matches the API change (PVP)
Dependencies added: safe, safe-exceptions
Dependencies removed: exceptions
API changes (from Hackage documentation)
+ Data.Conduit.Parser: getParserNames :: ConduitParser i m [Text]
Files
- Data/Conduit/Parser.hs +2/−1
- Data/Conduit/Parser/Internal.hs +28/−21
- conduit-parse.cabal +4/−3
- test/Main.hs +7/−5
Data/Conduit/Parser.hs view
@@ -9,6 +9,7 @@ -- * Primitives , await , leftover+ , getParserNames , getParserName -- * Utility , peek@@ -16,4 +17,4 @@ , ConduitParserException(..) ) where -import Data.Conduit.Parser.Internal+import Data.Conduit.Parser.Internal
Data/Conduit/Parser/Internal.hs view
@@ -8,25 +8,27 @@ -- {{{ Imports import Control.Applicative-import Control.Arrow (second)+import Control.Exception.Safe import Control.Monad-import Control.Monad.Catch import Control.Monad.Error.Class import Control.Monad.Except 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+import Data.DList (DList (..), append, cons) import Data.Maybe (fromMaybe)-import Data.Text as Text (Text, null, pack, unpack)+import Data.Text as Text (Text, pack, unpack) +import Safe+ 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) (Sink i m)) a) deriving instance Applicative (ConduitParser i m) deriving instance Functor (ConduitParser i m)@@ -46,10 +48,9 @@ -- which means the consumer no longer uses constant memory. instance MonadError ConduitParserException (ConduitParser i m) where throwError e = do- name <- getParserName- if Text.null name- then ConduitParser $ throwError e- else ConduitParser . throwError $ NamedParserException name e+ names <- getParserNames+ ConduitParser . throwError $ foldr NamedParserException e $ reverse names+ catchError (ConduitParser f) handler = do buffer <- withBuffer resetBuffer withBuffer $ setEnabled True@@ -57,7 +58,7 @@ result <- ConduitParser $ (Right <$> f) `catchError` (return . Left) case result of- Left e -> backtrack >> setBuffer buffer >> handler e+ Left e -> backtrack >> setBuffer buffer >> handler e Right a -> withBuffer (prependBuffer buffer) >> return a -- | Parsers can be combined with ('<|>'), 'some', 'many', 'optional', 'choice'.@@ -76,10 +77,9 @@ try parser = parser parser <?> name = do- oldName <- getParserName- setParserName $ pack name+ pushParserName $ pack name a <- parser- setParserName oldName+ popParserName return a unexpected = throwError . Unexpected . pack@@ -103,13 +103,20 @@ runConduitParser :: (MonadThrow m) => ConduitParser i m a -> Sink i m a runConduitParser (ConduitParser p) = either throwM return . fst =<< runStateT (runExceptT p) (mempty, mempty) --- | Return the name of the parser (assigned through ('<?>')), or 'mempty' if has none.+-- | Return the ordered list of names (assigned through ('<?>')) for the current parser stack. First element is the most nested parser.+getParserNames :: ConduitParser i m [Text]+getParserNames = ConduitParser $ lift $ gets fst++-- | Return the name (assigned through ('<?>')) of the current parser (most nested), or 'mempty' if it has none. getParserName :: ConduitParser i m Text-getParserName = ConduitParser $ lift $ gets fst+getParserName = ConduitParser $ lift $ gets (headDef "" . fst) -setParserName :: Text -> ConduitParser i m ()-setParserName name = ConduitParser $ lift $ modify $ \(_, b) -> (name, b)+pushParserName :: Text -> ConduitParser i m ()+pushParserName name = ConduitParser $ lift $ modify $ first (name :) +popParserName :: ConduitParser i m ()+popParserName = ConduitParser $ lift $ modify $ first tailSafe+ getBuffer :: ConduitParser i m (Buffer i) getBuffer = ConduitParser $ lift $ gets snd @@ -131,17 +138,17 @@ deriving instance (Show i) => Show (Buffer i) instance Functor Buffer where- fmap _ (Buffer Nothing) = Buffer mempty+ fmap _ (Buffer Nothing) = Buffer mempty fmap f (Buffer (Just a)) = Buffer $ Just $ fmap f a instance Foldable Buffer where- foldMap _ (Buffer Nothing) = mempty+ foldMap _ (Buffer Nothing) = mempty foldMap f (Buffer (Just a)) = foldMap f a setEnabled :: Bool -> Buffer i -> Buffer i setEnabled True (Buffer a) = Buffer (a <|> Just mempty)-setEnabled _ (Buffer _) = Buffer mempty+setEnabled _ (Buffer _) = Buffer mempty prependItem :: i -> Buffer i -> Buffer i prependItem new (Buffer a) = Buffer $ fmap (cons new) a@@ -150,7 +157,7 @@ prependBuffer :: Buffer i -> Buffer i -> Buffer i prependBuffer (Buffer a) (Buffer b) = case a of Just a' -> Buffer $ Just (fromMaybe mempty b `append` a')- _ -> Buffer a+ _ -> Buffer a resetBuffer :: Buffer i -> Buffer i resetBuffer (Buffer a) = Buffer $ fmap (const mempty) a
conduit-parse.cabal view
@@ -1,5 +1,5 @@ name: conduit-parse-version: 0.1.1.1+version: 0.1.2.0 synopsis: Parsing framework based on conduit. description: Please refer to README. homepage: https://github.com/k0ral/conduit-parse@@ -25,9 +25,10 @@ base >= 4.8 && < 5 , conduit , dlist- , exceptions+ , safe-exceptions , mtl , parsers+ , safe , text , transformers default-language: Haskell2010@@ -41,7 +42,7 @@ base >= 4.8 && < 5 , conduit , conduit-parse- , exceptions+ , safe-exceptions , hlint , mtl , parsers
test/Main.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} import Control.Applicative-import Control.Monad.Catch as Exception+import Control.Exception.Safe as Exception import Control.Monad.Error.Class import Control.Monad.Trans.Resource @@ -65,10 +65,12 @@ errorCase :: TestTree errorCase = testCase "error" $ do- result1 <- Exception.try . runResourceT . runConduit $ sourceList [] =$= runConduitParser (parser <?> "Unexpected error")- result2 <- Exception.try . runResourceT . runConduit $ sourceList [] =$= runConduitParser parser- result1 @=? Left (NamedParserException "Unexpected error" $ Unexpected "ERROR")- result2 @=? Left (Unexpected "ERROR")+ 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") where parser = unexpected "ERROR" >> return (1 :: Int)