Update for 1.0 core libraries

Author: paf31

bower.json

@@ -21,16 +21,16 @@
     "url": "git://github.com/paf31/purescript-string-parsers.git"
   },
   "dependencies": {
-    "purescript-control": "~0.3.1",
-    "purescript-arrays": "~0.4.2",
-    "purescript-maybe": "~0.3.4",
-    "purescript-strings": "~0.7.0",
-    "purescript-foldable-traversable": "~0.4.0",
-    "purescript-either": "~0.2.3",
-    "purescript-lists": "~0.7.8"
+    "purescript-control": "^1.0.0",
+    "purescript-arrays": "^1.0.0",
+    "purescript-maybe": "^1.0.0",
+    "purescript-strings": "^1.0.0",
+    "purescript-foldable-traversable": "^1.0.0",
+    "purescript-either": "^1.0.0",
+    "purescript-lists": "^1.0.0"
   },
   "devDependencies": {
-    "purescript-math": "~0.2.0",
-    "purescript-quickcheck": "~0.12.0"
+    "purescript-math": "^2.0.0",
+    "purescript-quickcheck": "^1.0.0"
   }
 }

src/Text/Parsing/StringParser.purs

@@ -3,23 +3,21 @@
 module Text.Parsing.StringParser where
 
 import Prelude
-
+import Control.MonadPlus (class MonadPlus, class MonadZero, class Alternative)
+import Control.Monad.Rec.Class (class MonadRec, tailRecM)
+import Control.Plus (class Plus, class Alt)
+import Data.Bifunctor (bimap, lmap)
 import Data.Either (Either(..))
 
-import Control.Alt
-import Control.Alternative
-import Control.MonadPlus
-import Control.Plus
-
 -- | A poition in an input string.
 type Pos = Int
 
 -- | Strings are represented as a string with an index from the
 -- | start of the string.
--- | 
+-- |
 -- | `{ str: s, pos: n }` is interpreted as the substring of `s`
 -- | starting at index n.
--- | 
+-- |
 -- | This allows us to avoid repeatedly finding substrings
 -- | every time we match a character.
 type PosString = { str :: String, pos :: Pos }
@@ -35,56 +33,63 @@ instance eqParseError :: Eq ParseError where
 
 -- | 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)
+data Parser a = Parser (PosString -> Either { pos :: Pos, error :: ParseError } { result :: a, suffix :: PosString })
 
 -- | Run a parser by providing success and failure continuations.
-unParser :: forall a r. Parser a -> PosString -> (Pos -> ParseError -> r) -> (a -> PosString -> r) -> r
+unParser :: forall a. Parser a -> PosString -> Either { pos :: Pos, error :: ParseError } { result :: a, suffix :: PosString }
 unParser (Parser p) = p
 
 -- | Run a parser for an input string, returning either an error or a result.
 runParser :: forall a. Parser a -> String -> Either ParseError a
-runParser p s = unParser p { str: s, pos: 0 } (\_ err -> Left err) (\a _ -> Right a)
+runParser (Parser p) s = bimap _.error _.result (p { str: s, pos: 0 })
 
 instance functorParser :: Functor Parser where
-  map f p = Parser (\s fc sc ->
-    unParser p s fc (\a s' -> sc (f a) s'))
+  map f (Parser p) = Parser (map (\{ result, suffix } -> { result: f result, suffix }) <<< p)
 
 instance applyParser :: Apply Parser where
-  apply f x = Parser (\s fc sc ->
-    unParser f s fc (\f' s' ->
-      unParser x s' fc (\x' s'' -> sc (f' x') s'')))
+  apply (Parser p1) (Parser p2) = Parser \s -> do
+    { result: f, suffix: s1 } <- p1 s
+    { result: x, suffix: s2 } <- p2 s1
+    pure { result: f x, suffix: s2 }
 
 instance applicativeParser :: Applicative Parser where
-  pure a = Parser (\s _ sc -> sc a s)
+  pure a = Parser \s -> Right { result: a, suffix: s }
 
 instance altParser :: Alt Parser where
-  alt 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)
+  alt (Parser p1) (Parser p2) = Parser \s ->
+    case p1 s of
+      Left { error, pos } | s.pos == pos -> p2 s
+                          | otherwise -> Left { error, pos }
+      right -> right
 
 instance plusParser :: Plus Parser where
   empty = fail "No alternative"
 
 instance alternativeParser :: Alternative Parser
 
 instance bindParser :: Bind Parser where
-  bind p f = Parser (\s fc sc ->
-    unParser p s fc (\a s' ->
-      unParser (f a) s' fc sc))
+  bind (Parser p) f = Parser \s -> do
+    { result, suffix } <- p s
+    unParser (f result) suffix
 
 instance monadParser :: Monad Parser
 
+instance monadZeroParser :: MonadZero Parser
+
 instance monadPlusParser :: MonadPlus Parser
 
+instance monadRecParser :: MonadRec Parser where
+  tailRecM f a = Parser \str -> tailRecM (\st -> map split (unParser (f st.state) st.str)) { state: a, str }
+    where
+      split { result: Left state, suffix: str } = Left { state, str }
+      split { result: Right b, suffix } = Right { result: b, suffix }
+
 -- | Fail with the specified message.
 fail :: forall a. String -> Parser a
-fail msg = Parser (\{ pos = pos } fc _ -> fc pos (ParseError msg))
+fail msg = Parser \{ pos } -> Left { pos, error: ParseError msg }
 
 -- | In case of error, the default behavior is to backtrack if no input was consumed.
 -- |
 -- | `try p` backtracks even if input was consumed.
 try :: forall a. Parser a -> Parser a
-try p = Parser (\(s@{ pos = pos }) fc sc -> unParser p s (\_ -> fc pos) sc)
+try (Parser p) = Parser \(s@{ pos }) -> lmap (_ { pos = pos}) (p s)

src/Text/Parsing/StringParser/Combinators.purs

@@ -4,61 +4,67 @@ module Text.Parsing.StringParser.Combinators where
 
 import Prelude
 
+import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
 import Data.List (List(..), singleton)
-import Data.Foldable (Foldable, foldl)
+import Data.Foldable (class Foldable, foldl)
 
 import Control.Alt ((<|>))
 import Control.Apply ((*>))
 
-import Text.Parsing.StringParser
+import Text.Parsing.StringParser (Parser(..), fail, unParser)
 
 -- | Read ahead without consuming input.
 lookAhead :: forall a. Parser a -> Parser a
-lookAhead p = Parser \ps fc sc -> unParser p ps fc (\s _ -> sc s ps)
+lookAhead (Parser p) = Parser \s ->
+  case p s of
+    Right { result } -> Right { result, suffix: s }
+    left -> left
 
 -- | Match zero or more times.
 many :: forall a. Parser a -> Parser (List a)
-many p = many1 p <|> return Nil
+many p = many1 p <|> pure Nil
 
 -- | Match one or more times.
 many1 :: forall a. Parser a -> Parser (List a)
 many1 p = do
   a <- p
   as <- many p
-  return (Cons a as)
+  pure (Cons a as)
 
 -- | Provide an error message in case of failure.
-(<?>) :: forall a. Parser a -> String -> Parser a
-(<?>) p msg = p <|> fail msg
+withError :: forall a. Parser a -> String -> Parser a
+withError p msg = p <|> fail msg
+
+infixl 3 withError as <?>
 
 -- | Take the fixed point of a parser function. This function is sometimes useful when building recursive parsers.
 fix :: forall a. (Parser a -> Parser a) -> Parser a
-fix f = Parser (\s fc sc -> unParser (f (fix f)) s fc sc)
+fix f = Parser \s -> unParser (f (fix f)) s 
 
 -- | Parse a string between opening and closing markers.
 between :: forall a open close. Parser open -> Parser close -> Parser a -> Parser a
 between open close p = do
   open
   a <- p
   close
-  return a
+  pure a
 
 -- | Parse a value with a default value in case of failure.
 option :: forall a. a -> Parser a -> Parser a
-option a p = p <|> return a
+option a p = p <|> pure a
 
 -- | Attempt to parse a value.
 optional :: forall a. Parser a -> Parser Unit
-optional p = (p >>= \_ -> return unit) <|> return unit
+optional p = (p >>= \_ -> pure unit) <|> pure unit
 
--- | Attempt to parse a value, returning `Nothing` in case of failure.
+-- | Attempt to parse a value, pureing `Nothing` in case of failure.
 optionMaybe :: forall a. Parser a -> Parser (Maybe a)
 optionMaybe p = option Nothing (Just <$> p)
 
 -- | Parse zero or more separated values.
 sepBy :: forall a sep. Parser a -> Parser sep -> Parser (List a)
-sepBy p sep = sepBy1 p sep <|> return Nil
+sepBy p sep = sepBy1 p sep <|> pure Nil
 
 -- | Parse one or more separated values.
 sepBy1 :: forall a sep. Parser a -> Parser sep -> Parser (List a)
@@ -67,41 +73,41 @@ sepBy1 p sep = do
   as <- many $ do
     sep
     p
-  return (Cons a as)
+  pure (Cons a as)
 
 -- | Parse zero or more separated values, optionally ending with a separator.
 sepEndBy :: forall a sep. Parser a -> Parser sep -> Parser (List a)
-sepEndBy p sep = sepEndBy1 p sep <|> return Nil
+sepEndBy p sep = sepEndBy1 p sep <|> pure Nil
 
 -- | Parse one or more separated values, optionally ending with a separator.
 sepEndBy1 :: forall a sep. Parser a -> Parser sep -> Parser (List a)
 sepEndBy1 p sep = do
   a <- p
   (do sep
       as <- sepEndBy p sep
-      return (Cons a as)) <|> return (singleton a)
+      pure (Cons a as)) <|> pure (singleton a)
 
 -- | Parse zero or more separated values, ending with a separator.
 endBy1 :: forall a sep. Parser a -> Parser sep -> Parser (List a)
 endBy1 p sep = many1 $ do
   a <- p
   sep
-  return a
+  pure a
 
 -- | Parse one or more separated values, ending with a separator.
 endBy :: forall a sep. Parser a -> Parser sep -> Parser (List a)
 endBy p sep = many $ do
   a <- p
   sep
-  return a
+  pure a
 
 -- | Parse zero or more values separated by a right-associative operator.
 chainr :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
-chainr p f a = chainr1 p f <|> return a
+chainr p f a = chainr1 p f <|> pure a
 
 -- | Parse zero or more values separated by a left-associative operator.
 chainl :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
-chainl p f a = chainl1 p f <|> return a
+chainl p f a = chainl1 p f <|> pure a
 
 -- | Parse one or more values separated by a left-associative operator.
 chainl1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a
@@ -113,7 +119,7 @@ chainl1 p f = do
 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
+                     chainl1' p f (f' a a')) <|> pure a
 
 -- | Parse one or more values separated by a right-associative operator.
 chainr1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a
@@ -125,7 +131,7 @@ chainr1 p f = do
 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
+                     pure $ f' a a') <|> pure a
 
 -- | Parse using any of a collection of parsers.
 choice :: forall f a. (Foldable f) => f (Parser a) -> Parser a
@@ -135,6 +141,6 @@ choice = foldl (<|>) (fail "Nothing to parse")
 manyTill :: forall a end. Parser a -> Parser end -> Parser (List a)
 manyTill p end = scan
   where
-  scan = (end *> return Nil) <|> do x <- p
-                                    xs <- scan
-                                    return (Cons x xs)
+  scan = (end *> pure Nil) <|> do x <- p
+                                  xs <- scan
+                                  pure (Cons x xs)

src/Text/Parsing/StringParser/Expr.purs

@@ -9,13 +9,11 @@ module Text.Parsing.StringParser.Expr
 
 import Prelude
 
-import Data.Foldable
+import Control.Alt ((<|>))
+import Data.Foldable (foldl, foldr)
 import Data.List (List(..))
-
-import Control.Alt
-
-import Text.Parsing.StringParser
-import Text.Parsing.StringParser.Combinators
+import Text.Parsing.StringParser (Parser)
+import Text.Parsing.StringParser.Combinators (choice, (<?>))
 
 -- | Operator associativity types.
 data Assoc = AssocNone | AssocLeft | AssocRight
@@ -48,14 +46,14 @@ buildExprParser operators simpleExpr =
         prefixOp  = choice accum.prefix <?> ""
         postfixOp = choice accum.postfix <?> ""
 
-        postfixP = postfixOp <|> return id
-        prefixP  = prefixOp <|> return id
+        postfixP = postfixOp <|> pure id
+        prefixP  = prefixOp <|> pure id
       in do
         x <- termP prefixP term postfixP
         rassocP x rassocOp prefixP term postfixP
           <|> lassocP x lassocOp prefixP term postfixP
           <|> nassocP x nassocOp prefixP term postfixP
-          <|> return x
+          <|> pure x
           <?> "operator"
 
     splitOp :: forall b. Operator b -> SplitAccum b -> SplitAccum b
@@ -71,10 +69,10 @@ buildExprParser operators simpleExpr =
       y <- do
         z <- termP prefixP term postfixP
         rassocP1 z rassocOp prefixP term postfixP
-      return (f x y)
+      pure (f x y)
 
     rassocP1 :: forall b c d. b -> Parser (b -> b -> b) -> Parser (c -> d) -> Parser c -> Parser (d -> b) -> Parser b
-    rassocP1 x rassocOp prefixP term postfixP = rassocP x rassocOp prefixP term postfixP <|> return x
+    rassocP1 x rassocOp prefixP term postfixP = rassocP x rassocOp prefixP term postfixP <|> pure x
 
     lassocP :: forall b c d. b -> Parser (b -> b -> b) -> Parser (c -> d) -> Parser c -> Parser (d -> b) -> Parser b
     lassocP x lassocOp prefixP term postfixP = do
@@ -83,19 +81,19 @@ buildExprParser operators simpleExpr =
       lassocP1 (f x y) lassocOp prefixP term postfixP
 
     lassocP1 :: forall b c d. b -> Parser (b -> b -> b) -> Parser (c -> d) -> Parser c -> Parser (d -> b) -> Parser b
-    lassocP1 x lassocOp prefixP term postfixP = lassocP x lassocOp prefixP term postfixP <|> return x
+    lassocP1 x lassocOp prefixP term postfixP = lassocP x lassocOp prefixP term postfixP <|> pure x
 
     nassocP :: forall b c d. b -> Parser (b -> b -> b) -> Parser (c -> d) -> Parser c -> Parser (d -> b) -> Parser b
     nassocP x nassocOp prefixP term postfixP = do
       f <- nassocOp
       y <- termP prefixP term postfixP
-      return (f x y)
+      pure (f x y)
 
     termP :: forall b c d. Parser (b -> c) -> Parser b -> Parser (c -> d) -> Parser d
     termP prefixP term postfixP = do
       pre   <- prefixP
       x     <- term
       post  <- postfixP
-      return (post (pre x))
+      pure (post (pre x))
 
   in foldl (makeParser) simpleExpr operators