-
Notifications
You must be signed in to change notification settings - Fork 0
/
Parser.fs
84 lines (65 loc) · 2.54 KB
/
Parser.fs
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
74
75
76
77
78
79
80
81
82
83
84
namespace Parser
open FParsec
open Model
module private Testing =
let (<!>) (p: Parser<_, _>) label : Parser<_, _> =
fun stream ->
printfn "%A: Entering %s" stream.Position label
let reply = p stream
printfn "%A: Leaving %s (%A)" stream.Position label reply.Status
reply
module RollingMethod =
let keepHigh =
pstringCI "H" <|> pstringCI "KH" >>. opt puint32
|>> function
| Some n -> KeepHigh n
| None -> KeepHigh 1u
let keepLow =
pstringCI "L" <|> pstringCI "KL" >>. opt puint32
|>> function
| Some n -> KeepLow n
| None -> KeepLow 1u
let total = optional (pstringCI "T") |>> fun () -> Total
let RollingMethodParser = (attempt keepHigh) <|> (attempt keepLow) <|> total
module DiceSize =
let constant = puint32 |>> Constant
let enumeration =
(sepBy pint32 (spaces .>>? skipChar ',' .>> spaces)) |>> Enumeration
let range =
pint32 .>> spaces .>>? skipStringCI ".." .>> spaces .>>. pint32
>>= fun (a, b) ->
if a > b then
fail "The right number of the range must be equal or larger than the left number"
else
preturn <| Range(a, b)
let sequence =
skipChar '[' >>. spaces >>. (range <|> enumeration) .>> spaces .>> skipChar ']'
let DiceSizeParser = constant <|> sequence
module Dice =
let count = puint32
let size = DiceSize.DiceSizeParser
let method = RollingMethod.RollingMethodParser
let DiceParser =
count .>> (pchar 'd' <|> pchar 'D') .>>. size .>>. method
|>> fun ((count, size), method) ->
{ Count = count
Size = size
Method = method }
let FlatParser =
pint32 .>>? notFollowedByStringCI "d"
<?> "integer number (32-bit, signed) not followed by 'd' (case-insensitive)"
module Expression =
let add = skipChar '+' |>> fun () -> Add
let subtract = skipChar '-' |>> fun () -> Subtract
let operator = (attempt add) <|> subtract
let valueExpression =
(Dice.FlatParser |>> ValueExpression.Flat)
<|> (Dice.DiceParser |>> ValueExpression.Dice)
let ExpressionParser =
spaces >>. valueExpression
.>>. many (spaces >>. operator .>> spaces .>>. valueExpression)
|>> fun (first, rest) -> { First = first; Rest = rest }
let evaluate str =
match run ExpressionParser str with
| Success(res, _, _) -> Result.Ok res
| Failure(msg, _, _) -> Result.Error msg