// Learn more about F# at http://fsharp.org open Thoth.Json.Net open TypeShape.Core.Core open FSharp.Reflection open Groot.Contracts.SportRadar.Types.Soccer open System let apply (d1:Decoder<'C -> 'B>) (d2:Decoder<'C>) : Decoder<'B> = Decode.andThen(fun x -> Decode.map (fun f -> f x) d1 ) d2 let applAsObject (d1:Decoder<'C -> 'C>) (d2:Decoder<'C>) (grp:Decode.IGetters) fldName : Decoder<'C> = Decode.map ( fun obj -> let f = grp.Required.Field fldName d1 f obj ) d2 let rec mkDecoder<'T>() : Decoder<'T> = let wrap(t:Decoder<'a>) = unbox> t let delay (f : unit -> 'T) : Decoder<'T> = f () |> Decode.succeed let mkMemberDecoder (shape:IShapeMember<'DeclaringType>) = let memberVisitor = { new IMemberVisitor<'DeclaringType ,Decoder<'DeclaringType -> 'DeclaringType>> with member __.Visit<'Field>(shape: ShapeMember<'DeclaringType,'Field>) = let md:Decoder<'Field> = mkDecoder<'Field> () md |> Decode.map(fun f dt -> shape.Set dt f ) } shape.Accept( memberVisitor ) match shapeof<'T> with | Shape.Bool -> Decode.bool |> wrap | Shape.Int32 -> Decode.int |> wrap | Shape.Int64 -> wrap Decode.int64 | Shape.String -> Decode.string |> wrap | Shape.DateTimeOffset -> wrap Decode.datetimeOffset | Shape.DateTime -> wrap Decode.datetime | Shape.Guid -> wrap Decode.guid | Shape.Double -> wrap Decode.float | Shape.Decimal -> wrap Decode.decimal | Shape.TimeSpan -> wrap Decode.timespan | Shape.FSharpOption s -> s.Element.Accept { new ITypeVisitor> with member __.Visit<'a> () = let tp = mkDecoder<'a>() wrap <| Decode.option tp } | Shape.FSharpList s -> s.Element.Accept { new ITypeVisitor> with member __.Visit<'a> () = let tp = mkDecoder<'a>() wrap <| Decode.list tp } | Shape.Array s when s.Rank = 1 -> s.Element.Accept { new ITypeVisitor> with member __.Visit<'a> () = let tp = mkDecoder<'a> () Decode.array tp |> wrap } | Shape.FSharpRecord (:? ShapeFSharpRecord<'T> as shape) -> let toSnakeCase (s:string) = s.ToCharArray() |> Array.fold (fun s c -> match s, System.Char.IsUpper c with | "", true -> (System.Char.ToLower c).ToString() | s, true -> sprintf "%s_%O" s (System.Char.ToLower c) | _ -> sprintf "%s%O" s c ) "" let isOpt (mmbr:IShapeMember<'T>) = let typ = mmbr.Member.Type typ.IsGenericType && typ.GetGenericTypeDefinition() = typedefof> let isArr (mmbr:IShapeMember<'T>) = mmbr.Member.Type.IsArray let folder (g:Decode.IGetters) (i,s) (mmbr, func) = printfn "%d, state: %A" i s if isOpt mmbr then match g.Optional.Field (toSnakeCase mmbr.Label) func with | Some f -> i+1, f s | None -> i+1, s else if isArr mmbr then match g.Optional.Field (toSnakeCase mmbr.Label) func with | Some f -> i+1, f s | None -> let flds = FSharpValue.GetRecordFields(s) flds.[i] <- (Array.CreateInstance(mmbr.Member.Type.GetElementType(), 0) :> obj) i+1, FSharpValue.MakeRecord(s.GetType(), flds) :?> 'T else i+1, (g.Required.Field (toSnakeCase mmbr.Label) func) s let dkdr = Decode.object <| fun g -> let (i,s) = shape.Fields |> Array.map (fun x -> x, mkMemberDecoder x) |> Array.fold (folder g) (0,shape.CreateUninitialized()) s dkdr |> wrap | Shape.Enum s -> s.Accept({ new IEnumVisitor> with member __.Visit<'Enum, 'Underlying when 'Enum : enum<'Underlying> and 'Enum : struct and 'Enum :> System.ValueType and 'Enum : (new : unit -> 'Enum)> () = let t = typeof<'Enum> let parse (x:string) = System.Enum.Parse(t, x.ToLower(), ignoreCase = true ) :?> 'Enum Decode.map parse Decode.string |> wrap }) | Shape.FSharpUnion (:? ShapeFSharpUnion<'T> as shape) -> let lngth = shape.UnionCases.Length let hasArityGreaterThan n = shape.UnionCases |> Array.exists (fun x -> x.Arity > n ) let hasArity n = shape.UnionCases |> Array.exists (fun x -> x.Arity = n ) if lngth > 1 || hasArityGreaterThan 1 || hasArity 0 then failwith "only Single Case Unions are welcome f.e. type SingleCase = SimgleCase of type" else let mkUnionCaseDecoder (case: ShapeFSharpUnionCase<'T>) = let field = case.Fields |> Array.head |> mkMemberDecoder let init = delay case.CreateUninitialized apply field init let singleCaseUnionDecoder = shape.UnionCases |> Array.head |> mkUnionCaseDecoder singleCaseUnionDecoder |> wrap | _ -> failwithf "unsupported type '%O'" typeof<'T> let str = """[{ n : "wtf", as: ["lol", "what?"] }] """ type M1 = { Lol : int option N : string S : int array As : string array } [] let main argv = let d = mkDecoder () let s = Decode.fromString d match s str with | Ok s -> sprintf "it's ok: %A" s | Error e -> sprintf "wtf! %A" e |> printfn "%s" 0 // return an integer exit code