Add combinators, port tests.

Author: paf31

src/Text/Parsing/StringParser.purs

@@ -1,5 +1,6 @@
 module Text.Parsing.StringParser where
 
+import Data.Maybe (Maybe(..))
 import Data.String (charAt, length, take)
 import Data.Either (Either(..))
 
@@ -64,15 +65,13 @@ instance alternativeParser :: Alternative Parser where
     unParser p1 s (\_ ->
       unParser p2 s fc sc) sc)
 
---
--- Error handling combinator
---
-(<?>) :: forall a. Parser a -> String -> Parser a
-(<?>) p msg = Parser (\s fc sc -> unParser p s (\_ -> fc (ParseError msg)) sc)
-
 --
 -- Some elementary parsers
 --
+
+fail :: forall a. String -> Parser a
+fail msg = Parser (\_ fc _ -> fc (ParseError msg))
+
 eof :: Parser {}
 eof = Parser (\s fc sc -> case s of
   { str = str, pos = i } | i < length str -> fc (ParseError "Expected EOF") 
@@ -94,6 +93,104 @@ foreign import indexOf'
 
 string :: String -> Parser String
 string nt = Parser (\s fc sc -> case s of
-  { str = str, pos = i } | indexOf' nt i str == 0 -> sc nt { str: str, pos: i + length nt }
-  _ -> fc (ParseError $ "Expected '" ++ nt ++ "'"))
+  { str = str, pos = i } | indexOf' nt i str == i -> sc nt { str: str, pos: i + length nt }
+  { pos = i } -> fc (ParseError $ "Expected '" ++ nt ++ "' at position " ++ show i ++ "."))
 
+--
+-- Parsing Combinators
+--
+
+many :: forall a. Parser a -> Parser [a]
+many p = many1 p <|> return []
+
+many1 :: forall a. Parser a -> Parser [a]
+many1 p = do
+  a <- p
+  as <- many p
+  return (a : as)
+
+(<?>) :: forall a. Parser a -> String -> Parser a
+(<?>) p msg = p <|> fail msg
+
+fix :: forall a. (Parser a -> Parser a) -> Parser a
+fix f = Parser (\s fc sc -> unParser (f (fix f)) s fc sc)
+
+between :: forall a open close. Parser open -> Parser close -> Parser a -> Parser a
+between open close p = do
+  open
+  a <- p
+  close 
+  return a
+
+option :: forall a. a -> Parser a -> Parser a
+option a p = p <|> return a
+
+optional :: forall a. Parser a -> Parser {}
+optional p = (p >>= \_ -> return {}) <|> return {}
+
+optionMaybe :: forall a. Parser a -> Parser (Maybe a)
+optionMaybe p = option Nothing (Just <$> p)
+
+sepBy :: forall a sep. Parser a -> Parser sep -> Parser [a]
+sepBy p sep = sepBy1 p sep <|> return []
+
+sepBy1 :: forall a sep. Parser a -> Parser sep -> Parser [a]
+sepBy1 p sep = do
+  a <- p
+  as <- many $ do
+    sep
+    p
+  return (a : as)
+
+sepEndBy :: forall a sep. Parser a -> Parser sep -> Parser [a]
+sepEndBy p sep = sepEndBy1 p sep <|> return []
+
+sepEndBy1 :: forall a sep. Parser a -> Parser sep -> Parser [a]
+sepEndBy1 p sep = do
+  a <- p
+  (do sep
+      as <- sepEndBy p sep
+      return (a : as)) <|> return [a]
+
+endBy1 :: forall a sep. Parser a -> Parser sep -> Parser [a]
+endBy1 p sep = many1 $ do 
+  a <- p
+  sep
+  return a
+
+endBy :: forall a sep. Parser a -> Parser sep -> Parser [a]
+endBy p sep = many $ do
+  a <- p
+  sep
+  return a
+
+chainr :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
+chainr p f a = chainr1 p f <|> return a
+
+chainl :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
+chainl p f a = chainl1 p f <|> return a
+
+chainl1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a
+chainl1 p f = do
+  a <- p
+  chainl1' p f a
+
+chainl1' :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
+chainl1' p f a = (do f' <- f
+                     a' <- p
+                     chainl1' p f (f' a a')) <|> return a
+
+chainr1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a
+chainr1 p f = do
+  a <- p
+  chainr1' p f a
+
+chainr1' :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
+chainr1' p f a = (do f' <- f
+                     a' <- chainr1 p f
+                     return $ f' a a') <|> return a
+
+choice :: forall a. [Parser a] -> Parser a
+choice []   = fail "Nothing to parse"
+choice [x]  = x
+choice (x:xs) = x <|> choice xs

tests/Tests.purs

@@ -2,16 +2,43 @@ module Main where
 
 import Data.Array
 import Data.Maybe
+import Data.Either
 
 import Debug.Trace
 
-import qualified Text.Parsing.StringParser as P
+import Control.Monad.Eff
+
+import Text.Parsing.StringParser 
 
 import qualified Test.QuickCheck as QC
 
-main = do
+parens :: forall a. Parser a -> Parser a
+parens = between (string "(") (string ")")
+
+nested :: Parser Number
+nested = fix $ \p -> (do 
+  string "a"
+  return 0) <|> ((+) 1) <$> parens p
 
-  let test1 = P.string "test" :: P.Parser String
-  
-  print $ P.runParser test1 "testing"
-  print $ P.runParser test1 "foo" 
+parseTest :: forall a eff. (Show a) => Parser a -> String -> Eff (trace :: Trace | eff) {}
+parseTest p input = case runParser p input of
+  Left (ParseError err) -> print err
+  Right result -> print result
+
+opTest :: Parser String
+opTest = chainl anyChar (do 
+  string "+"
+  return (++)) ""
+
+main = do
+  parseTest nested "(((a)))"
+  parseTest (many (string "a")) "aaa"
+  parseTest (parens (do
+    string "a"
+    optionMaybe $ string "b")) "(ab)"
+  parseTest (string "a" `sepBy1` string ",") "a,a,a"
+  parseTest (do
+    as <- string "a" `endBy1` string ","
+    eof
+    return as) "a,a,a,"  
+  parseTest opTest "a+b+c"