Add many-try test

Author: phadej

parsec.cabal

@@ -114,6 +114,7 @@ test-suite parsec-tests
         Bugs.Bug6
         Bugs.Bug9
         Bugs.Bug35
+        Bugs.Bug179
         Features
         Features.Feature80
         Features.Feature150

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
        ]

test/Bugs/Bug179.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE BangPatterns #-}
+module Bugs.Bug179
+       ( tests
+       ) where
+
+import Control.Applicative
+import Control.Monad
+import Data.Char
+import Data.Functor
+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
+import qualified Text.Parsec.Pos as P
+
+tests :: TestTree
+tests = testGroup "many try (#179)"
+    [ testCase "Parsec" $ examples parser3
+    , testCase "manyDefault" $ examples parser1
+    , testCase "C.Applicative" $ examples parser2
+    ]
+ where
+    examples p = do
+        res1 <- parseString p $ "foo # bar"
+        res1 @?= ["foo"]
+
+
+    parseString :: P.Parser [String] -> String -> IO [String]
+    parseString p input =
+      case P.parse p "" input of
+        Left err -> assertFailure $ show err
+        Right xs -> return xs
+
+skipSpaces :: P.Parser ()
+skipSpaces = P.skipMany (P.satisfy isSpace)
+
+lexeme :: P.Parser a -> P.Parser a
+lexeme p = p <* skipSpaces
+
+identifier :: P.Parser String
+identifier = mfilter (not . null) (scan (\s c -> if isAlphaNum c then Just s else Nothing) ())
+
+parser1 :: P.Parser [String]
+parser1 = skipSpaces *> manyDefault (lexeme identifier)
+
+parser2 :: P.Parser [String]
+parser2 = skipSpaces *> Control.Applicative.many (lexeme identifier)
+
+parser3 :: P.Parser [String]
+parser3 = skipSpaces *> P.many (P.try (lexeme identifier) <|> lexeme hash)
+
+hash :: P.Parser String
+hash = "#" <$ P.char '#'
+
+-- 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
+
+-- | Scan the input text, accumulating characters as long as the scanning
+-- function returns true.
+scan :: (s -> Char -> Maybe s) -- ^ scan function
+     -> s                      -- ^ initial state
+     -> P.Parser String
+scan f st = do
+  s@P.State{ P.stateInput = inp, P.statePos = pos } <- P.getParserState
+  go inp st pos 0 $ \inp' pos' n -> do
+    let s' = s{ P.stateInput = inp', P.statePos = pos' }
+    P.setParserState s' $> take n inp
+  where
+    go inp s !pos !n cont
+      = case inp of
+          [] -> cont inp pos n        -- ran out of input
+          c : inp' ->
+             case f s c of
+               Nothing -> cont inp pos n   -- scan function failed
+               Just s' -> go inp' s' (P.updatePosChar pos c) (n+1) cont