Kiln » babybearparser
Clone URL:  
Pushed to one repository · View In Graph Contained in tip

Better error parsing.

Changeset 17b2b6ad680b

Parent ab91a87e0efb

by Profile picture of User 138Hao Lian <hao@fogcreek.com>

Changes to 2 files · Browse files at 17b2b6ad680b Showing diff from parent ab91a87e0efb Diff from another changeset...

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
30
 
 
 
 
 
 
31
 
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
 
51
52
53
54
55
56
57
58
59
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 
 
 
 
 
 
 
48
49
50
 
51
52
53
54
55
56
57
58
59
60
 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 findFilter = function - | "author" -> Author - | "file" -> File - | "project" -> Project - | "repo" -> Repo - | _ -> raise <| Exception "Invalid filter name" -  let filter =   (filterName |>> findFilter)   .>> (pchar ':') - .>>. (phrase <|> word) + .>>. (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
 
6
7
8
9
10
 
 
11
12
 
13
14
 
15
16
17
 
19
20
21
22
 
23
24
25
 
59
60
61
62
 
63
64
65
66
 
 
 
6
7
8
 
 
9
10
11
 
12
13
 
14
15
16
17
 
19
20
21
 
22
23
24
25
 
59
60
61
 
62
63
64
65
 
 
66
@@ -6,12 +6,12 @@
   open babybearparser.Parser   -let equals actual expected = Assert.AreEqual (expected, actual) -let throws<'a when 'a :> exn> (f: unit -> unit) = +let equals actual expected = Assert.IsTrue ((actual = expected), String.Format("{0} <> {1}", actual, expected)) +let throwsParseError (f: unit -> unit) contains =   try - f(); Assert.Fail ("throws: no exception thrown of type: " + typedefof<'a>.Name) + f(); Assert.Fail ("throws: no exception thrown of type ParseError")   with - | :? 'a -> () + | ParseError(x) -> Assert.IsTrue (x.Contains(contains), String.Format("{0} does not contain {1}", x, contains))    [<TestClass>]  type public Tests () = @@ -19,7 +19,7 @@
  [<TestMethod>]   member this.TestsWorking() =   equals 1 1 - +   [<TestMethod>]   member this.TestsKeywords() =   equals (parse "foo bar") [KeywordAtom <| Word "foo"; KeywordAtom <| Word "bar"] @@ -59,8 +59,8 @@
  [<TestMethod>]   member this.TestsMissingFilter() =   let f () = parse "\"foo bar\" project:" |> ignore - throws<ParseError> f + throwsParseError f "filter argument"     [<TestMethod>]   member this.TestsUnknownFilter() = - equals (parse "unknown:careless") [KeywordAtom <| Word "unknown:careless"] \ No newline at end of file
+ equals (parse "unknown:careless") [KeywordAtom <| Word "unknown:careless"]