Add fix combinator

Author: paf31

examples/test.purs.hs

@@ -12,13 +12,13 @@ import Text.Parsing.Parser.Combinators
 import Text.Parsing.Parser.Expr
 import Text.Parsing.Parser.String
 
-parens :: forall m a. (Monad m) => ({} -> ParserT String m a) -> ParserT String m a
+parens :: forall m a. (Monad m) => ParserT String m a -> ParserT String m a
 parens = between (string "(") (string ")")
 
-nested :: forall m. (Monad m) => {} -> ParserT String m Number
-nested _ = (do 
+nested :: forall m. (Monad m) => ParserT String m Number
+nested = fix $ \p -> (do 
   string "a"
-  return 0) <|> ((+) 1) <$> parens nested
+  return 0) <|> ((+) 1) <$> parens p
 
 parseTest :: forall s a eff. (Show a) => Parser s a -> s -> Eff (trace :: Trace | eff) {}
 parseTest p input = case runParser input p of
@@ -46,11 +46,11 @@ exprTest = buildExprParser [[Infix (string "/" >>= \_ -> return (/)) AssocRight]
                            ,[Infix (string "*" >>= \_ -> return (*)) AssocRight]
                            ,[Infix (string "-" >>= \_ -> return (-)) AssocRight]
                            ,[Infix (string "+" >>= \_ -> return (+)) AssocRight]] digit
-
+              
 main = do
-  parseTest (nested {}) "(((a)))"
+  parseTest nested "(((a)))"
   parseTest (many (string "a")) "aaa"
-  parseTest (parens (const $ do
+  parseTest (parens (do
     string "a"
     optionMaybe $ string "b")) "(ab)"
   parseTest (string "a" `sepBy1` string ",") "a,a,a"

src/Text/Parsing/Parser/Combinators.purs.hs

@@ -15,6 +15,9 @@ import Control.Monad.State.Class
 
 import Text.Parsing.Parser
 
+fix :: forall m s a. (ParserT m s a -> ParserT m s a) -> ParserT m s a
+fix f = ParserT (StateT (\s -> runStateT (unParserT (f (fix f))) s))
+
 many :: forall m s a. (Monad m) => ParserT s m a -> ParserT s m [a]
 many p = many1 p <|> return []
 
@@ -24,12 +27,12 @@ many1 p = do a <- p
              return (a : as)
 
 (<?>) :: forall m s a. (Monad m) => ParserT s m a -> String -> ParserT s m a
-(<?>) p msg = p <|> fail msg
+(<?>) p msg = p <|> fail ("Expected " ++ msg)
 
-between :: forall m s a open close. (Monad m) => ParserT s m open -> ParserT s m close -> ({} -> ParserT s m a) -> ParserT s m a
+between :: forall m s a open close. (Monad m) => ParserT s m open -> ParserT s m close -> ParserT s m a -> ParserT s m a
 between open close p = do
   open
-  a <- p {}
+  a <- p
   close 
   return a