module babybearparser.Parser
open FParsec.CharParsers
open FParsec.Primitives
open System
type Keyword = Word of string | Phrase of string
with
override this.ToString() =
match this with
| Word s -> String.Format("Word<{0}>", s)
| Phrase s -> String.Format("Phrase<{0}>", s)
type Filter =
| Author of string
| Date of DateTime * DateTime
| File of string
| Project of string
| Repo of string
type Atom = KeywordAtom of Keyword | FilterAtom of Filter
with
override this.ToString() =
match this with
| KeywordAtom k -> String.Format("KeywordAtom<{0}>", k)
| FilterAtom f -> String.Format("FilterAtom<{0}>", f)
exception ParseError of string
(* Utilities *)
let pipeline (f, a) = f a
let findFilter = function
| "author" -> Author
| "file" -> File
| "project" -> Project
| "repo" -> Repo
| _ -> raise <| Exception "Invalid filter name"
(* Parsers *)
let word = many1Satisfy <| fun c -> c <> ' '
let phraseEscape = pchar '\\' >>. pchar '"'
let phraseInnard = phraseEscape <|> noneOf "\""
let phraseInnards = manyChars phraseInnard
let phrase = between (pchar '"') (pchar '"') phraseInnards
let keyword = (phrase |>> Phrase) <|> (word |>> Word)
let filterName = ["author"; "file"; "project"; "repo"] |> Seq.map pstring |> choice
let filter =
(filterName |>> findFilter)
.>> (pchar ':')
.>>. (phrase <|> word <?> "filter argument")
|>> pipeline
let atom = (filter |>> FilterAtom) <|> (keyword |>> KeywordAtom)
let spaces = many1Satisfy <| fun c -> c = ' '
let atoms = sepBy atom spaces
let parse input =
match run atoms input with
| Success (x, _, _) -> x
| Failure (x, _, _) -> raise <| ParseError x
|
Loading...