bergamot-elm/src/Bergamot/Parser.elm

module Bergamot.Parser exposing (..)

import Bergamot.Syntax exposing (Term(..), Metavariable(..))
import Bergamot.Rules exposing (Rule, Section, RuleEnv)
import Bergamot.Utils exposing (decodeStr)

import Parser exposing (Parser, Trailing(..), (|.), (|=))
import Set exposing (Set)

reserved : Set String
reserved = Set.fromList ["section"]

intLit : Parser Int
intLit = Parser.int

strLit : Parser String
strLit =
    let
        char = Parser.map decodeStr <| Parser.getChompedString <|
            Parser.oneOf
                [ Parser.backtrackable <|
                    Parser.chompIf (\c -> c == '\\')
                    |. Parser.chompIf (\c -> True)
                , Parser.backtrackable <| Parser.chompIf (\c -> c /= '"')
                ]
    in
        Parser.map (String.join "") <| Parser.sequence
            { start = "\""
            , separator = ""
            , end = "\""
            , spaces = Parser.succeed ()
            , item = char
            , trailing = Optional
            }


name : Parser String
name = Parser.variable
    { start = \c -> Char.isAlpha c || c == '_'
    , inner = \c -> Char.isAlphaNum c || c == '_'
    , reserved = reserved
    }

variable : Parser Metavariable
variable =
    Parser.succeed MkMetavariable
    |= Parser.variable
        { start = \c -> c == '?'
        , inner = \c -> Char.isAlphaNum c || c == '_'
        , reserved = reserved
        }

term : Parser (Term Metavariable)
term = Parser.lazy (\() -> Parser.oneOf
    [ Parser.backtrackable <|
      Parser.succeed Call
        |= name
        |= Parser.sequence
            { start = "("
            , separator = ","
            , end = ")"
            , spaces = Parser.spaces
            , item = term
            , trailing = Forbidden
            }
    , Parser.backtrackable
        <| Parser.map (List.foldr (\x xs -> Call "cons" [x, xs]) (Call "nil" []))
        <| Parser.sequence
            { start = "["
            , separator = ","
            , end = "]"
            , spaces = Parser.spaces
            , item = term
            , trailing = Forbidden
            }
    , Parser.backtrackable <|
      Parser.succeed (\n -> Call n [])
        |= name
    , Parser.backtrackable <|
      Parser.succeed Var |= variable
    , Parser.succeed IntLit |= intLit
    , Parser.succeed StringLit |= strLit
    ])

rule : Parser Rule
rule =
    let
        makeRule n c ps = { name = n, conclusion = c, premises = ps }
    in
        Parser.succeed makeRule
        |= name
        |. Parser.spaces |. Parser.symbol "@" |. Parser.spaces
        |= term
        |. Parser.spaces |. Parser.symbol "<-" |. Parser.spaces
        |= Parser.sequence
            { start = ""
            , separator = ","
            , end = ""
            , spaces = Parser.spaces
            , item = term
            , trailing = Forbidden
            }
        |. Parser.spaces |. Parser.symbol ";"

rules : Parser (List Rule)
rules = Parser.sequence
    { start = ""
    , separator = ""
    , end = ""
    , spaces = Parser.spaces
    , item = rule
    , trailing = Optional
    }

sectionExp : Parser Section
sectionExp =
    Parser.succeed (\n rs -> { name = n, rules = rs })
    |. Parser.symbol "section" |. Parser.spaces
    |= strLit |. Parser.spaces
    |. Parser.symbol "{" |. Parser.spaces
    |= rules
    |. Parser.symbol "}" |. Parser.spaces

sectionImp : Parser Section
sectionImp =
    (\rs ->
        Parser.oneOf
            [ rule |> Parser.map (\r -> Parser.Loop <| r :: rs)
            , case rs of
                [] -> Parser.problem "empty implicit sections not allowed."
                _ -> Parser.succeed (Parser.Done <| List.reverse rs)
            ])
    |> Parser.loop []
    |> Parser.map (\rs -> { name = "", rules = rs })

program : Parser RuleEnv
program =
    Parser.succeed (\ss -> { sections = ss })
    |= Parser.sequence
        { start = ""
        , separator = ""
        , end = ""
        , spaces = Parser.spaces
        , item = Parser.oneOf [sectionExp, sectionImp]
        , trailing = Mandatory
        }
    |. Parser.end

run : Parser a -> String -> Maybe a
run prs s =
    case Parser.run prs s of
        Ok a -> Just a
        Err _ -> Nothing