diff --git a/parsec.cabal b/parsec.cabal index f094fe7f181ca5292d103090983d7afb1028c052..21cd24e4af70357a13730d62179ebcf7046c4fdc 100644 --- a/parsec.cabal +++ b/parsec.cabal @@ -114,6 +114,7 @@ test-suite parsec-tests Bugs.Bug6 Bugs.Bug9 Bugs.Bug35 + Bugs.Bug179 Features Features.Feature80 Features.Feature150 diff --git a/test/Bugs.hs b/test/Bugs.hs index 4b2d4bcd07f12bfc19510ce560163ec0a161d180..87a819fb371bedd0c0d8dabcd9b985f538b71372 100644 --- a/test/Bugs.hs +++ b/test/Bugs.hs @@ -9,10 +9,12 @@ import qualified Bugs.Bug2 import qualified Bugs.Bug6 import qualified Bugs.Bug9 import qualified Bugs.Bug35 +import qualified Bugs.Bug179 bugs :: [TestTree] bugs = [ Bugs.Bug2.main , Bugs.Bug6.main , Bugs.Bug9.main , Bugs.Bug35.main + , Bugs.Bug179.tests ] diff --git a/test/Bugs/Bug179.hs b/test/Bugs/Bug179.hs new file mode 100644 index 0000000000000000000000000000000000000000..79c7634c06b68c52fd3bb5cd5c070ef6bff5ed95 --- /dev/null +++ b/test/Bugs/Bug179.hs @@ -0,0 +1,60 @@ + +module Bugs.Bug179 + ( tests + ) where + +import Control.Applicative (Alternative (..), liftA2, (<|>)) +import Test.Tasty ( testGroup, TestTree ) +import Test.Tasty.HUnit + +import qualified Control.Applicative +import qualified Text.Parsec as P +import qualified Text.Parsec.String as P + +tests :: TestTree +tests = testGroup "many try (#179)" + [ testCase "manyDefault" $ examples parser1 + , testCase "C.Applicative" $ examples parser2 + , testCase "Parsec" $ examples parser3 + ] + where + examples p = do + res1 <- parseString p $ unlines [" ", " ", "foo"] + res1 @?= "foo\n" + + res2 <- parseString p $ unlines ["bar"] + res2 @?= "bar\n" + + res3 <- parseString p $ unlines [" ", " ", " foo"] + res3 @?= " foo\n" + + res4 <- parseString p $ unlines [" bar"] + res4 @?= " bar\n" + + parseString :: P.Parser String -> String -> IO String + parseString p input = + case P.parse p "" input of + Left err -> assertFailure $ show err + Right str -> return str + +parser1 :: P.Parser String +parser1 = emptyLines *> P.getInput where + emptyLines :: P.Parser String + emptyLines = manyDefault $ P.try $ P.skipMany (P.satisfy (== ' ')) *> P.char '\n' + +parser2 :: P.Parser String +parser2 = emptyLines *> P.getInput where + emptyLines :: P.Parser String + emptyLines = Control.Applicative.many $ P.try $ P.skipMany (P.satisfy (== ' ')) *> P.char '\n' + +parser3 :: P.Parser String +parser3 = emptyLines *> P.getInput where + emptyLines :: P.Parser String + emptyLines = P.many $ P.try $ P.skipMany (P.satisfy (== ' ')) *> P.char '\n' + +-- many's default definition +manyDefault :: Alternative f => f a -> f [a] +manyDefault v = many_v + where + many_v = some_v <|> pure [] + some_v = liftA2 (:) v many_v