open System

open System.Collections.Generic

open System.Diagnostics

open System.Globalization

open System.Reflection

open Microsoft.FSharp.Reflection

open FSharp.Data.GraphQL

open FSharp.Data.GraphQL.Client.ReflectionPatterns

let private makeOption t (value : obj) =

let otype = typedefof<_ option>

let cases = FSharpType.GetUnionCases(otype.MakeGenericType([|t|]))

match value with

| null -> FSharpValue.MakeUnion(cases.[0], [||])

| _ -> FSharpValue.MakeUnion(cases.[1], [|value|])

let private downcastNone<'T> t =

match t with

| Option t -> downcast (makeOption t null)

| ValueOption t -> downcast (makeValueOption t null)

| _ -> failwith $"Error parsing JSON value: %O{t} is not an option value."

let private downcastType (t : Type) x =

match t with

| Option t -> downcast (makeOption t (Convert.ChangeType(x, t)))

| ValueOption t -> downcast (makeValueOption t (Convert.ChangeType(x, t)))

| _ -> downcast (Convert.ChangeType(x, t))

let private isStringType = isType typeof<string>

let private isDateTimeType = isType typeof<DateTime>

let private isDateTimeOffsetType = isType typeof<DateTimeOffset>

let private isUriType = isType typeof<Uri>

let private isGuidType = isType typeof<Guid>

let private isBooleanType = isType typeof<bool>

let private isEnumType = function (Option t | ValueOption t | t) when t.IsEnum -> true | _ -> false

let private downcastString (t : Type) (s : string) =

match t with

| t when isStringType t -> downcastType t s

| t when isUriType t ->

match Uri.TryCreate(s, UriKind.RelativeOrAbsolute) with

| (true, uri) -> downcastType t uri

| _ -> failwith $"Error parsing JSON value: %O{t} is an URI type, but parsing of value \"%s{s}\" failed."

| t when isDateTimeType t ->

match DateTime.TryParse(s, CultureInfo.InvariantCulture, DateTimeStyles.None) with

| (true, d) -> downcastType t d

| _ -> failwith $"Error parsing JSON value: %O{t} is a date type, but parsing of value \"%s{s}\" failed."

| t when isDateTimeOffsetType t ->

match DateTimeOffset.TryParse(s, CultureInfo.InvariantCulture, DateTimeStyles.None) with

| (true, d) -> downcastType t d

| _ -> failwith $"Error parsing JSON value: %O{t} is a date time offset type, but parsing of value \"%s{s}\" failed."

| t when isGuidType t ->

match Guid.TryParse(s) with

| (true, g) -> downcastType t g

| _ -> failwith $"Error parsing JSON value: %O{t} is a Guid type, but parsing of value \"%s{s}\" failed."

| t when isEnumType t ->

match t with

| (Option et | ValueOption et | et) ->

try Enum.Parse(et, s) |> downcastType t

with _ -> failwith $"Error parsing JSON value: %O{t} is a Enum type, but parsing of value \"%s{s}\" failed."

| _ -> failwith $"Error parsing JSON value: %O{t} is not a string type."

let private downcastBoolean (t : Type) b =

match t with

| t when isBooleanType t -> downcastType t b

| _ -> failwith $"Error parsing JSON value: %O{t} is not a boolean type."

let rec private getArrayValue (t : Type) (converter : Type -> JsonValue -> obj) (items : JsonValue []) =

let castArray itemType (items : obj []) : obj =

let arr = Array.CreateInstance(itemType, items.Length)

items |> Array.iteri (fun ix i -> arr.SetValue(i, ix))

upcast arr

let castList itemType (items : obj list) =

let tlist = typedefof<_ list>.MakeGenericType([|itemType|])

let empty =

let uc =

Reflection.FSharpType.GetUnionCases(tlist)

|> Seq.filter (fun uc -> uc.Name = "Empty")

|> Seq.exactlyOne

Reflection.FSharpValue.MakeUnion(uc, [||])

let rec helper items =

match items with

| [] -> empty

| [x] -> Activator.CreateInstance(tlist, [|x; empty|])

| x :: xs -> Activator.CreateInstance(tlist, [|x; helper xs|])

helper items

Tracer.runAndMeasureExecutionTime "Converted Array JsonValue to CLR array" (fun _ ->

match t with

| Option t -> getArrayValue t converter items |> makeOption t

| ValueOption t -> getArrayValue t converter items |> makeValueOption t

| Array itype | Seq itype -> items |> Array.map (converter itype) |> castArray itype

| List itype -> items |> Seq.map (converter itype) |> Seq.toList |> castList itype

| _ -> failwith $"Error parsing JSON value: %O{t} is not an array type.")

let private downcastNumber (t : Type) n =

match t with

| t when isNumericType t -> downcastType t n

| _ -> failwith $"Error parsing JSON value: %O{t} is not a numeric type."

let rec private convert t parsed : obj =

Tracer.runAndMeasureExecutionTime $"Converted JsonValue to %O{t} type." (fun _ ->

match parsed with

| JsonValue.Null -> downcastNone t

| JsonValue.String s -> downcastString t s

| JsonValue.Float n -> downcastNumber t n

| JsonValue.Integer n -> downcastNumber t n

| JsonValue.Record jprops ->

let jprops =

jprops

|> Seq.map (fun (n, v) -> n.ToLowerInvariant(), v)

|> Map.ofSeq

let tprops t =

FSharpType.GetRecordFields(t, true)

|> Array.map (fun p -> p.Name.ToLowerInvariant(), p.PropertyType)

let vals t =

tprops t

|> Array.map (fun (n, t) ->

match Map.tryFind n jprops with

| Some p -> n, convert t p

| None ->

match t with

| ValueOption vt -> n, makeValueOption vt null

| _ -> n, makeOption t null)

let rcrd =

let t = match t with Option t | ValueOption t -> t | _ -> t

let vals = vals t

if isMap t

then Map.ofArray vals |> box

else FSharpValue.MakeRecord(t, Array.map snd vals, true)

downcastType t rcrd

| JsonValue.Array items -> items |> getArrayValue t convert

| JsonValue.Boolean b -> downcastBoolean t b)

let deserializeRecord<'T> (json : string) : 'T =

let t = typeof<'T>

Tracer.runAndMeasureExecutionTime $"Deserialized JSON string to record type %O{t}." (fun _ ->

downcast (JsonValue.Parse(json) |> convert t))

let deserializeMap values =

let rec helper (values : (string * JsonValue) []) =

values

|> Array.map (fun (name, value) ->

match value with

| JsonValue.Record fields -> name, (fields |> helper |> Map.ofArray |> box)

| JsonValue.Null -> name, null

| JsonValue.String s -> name, box s

| JsonValue.Integer n -> name, box n

| JsonValue.Float f -> name, box f

| JsonValue.Array items -> name, (items |> Array.map (fun item -> null, item) |> helper |> Array.map snd |> box)

| JsonValue.Boolean b -> name, box b)

Tracer.runAndMeasureExecutionTime "Deserialized JSON Record into FSharp Map" (fun _ ->

helper values |> Map.ofArray)

let private isoDateFormat = "yyyy-MM-dd"

let private isoDateTimeFormat = "O"

let rec toJsonValue (x : obj) : JsonValue =

if isNull x

then JsonValue.Null

else

let t = x.GetType()

Tracer.runAndMeasureExecutionTime $"Converted object type %O{t} to JsonValue" (fun _ ->

match x with

| null -> JsonValue.Null

| OptionValue ValueNone -> JsonValue.Null

| :? int as x -> JsonValue.Integer (int x)

| :? float as x -> JsonValue.Float x

| :? string as x -> JsonValue.String x

| :? Guid as x -> JsonValue.String (x.ToString())

| :? DateTime as x when x.Date = x -> JsonValue.String (x.ToString(isoDateFormat))

| :? DateTime as x -> JsonValue.String (x.ToString(isoDateTimeFormat))

| :? DateTimeOffset as x -> JsonValue.String (x.ToString(isoDateTimeFormat))

| :? bool as x -> JsonValue.Boolean x

| :? Uri as x -> JsonValue.String (x.ToString())

| :? Upload as u -> JsonValue.String u.Name

| :? IDictionary<string, obj> as items ->

items

|> Seq.map (fun (KeyValue (k, v)) -> k.FirstCharLower(), toJsonValue v)

|> Seq.toArray

|> JsonValue.Record

| EnumerableValue items ->

items

|> Array.map toJsonValue

|> JsonValue.Array

| OptionValue (ValueSome x) -> toJsonValue x

| EnumValue x -> JsonValue.String x

| _ ->

let props = t.GetProperties(BindingFlags.Public ||| BindingFlags.Instance)

let items = props |> Array.map (fun p -> (p.Name.FirstCharLower(), p.GetValue(x) |> toJsonValue))

JsonValue.Record items)

let serializeRecord (x : obj) =

Tracer.runAndMeasureExecutionTime $"Serialized object type %O{x.GetType()} to a JSON string" (fun _ ->

(toJsonValue x).ToString())

let deserializeSchema (json : string) =

Tracer.runAndMeasureExecutionTime "Deserialized schema" (fun _ ->

let result = deserializeRecord<GraphQLResponse<IntrospectionResult>> json

match result.Errors with

| None -> result.Data.__schema

| Some errors -> String.concat "\n" errors |> failwithf "%s")