Merge pull request #36 from purescript-contrib/0.10

Updates for 0.10

Author: paf31

LICENSE

@@ -1,23 +1,24 @@
-The MIT License (MIT)
-
-Copyright (c) 2014 PureScript
-
-Permission is hereby granted, free of charge, to any person obtaining a copy of
-this software and associated documentation files (the "Software"), to deal in
-the Software without restriction, including without limitation the rights to
-use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
-the Software, and to permit persons to whom the Software is furnished to do so,
-subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all
-copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
-FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
-COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
-IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
-CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+Copyright 2014-2016 PureScript
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice,
+  this list of conditions and the following disclaimer.
+* Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer in the
+  documentation and/or other materials provided with the distribution.
+
+This software is provided by the copyright holders "as is" and any express or
+implied warranties, including, but not limited to, the implied warranties of
+merchantability and fitness for a particular purpose are disclaimed. In no
+event shall the copyright holders be liable for any direct, indirect,
+incidental, special, exemplary, or consequential damages (including, but not
+limited to, procurement of substitute goods or services; loss of use, data,
+or profits; or business interruption) however caused and on any theory of
+liability, whether in contract, strict liability, or tort (including
+negligence or otherwise) arising in any way out of the use of this software,
+even if advised of the possibility of such damage.
 
 -------------------------------------------------------------------------------
 

bower.json

@@ -5,7 +5,7 @@
   "keywords": [
     "purescript"
   ],
-  "license": "MIT",
+  "license": "BSD3",
   "repository": {
     "type": "git",
     "url": "git://github.com/purescript-contrib/purescript-parsing.git"
@@ -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": "^2.0.0"
   },
   "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,107 @@
-module Text.Parsing.Parser where
+module Text.Parsing.Parser
+  ( ParseError
+  , parseErrorMessage
+  , parseErrorPosition
+  , 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
-  { message :: String
-  , position :: Position
-  }
+data ParseError = ParseError String Position
+
+parseErrorMessage :: ParseError -> String
+parseErrorMessage (ParseError msg _) = msg
+
+parseErrorPosition :: ParseError -> Position
+parseErrorPosition (ParseError _ pos) = pos
 
 instance showParseError :: Show ParseError where
-  show (ParseError msg) = "ParseError { message: " <> msg.message <> ", position: " <> show msg.position <> " }"
+  show (ParseError msg pos) =
+    "(ParseError " <> show msg <> show pos <> ")"
 
-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
+derive instance ordParseError :: Ord ParseError
 
--- | `PState` contains the remaining input and current position.
-data PState s = PState
-  { input :: s
-  , position :: Position
-  }
+-- | Contains the remaining input and current position.
+data ParseState s = ParseState s Position 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 s initialPos 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 })
+runParser s = unwrap <<< runParserT s
 
-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 }
-
-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 i p _)) -> do
+    Tuple e s'@(ParseState i' p' c') <- runStateT (runExceptT (unwrap p1)) (ParseState i p false)
+    case e of
+      Left err
+        | not c' -> runStateT (runExceptT (unwrap p2)) s
+      _ -> pure (Tuple e 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 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 _ pos _) -> pos
+  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 }