We are currently indexing your data, so search results may be incomplete until we finish.
|
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 failIfNone msg = function
| Some x -> preturn x
| None -> fail msg
let stringToDate = function
| "today" -> Some DateTime.UtcNow.Date
| "yesterday" -> Some <| DateTime.UtcNow.Date.AddDays(-1.)
| s -> try DateTime.Parse s |> Some with :? FormatException -> None
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 regularFilter =
(filterName |>> findFilter)
.>> (pchar ':')
.>>. (phrase <|> word <?> "filter argument")
|>> pipeline
let dateWord = many1Chars <| noneOf ". "
let fullDate = (phrase <|> dateWord) |>> stringToDate >>= failIfNone "Unrecognized date"
let dateStart = fullDate <|>% DateTime.MinValue
let dateEnd = fullDate <|>% DateTime.UtcNow.Date
let dateFilter = pstring "date:" >>. dateStart .>> pstring ".." .>>. dateEnd |>> Date
let filter = regularFilter <|> dateFilter
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...