Utilities/Utilities.SerDes.Bin.fsx

Utilities.SerDes.Bin.fsx

module Utilities.SerDes.Bin
// Licence: Apache 2.0
// Author Matthew Moloney
open System.Reflection
open Microsoft.FSharp.Reflection
open System
open System.Text
open System.IO
open System.Net
open System.Net.Sockets
open Microsoft.FSharp.Control.WebExtensions

#if BSON
open Newtonsoft.Json.Linq
module Bson =
    open System.IO
    open Newtonsoft.Json.Bson
    let jtToBson (jt:JToken) : byte[] =
        use ms = new MemoryStream()
        use bw = new BsonWriter(ms)
        jt.WriteTo(bw)
        bw.Flush()
        ms.ToArray()
    
    let bsonToJt (data:byte[]) : JToken =
        use ms = new MemoryStream(data)
        use br = new BsonReader(ms)
        JToken.ReadFrom(br)
#endif

#if WPF
open System.Windows
open System.Windows.Media
#endif

module PreComp =
    open System.Reflection
    open Microsoft.FSharp.Reflection
    open System.Collections.Generic
    open System.Collections.Concurrent
    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

    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())

[<AutoOpen>]
module SerDes =
    type System.IO.Stream with
        member this.Write(bytes:byte[]) =
            this.Write(bytes,0,bytes.Length)
        member this.WriteWithLength(bytes:byte[]) =
            let length = bytes.Length
            this.Write(BitConverter.GetBytes(length), 0, 4)
            this.Write(bytes,0,bytes.Length)

    let rec serialize (stream:Stream) (o:obj)  =
        if (o = null) 
            then
                serialize stream 0 // represents the None option
            else
                let t = o.GetType()
                match t.Name with
                | "DateTime"-> stream.Write(BitConverter.GetBytes((o :?> DateTime).Ticks))
                | "Boolean" -> stream.Write(BitConverter.GetBytes(o :?> bool))
                | "Byte"   -> stream.Write [|o :?> byte |]
                | "UInt16" -> stream.Write(BitConverter.GetBytes(o :?> uint16 ))
                | "UInt32" -> stream.Write(BitConverter.GetBytes(o :?> uint32 ))
                | "Int32"   -> stream.Write(BitConverter.GetBytes(o :?> int32 ))
                | "Int64"   -> stream.Write(BitConverter.GetBytes(o :?> int64 ))
                | "Single"  -> stream.Write(BitConverter.GetBytes(o :?> single))
                | "Double"  -> stream.Write(BitConverter.GetBytes(o :?> double))
                | "String"  -> stream.WriteWithLength(Encoding.UTF8.GetBytes(o :?> string ))
                | "Uri"     -> stream.WriteWithLength(Encoding.UTF8.GetBytes((o :?> Uri).ToString() ))
                | "Byte[]"  -> stream.WriteWithLength(o :?> byte array)
                | "IPAddress" -> stream.Write((o :?> IPAddress).GetAddressBytes())
                | "Guid" -> stream.Write((o :?> System.Guid).ToByteArray())
                | "Version" -> stream.WriteWithLength(Encoding.UTF8.GetBytes((o :?> System.Version).ToString()))
#if BSON
                | "JObject"
                | "JArray"
                | "JToken" -> stream.WriteWithLength((o :?> JToken) |> Bson.jtToBson)
#endif

#if WPF
                | "Point" -> 
                    let p = o :?> Point
                    stream.Write(BitConverter.GetBytes(p.X))
                    stream.Write(BitConverter.GetBytes(p.Y))
                | "Color" ->
                    let c = (o :?> Color)
                    stream.Write([|c.A;c.R;c.G;c.B|])
#endif  
                | "List`1" -> 
                    let list = o :?> System.Collections.IList
                    stream.Write(BitConverter.GetBytes(list.Count))
                    for x in list do serialize stream x
                | _ -> 
                    match t with
                    | t when PreComp.isTuple t -> for ts in PreComp.tupleReader t o do serialize stream ts
                    | t when PreComp.isUnion t ->
                        let tag = PreComp.unionTagReader t o
                        stream.Write(BitConverter.GetBytes(tag))
                        (PreComp.getUnionFields(t,tag), PreComp.unionReader(t,tag) o) ||> Array.iter2 (fun (name,_) o -> serialize stream o)
                    | t when PreComp.isRecord t -> 
                        (PreComp.getRecordFields t, o |> PreComp.recordReader t) ||> Array.iter2 (fun (name,_) o -> serialize stream o)
                    | t when t.IsArray -> 
                        let array = o :?> Array
                        stream.Write(BitConverter.GetBytes(array.Length))
                        for x in array do serialize stream x
                    | t when t.IsEnum -> serialize stream (Convert.ChangeType(o, PreComp.getEnumType t))
                    | _ -> failwith (sprintf "unrecognized type %A" t)

    let rec deserialize (t:System.Type) (reader:int -> byte[]) =
        match t.Name with
            | "Guid" -> System.Guid(reader(16)) :> obj
            | "DateTime" -> System.DateTime.FromBinary(BitConverter.ToInt64(reader(8),0)) :> obj
            | "Boolean" -> BitConverter.ToBoolean(reader(1),0) :> obj
            | "Byte" -> reader(1).[0] :> obj
            | "UInt16" -> BitConverter.ToUInt16(reader(2),0) :> obj
            | "UInt32" -> BitConverter.ToUInt32(reader(4),0) :> obj
            | "Int32" -> BitConverter.ToInt32(reader(4),0) :> obj
            | "Int64" -> BitConverter.ToInt64(reader(8),0) :> obj
            | "Single" -> BitConverter.ToSingle(reader(4),0) :> obj
            | "Double" -> BitConverter.ToDouble(reader(8),0) :> obj
            | "String" -> 
                let length = BitConverter.ToInt32(reader(4),0)
                Encoding.UTF8.GetString(reader(length),0, length) :> obj
            | "Uri" -> 
                let length = BitConverter.ToInt32(reader(4),0)
                Uri(Encoding.UTF8.GetString(reader(length),0, length)) :> obj
            | "Byte[]" -> 
                 let length = BitConverter.ToInt32(reader(4),0)
                 reader(length) :> obj
            | "IPAddress" -> IPAddress(reader(4)) :> obj
#if BSON
            | "JObject"
            | "JArray"
            | "JToken" -> 
                let length = BitConverter.ToInt32(reader(4),0)
                reader(length) |> Bson.bsonToJt :> obj
#endif
            | "Version" -> 
                let length = BitConverter.ToInt32(reader(4),0)
                System.Version.Parse(Encoding.UTF8.GetString(reader(length),0, length)) :> obj
#if WPF
            | "Point" -> Point(BitConverter.ToDouble(reader(8),0),BitConverter.ToDouble(reader(8),0)) :> obj
            | "Color" -> 
                match reader(4) with
                | [|a;r;g;b|] -> Color.FromArgb(a,r,g,b) :> obj
                | _ -> failwith "never"
#endif  
            | "List`1" -> 
                // TODO - check if this is slow, or better yet avoid using lists?
                let gt = t.GetGenericArguments() |> Seq.head
                let count = BitConverter.ToInt32(reader(4),0)
                let xs = Array.CreateInstance(gt,count)
                let mutable index = 0
                for x in xs do 
                    xs.SetValue(deserialize gt reader, index)
                    index <- index + 1
                Activator.CreateInstance(Type.GetType("System.Collections.Generic.List`1").MakeGenericType(gt), xs)
            | _ -> 
                match t with
                | t when PreComp.isTuple  t -> PreComp.tupleConstructor t (PreComp.getTupleElements t |> Array.map (fun te -> deserialize te reader))
                | t when PreComp.isUnion  t -> 
                    let tag = BitConverter.ToInt32(reader(4),0)
                    PreComp.getUnionFields(t,tag) 
                    |> Array.map (fun (_,subt) -> deserialize subt reader)
                    |> PreComp.unionConstructor(t,tag)
                | t when PreComp.isRecord t ->
                    PreComp.getRecordFields t
                    |> Array.map (fun (name,et) ->
                        try 
                            deserialize et reader
                        with
                        | ex ->
                            printf "Error at property name %s" name
                            raise ex
                        )
                    |> PreComp.recordConstructor t
                | t when t.IsArray -> 
                    // todo - is this slow?
                    let et = t.GetElementType()                
                    let count = BitConverter.ToInt32(reader(4),0)
                    let xs = Array.CreateInstance(et,count)
                    let mutable index = 0
                    for x in xs do 
                        xs.SetValue(deserialize et reader, index)
                        index <- index + 1
                    xs :> obj
                | t when t.IsEnum -> Enum.ToObject(t,deserialize (PreComp.getEnumType t) reader)
                | _ -> failwith (sprintf "unrecognized type %A" t)

    let bufferReader (buffer:byte array) =
        let offset = ref 0
        fun (length:int) -> 
            let bytes = Array.sub buffer (offset.Value) length
            offset.Value <- offset.Value + length
            bytes

    let toBytes (a:'a) = 
        use ms = new MemoryStream()
        serialize ms a
        ms.ToArray()

    let fromBytes<'a> (bytes:byte[]) = bufferReader bytes |> deserialize typeof<'a> :?> 'a

    let roundtrip (a:'a) = deserialize typeof<'a> (toBytes a |> bufferReader)  :?> 'a

    let readMsg (stream:Stream) =
        async {
            let! lengthBytes = stream.AsyncRead(4)
            let length = BitConverter.ToUInt32(lengthBytes,0)
            return! stream.AsyncRead(int length)
        }

    let sendMsg (stream:Stream) (bytes:byte[]) =
        async {
            do! stream.AsyncWrite(BitConverter.GetBytes(uint32 bytes.Length),0,4)
            do! stream.AsyncWrite(bytes,0,bytes.Length)
            stream.Flush()
        }  

    let readTypedMsg<'a> (stream:Stream) =
        async {
            let! bytes = readMsg stream
            return deserialize typeof<'a> (bytes |> bufferReader) :?> 'a
        }

    let sendTypedMsg (stream:Stream) (x:'a) = sendMsg stream (toBytes x)

    let update (f : 'a -> 'b) (bytes:byte[]) = toBytes (f(fromBytes bytes : 'a))