58 lines
2.0 KiB
Plaintext
58 lines
2.0 KiB
Plaintext
module Language.Bergamot.Parser where
|
|
|
|
import Prelude
|
|
|
|
|
|
import Language.Bergamot.Syntax (Expr(..))
|
|
import Language.Bergamot.Rules (Rule(..), Metavariable)
|
|
|
|
import Control.Apply (lift2)
|
|
import Control.Lazy (defer)
|
|
import Parsing (Parser, runParser)
|
|
import Parsing.String (char, eof, string)
|
|
import Parsing.String.Basic (digit, letter, space)
|
|
import Parsing.Combinators (many, many1, sepBy, (<|>))
|
|
import Data.Array (fromFoldable)
|
|
import Data.Either (hush)
|
|
import Data.List (List(..))
|
|
import Data.List.NonEmpty (NonEmptyList)
|
|
import Data.Maybe (Maybe)
|
|
import Data.String (codePointFromChar, fromCodePointArray)
|
|
|
|
charsToString :: NonEmptyList Char -> String
|
|
charsToString = fromCodePointArray <<< fromFoldable <<< map codePointFromChar
|
|
|
|
whitespace :: Parser String Unit
|
|
whitespace = void $ many space
|
|
|
|
identifier :: Parser String String
|
|
identifier = (charsToString <$> many1 (letter <|> digit <|> char '_')) <* whitespace
|
|
|
|
expr :: Parser String (Expr Metavariable)
|
|
expr = (defer $ \_ -> atom) <|> (defer $ \_ -> metavariable)
|
|
|
|
atom :: Parser String (Expr Metavariable)
|
|
atom = lift2 Atom (identifier <* whitespace) (args <|> pure Nil)
|
|
where args = char '(' *> sepBy (defer $ \_ -> expr) (char ',' *> whitespace) <* char ')' <* whitespace
|
|
|
|
metavariable :: Parser String (Expr Metavariable)
|
|
metavariable = Var <$> (char '?' *> identifier <* whitespace)
|
|
|
|
rule :: Parser String (Rule Metavariable)
|
|
rule = map MkRule $ pure { head: _, tail: _ } <*> expr <*> (args <|> pure Nil) <* char ';' <* whitespace
|
|
where
|
|
arrow = (void (char '←') <|> void (string "<-")) <* whitespace
|
|
args = arrow *> sepBy expr (char ',' *> whitespace) <* whitespace
|
|
|
|
rules :: Parser String (List (Rule Metavariable))
|
|
rules = many rule
|
|
|
|
parseRule :: String -> Maybe (Rule Metavariable)
|
|
parseRule s = hush $ runParser s (rule <* eof)
|
|
|
|
parseRules :: String -> Maybe (List (Rule Metavariable))
|
|
parseRules s = hush $ runParser s (rules <* eof)
|
|
|
|
parseQuery :: String -> Maybe (Expr Metavariable)
|
|
parseQuery s = hush $ runParser s (expr <* eof)
|