trifecta 1.4.2 → 1.4.3
raw patch · 5 files changed
+125/−16 lines, 5 filesdep +QuickCheckdep +trifectadep ~basedep ~parsers
Dependencies added: QuickCheck, trifecta
Dependency ranges changed: base, parsers
Files
- examples/RFC2616.txt +6/−0
- src/Text/Trifecta/Combinators.hs +12/−12
- src/Text/Trifecta/Parser.hs +2/−0
- tests/QuickCheck.hs +88/−0
- trifecta.cabal +17/−4
+ examples/RFC2616.txt view
@@ -0,0 +1,6 @@+GET http://slashdot.org/ HTTP/1.1+foo: this is a test++GET http://slashdot.org/ HTTP/1.0+foo: of the emergency broadcast system+
src/Text/Trifecta/Combinators.hs view
@@ -67,7 +67,7 @@ restOfLine = Strict.drop . fromIntegral . columnByte <$> position <*> line {-# INLINE restOfLine #-} -instance (MonadPlus m, DeltaParsing m) => DeltaParsing (Lazy.StateT s m) where+instance (MonadPlus m, DeltaParsing m, Show s) => DeltaParsing (Lazy.StateT s m) where line = lift line {-# INLINE line #-} position = lift position@@ -79,7 +79,7 @@ restOfLine = lift restOfLine {-# INLINE restOfLine #-} -instance (MonadPlus m, DeltaParsing m) => DeltaParsing (Strict.StateT s m) where+instance (MonadPlus m, DeltaParsing m, Show s) => DeltaParsing (Strict.StateT s m) where line = lift line {-# INLINE line #-} position = lift position@@ -103,7 +103,7 @@ restOfLine = lift restOfLine {-# INLINE restOfLine #-} -instance (MonadPlus m, DeltaParsing m, Monoid w) => DeltaParsing (Strict.WriterT w m) where+instance (MonadPlus m, DeltaParsing m, Monoid w, Show w) => DeltaParsing (Strict.WriterT w m) where line = lift line {-# INLINE line #-} position = lift position@@ -115,7 +115,7 @@ restOfLine = lift restOfLine {-# INLINE restOfLine #-} -instance (MonadPlus m, DeltaParsing m, Monoid w) => DeltaParsing (Lazy.WriterT w m) where+instance (MonadPlus m, DeltaParsing m, Monoid w, Show w) => DeltaParsing (Lazy.WriterT w m) where line = lift line {-# INLINE line #-} position = lift position@@ -127,7 +127,7 @@ restOfLine = lift restOfLine {-# INLINE restOfLine #-} -instance (MonadPlus m, DeltaParsing m, Monoid w) => DeltaParsing (Lazy.RWST r w s m) where+instance (MonadPlus m, DeltaParsing m, Monoid w, Show s, Show w) => DeltaParsing (Lazy.RWST r w s m) where line = lift line {-# INLINE line #-} position = lift position@@ -139,7 +139,7 @@ restOfLine = lift restOfLine {-# INLINE restOfLine #-} -instance (MonadPlus m, DeltaParsing m, Monoid w) => DeltaParsing (Strict.RWST r w s m) where+instance (MonadPlus m, DeltaParsing m, Monoid w, Show s, Show w) => DeltaParsing (Strict.RWST r w s m) where line = lift line {-# INLINE line #-} position = lift position@@ -201,13 +201,13 @@ -- | Seek a previously marked location release :: d -> m () -instance (MonadPlus m, MarkParsing d m) => MarkParsing d (Lazy.StateT s m) where+instance (MonadPlus m, MarkParsing d m, Show s) => MarkParsing d (Lazy.StateT s m) where mark = lift mark {-# INLINE mark #-} release = lift . release {-# INLINE release #-} -instance (MonadPlus m, MarkParsing d m) => MarkParsing d (Strict.StateT s m) where+instance (MonadPlus m, MarkParsing d m, Show s) => MarkParsing d (Strict.StateT s m) where mark = lift mark {-# INLINE mark #-} release = lift . release@@ -219,25 +219,25 @@ release = lift . release {-# INLINE release #-} -instance (MonadPlus m, MarkParsing d m, Monoid w) => MarkParsing d (Strict.WriterT w m) where+instance (MonadPlus m, MarkParsing d m, Monoid w, Show w) => MarkParsing d (Strict.WriterT w m) where mark = lift mark {-# INLINE mark #-} release = lift . release {-# INLINE release #-} -instance (MonadPlus m, MarkParsing d m, Monoid w) => MarkParsing d (Lazy.WriterT w m) where+instance (MonadPlus m, MarkParsing d m, Monoid w, Show w) => MarkParsing d (Lazy.WriterT w m) where mark = lift mark {-# INLINE mark #-} release = lift . release {-# INLINE release #-} -instance (MonadPlus m, MarkParsing d m, Monoid w) => MarkParsing d (Lazy.RWST r w s m) where+instance (MonadPlus m, MarkParsing d m, Monoid w, Show s, Show w) => MarkParsing d (Lazy.RWST r w s m) where mark = lift mark {-# INLINE mark #-} release = lift . release {-# INLINE release #-} -instance (MonadPlus m, MarkParsing d m, Monoid w) => MarkParsing d (Strict.RWST r w s m) where+instance (MonadPlus m, MarkParsing d m, Monoid w, Show s, Show w) => MarkParsing d (Strict.RWST r w s m) where mark = lift mark {-# INLINE mark #-} release = lift . release
src/Text/Trifecta/Parser.hs view
@@ -148,6 +148,8 @@ {-# INLINE unexpected #-} eof = notFollowedBy anyChar <?> "end of input" {-# INLINE eof #-}+ notFollowedBy p = try (optional p >>= maybe (pure ()) (unexpected . show))+ {-# INLINE notFollowedBy #-} instance Errable Parser where raiseErr e = Parser $ \ _ ee _ _ _ _ -> ee e
+ tests/QuickCheck.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}++module Main+( main+) where++import Control.Applicative++#if MIN_VERSION_base(4,7,0)+import Data.Either+#endif+import Data.Monoid++import qualified Test.QuickCheck as Q++import Text.Parser.Char+import Text.Parser.Combinators++import Text.Trifecta.Parser+import Text.Trifecta.Result++import System.Exit++-- -------------------------------------------------------------------------- --+-- Main++main :: IO ()+main = mapM Q.quickCheckResult tests >>= \x -> case filter (not . passed) x of+ [] -> exitSuccess+ _ -> exitFailure+ where+ passed Q.Success{} = True+ passed _ = False++-- -------------------------------------------------------------------------- --+-- Tests++tests :: [Q.Property]+tests =+ [ Q.property prop_fail+ , Q.property prop_succeed+ , Q.property prop_notFollowedBy0+ , Q.property prop_notFollowedBy1+ , Q.property prop_notFollowedBy2+ , Q.property prop_notFollowedBy3+ ]++-- -------------------------------------------------------------------------- --+-- Properties++prop_fail :: String -> Bool+prop_fail = isLeft . parse (fail "fail" :: Parser ())++prop_succeed :: String -> Bool+prop_succeed = isRight . parse (mempty :: Parser ())++prop_notFollowedBy0 :: Char -> Char -> Bool+prop_notFollowedBy0 x y = either (\_ -> x == y) (/= y)+ $ parse (notFollowedBy (char y) *> anyChar) [x]++prop_notFollowedBy1 :: Char -> Bool+prop_notFollowedBy1 x = either (\_ -> x == x) (/= x)+ $ parse (notFollowedBy (char x) *> anyChar) [x]++prop_notFollowedBy2 :: String -> Char -> Bool+prop_notFollowedBy2 x y = isLeft+ $ parse (anyChar *> notFollowedBy (char y) *> char y) x++prop_notFollowedBy3 :: Char -> Bool+prop_notFollowedBy3 x = isRight+ $ parse (notFollowedBy (char x) <|> char x *> pure ()) [x]++-- -------------------------------------------------------------------------- --+-- Utils++parse :: Parser a -> String -> Either String a+parse p s = case parseString p mempty s of+ Failure e -> Left (show e)+ Success a -> Right a++#if !MIN_VERSION_base(4,7,0)+isLeft :: Either a b -> Bool+isLeft = either (const True) (const False)++isRight :: Either a b -> Bool+isRight = either (const False) (const True)+#endif
trifecta.cabal view
@@ -1,6 +1,6 @@ name: trifecta category: Text, Parsing, Diagnostics, Pretty Printer, Logging-version: 1.4.2+version: 1.4.3 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE@@ -16,7 +16,7 @@ build-type: Custom -extra-source-files: examples/RFC2616.hs .travis.yml README.markdown+extra-source-files: examples/RFC2616.hs examples/RFC2616.txt .travis.yml README.markdown source-repository head type: git@@ -57,11 +57,11 @@ ghc-prim, hashable >= 1.2.1 && < 1.3, lens >= 4.0 && < 5,- mtl >= 2.0.1 && < 2.2,+ mtl >= 2.0.1 && < 2.3, parsers >= 0.10 && < 1, reducers >= 3.10 && < 4, semigroups >= 0.8.3.1 && < 1,- transformers >= 0.2 && < 0.4,+ transformers >= 0.2 && < 0.5, unordered-containers >= 0.2.1 && < 0.3, utf8-string >= 0.3.6 && < 0.4 @@ -84,3 +84,16 @@ if impl(ghc<7.6.1) ghc-options: -Werror++test-suite quickcheck+ type: exitcode-stdio-1.0+ main-is: QuickCheck.hs+ default-language: Haskell2010+ build-depends:+ base == 4.*,+ parsers,+ QuickCheck,+ trifecta+ ghc-options: -Wall -threaded+ hs-source-dirs: tests+