updates for 0.10

Author: paf31

.gitignore

@@ -1,8 +1,6 @@
-/.*
-!/.gitignore
-!/.jscsrc
-!/.jshintrc
-!/.travis.yml
-/bower_components/
-/node_modules/
-/output/
+.psci*
+bower_components/
+output/
+.psc-package
+.psc-ide-port
+.psa-stash

bower.json

@@ -20,19 +20,19 @@
     "package.json"
   ],
   "dependencies": {
-    "purescript-arrays": "^1.0.0",
-    "purescript-either": "^1.0.0",
-    "purescript-foldable-traversable": "^1.0.0",
-    "purescript-identity": "^1.0.0",
-    "purescript-integers": "^1.0.0",
-    "purescript-lists": "^1.0.0",
-    "purescript-maybe": "^1.0.0",
-    "purescript-strings": "^1.0.0",
-    "purescript-transformers": "^1.0.0",
-    "purescript-unicode": "^1.0.0"
+    "purescript-arrays": "^3.0.0",
+    "purescript-either": "^2.0.0",
+    "purescript-foldable-traversable": "^2.0.0",
+    "purescript-identity": "^2.0.0",
+    "purescript-integers": "^2.0.0",
+    "purescript-lists": "^2.0.0",
+    "purescript-maybe": "^2.0.0",
+    "purescript-strings": "^2.0.0",
+    "purescript-transformers": "^2.0.0",
+    "purescript-unicode": "6d9a4ab9d239da4cecb33283994cce56350bbe87"
   },
   "devDependencies": {
-    "purescript-assert": "^1.0.0",
-    "purescript-console": "^1.0.0"
+    "purescript-assert": "^2.0.0",
+    "purescript-console": "^2.0.0"
   }
 }

src/Text/Parsing/Parser.purs

@@ -1,115 +1,104 @@
-module Text.Parsing.Parser where
+module Text.Parsing.Parser
+  ( ParseError(..)
+  , ParseState(..)
+  , ParserT(..)
+  , Parser
+  , runParser
+  , consume
+  , fail
+  ) where
 
 import Prelude
-
-import Control.Lazy (class Lazy)
-import Control.Monad.State.Class (class MonadState)
-import Control.Monad.Trans (class MonadTrans)
-import Control.MonadPlus (class MonadPlus, class MonadZero, class Alternative)
-import Control.Plus (class Plus, class Alt)
+import Control.Alt (class Alt)
+import Control.Lazy (defer, class Lazy)
+import Control.Monad.Except (class MonadError, ExceptT(..), throwError, runExceptT)
+import Control.Monad.Rec.Class (class MonadRec)
+import Control.Monad.State (runStateT, class MonadState, StateT(..), gets, evalStateT, modify)
+import Control.Monad.Trans.Class (lift, class MonadTrans)
+import Control.MonadPlus (class Alternative, class MonadZero, class MonadPlus, class Plus)
 import Data.Either (Either(..))
-import Data.Identity (Identity, runIdentity)
+import Data.Identity (Identity)
+import Data.Newtype (class Newtype, unwrap)
 import Data.Tuple (Tuple(..))
 import Text.Parsing.Parser.Pos (Position, initialPos)
 
 -- | A parsing error, consisting of a message and position information.
-data ParseError = ParseError
+newtype ParseError = ParseError
   { message :: String
   , position :: Position
   }
 
 instance showParseError :: Show ParseError where
   show (ParseError msg) = "ParseError { message: " <> msg.message <> ", position: " <> show msg.position <> " }"
 
-instance eqParseError :: Eq ParseError where
-  eq (ParseError {message : m1, position : p1}) (ParseError {message : m2, position : p2}) = m1 == m2 && p1 == p2
+derive instance eqParseError :: Eq ParseError
 
 -- | `PState` contains the remaining input and current position.
-data PState s = PState
+newtype ParseState s = ParseState
   { input :: s
   , position :: Position
+  , consumed :: Boolean
   }
 
 -- | 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 })
+-- | 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 (ExceptT ParseError (StateT (ParseState s) m) 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 (ParserT p) = p
+derive instance newtypeParserT :: Newtype (ParserT s m a) _
 
 -- | 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
+runParserT :: forall m s a. Monad m => s -> ParserT s m a -> m (Either ParseError a)
+runParserT s p = evalStateT (runExceptT (unwrap p)) initialState where
+  initialState = ParseState { input: s, position: initialPos, consumed: false }
 
 -- | 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 })
-
-instance functorParserT :: (Functor m) => Functor (ParserT s m) where
-  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 }
+runParser s = unwrap <<< runParserT s
 
-instance applyParserT :: Monad m => Apply (ParserT s m) where
-  apply = ap
+instance lazyParserT :: Lazy (ParserT s m a) where
+  defer f = ParserT (ExceptT (defer (runExceptT <<< unwrap <<< f)))
 
-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 }
+derive newtype instance functorParserT :: Functor m => Functor (ParserT s m)
+derive newtype instance applyParserT :: Monad m => Apply (ParserT s m)
+derive newtype instance applicativeParserT :: Monad m => Applicative (ParserT s m)
+derive newtype instance bindParserT :: Monad m => Bind (ParserT s m)
+derive newtype instance monadParserT :: Monad m => Monad (ParserT s m)
+derive newtype instance monadRecParserT :: MonadRec m => MonadRec (ParserT s m)
+derive newtype instance monadStateParserT :: Monad m => MonadState (ParseState s) (ParserT s m)
+derive newtype instance monadErrorParserT :: Monad m => MonadError ParseError (ParserT s m)
 
 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 <<< ExceptT <<< StateT) \(s@(ParseState { input, position })) -> do
+    Tuple e (ParseState s') <- runStateT (runExceptT (unwrap p1)) (ParseState { input, position, consumed: false })
+    case e of
+      Left err
+        | not s'.consumed -> runStateT (runExceptT (unwrap p2)) s
+      _ -> pure (Tuple e (ParseState s'))
 
 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 }
-
-instance monadParserT :: Monad m => Monad (ParserT s m)
-
 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
-
-instance monadStateParserT :: Monad m => MonadState s (ParserT s m) where
-  state f = ParserT $ \(PState { input: s, position: pos }) ->
-    pure $ case f s of
-      Tuple a s' -> { input: s', consumed: false, result: Right a, position: pos }
-
-instance lazyParserT :: Lazy (ParserT s m a) where
-  defer f = ParserT $ \s -> unParserT (f unit) s
+  lift = ParserT <<< lift <<< lift
 
 -- | 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 = modify \(ParseState { input, position }) ->
+  ParseState { input, position, consumed: true }
 
 -- | 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
-
--- | 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 }
+fail message = do
+  position <- gets \(ParseState s) -> s.position
+  throwError (ParseError { message, position })

src/Text/Parsing/Parser/Combinators.purs

@@ -1,6 +1,7 @@
 -- | Combinators for creating parsers.
 -- |
--- | ### Notes:
+-- | ### Notes
+-- |
 -- | A few of the known combinators from Parsec are missing in this module. That
 -- | is because they have already been defined in other libraries.
 -- |
@@ -16,19 +17,20 @@
 -- | ```purescript
 -- | Text.Parsec.many  (char 'x') <=> fromCharArray <$> Data.Array.many (char 'x')
 -- | ```
--- |
--- | ===
 
 module Text.Parsing.Parser.Combinators where
 
-import Prelude (class Functor, class Monad, Unit, ($), (*>), (<>), (<$>), bind, flip, pure, unit)
-
+import Prelude
+import Control.Monad.Except (runExceptT, ExceptT(..))
+import Control.Monad.State (StateT(..), runStateT)
 import Control.Plus (empty, (<|>))
 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 Data.Newtype (unwrap)
+import Data.Tuple (Tuple(..))
+import Text.Parsing.Parser (ParseState(..), ParserT(..), fail)
 
 -- | 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
@@ -70,11 +72,18 @@ optionMaybe :: forall m s a. Monad m => ParserT s m a -> ParserT s m (Maybe a)
 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 })
-  where
-  try' s pos o@{ result: Left _ } = { input: s, result: o.result, consumed: false, position: pos }
-  try' _ _   o = o
+try :: forall m s a. Monad m => ParserT s m a -> ParserT s m a
+try p = (ParserT <<< ExceptT <<< StateT) \(s@(ParseState { consumed })) -> do
+  Tuple e s'@(ParseState { input, position }) <- runStateT (runExceptT (unwrap p)) s
+  case e of
+    Left _ -> pure (Tuple e (ParseState { input, position, consumed }))
+    _ -> pure (Tuple e s')
+
+-- | 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 p = (ParserT <<< ExceptT <<< StateT) \s -> do
+  Tuple e _ <- runStateT (runExceptT (unwrap p)) s
+  pure (Tuple e s)
 
 -- | Parse phrases delimited by a separator.
 -- |
@@ -172,12 +181,6 @@ skipMany1 p = do
   xs <- skipMany p
   pure unit
 
--- | 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}
-
 -- | Fail if the specified parser matches.
 notFollowedBy :: forall s a m. Monad m => ParserT s m a -> ParserT s m Unit
 notFollowedBy p = try $ (try p *> fail "Negated parser succeeded") <|> pure unit

src/Text/Parsing/Parser/Pos.purs

@@ -1,15 +1,15 @@
 module Text.Parsing.Parser.Pos where
 
 import Prelude
-
-import Data.String (split)
 import Data.Foldable (foldl)
+import Data.Newtype (wrap)
+import Data.String (split)
 
 -- | `Position` represents the position of the parser in the input.
 -- |
 -- | - `line` is the current line in the input
 -- | - `column` is the column of the next character in the current line that will be parsed
-data Position = Position
+newtype Position = Position
   { line :: Int
   , column :: Int
   }
@@ -18,17 +18,16 @@ instance showPosition :: Show Position where
   show (Position { line: line, column: column }) =
     "Position { line: " <> show line <> ", column: " <> show column <> " }"
 
-instance eqPosition :: Eq Position where
-  eq (Position { line: l1, column: c1 }) (Position { line: l2, column: c2 }) =
-    l1 == l2 && c1 == c2
+derive instance eqPosition :: Eq Position
+derive instance ordPosition :: Ord Position
 
 -- | The `Position` before any input has been parsed.
 initialPos :: Position
 initialPos = Position { line: 1, column: 1 }
 
 -- | Updates a `Position` by adding the columns and lines in `String`.
 updatePosString :: Position -> String -> Position
-updatePosString pos str = foldl updatePosChar pos (split "" str)
+updatePosString pos str = foldl updatePosChar pos (split (wrap "") str)
   where
   updatePosChar (Position pos) c = case c of
     "\n" -> Position { line: pos.line + 1, column: 1 }