Base for a new Parser structure.

This commit is contained in:
Philippe Pittoli 2024-01-13 04:17:03 +01:00
parent 829be33168
commit c4c624a2b4
4 changed files with 82 additions and 57 deletions

View File

@ -16,6 +16,7 @@ to generate this file without the comments in this block.
, "console"
, "control"
, "effect"
, "either"
, "integers"
, "maybe"
, "prelude"

View File

@ -1,8 +1,7 @@
-- | `DomainParser` is a simple parser for domain names as described in RFC 1035.
module DomainParser where
import Prelude
--import Prelude (bind, discard, pure, show, ($), (<>), (>))
import Prelude (class Monoid, bind, mempty, not, pure, ($), (&&), (*>), (<<<), (<>), (==), (>))
import Control.Lazy (defer)
import Data.Maybe (Maybe(..))
@ -14,7 +13,7 @@ import Data.String.CodeUnits as CU
import Control.Alt ((<|>))
import Control.Plus (empty)
import Parser
import Parser (Parser(..), alphanum, char, letter, many1, parse, string)
-- | From RFC 1035: <let-dig> ::= <letter> | <digit>
let_dig :: Parser Char

View File

@ -1,9 +1,9 @@
module Main where
import Parser
import DomainParser
import Parser (Parser, parse)
import DomainParser (domain, label, ldh_str, sub_eof, subdomain)
import Prelude (Unit, discard, show, ($), (==), (<>))
import Prelude (Unit, discard, show, ($), (<>))
import Effect (Effect)
import Effect.Console (log)

View File

@ -8,134 +8,159 @@ import Control.Plus (class Plus, empty)
import Data.Array as A
import Data.Int as Int
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.String.CodeUnits (uncons, toCharArray, fromCharArray)
import Data.Tuple (Tuple(..))
-- import Data.Tuple (Tuple(..))
import BaseFunctions (concat, isAlpha, isAlphaNum, isDigit, isLower, isSpace, isUpper)
newtype Parser v = Parser (String -> Maybe (Tuple v String))
parse :: forall a. Parser a -> (String -> Maybe (Tuple a String))
type Input = String
type Size = Int
type Position = Int
data DomainError
= SubdomainTooLarge Position Size
| DomainTooLarge Size
| InvalidCharacter Position
type Error e = { pos :: Position, input :: Input, error :: Maybe e }
type Value v = { pos :: Position, input :: Input, result :: v }
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
item :: Parser Char
failError :: forall e v. Position -> Input -> Maybe e -> Result e v
failError pos input error = Left { pos: pos, error: error, input: input }
fail :: forall e v. Position -> Input -> Result e v
fail pos input = failError pos input Nothing
success :: forall e v. Position -> Input -> v -> Result e v
success pos input v = Right { pos: pos, input: input, result: v }
item :: forall e. Parser e Char
item = Parser p
where p str = case uncons str of
Nothing -> Nothing
Just { head: x, tail: xs } -> Just (Tuple x xs)
Nothing -> fail 0 str
Just { head: x, tail: xs } -> success 1 xs x
instance functorParser :: Functor Parser where
instance functorParser :: Functor (Parser e) where
map :: forall a b. (a -> b) -> Parser e a -> Parser e b
map f (Parser p) =
Parser $ \s0 -> do
(Tuple x s1) <- p s0
pure (Tuple (f x) s1)
Parser $ \s0 -> case p s0 of
Right { pos: pos, input: input, result: v } -> success pos input (f v)
Left { pos: pos, input: input, error: e } -> failError pos input e
instance applyParser :: Apply Parser where
instance applyParser :: Apply (Parser e) where
apply (Parser p1) (Parser p2)
= Parser $ \str -> case p1 str of
Nothing -> Nothing
Just (Tuple x1 xs1) -> case p2 xs1 of
Nothing -> Nothing
Just (Tuple x2 xs2) -> Just (Tuple (x1 x2) xs2)
= Parser $ \s0 -> case p1 s0 of
Left error -> Left error
Right { pos: pos1, input: s1, result: r1 } -> case p2 s1 of
Left error -> Left error
Right { pos: pos2, input: s2, result: r2 } -> success (pos1 + pos2) s2 (r1 r2)
instance applicativeParser :: Applicative Parser where
pure a = Parser $ \str -> Just (Tuple a str)
instance applicativeParser :: Applicative (Parser e) where
pure a = Parser $ \str -> success 0 str a
instance bindParser :: Bind Parser where
bind (Parser p) f = Parser $ \str -> case p str of
Nothing -> Nothing
Just (Tuple x xs) ->
let (Parser p2) = f x
in p2 xs
instance bindParser :: Bind (Parser e) where
bind (Parser p) f = Parser $ \s0 -> case p s0 of
Left error -> Left error
Right { pos: _, input: input, result: result } ->
let (Parser p2) = f result
in p2 input
instance altParser :: Alt Parser where
alt :: forall a. Parser a -> Parser a -> Parser a
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
Nothing -> p2 stream
Left { pos: pos, error: error, input: input } -> case error of
Nothing -> p2 stream
_ -> failError pos input error
right -> right
instance plusParser :: Plus Parser where
empty :: forall a. Parser a
empty = Parser \_ -> Nothing
instance plusParser :: Plus (Parser e) where
empty :: forall v. Parser e v
empty = Parser \input -> fail 0 input
instance alternativeParser :: Alternative Parser
instance alternativeParser :: Alternative (Parser e)
instance lazyParser :: Lazy (Parser a) where
instance lazyParser :: Lazy (Parser e v) where
defer f = Parser \str -> parse (f unit) str
-- Generic parsing functions.
sat :: (Char -> Boolean) -> Parser Char
sat :: forall e. (Char -> Boolean) -> Parser e Char
sat p = do x <- item
if p x then pure x else empty
digit :: Parser Char
digit :: forall e. Parser e Char
digit = sat isDigit
lower :: Parser Char
lower :: forall e. Parser e Char
lower = sat isLower
upper :: Parser Char
upper :: forall e. Parser e Char
upper = sat isUpper
letter :: Parser Char
letter :: forall e. Parser e Char
letter = sat isAlpha
alphanum :: Parser Char
alphanum :: forall e. Parser e Char
alphanum = sat isAlphaNum
char :: Char -> Parser Char
char :: forall e. Char -> Parser e Char
char x = sat (_ == x)
string :: String -> Parser String
string :: forall e. String -> Parser e String
string str = case A.uncons (toCharArray str) of
Nothing -> Parser \stream -> Just (Tuple "" stream)
Nothing -> Parser \stream -> success 0 stream ""
Just { head: x, tail: xs } -> do c <- char x
rest <- string (fromCharArray xs)
pure (concat c rest)
ident :: Parser String
ident :: forall e. Parser e String
ident = do x <- lower
xs <- A.many alphanum
pure (fromCharArray $ A.cons x xs)
nat :: Parser Int
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 :: Parser Int
int :: forall e. Parser e Int
int = do _ <- char '-'
n <- nat
pure (-n)
<|> nat
space :: Parser Unit
space :: forall e. Parser e Unit
space = do _ <- A.many (sat isSpace)
pure unit
token :: forall a. Parser a -> Parser a
token :: forall e a. Parser e a -> Parser e a
token p = do space
v <- p
_ <- space
pure v
identifier :: Parser String
identifier :: forall e. Parser e String
identifier = token ident
natural :: Parser Int
natural :: forall e. Parser e Int
natural = token nat
integer :: Parser Int
integer :: forall e. Parser e Int
integer = token int
symbol :: String -> Parser String
symbol :: forall e. String -> Parser e String
symbol xs = token (string xs)
many1 :: forall a. Parser a -> Parser (Array a)
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