1+ namespace ARCtrl.Json
2+
3+ open ARCtrl
4+ open System
5+ open ARCtrl.ROCrate
6+ open Thoth.Json .Core
7+ open DynamicObj
8+
9+ module rec ROCrateObject =
10+
11+ #if ! FABLE_ COMPILER
12+ let (| SomeObj | _ |) =
13+ // create generalized option type
14+ let ty = typedefof< option<_>>
15+ fun ( a : obj ) ->
16+ // Check for nulls otherwise 'a.GetType()' would fail
17+ if isNull a
18+ then
19+ None
20+ else
21+ let aty = a.GetType()
22+ // Get option'.Value
23+ let v = aty.GetProperty( " Value" )
24+ if aty.IsGenericType && aty.GetGenericTypeDefinition() = ty then
25+ // return value if existing
26+ Some( v.GetValue( a, [| |]))
27+ else
28+ None
29+ #endif
30+
31+
32+ let genericEncoder ( obj : obj ) : IEncodable =
33+ match obj with
34+ | :? string as s -> Encode.string s
35+ | :? int as i -> Encode.int i
36+ | :? bool as b -> Encode.bool b
37+ | :? float as f -> Encode.float f
38+ | :? DateTime as d -> Encode.dateTime d
39+ | :? ROCrateObject as o -> encoder o
40+ #if ! FABLE_ COMPILER
41+ | SomeObj o -> genericEncoder o
42+ #endif
43+ | null -> Encode.nil
44+ | :? System.Collections.IEnumerable as l -> [ for x in l -> genericEncoder x] |> Encode.list
45+ | _ -> failwith " Unknown type"
46+
47+ let rec encoder ( obj : ROCrateObject ) =
48+ obj.GetProperties true
49+ |> Seq.map ( fun kv ->
50+ kv.Key,
51+ genericEncoder obj
52+ )
53+ |> Encode.object
54+
55+
56+ let rec decoder : Decoder < obj > =
57+ let rec decode () =
58+ let decodeObject : Decoder < ROCrateObject > =
59+ { new Decoder< ROCrateObject> with
60+ member _.Decode ( helpers , value ) =
61+ if helpers.isObject value then
62+ let getters = Decode.Getters( helpers, value)
63+ let properties = helpers.getProperties value
64+ let builder =
65+ fun ( get : Decode.IGetters ) ->
66+ let o = ROCrateObject(
67+ id = get.Required.Field " @id" ,
68+ schemaType = get.Required.Field " @type"
69+ )
70+ for property in properties do
71+ if property <> " @id" && property <> " @type" then
72+ o.SetProperty( property, get.Required.Field property ( decode()))
73+ o
74+ let result = builder getters
75+ match getters.Errors with
76+ | [] -> Ok result
77+ | fst :: _ as errors ->
78+ if errors.Length > 1 then
79+ ( " " , BadOneOf errors) |> Error
80+ else
81+ Error fst
82+ else
83+ ( " " , BadPrimitive( " an object" , value)) |> Error
84+ }
85+ let resizeArray : Decoder < ResizeArray < obj >> =
86+ { new Decoder< ResizeArray< obj>> with
87+ member _.Decode ( helpers , value ) =
88+ if helpers.isArray value then
89+ let mutable i = - 1
90+ let tokens = helpers.asArray value
91+ let arr = ResizeArray()
92+
93+ ( Ok arr, tokens)
94+ ||> Array.fold ( fun acc value ->
95+ i <- i + 1
96+
97+ match acc with
98+ | Error _ -> acc
99+ | Ok acc ->
100+ match decode() .Decode( helpers, value) with
101+ | Error er ->
102+ Error(
103+ er
104+ |> Helpers.prependPath (
105+ " .[" + ( i.ToString()) + " ]"
106+ )
107+ )
108+ | Ok value ->
109+ acc.Add value
110+ Ok acc
111+ )
112+ else
113+ ( " " , BadPrimitive( " an array" , value)) |> Error
114+ }
115+ Decode.oneOf [
116+ Decode.map box ( decodeObject)
117+ Decode.map box ( resizeArray)
118+ Decode.map box ( Decode.string)
119+ Decode.map box ( Decode.int)
120+ Decode.map box ( Decode.decimal)
121+
122+ ]
123+ decode()
0 commit comments