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

Better exception and exception handling.

Changeset c381bb2b7e39…

Parent 876e4bb434dc…

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

Changes to 2 files · Browse files at c381bb2b7e39 Showing diff from parent 876e4bb434dc Diff from another changeset...

Change 1 of 3 Show Changes Only babybearparser/​Parser.fs Stacked
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
61
62
63
64
65
66
67
68
69
70
71
72
73
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
61
62
63
64
 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 +type ParseError (msg: string) = + inherit Exception (msg)    (* Utilities *)  let pipeline (f, a) = f a  let failIfNone msg = function   | Some x -> preturn x   | None -> fail msg  let stringToDate = function   | "today" -> DateTime.UtcNow.Date |> Some   | "yesterday" -> DateTime.UtcNow.Date.AddDays -1. |> Some   | 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" + | _ -> raise <| ParseError "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
Change 1 of 1 Show Entire File babybearparser/​Testing.fs Stacked
 
6
7
8
9
 
 
10
11
12
13
14
 
15
16
17
 
6
7
8
 
9
10
11
12
13
14
 
15
16
17
18
@@ -6,12 +6,13 @@
   open babybearparser.Parser   -let equals actual expected = Assert.IsTrue ((actual = expected), String.Format("{0} <> {1}", actual, expected)) +let equals actual expected = Assert.IsTrue ((actual = expected), sprintf "%+A <> %+A" actual expected) +  let throwsParseError (f: unit -> unit) contains =   try   f(); Assert.Fail ("throws: no exception thrown of type ParseError")   with - | ParseError(x) -> Assert.IsTrue (x.Contains(contains), String.Format("{0} does not contain {1}", x, contains)) + | :? ParseError as ex -> Assert.IsTrue (ex.Message.Contains(contains), sprintf "%O does not contain %s" ex contains)    [<TestClass>]  type public Tests () =