Skip to content

Instantly share code, notes, and snippets.

@moloneymb

moloneymb/Utilities.SerDes.JS.fsx

Created April 12, 2023 18:17
Show Gist options
  • Save moloneymb/0a29d44dbd51ed8cc81faff3400a4018 to your computer and use it in GitHub Desktop.
Save moloneymb/0a29d44dbd51ed8cc81faff3400a4018 to your computer and use it in GitHub Desktop.
Download ZIP
Utilities/Utilities.SerDes.JS.fsx
Raw
Utilities.SerDes.JS.fsx
module Utilities.SerDes.JS
// Licence: Apache 2.0
// Author: Matthew Moloney
// TODO - maybe use https://github.com/Tarmil/FSharp.SystemTextJson
open System
open System.Text
open System.IO
open System.Net
open Newtonsoft.Json
open Newtonsoft.Json.Linq
open System.Collections.Concurrent
module PreComp =
open System.Reflection
open Microsoft.FSharp.Reflection
open System.Collections.Generic
let private memoize (f:'a -> 'b) =
let cache = new ConcurrentDictionary<'a,'b>()
fun x ->
match cache.TryGetValue(x) with
| (true,y) -> y
| (false,_) ->
let y = f x
cache.[x] <- y
y
/// NOTE: concurrently may evaulate more than once
// let private memoize2 (f:'a -> 'b) =
// let mutable cache = Map.empty<'a,'b>
// fun x ->
// match cache.TryFind(x) with
// | Some(y) -> y
// | None ->
// let y = f x
// cache <- cache.Add(x,y)
// y
let private anyVisModifier = BindingFlags.Public ||| BindingFlags.NonPublic
let recordReader = memoize (fun (t:Type) -> FSharpValue.PreComputeRecordReader(t,anyVisModifier))
let tupleReader = memoize (fun (t:Type) -> FSharpValue.PreComputeTupleReader(t))
let unionReader = memoize (fun (t:Type,case:int) -> FSharpValue.PreComputeUnionReader(FSharpType.GetUnionCases(t, anyVisModifier).[case],anyVisModifier))
let unionTagReader = memoize (fun (t:Type) -> FSharpValue.PreComputeUnionTagReader(t,anyVisModifier))
let getTupleElements = memoize (fun (t:Type) -> FSharpType.GetTupleElements(t))
let getUnionFields = memoize (fun (t:Type,case:int) -> FSharpType.GetUnionCases(t, anyVisModifier).[case].GetFields() |> Array.map (fun f -> (f.Name, f.PropertyType)))
let getRecordFields = memoize (fun (t:Type) -> FSharpType.GetRecordFields(t) |> Array.map (fun f -> (f.Name, f.PropertyType)))
let isRecord = memoize (fun (t:Type) -> FSharpType.IsRecord(t,anyVisModifier))
let isTuple = memoize (fun (t:Type) -> FSharpType.IsTuple(t))
let isUnion = memoize (fun (t:Type) -> FSharpType.IsUnion(t,anyVisModifier))
// Record // Tuple // Union
let recordConstructor = memoize (fun (t:Type) -> FSharpValue.PreComputeRecordConstructor(t,anyVisModifier))
let tupleConstructor = memoize (fun (t:Type) -> FSharpValue.PreComputeTupleConstructor(t))
let unionConstructor = memoize (fun (t:Type,case:int) -> FSharpValue.PreComputeUnionConstructor(FSharpType.GetUnionCases(t, anyVisModifier).[case],anyVisModifier))
let getEnumType = memoize (fun (t:Type) -> t.GetEnumUnderlyingType())
//PreComp.getUnionCases(typeof<int option>).[1]
//open System.Text
//type StringBuilder with
// member this.Add(str:string) = this.Append(str) |> ignore
// member this.Add(c:char) = this.Append(c) |> ignore
(* 50% faster than newton soft, needs work to make sure it produces valid JSON *)
//let rec serializeJSON (sb:StringBuilder) (o:obj) =
// if o = null // represents the None option
// then () // ignore nulls
// else
// let t = o.GetType()
// match t.Name with
// //| "DateTime"-> jw.WriteValue(o :?> DateTime)
// | "Boolean" -> sb.Append(if o :?> bool then "true" else "false") |> ignore
// | "Int32" -> sb.Append(o :?> int32) |> ignore
// | "Int64" -> sb.Append(o :?> int64) |> ignore
// | "Single" -> sb.Append(o :?> single) |> ignore
// | "Double" -> sb.Append(o :?> double) |> ignore
// | "String" -> sb.Append('"') |> ignore; sb.Append(o :?> string) |> ignore; sb.Append('"') |> ignore
// | "Byte[]" -> sb.Append(System.Convert.ToBase64String(o :?> byte array)) |> ignore
// //| "FSharpOption`1" -> PreComp.unionReader (t,PreComp.unionTagReader t o) o |> Array.iter (serializeJSON jw)
// | _ ->
// match t with
// | t when PreComp.isTuple t ->
// sb.Add('[')
// o |> PreComp.tupleReader t |> Array.iteri (fun i x -> if i <> 0 then sb.Add(','); serializeJSON sb x; )
// sb.Add(']')
// | t when PreComp.isUnion t ->
// let tag = PreComp.unionTagReader t o
// sb.Add('{')
// sb.Add("Tag:")
// sb.Append(tag) |> ignore
// (PreComp.unionPropertyNames(t,tag), PreComp.unionReader(t,tag) o ) ||> Array.iter2 (fun name o -> sb.Add(','); sb.Add(name); sb.Add(':'); serializeJSON sb o)
// sb.Add('}')
// | t when PreComp.isRecord t ->
// sb.Add('{')
// (PreComp.recordPropertyNames t, o |> PreComp.recordReader t) ||> Array.iteri2 (fun i name o -> if i <> 0 then sb.Add(','); sb.Add(name); sb.Add(':'); serializeJSON sb o)
// sb.Add('}')
// | t when t.IsArray ->
// sb.Add('[')
// [|for x in (o :?> Array) -> x|] |> Array.iteri (fun i x -> if i <> 0 then sb.Add(','); serializeJSON sb x;)
// sb.Add(']')
// | _ -> failwith (sprintf "unrecognized type %A" t)
//let toJSON (a:'a) =
// let sb = StringBuilder()
// serializeJSON sb a
// sb.ToString()
(*
let rec serializeJSON (jw:JsonWriter) (o:obj) =
if o = null // represents the None option
then jw.WriteNull()
else
let t = o.GetType()
match t.Name with
| "DateTime"-> jw.WriteValue(o :?> DateTime)
| "Boolean" -> jw.WriteValue(o :?> bool)
| "Int32" -> jw.WriteValue(o :?> int32)
| "Int64" -> jw.WriteValue(o :?> int64)
| "Single" -> jw.WriteValue(o :?> single)
| "Double" -> jw.WriteValue(o :?> double)
| "String" -> jw.WriteValue(o :?> string)
| "Byte[]" -> jw.WriteValue(o :?> byte array)
| "FSharpOption`1" -> PreComp.unionReader (t,PreComp.unionTagReader t o) o |> Array.iter (serializeJSON jw)
| _ ->
match t with
| t when PreComp.isTuple t ->
jw.WriteStartArray()
for x in PreComp.tupleReader t o do serializeJSON jw x
jw.WriteEndArray()
| t when PreComp.isUnion t ->
let tag = PreComp.unionTagReader t o
jw.WriteStartObject()
jw.WritePropertyName("Tag")
jw.WriteValue(tag)
(PreComp.unionPropertyNames(t,tag), PreComp.unionReader(t,tag) o ) ||> Array.iter2 (fun name o -> jw.WritePropertyName(name); serializeJSON jw o)
jw.WriteEndObject()
| t when PreComp.isRecord t ->
jw.WriteStartObject()
(PreComp.recordPropertyNames t, o |> PreComp.recordReader t) ||> Array.iter2 (fun name o -> jw.WritePropertyName(name); serializeJSON jw o)
jw.WriteEndObject()
| t when t.IsArray ->
let array = o :?> Array
jw.WriteStartArray()
for x in array do serializeJSON jw x
jw.WriteEndArray()
| _ -> failwith (sprintf "unrecognized type %A" t)
*)
let rec serializeJSON (jw:JsonWriter) (o:obj) =
if o = null // represents the None option
then jw.WriteNull()
else
let t = o.GetType()
match t.Name with
| "DateTime"-> jw.WriteValue(o :?> DateTime)
| "Boolean" -> jw.WriteValue(o :?> bool)
| "Int32" -> jw.WriteValue(o :?> int32)
| "Int64" -> jw.WriteValue(o :?> int64)
| "Single" -> jw.WriteValue(o :?> single)
| "Double" -> jw.WriteValue(o :?> double)
| "String" -> jw.WriteValue(o :?> string)
| "Byte" -> jw.WriteValue(int16 (o :?> byte))
| "Byte[]" -> jw.WriteValue(o :?> byte array)
| "Guid" -> jw.WriteValue(o :?> Guid)
| "Version" -> jw.WriteValue(Encoding.UTF8.GetBytes((o :?> System.Version).ToString()))
| "IPAddress" -> jw.WriteValue((o :?> IPAddress).ToString())
| "Uri" -> jw.WriteValue((o :?> Uri).ToString())
| "JArray"
| "JObject"
| "JToken" -> jw.WriteToken((o :?> JToken).CreateReader())
| "List`1" ->
let list = o :?> System.Collections.IList
jw.WriteStartArray()
for x in list do serializeJSON jw x
jw.WriteEndArray()
| "FSharpOption`1" ->
match PreComp.unionTagReader t o with
| 0 -> jw.WriteNull()
| _ -> serializeJSON jw ((PreComp.unionReader(t,1) o) |> Seq.head)
| _ ->
match t with
| t when PreComp.isTuple t ->
jw.WriteStartArray()
for x in PreComp.tupleReader t o do serializeJSON jw x
jw.WriteEndArray()
| t when PreComp.isUnion t ->
let tag = PreComp.unionTagReader t o
jw.WriteStartObject()
jw.WritePropertyName("Tag")
jw.WriteValue(tag)
(PreComp.getUnionFields(t,tag), PreComp.unionReader(t,tag) o ) ||> Array.iter2 (fun (name,_) o -> jw.WritePropertyName(name); serializeJSON jw o)
jw.WriteEndObject()
| t when PreComp.isRecord t ->
jw.WriteStartObject()
(PreComp.getRecordFields t, o |> PreComp.recordReader t) ||> Array.iter2 (fun (name,_) o -> jw.WritePropertyName(name); serializeJSON jw o)
jw.WriteEndObject()
| t when t.IsArray ->
let notJsonObj() =
let array = o :?> Array
jw.WriteStartArray()
for x in array do serializeJSON jw x
jw.WriteEndArray()
let et = t.GetElementType()
if PreComp.isTuple et then
let ets = PreComp.getTupleElements et
if ets.Length = 2 && ets.[0].Name = "String"
then
let t = ets.[1]
let array = o :?> Array
jw.WriteStartObject()
for x in array do
match PreComp.tupleReader et x with
| [|:? string as s;v|] ->
jw.WritePropertyName(s)
serializeJSON jw v
| _ -> ()
jw.WriteEndObject()
else notJsonObj()
else notJsonObj()
| t when t.IsEnum -> serializeJSON jw (Convert.ChangeType(o, PreComp.getEnumType t))
| _ -> failwith (sprintf "unrecognized type %A" t)
let deserializeJSONOuter (isFromXML:bool) (t:System.Type) (jt:JToken) =
let rec deserializeJSON (t:System.Type) (jt:JToken) =
//System.Diagnostics.Debug.WriteLine(t.Name);
match t.Name with
| "Guid" -> Guid.Parse(jt.Value<string>()) :> obj
| "DateTime" -> jt.Value<DateTime>() :> obj
| "Boolean" -> jt.Value<bool>() :> obj
| "Int32" -> jt.Value<int32>() :> obj
| "Int64" -> jt.Value<int64>() :> obj
| "Single" -> jt.Value<single>() :> obj
| "Double" -> jt.Value<float>() :> obj
| "String" -> jt.Value<string>() :> obj
// Use Int16
| "Byte" -> byte (jt.Value<int16>()) :> obj
| "Byte[]" -> Convert.FromBase64String(jt.Value<string>()) :> obj
| "IPAddress" ->IPAddress.Parse(jt.Value<string>()) :> obj
| "Uri" -> System.Uri(jt.Value<string>()) :> obj
| "Version" -> System.Version.Parse(jt.Value<string>()) :> obj
| "List`1" -> failwith "unsupported"
| "JArray"
| "JObject"
| "JToken" -> jt :> obj
| "FSharpOption`1" ->
if jt = null || jt.Type = JTokenType.Null then box None
else
PreComp.getUnionFields(t,1)
|> Array.map (fun (_,el) -> deserializeJSON el jt)
|> PreComp.unionConstructor(t,1)
| _ ->
match t with
| t when PreComp.isTuple t ->
let xs = jt.Values<JToken>() |> Array.ofSeq
PreComp.getTupleElements t
|> Array.mapi (fun i te -> deserializeJSON te xs.[i])
|> PreComp.tupleConstructor t
| t when PreComp.isUnion t ->
let jo = jt :?> JObject
let tag = jo.["Tag"].Value<int>()
PreComp.getUnionFields(t,tag)
|> Array.map (fun (name,subt) -> deserializeJSON subt jo.[name])
|> PreComp.unionConstructor(t,tag)
| t when PreComp.isRecord t ->
let jo = jt :?> JObject
PreComp.getRecordFields t
|> Array.map (fun (name,et) ->
try
deserializeJSON et jo.[name]
with
| ex ->
#if SILVERLIGHT
#else
printfn "Error at property name %s" name
#endif
raise ex
)
|> PreComp.recordConstructor t
| t when t.IsArray ->
// get property name
let et = t.GetElementType()
let notJsonObj() =
let xs =
match jt.Type with
| JTokenType.Object when isFromXML -> [|jt|]
| JTokenType.Array -> (jt :?> JArray).Values<JToken>() |> Seq.toArray
| _ -> failwith "unsupported"
let ys = Array.CreateInstance(et,xs.Length)
let mutable index = 0
for x in xs do
ys.SetValue(deserializeJSON et x, index)
index <- index + 1
ys :> obj
if PreComp.isTuple et then
let ets = PreComp.getTupleElements et
if ets.Length = 2 && ets.[0].Name = "String"
then
let t = ets.[1]
let jo = jt :?> JObject
let xs = jo.Properties() |> Seq.toArray |> Array.map (fun x -> (x.Name, (deserializeJSON t x.Value)))
let ys = Array.CreateInstance(et,xs.Length)
for (index,(name,value)) in xs |> Seq.mapi (fun i x -> (i,x)) do
ys.SetValue(PreComp.tupleConstructor et ([|name;value|]), index)
ys :> obj
else notJsonObj()
else notJsonObj()
| t when t.IsEnum -> Enum.ToObject(t,deserializeJSON (PreComp.getEnumType t) jt)
| _ -> failwith (sprintf "unrecognized type %A" t)
deserializeJSON t jt
let toJSON (a:'a) =
use sw = new StringWriter()
use jw = new Newtonsoft.Json.JsonTextWriter(sw)
jw.Formatting <- Formatting.Indented
serializeJSON jw a
sw.ToString()
let fromJSON<'a> (str:string) = deserializeJSONOuter false typeof<'a> (JToken.Parse(str)) :?> 'a
let roundTrip(x:'a) = toJSON(x) |> fromJSON<'a>
open Newtonsoft
open System.Xml
let XMLtoJS (str:string) =
let doc = new XmlDocument()
doc.LoadXml(str)
Json.JsonConvert.SerializeXmlNode(doc)
let fromXML<'a> (str:string) = deserializeJSONOuter true typeof<'a> (JToken.Parse(str |> XMLtoJS)) :?> 'a
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment