-
Notifications
You must be signed in to change notification settings - Fork 0
/
Jason.fsx
117 lines (100 loc) · 3.63 KB
/
Jason.fsx
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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
#r "packages/FSharp.Data/lib/net40/FSharp.Data.dll"
open FSharp.Data
open FSharp.Data.JsonExtensions
open System.Text.RegularExpressions
type MappedJson<'TObject> =
| Success of 'TObject
| Error of error:string
// Maps a wrapped value 'a to 'b using the provided mapping function
// ('a -> 'b) -> MappedJson<'a> -> MappedJson<'b>
let map f json =
match json with
| Success obj ->
Success (f obj)
| Error e ->
Error e
// Applies a wrapped function 'a -> 'b to a wrapped value M<'a>
let apply (wrappedFunc: MappedJson<'a -> 'b>) (x: MappedJson<'a>) =
match x, wrappedFunc with
| Success obj, Success f ->
Success (f obj)
| _, Error e ->
Error e
| Error e, _ ->
Error e
// Unwraps a wrapped value M<'a> inside a function that yields M<'b>
let bind m f =
match m with
| Success o -> f o
| Error e -> Error e
type MappedJsonBuilder() =
member __.Bind m f = bind m f
member __.Return(x) = Success x
member __.ReturnFrom(m) = m
let mappedJson = MappedJsonBuilder()
let coerceType<'TValue> =
let coerce v = box v :?> 'TValue
function
| JsonValue.String s when typeof<'TValue> = typeof<string> ->
Success (coerce s)
// This will obviously mean that we can lose precision but that's up to the user
| JsonValue.Number n when typeof<'TValue> = typeof<decimal> ->
Success (coerce n)
| JsonValue.Number n when typeof<'TValue> = typeof<float> ->
float n |> coerce |> Success
| JsonValue.Number n when typeof<'TValue> = typeof<int> ->
int n |> coerce |> Success
| JsonValue.Boolean b when typeof<'TValue> = typeof<bool> ->
Success (box b :?> 'TValue)
// HACK: Doesn't seem like runtime type checking works for Option<T>
| JsonValue.Null when typeof<'TValue>.Name = "FSharpOption`1" ->
Success (coerce None)
| prop ->
Error (sprintf "Could not coerce value <%A> to type <%s>" prop typeof<'TValue>.Name)
let property prop (json:JsonValue) f =
let errorRegex =
Regex @"Didn't find property '([\w\d]+)'"
try
let prop = JsonExtensions.GetProperty(json, prop)//json?property
f prop
with e ->
let ``match`` = errorRegex.Match e.Message
if ``match``.Success then
Error ``match``.Value
else
printfn "Property that failed (%s), value = %A" prop json
raise e
let parse<'TValue> prop (json:JsonValue) : MappedJson<'TValue> =
property prop json coerceType
let tryParse property json =
match parse property json with
| Success o -> Success <| Some o
| Error e -> Success None
let inline parseObject< ^TValue when ^TValue : (static member FromJson: JsonValue -> MappedJson<'TValue>)> json =
( ^TValue : (static member FromJson : JsonValue -> MappedJson<'TValue>) json)
let inline parseAs prop json =
property prop json parseObject
type JsonValue with
member x.Read property =
parse property x
member x.TryRead property =
tryParse property x
let sequenceJson st v =
match st, v with
| Success xs, Success x ->
Success (x::xs)
| _, Error e ->
Error e
let tryParseArr<'TValue> arr (json:JsonValue) : MappedJson<'TValue list> =
match JsonExtensions.TryGetProperty (json, arr) with
| Some (JsonValue.Array elems) ->
elems
|> List.ofArray
|> List.map coerceType
|> List.fold sequenceJson (Success [])
| _ -> Error "Array does not contain same elements of same type"
let (?|) = fun js str -> parse str js
let (??|) = fun js str -> tryParseArr str js
let (<!>) = map
let (<*>) = apply
let (>>=) = fun f m -> bind m f