Hello community, here is the log from the commit of package ghc-conduit-parse for openSUSE:Factory checked in at 2017-07-05 23:58:34 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-conduit-parse (Old) and /work/SRC/openSUSE:Factory/.ghc-conduit-parse.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-conduit-parse" Wed Jul 5 23:58:34 2017 rev:2 rq:506803 version:0.1.2.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-conduit-parse/ghc-conduit-parse.changes 2017-04-18 13:50:01.289670367 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-conduit-parse.new/ghc-conduit-parse.changes 2017-07-05 23:58:42.977883610 +0200 @@ -1,0 +2,5 @@ +Mon Jun 19 21:01:50 UTC 2017 - [email protected] + +- Update to version 0.1.2.1. + +------------------------------------------------------------------- Old: ---- conduit-parse-0.1.2.0.tar.gz New: ---- conduit-parse-0.1.2.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-conduit-parse.spec ++++++ --- /var/tmp/diff_new_pack.oGlLwy/_old 2017-07-05 23:58:43.681784452 +0200 +++ /var/tmp/diff_new_pack.oGlLwy/_new 2017-07-05 23:58:43.685783889 +0200 @@ -19,7 +19,7 @@ %global pkg_name conduit-parse %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.1.2.0 +Version: 0.1.2.1 Release: 0 Summary: Parsing framework based on conduit License: WTFPL @@ -27,6 +27,7 @@ Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-conduit-combinators-devel BuildRequires: ghc-conduit-devel BuildRequires: ghc-dlist-devel BuildRequires: ghc-mtl-devel ++++++ conduit-parse-0.1.2.0.tar.gz -> conduit-parse-0.1.2.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-parse-0.1.2.0/Data/Conduit/Parser/Internal.hs new/conduit-parse-0.1.2.1/Data/Conduit/Parser/Internal.hs --- old/conduit-parse-0.1.2.0/Data/Conduit/Parser/Internal.hs 2016-08-23 13:17:32.000000000 +0200 +++ new/conduit-parse-0.1.2.1/Data/Conduit/Parser/Internal.hs 2017-06-16 07:46:35.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-parse-0.1.2.0/Data/Conduit/Parser.hs new/conduit-parse-0.1.2.1/Data/Conduit/Parser.hs --- old/conduit-parse-0.1.2.0/Data/Conduit/Parser.hs 2016-08-23 12:56:46.000000000 +0200 +++ new/conduit-parse-0.1.2.1/Data/Conduit/Parser.hs 2017-06-16 07:46:35.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-parse-0.1.2.0/conduit-parse.cabal new/conduit-parse-0.1.2.1/conduit-parse.cabal --- old/conduit-parse-0.1.2.0/conduit-parse.cabal 2016-08-23 13:41:18.000000000 +0200 +++ new/conduit-parse-0.1.2.1/conduit-parse.cabal 2017-06-16 07:46:35.000000000 +0200 @@ -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 <[email protected]> maintainer: koral <[email protected]> @@ -24,6 +24,7 @@ build-depends: base >= 4.8 && < 5 , conduit + , conduit-combinators , dlist , safe-exceptions , mtl diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-parse-0.1.2.0/test/Main.hs new/conduit-parse-0.1.2.1/test/Main.hs --- old/conduit-parse-0.1.2.0/test/Main.hs 2016-08-23 12:47:36.000000000 +0200 +++ new/conduit-parse-0.1.2.1/test/Main.hs 2017-06-16 07:46:35.000000000 +0200 @@ -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")
