Use ADTs for ParseError, PState and intermediate results

src/Text/Parsing/Parser.purs

@@ -1,4 +1,13 @@
-module Text.Parsing.Parser where
+module Text.Parsing.Parser (
+    unParserT
+  , runParserT
+  , ParserT (..)
+  , runParser
+  , Parser ()
+  , consume
+  , fail
+  , parseFailed
+  ) where
 
 import Prelude
 
@@ -13,74 +22,76 @@ import Data.Tuple (Tuple(..))
 import Text.Parsing.Parser.Pos (Position, initialPos)
 
 -- | A parsing error, consisting of a message and position information.
-data ParseError = ParseError
-  { message :: String
-  , position :: Position
-  }
+data ParseError = ParseError String Position
 
-instance showParseError :: Show ParseError where
-  show (ParseError msg) = "ParseError { message: " <> msg.message <> ", position: " <> show msg.position <> " }"
+derive instance eqParseError :: Eq ParseError
+
+-- | The result of a single parse
+data Result s a = Result  s                     -- the new input
+                          (Either ParseError a) -- the result
+                          Boolean               -- consumed?
+                          Position              -- the new position
 
-instance eqParseError :: Eq ParseError where
-  eq (ParseError {message : m1, position : p1}) (ParseError {message : m2, position : p2}) = m1 == m2 && p1 == p2
+instance showParseError :: Show ParseError where
+  show (ParseError msg pos) = "ParseError " <> show msg <> " " <> show pos
 
 -- | `PState` contains the remaining input and current position.
-data PState s = PState
-  { input :: s
-  , position :: Position
-  }
+data PState s = PState s Position
 
 -- | The Parser monad transformer.
 -- |
 -- | The first type argument is the stream type. Typically, this is either `String`, or some sort of token stream.
-newtype ParserT s m a = ParserT (PState s -> m { input :: s, result :: Either ParseError a, consumed :: Boolean, position :: Position })
+newtype ParserT s m a = ParserT (PState s -> m (Result s a))
 
 -- | Apply a parser by providing an initial state.
-unParserT :: forall m s a. ParserT s m a -> PState s -> m { input :: s, result :: Either ParseError a, consumed :: Boolean, position :: Position }
+unParserT :: forall m s a. ParserT s m a -> PState s -> m (Result s a)
 unParserT (ParserT p) = p
 
 -- | Apply a parser, keeping only the parsed result.
 runParserT :: forall m s a. Monad m => PState s -> ParserT s m a -> m (Either ParseError a)
 runParserT s p = do
-  o <- unParserT p s
-  pure o.result
+  Result _ result _ _ <- unParserT p s
+  pure result
 
 -- | The `Parser` monad is a synonym for the parser monad transformer applied to the `Identity` monad.
 type Parser s a = ParserT s Identity a
 
 -- | Apply a parser, keeping only the parsed result.
 runParser :: forall s a. s -> Parser s a -> Either ParseError a
-runParser s = runIdentity <<< runParserT (PState { input: s, position: initialPos })
+runParser s = runIdentity <<< runParserT (PState s initialPos)
 
 instance functorParserT :: (Functor m) => Functor (ParserT s m) where
-  map f p = ParserT $ \s -> f' <$> unParserT p s
+  map f p = ParserT \s -> f' <$> unParserT p s
     where
-    f' o = { input: o.input, result: f <$> o.result, consumed: o.consumed, position: o.position }
+    f' (Result input result consumed pos) = Result input (f <$> result) consumed pos
 
 instance applyParserT :: Monad m => Apply (ParserT s m) where
   apply = ap
 
 instance applicativeParserT :: Monad m => Applicative (ParserT s m) where
-  pure a = ParserT $ \(PState { input: s, position: pos }) -> pure { input: s, result: Right a, consumed: false, position: pos }
+  pure a = ParserT \(PState s pos) -> do
+    pure (Result s (Right a) false pos)
 
 instance altParserT :: Monad m => Alt (ParserT s m) where
-  alt p1 p2 = ParserT $ \s -> unParserT p1 s >>= \o ->
-    case o.result of
-      Left _ | not o.consumed -> unParserT p2 s
-      _ -> pure o
+  alt p1 p2 = ParserT \s -> do
+    (o@(Result input result consumed pos)) <- unParserT p1 s
+    case result of
+      Left _ | not consumed -> unParserT p2 s
+      otherwise             -> pure o
 
 instance plusParserT :: Monad m => Plus (ParserT s m) where
   empty = fail "No alternative"
 
 instance alternativeParserT :: Monad m => Alternative (ParserT s m)
 
 instance bindParserT :: Monad m => Bind (ParserT s m) where
-  bind p f = ParserT $ \s -> unParserT p s >>= \o ->
-    case o.result of
-      Left err -> pure { input: o.input, result: Left err, consumed: o.consumed, position: o.position }
-      Right a -> updateConsumedFlag o.consumed <$> unParserT (f a) (PState { input: o.input, position: o.position })
-    where
-    updateConsumedFlag c o = { input: o.input, consumed: c || o.consumed, result: o.result, position: o.position }
+  bind p f = ParserT \s -> do
+    (Result input result consumed pos) <- unParserT p s
+    case result of
+      Left err  -> pure (Result input (Left err) consumed pos)
+      Right a -> do
+        (Result input' result' consumed' pos') <- unParserT (f a) (PState input pos)
+        pure (Result input' result' (consumed || consumed') pos')
 
 instance monadParserT :: Monad m => Monad (ParserT s m)
 
@@ -89,27 +100,27 @@ instance monadZeroParserT :: Monad m => MonadZero (ParserT s m)
 instance monadPlusParserT :: Monad m => MonadPlus (ParserT s m)
 
 instance monadTransParserT :: MonadTrans (ParserT s) where
-  lift m = ParserT $ \(PState { input: s, position: pos }) -> (\a -> { input: s, consumed: false, result: Right a, position: pos }) <$> m
+  lift m = ParserT \(PState s pos) -> (\a -> Result s (Right a) false pos) <$> m
 
 instance monadStateParserT :: Monad m => MonadState s (ParserT s m) where
-  state f = ParserT $ \(PState { input: s, position: pos }) ->
+  state f = ParserT \(PState s pos) ->
     pure $ case f s of
-      Tuple a s' -> { input: s', consumed: false, result: Right a, position: pos }
+      Tuple a s' -> Result s' (Right a) false pos
 
 instance lazyParserT :: Lazy (ParserT s m a) where
-  defer f = ParserT $ \s -> unParserT (f unit) s
+  defer f = ParserT \s -> unParserT (f unit) s
 
 -- | Set the consumed flag.
 consume :: forall s m. Monad m => ParserT s m Unit
-consume = ParserT $ \(PState { input: s, position: pos }) -> pure { consumed: true, input: s, result: Right unit, position: pos }
+consume = ParserT \(PState s pos) -> pure (Result s (Right unit) true pos)
 
 -- | Fail with a message.
 fail :: forall m s a. Monad m => String -> ParserT s m a
-fail message = ParserT $ \(PState { input: s, position: pos }) -> pure $ parseFailed s pos message
+fail message = ParserT \(PState s pos) -> pure $ parseFailed s pos message
 
 -- | Creates a failed parser state for the remaining input `s` and current position
 -- | with an error message.
 -- |
 -- | Most of the time, `fail` should be used instead.
-parseFailed :: forall s a. s -> Position -> String -> { input :: s, result :: Either ParseError a, consumed :: Boolean, position :: Position }
-parseFailed s pos message = { input: s, consumed: false, result: Left (ParseError { message: message, position: pos }), position: pos }
+parseFailed :: forall s a. s -> Position -> String -> Result s a
+parseFailed s pos message = Result s (Left (ParseError message pos)) false pos

src/Text/Parsing/Parser/Combinators.purs

@@ -28,7 +28,7 @@ import Data.Either (Either(..))
 import Data.Foldable (class Foldable, foldl)
 import Data.List (List(..), (:), many, some, singleton)
 import Data.Maybe (Maybe(..))
-import Text.Parsing.Parser (PState(..), ParserT(..), fail, unParserT)
+import Text.Parsing.Parser (PState(..), ParserT(..), Result(..), fail, unParserT)
 
 -- | Provide an error message in the case of failure.
 withErrorMessage :: forall m s a. Monad m => ParserT s m a -> String -> ParserT s m a
@@ -71,10 +71,10 @@ optionMaybe p = option Nothing (Just <$> p)
 
 -- | In case of failure, reset the stream to the unconsumed state.
 try :: forall m s a. (Functor m) => ParserT s m a -> ParserT s m a
-try p = ParserT $ \(PState { input: s, position: pos }) -> try' s pos <$> unParserT p (PState { input: s, position: pos })
+try p = ParserT \(PState s pos) -> try' s pos <$> unParserT p (PState s pos)
   where
-  try' s pos o@{ result: Left _ } = { input: s, result: o.result, consumed: false, position: pos }
-  try' _ _   o = o
+  try' s pos o@(Result _ (result@(Left _)) _ _) = Result s result false pos
+  try' _ _ o = o
 
 -- | Parse phrases delimited by a separator.
 -- |
@@ -174,9 +174,9 @@ skipMany1 p = do
 
 -- | Parse a phrase, without modifying the consumed state or stream position.
 lookAhead :: forall s a m. Monad m => ParserT s m a -> ParserT s m a
-lookAhead (ParserT p) = ParserT \(PState { input: s, position: pos }) -> do
-  state <- p (PState { input: s, position: pos })
-  pure state{input = s, consumed = false, position = pos}
+lookAhead (ParserT p) = ParserT \(PState s pos) -> do
+  (Result _ res _ _) <- p (PState s pos)
+  pure (Result s res false pos)
 
 -- | Fail if the specified parser matches.
 notFollowedBy :: forall s a m. Monad m => ParserT s m a -> ParserT s m Unit

src/Text/Parsing/Parser/String.purs

@@ -9,30 +9,30 @@ import Data.Either (Either(..))
 import Data.Foldable (elem, notElem)
 import Data.Maybe (Maybe(..))
 import Data.String (charAt, drop, fromCharArray, indexOf, length, singleton)
-import Text.Parsing.Parser (PState(..), ParserT(..), fail, parseFailed)
+import Text.Parsing.Parser (PState(..), ParserT(..), Result(..), fail, parseFailed)
 import Text.Parsing.Parser.Combinators (try)
 import Text.Parsing.Parser.Pos (updatePosString)
 
 -- | Match end-of-file.
 eof :: forall m. (Monad m) => ParserT String m Unit
-eof = ParserT $ \(PState { input: s, position: pos }) ->
+eof = ParserT \(PState s pos) ->
   pure $ case s of
-    "" -> { consumed: false, input: s, result: Right unit, position: pos }
+    "" -> Result s (Right unit) false pos
     _  -> parseFailed s pos "Expected EOF"
 
 -- | Match the specified string.
 string :: forall m. (Monad m) => String -> ParserT String m String
-string str = ParserT $ \(PState { input: s, position: pos })  ->
+string str = ParserT \(PState s pos)  ->
   pure $ case indexOf str s of
-    Just 0 -> { consumed: true, input: drop (length str) s, result: Right str, position: updatePosString pos str }
+    Just 0 -> Result (drop (length str) s) (Right str) true (updatePosString pos str)
     _ -> parseFailed s pos ("Expected " <> str)
 
 -- | Match any character.
 anyChar :: forall m. (Monad m) => ParserT String m Char
-anyChar = ParserT $ \(PState { input: s, position: pos }) ->
+anyChar = ParserT \(PState s pos) ->
   pure $ case charAt 0 s of
     Nothing -> parseFailed s pos "Unexpected EOF"
-    Just c  -> { consumed: true, input: drop 1 s, result: Right c, position: updatePosString pos (singleton c) }
+    Just c  -> Result (drop 1 s) (Right c) true (updatePosString pos (singleton c))
 
 -- | Match a character satisfying the specified predicate.
 satisfy :: forall m. (Monad m) => (Char -> Boolean) -> ParserT String m Char

src/Text/Parsing/Parser/Token.purs

@@ -34,24 +34,24 @@ import Data.Either (Either(..))
 import Data.Foldable (foldl, foldr)
 import Data.Identity (Identity)
 import Data.Int (toNumber)
-import Data.List (List(..))
+import Data.List (List(..), (:))
 import Data.List as List
 import Data.Maybe (Maybe(..), maybe)
 import Data.String (toCharArray, null, toLower, fromCharArray, singleton, uncons)
 import Data.Tuple (Tuple(..))
 
 import Math (pow)
 
-import Text.Parsing.Parser (PState(..), ParserT(..), fail, parseFailed)
+import Text.Parsing.Parser (PState(..), ParserT(..), Result(..), fail, parseFailed)
 import Text.Parsing.Parser.Combinators (skipMany1, try, skipMany, notFollowedBy, option, choice, between, sepBy1, sepBy, (<?>), (<??>))
 import Text.Parsing.Parser.Pos (Position)
 import Text.Parsing.Parser.String (satisfy, oneOf, noneOf, string, char)
 
 -- | Create a parser which Returns the first token in the stream.
 token :: forall m a. Monad m => (a -> Position) -> ParserT (List a) m a
-token tokpos = ParserT $ \(PState { input: toks, position: pos }) ->
+token tokpos = ParserT \(PState toks pos) ->
   pure $ case toks of
-    Cons x xs -> { consumed: true, input: xs, result: Right x, position: tokpos x }
+    x : xs -> Result xs (Right x) true (tokpos x)
     _ -> parseFailed toks pos "expected token, met EOF"
 
 -- | Create a parser which matches any token satisfying the predicate.
@@ -400,7 +400,7 @@ makeTokenParser (LanguageDef languageDef)
 
         folder :: Maybe Char -> List Char -> List Char
         folder Nothing chars = chars
-        folder (Just c) chars = Cons c chars
+        folder (Just c) chars = c : chars
 
 
     stringChar :: ParserT String m (Maybe Char)

test/Main.purs

@@ -39,7 +39,7 @@ parseTest input expected p = case runParser input p of
 parseErrorTestPosition :: forall s a eff. (Show a) => Parser s a -> s -> Position -> Eff (console :: CONSOLE, assert :: ASSERT | eff) Unit
 parseErrorTestPosition p input expected = case runParser input p of
   Right _ -> assert' "error: ParseError expected!" false
-  Left (ParseError { position: pos }) -> assert' ("expected: " <> show expected <> ", pos: " <> show pos) (expected == pos)
+  Left (ParseError _ pos) -> assert' ("expected: " <> show expected <> ", pos: " <> show pos) (expected == pos)
 
 opTest :: Parser String String
 opTest = chainl (singleton <$> anyChar) (char '+' $> append) ""