Skip to content

Updates for 0.10 #36

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Oct 27, 2016
Merged
Show file tree
Hide file tree
Changes from 2 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 6 additions & 8 deletions .gitignore
Original file line number Diff line number Diff line change
@@ -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
24 changes: 12 additions & 12 deletions bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -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"
}
}
115 changes: 52 additions & 63 deletions src/Text/Parsing/Parser.purs
Original file line number Diff line number Diff line change
@@ -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
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Derive Newtype too? It might be uncommonly used, but may as well since the ParseError ctor isn't private or anything.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can't, because of the record restriction. I could write it by hand with type-equality, but do you think it's worth it?

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ohh, yeah. I keep forgetting about that 😄.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Are we going to add that deriving with type-equality thing for 0.10.2? Or is it not too straightforward?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think that if we do it for everything then it's not too difficult. Trying to pick out the record parts of a type would be much more difficult, or impossible in general, I think.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The downside of doing it for everything is that it makes writing the instance derivation slightly trickier.


-- | `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 })
37 changes: 20 additions & 17 deletions src/Text/Parsing/Parser/Combinators.purs
Original file line number Diff line number Diff line change
@@ -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.
-- |
Expand All @@ -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
Expand Down Expand Up @@ -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.
-- |
Expand Down Expand Up @@ -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
Expand Down
13 changes: 6 additions & 7 deletions src/Text/Parsing/Parser/Pos.purs
Original file line number Diff line number Diff line change
@@ -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
}
Expand All @@ -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 }
Expand Down
Loading