196 lines
6.7 KiB
Text
196 lines
6.7 KiB
Text
module GenericParser.Parser where
|
|
import Prelude
|
|
|
|
import Control.Alt (class Alt, (<|>))
|
|
import Control.Alternative (class Alternative)
|
|
import Control.Lazy (class Lazy)
|
|
import Control.Plus (class Plus, empty)
|
|
import Data.Array as A
|
|
import Data.Either (Either(..))
|
|
import Data.Int as Int
|
|
import Data.Maybe (Maybe(..))
|
|
import Data.String.CodeUnits (toCharArray, fromCharArray)
|
|
|
|
import GenericParser.BaseFunctions (concat, isAlpha, isAlphaNum, isDigit, isLower, isSpace, isUpper)
|
|
|
|
type Position = Int
|
|
type PositionString = { string :: String, position :: Position }
|
|
type Input = PositionString
|
|
|
|
type Error e = { position :: Position, error :: Maybe e }
|
|
type Value v = { result :: v, suffix :: Input }
|
|
type Result e v = Either (Error e) (Value v)
|
|
|
|
newtype Parser e v = Parser (Input -> Result e v)
|
|
--newtype Parser v = Parser (String -> Maybe (Tuple v String))
|
|
parse :: forall e v. Parser e v -> (Input -> Result e v)
|
|
parse (Parser p) = p
|
|
|
|
current_position :: forall e. Parser e Position
|
|
current_position = Parser \input -> success input input.position
|
|
|
|
-- | Fail with a specified error.
|
|
-- | When a parsing has a specified error, no alternative will be tried and the error is reported.
|
|
failureError :: forall e v. Position -> Maybe e -> Result e v
|
|
failureError position error = Left { position, error }
|
|
|
|
-- | Fail without a specified error.
|
|
-- | This is used in generic parsers not attached to a specified context,
|
|
-- | such as `digit` or `letter`.
|
|
-- | Also, this can be used to express a possibly expected invalid parsing that should not
|
|
-- | halt the parsing, but rather let an alternative path to be tried.
|
|
failure :: forall e v. Position -> Result e v
|
|
failure position = failureError position Nothing
|
|
|
|
-- | `success` constructs a result value for a successful parsing.
|
|
-- | It requires the input (a string with its current position) and the result.
|
|
success :: forall e v. Input -> v -> Result e v
|
|
success suffix result = Right { suffix, result }
|
|
|
|
-- | Read a single char from the input.
|
|
item :: forall e. Parser e Char
|
|
item = Parser p
|
|
where
|
|
p input = case A.uncons (toCharArray input.string) of
|
|
Nothing -> failure input.position
|
|
Just { head: x, tail: xs } -> success { string: (fromCharArray xs), position: input.position+1 } x
|
|
|
|
instance functorParser :: Functor (Parser e) where
|
|
map :: forall a b. (a -> b) -> Parser e a -> Parser e b
|
|
map f (Parser p) =
|
|
Parser $ \s0 -> case p s0 of
|
|
Right { suffix, result } -> success suffix (f result)
|
|
Left error -> Left error
|
|
|
|
instance applyParser :: Apply (Parser e) where
|
|
apply (Parser p1) (Parser p2)
|
|
= Parser $ \s0 -> case p1 s0 of
|
|
Right { suffix: suffix1, result: result1 } -> case p2 suffix1 of
|
|
Right { suffix: suffix2, result: result2 } -> success suffix2 (result1 result2)
|
|
Left error -> Left error
|
|
Left error -> Left error
|
|
|
|
instance applicativeParser :: Applicative (Parser e) where
|
|
pure a = Parser $ \input -> success input a
|
|
|
|
instance bindParser :: Bind (Parser e) where
|
|
bind (Parser p) f = Parser $ \s0 -> case p s0 of
|
|
Right { suffix, result } -> parse (f result) suffix
|
|
Left error -> Left error
|
|
|
|
-- | `Alt` instance: in case of an error that produced an error value, the computation stops.
|
|
instance altParser :: Alt (Parser e) where
|
|
alt :: forall v. Parser e v -> Parser e v -> Parser e v
|
|
alt (Parser p1) (Parser p2) = Parser p
|
|
where
|
|
p stream = case p1 stream of
|
|
Left { position, error } -> case error of
|
|
Nothing -> p2 stream
|
|
_ -> failureError position error
|
|
Right right -> Right right
|
|
|
|
instance plusParser :: Plus (Parser e) where
|
|
empty :: forall v. Parser e v
|
|
empty = Parser \input -> failure input.position
|
|
|
|
instance alternativeParser :: Alternative (Parser e)
|
|
|
|
instance lazyParser :: Lazy (Parser e v) where
|
|
defer f = Parser \input -> parse (f unit) input
|
|
|
|
-- Generic parsing functions.
|
|
|
|
-- | `tryMaybe` provides a way to accept a faulty parser and
|
|
-- | just rewinds back to previous input state if an error occurs.
|
|
tryMaybe :: forall e a. Parser e a -> Parser e (Maybe a)
|
|
tryMaybe p = Parser p'
|
|
where p' input = case parse p input of
|
|
Left _ -> success input Nothing
|
|
Right { suffix, result } -> success suffix (Just result)
|
|
|
|
-- | `try` provides a way to accept a faulty parser and
|
|
-- | just rewinds back to previous input state if a non-specific error occurs.
|
|
-- | The difference with `tryMaybe` is that `try` will forward the error if it is
|
|
-- | a specific one, meaning that `error` isn't `Nothing`.
|
|
try :: forall e a. Parser e a -> Parser e (Maybe a)
|
|
try p = Parser p'
|
|
where p' input = case parse p input of
|
|
Right { suffix, result } -> success suffix (Just result)
|
|
Left { position, error } -> case error of
|
|
Nothing -> success input Nothing
|
|
_ -> failureError position error
|
|
|
|
sat :: forall e. (Char -> Boolean) -> Parser e Char
|
|
sat p = do
|
|
pos <- current_position
|
|
x <- item
|
|
if p x then pure x else Parser \input -> failure pos
|
|
|
|
digit :: forall e. Parser e Char
|
|
digit = sat isDigit
|
|
|
|
lower :: forall e. Parser e Char
|
|
lower = sat isLower
|
|
|
|
upper :: forall e. Parser e Char
|
|
upper = sat isUpper
|
|
|
|
letter :: forall e. Parser e Char
|
|
letter = sat isAlpha
|
|
|
|
alphanum :: forall e. Parser e Char
|
|
alphanum = sat isAlphaNum
|
|
|
|
char :: forall e. Char -> Parser e Char
|
|
char x = sat (_ == x)
|
|
|
|
string :: forall e. String -> Parser e String
|
|
string str = case A.uncons (toCharArray str) of
|
|
Nothing -> Parser \input -> success input ""
|
|
Just { head: x, tail: xs } -> do c <- char x
|
|
rest <- string (fromCharArray xs)
|
|
pure (concat c rest)
|
|
|
|
ident :: forall e. Parser e String
|
|
ident = do x <- lower
|
|
xs <- A.many alphanum
|
|
pure (fromCharArray $ A.cons x xs)
|
|
|
|
nat :: forall e. Parser e Int
|
|
nat = do xs <- A.some digit
|
|
case Int.fromString (fromCharArray xs) of
|
|
Nothing -> empty
|
|
Just x -> pure x
|
|
|
|
int :: forall e. Parser e Int
|
|
int = do _ <- char '-'
|
|
n <- nat
|
|
pure (-n)
|
|
<|> nat
|
|
|
|
space :: forall e. Parser e Unit
|
|
space = do _ <- A.many (sat isSpace)
|
|
pure unit
|
|
|
|
token :: forall e a. Parser e a -> Parser e a
|
|
token p = do space
|
|
v <- p
|
|
_ <- space
|
|
pure v
|
|
|
|
identifier :: forall e. Parser e String
|
|
identifier = token ident
|
|
|
|
natural :: forall e. Parser e Int
|
|
natural = token nat
|
|
|
|
integer :: forall e. Parser e Int
|
|
integer = token int
|
|
|
|
symbol :: forall e. String -> Parser e String
|
|
symbol xs = token (string xs)
|
|
|
|
many1 :: forall e v. Parser e v -> Parser e (Array v)
|
|
many1 p = do first <- p
|
|
rest <- A.many p
|
|
pure $ A.cons first rest
|