diff --git a/bower.json b/bower.json index 26306fc..3bd3442 100644 --- a/bower.json +++ b/bower.json @@ -15,13 +15,14 @@ "package.json" ], "dependencies": { - "purescript-arrays" : "*", - "purescript-maybe" : "*", - "purescript-strings" : "*", + "purescript-control": "~0.2.0", + "purescript-arrays": "~0.2.0", + "purescript-maybe": "~0.2.0", + "purescript-strings": "*", "purescript-foldable-traversable" : "*" }, "devDependencies": { - "purescript-math" : "*", - "purescript-quickcheck" : "*" + "purescript-math": "*", + "purescript-quickcheck": "*" } } diff --git a/src/Text/Parsing/StringParser.purs b/src/Text/Parsing/StringParser.purs index 30971bd..05baec2 100644 --- a/src/Text/Parsing/StringParser.purs +++ b/src/Text/Parsing/StringParser.purs @@ -1,12 +1,17 @@ module Text.Parsing.StringParser where - + import Data.Either (Either(..)) +import Control.Alt +import Control.Alternative +import Control.MonadPlus +import Control.Plus + type Pos = Number --- +-- -- Strings are represented as a string with an index from the --- start of the string. +-- start of the string. -- -- { str: s, pos: n } is interpreted as the substring of s -- starting at index n. @@ -25,7 +30,7 @@ instance showParseError :: Show ParseError where show (ParseError msg) = msg -- --- A parser is represented as a function which takes a pair of +-- A parser is represented as a function which takes a pair of -- continuations for failure and success. -- data Parser a = Parser (forall r. PosString -> (Pos -> ParseError -> r) -> (a -> PosString -> r) -> r) @@ -41,17 +46,30 @@ runParser p s = unParser p { str: s, pos: 0 } (\_ err -> Left err) (\a _ -> Righ -- instance functorParser :: Functor Parser where - (<$>) f p = Parser (\s fc sc -> + (<$>) f p = Parser (\s fc sc -> unParser p s fc (\a s' -> sc (f a) s')) instance applyParser :: Apply Parser where - (<*>) f x = Parser (\s fc sc -> + (<*>) f x = Parser (\s fc sc -> unParser f s fc (\f' s' -> unParser x s' fc (\x' s'' -> sc (f' x') s''))) instance applicativeParser :: Applicative Parser where pure a = Parser (\s _ sc -> sc a s) +instance altParser :: Alt Parser where + (<|>) p1 p2 = Parser (\s fc sc -> + unParser p1 s (\pos msg -> + if s.pos == pos + then unParser p2 s fc sc + else fc pos msg) + sc) + +instance plusParser :: Plus Parser where + empty = fail "No alternative" + +instance alternativeParser :: Alternative Parser + instance bindParser :: Bind Parser where (>>=) p f = Parser (\s fc sc -> unParser p s fc (\a s' -> @@ -59,17 +77,10 @@ instance bindParser :: Bind Parser where instance monadParser :: Monad Parser -instance alternativeParser :: Alternative Parser where - empty = fail "No alternative" - (<|>) p1 p2 = Parser (\s fc sc -> - unParser p1 s (\pos msg -> - if s.pos == pos - then unParser p2 s fc sc - else fc pos msg) - sc) +instance monadPlusParser :: MonadPlus Parser fail :: forall a. String -> Parser a fail msg = Parser (\{ pos = pos } fc _ -> fc pos (ParseError msg)) try :: forall a. Parser a -> Parser a -try p = Parser (\(s@{ pos = pos }) fc sc -> unParser p s (\_ -> fc pos) sc) \ No newline at end of file +try p = Parser (\(s@{ pos = pos }) fc sc -> unParser p s (\_ -> fc pos) sc) diff --git a/src/Text/Parsing/StringParser/Combinators.purs b/src/Text/Parsing/StringParser/Combinators.purs index e612508..f14e8c1 100644 --- a/src/Text/Parsing/StringParser/Combinators.purs +++ b/src/Text/Parsing/StringParser/Combinators.purs @@ -1,6 +1,9 @@ module Text.Parsing.StringParser.Combinators where import Data.Maybe (Maybe(..)) + +import Control.Alt + import Text.Parsing.StringParser many :: forall a. Parser a -> Parser [a] @@ -22,14 +25,14 @@ between :: forall a open close. Parser open -> Parser close -> Parser a -> Parse between open close p = do open a <- p - close + 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 {} +optional :: forall a. Parser a -> Parser Unit +optional p = (p >>= \_ -> return unit) <|> return unit optionMaybe :: forall a. Parser a -> Parser (Maybe a) optionMaybe p = option Nothing (Just <$> p) @@ -56,7 +59,7 @@ sepEndBy1 p sep = do return (a : as)) <|> return [a] endBy1 :: forall a sep. Parser a -> Parser sep -> Parser [a] -endBy1 p sep = many1 $ do +endBy1 p sep = many1 $ do a <- p sep return a diff --git a/src/Text/Parsing/StringParser/Expr.purs b/src/Text/Parsing/StringParser/Expr.purs index 607849a..75c5f40 100644 --- a/src/Text/Parsing/StringParser/Expr.purs +++ b/src/Text/Parsing/StringParser/Expr.purs @@ -3,6 +3,8 @@ module Text.Parsing.StringParser.Expr where import Data.Either import Data.Foldable +import Control.Alt + import Text.Parsing.StringParser import Text.Parsing.StringParser.Combinators @@ -22,19 +24,19 @@ type SplitAccum a = { rassoc :: [Parser (a -> a -> a)] buildExprParser :: forall a. OperatorTable a -> Parser a -> Parser a buildExprParser operators simpleExpr = - let + let makeParser term ops = - let - accum = foldr splitOp { rassoc: [], lassoc: [], nassoc: [], prefix: [], postfix: [] } ops - - rassocOp = choice accum.rassoc - lassocOp = choice accum.lassoc - nassocOp = choice accum.nassoc - prefixOp = choice accum.prefix "" - postfixOp = choice accum.postfix "" - + let + accum = foldr splitOp { rassoc: [], lassoc: [], nassoc: [], prefix: [], postfix: [] } ops + + rassocOp = choice accum.rassoc + lassocOp = choice accum.lassoc + nassocOp = choice accum.nassoc + prefixOp = choice accum.prefix "" + postfixOp = choice accum.postfix "" + postfixP = postfixOp <|> return id - prefixP = prefixOp <|> return id + prefixP = prefixOp <|> return id in do x <- termP prefixP term postfixP rassocP x rassocOp prefixP term postfixP @@ -42,7 +44,7 @@ buildExprParser operators simpleExpr = <|> nassocP x nassocOp prefixP term postfixP <|> return x "operator" - + splitOp :: forall a. Operator a -> SplitAccum a -> SplitAccum a splitOp (Infix op AssocNone) accum = accum { nassoc = op: accum.nassoc } splitOp (Infix op AssocLeft) accum = accum { lassoc = op: accum.lassoc } @@ -83,4 +85,4 @@ buildExprParser operators simpleExpr = post <- postfixP return (post (pre x)) - in foldl (makeParser) simpleExpr operators \ No newline at end of file + in foldl (makeParser) simpleExpr operators diff --git a/src/Text/Parsing/StringParser/String.purs b/src/Text/Parsing/StringParser/String.purs index 44a860a..254fab9 100644 --- a/src/Text/Parsing/StringParser/String.purs +++ b/src/Text/Parsing/StringParser/String.purs @@ -1,12 +1,12 @@ module Text.Parsing.StringParser.String where - + import Data.String (charAt, length, take, indexOf') import Text.Parsing.StringParser -eof :: Parser {} +eof :: Parser Unit eof = Parser (\s fc sc -> case s of - { str = str, pos = i } | i < length str -> fc i (ParseError "Expected EOF") - _ -> sc {} s) + { str = str, pos = i } | i < length str -> fc i (ParseError "Expected EOF") + _ -> sc unit s) anyChar :: Parser String anyChar = Parser (\s fc sc -> case s of @@ -16,4 +16,4 @@ anyChar = Parser (\s fc sc -> case s of string :: String -> Parser String string nt = Parser (\s fc sc -> case s of { str = str, pos = i } | indexOf' nt i str == i -> sc nt { str: str, pos: i + length nt } - { pos = i } -> fc i (ParseError $ "Expected '" ++ nt ++ "'.")) \ No newline at end of file + { pos = i } -> fc i (ParseError $ "Expected '" ++ nt ++ "'.")) diff --git a/tests/Tests.purs b/tests/Tests.purs index 0d13b66..94944b2 100644 --- a/tests/Tests.purs +++ b/tests/Tests.purs @@ -6,9 +6,10 @@ import Data.Either import Debug.Trace +import Control.Alt import Control.Monad.Eff -import Text.Parsing.StringParser +import Text.Parsing.StringParser import Text.Parsing.StringParser.Combinators import Text.Parsing.StringParser.String import Text.Parsing.StringParser.Expr @@ -19,38 +20,38 @@ parens :: forall a. Parser a -> Parser a parens = between (string "(") (string ")") nested :: Parser Number -nested = fix $ \p -> (do +nested = fix $ \p -> (do string "a" return 0) <|> ((+) 1) <$> parens p -parseTest :: forall a eff. (Show a) => Parser a -> String -> Eff (trace :: Trace | eff) {} +parseTest :: forall a eff. (Show a) => Parser a -> String -> Eff (trace :: Trace | eff) Unit parseTest p input = case runParser p input of Left (ParseError err) -> print err Right result -> print result opTest :: Parser String -opTest = chainl anyChar (do +opTest = chainl anyChar (do string "+" return (++)) "" - + digit :: Parser Number -digit = (string "0" >>= \_ -> return 0) - <|> (string "1" >>= \_ -> return 1) - <|> (string "2" >>= \_ -> return 2) - <|> (string "3" >>= \_ -> return 3) - <|> (string "4" >>= \_ -> return 4) - <|> (string "5" >>= \_ -> return 5) - <|> (string "6" >>= \_ -> return 6) - <|> (string "7" >>= \_ -> return 7) - <|> (string "8" >>= \_ -> return 8) - <|> (string "9" >>= \_ -> return 9) +digit = (string "0" >>= \_ -> return 0) + <|> (string "1" >>= \_ -> return 1) + <|> (string "2" >>= \_ -> return 2) + <|> (string "3" >>= \_ -> return 3) + <|> (string "4" >>= \_ -> return 4) + <|> (string "5" >>= \_ -> return 5) + <|> (string "6" >>= \_ -> return 6) + <|> (string "7" >>= \_ -> return 7) + <|> (string "8" >>= \_ -> return 8) + <|> (string "9" >>= \_ -> return 9) exprTest :: Parser Number exprTest = buildExprParser [[Infix (string "/" >>= \_ -> return (/)) AssocRight] ,[Infix (string "*" >>= \_ -> return (*)) AssocRight] ,[Infix (string "-" >>= \_ -> return (-)) AssocRight] ,[Infix (string "+" >>= \_ -> return (+)) AssocRight]] digit - + tryTest :: Parser String tryTest = try ((++) <$> string "aa" <*> string "bb") <|> (++) <$> string "aa" <*> string "cc" @@ -65,7 +66,7 @@ main = do parseTest (do as <- string "a" `endBy1` string "," eof - return as) "a,a,a," + return as) "a,a,a," parseTest opTest "a+b+c" parseTest exprTest "1*2+3/4-5" parseTest tryTest "aacc"