Include TypeShape source to remove problematic code (fixes #226) and …

…preserve DateTimeKind (fixes #227)

ClientV2Tests/src/App.fs

@@ -124,15 +124,15 @@ let serverTests =
                 test.equal true (result = [| byte 1; byte 2; byte 3|])
             }
 
-        testCaseAsync "IServer.echoTestCommand" <| 
+        testCaseAsync "IServer.echoTestCommand" <|
             async {
                 let firstGuid = Guid.NewGuid()
                 let testCommand : TestCommand = {
                     Data = {
                         CataA = "CataA"
                         CataC = "CataC"
                         CataB = Map.ofList [
-                            firstGuid, { 
+                            firstGuid, {
                                 MataA = "MataA"
                                 MataC = "MataC"
                                 MataB = Map.ofList [
@@ -1381,6 +1381,11 @@ let inline serializeDeserializeCompare typ (value: 'a) =
     let deserialized = Fable.Remoting.MsgPack.Read.Reader(ra.ToArray ()).Read typ :?> 'a
     Expect.equal value deserialized "Values are equal after roundtrip"
 
+let inline serializeDeserialize typ (value: 'a) =
+    let ra = FSharp.Collections.ResizeArray<byte> ()
+    Fable.Remoting.MsgPack.Write.Fable.writeObject value typ ra
+    Fable.Remoting.MsgPack.Read.Reader(ra.ToArray ()).Read typ :?> 'a
+
 let inline serializeDeserializeCompareDictionary typ (value: System.Collections.Generic.IDictionary<'a, 'b>) =
     let ra = FSharp.Collections.ResizeArray<byte> ()
     Fable.Remoting.MsgPack.Write.Fable.writeObject value typ ra
@@ -1442,6 +1447,24 @@ let msgPackTests =
         testCase "DateTime" <| fun () ->
             DateTime.Now |> serializeDeserializeCompare typeof<DateTime>
 
+        testCase "DateTime conversions preverses Kind" <| fun () ->
+            let nowTicks = DateTime.Now.Ticks
+            let localNow = DateTime(nowTicks, DateTimeKind.Local)
+            let utcNow = DateTime(nowTicks, DateTimeKind.Utc)
+            let unspecifiedNow = DateTime(nowTicks, DateTimeKind.Unspecified)
+
+            let localNowDeserialized = serializeDeserialize typeof<DateTime> localNow
+            let utcNowDeserialized = serializeDeserialize typeof<DateTime> utcNow
+            let unspecifiedNowDeserialized = serializeDeserialize typeof<DateTime> unspecifiedNow
+
+            Expect.equal DateTimeKind.Local localNowDeserialized.Kind "Local is preserved"
+            Expect.equal DateTimeKind.Utc utcNowDeserialized.Kind "Utc is preserved"
+            Expect.equal DateTimeKind.Unspecified unspecifiedNowDeserialized.Kind "Unspecified is preserved"
+
+            Expect.equal localNow localNowDeserialized "Now(Local) can be converted"
+            Expect.equal utcNow utcNowDeserialized "Now(Utc) can be converted"
+            Expect.equal unspecifiedNow unspecifiedNowDeserialized "Now(Unspecified) can be converted"
+
         testCase "DateTimeOffset" <| fun () ->
             DateTimeOffset.Now |> serializeDeserializeCompare typeof<DateTimeOffset>
 

Fable.Remoting.MsgPack.Tests/FableConverterTests.fs

@@ -21,6 +21,12 @@ let serializeDeserializeCompare<'a when 'a: equality> (value: 'a) =
 
     equal value deserialized
 
+let serializeDeserialize<'a> (value: 'a) =
+    use ms = new MemoryStream ()
+    MsgPack.Write.serializeObj value ms
+
+    MsgPack.Read.Reader(ms.ToArray ()).Read typeof<'a> :?> 'a
+
 let serializeDeserializeCompareSequence (value: 'a) =
     use ms = new MemoryStream ()
     MsgPack.Write.serializeObj value ms
@@ -48,22 +54,22 @@ let converterTest =
             -20 |> serializeDeserializeCompareWithLength 1
         }
         test "Maybe" {
-            Just 1 |> serializeDeserializeCompare 
+            Just 1 |> serializeDeserializeCompare
         }
         test "Nested maybe array works" {
-            Just [| Nothing; Just 1 |] |> serializeDeserializeCompare 
+            Just [| Nothing; Just 1 |] |> serializeDeserializeCompare
         }
         test "Record" {
-            { Prop1 = ""; Prop2 = 2; Prop3 = None } |> serializeDeserializeCompare 
+            { Prop1 = ""; Prop2 = 2; Prop3 = None } |> serializeDeserializeCompare
         }
         test "None" {
-            (None: string option) |> serializeDeserializeCompare 
+            (None: string option) |> serializeDeserializeCompare
         }
         test "Some string works" {
-            Some "ddd" |> serializeDeserializeCompare 
+            Some "ddd" |> serializeDeserializeCompare
         }
         test "Long serialized as fixnum" {
-            20L |> serializeDeserializeCompare 
+            20L |> serializeDeserializeCompare
         }
         test "Long serialized as int16, 3 bytes" {
             60_000L |> serializeDeserializeCompareWithLength 3
@@ -77,6 +83,26 @@ let converterTest =
         test "DateTime" {
             DateTime.Now |> serializeDeserializeCompare
         }
+
+        test "DateTime conversions preverses Kind" {
+            let nowTicks = DateTime.Now.Ticks
+            let localNow = DateTime(nowTicks, DateTimeKind.Local)
+            let utcNow = DateTime(nowTicks, DateTimeKind.Utc)
+            let unspecifiedNow = DateTime(nowTicks, DateTimeKind.Unspecified)
+
+            let localNowDeserialized = serializeDeserialize localNow
+            let utcNowDeserialized = serializeDeserialize utcNow
+            let unspecifiedNowDeserialized = serializeDeserialize unspecifiedNow
+
+            Expect.equal DateTimeKind.Local localNowDeserialized.Kind "Local is preserved"
+            Expect.equal DateTimeKind.Utc utcNowDeserialized.Kind "Utc is preserved"
+            Expect.equal DateTimeKind.Unspecified unspecifiedNowDeserialized.Kind "Unspecified is preserved"
+
+            Expect.equal localNow localNowDeserialized "Now(Local) can be converted"
+            Expect.equal utcNow utcNowDeserialized "Now(Utc) can be converted"
+            Expect.equal unspecifiedNow unspecifiedNowDeserialized "Now(Unspecified) can be converted"
+        }
+
         test "DateTimeOffset" {
             DateTimeOffset.Now |> serializeDeserializeCompare
         }

Fable.Remoting.MsgPack/Read.fs

@@ -25,7 +25,6 @@ let inline interpretIntegerAs typ n =
     if typ = typeof<Int32> then int32 n |> box
     elif typ = typeof<Int64> then int64 n |> box
     elif typ = typeof<Int16> then int16 n |> box
-    elif typ = typeof<DateTime> then DateTime (int64 n) |> box
     elif typ = typeof<UInt32> then uint32 n |> box
     elif typ = typeof<UInt64> then uint64 n |> box
     elif typ = typeof<UInt16> then uint16 n |> box
@@ -114,10 +113,10 @@ type Reader (data: byte[]) =
 #else
         if BitConverter.IsLittleEndian then
             let arr = Array.zeroCreate len
-        
+
             for i in 0 .. len - 1 do
                 arr.[i] <- data.[pos + len - 1 - i]
-            
+
             pos <- pos + len
             m (arr, 0)
         else
@@ -171,24 +170,24 @@ type Reader (data: byte[]) =
 #if !FABLE_COMPILER
         mapReaderCache.GetOrAdd (t, Func<_, _>(fun (t: Type) ->
             let args = t.GetGenericArguments ()
-            
+
             if args.Length <> 2 then
                 failwithf "Expecting %s, but the data contains a map." t.Name
 
             let mapDeserializer = typedefof<DictionaryDeserializer<_,_>>.MakeGenericType args
             let isDictionary = t.GetGenericTypeDefinition () = typedefof<Dictionary<_, _>>
             let d = Delegate.CreateDelegate (typeof<Func<int, bool, (Type -> obj), obj>>, mapDeserializer.GetMethod "Deserialize") :?> Func<int, bool, (Type -> obj), obj>
-            
+
             fun (len, x: Reader) -> d.Invoke (len, isDictionary, x.Read))) (len, x)
 #else
         let args = t.GetGenericArguments ()
-        
+
         if args.Length <> 2 then
             failwithf "Expecting %s, but the data contains a map." t.Name
 
         let pairs =
             let arr = Array.zeroCreate len
-            
+
             for i in 0 .. len - 1 do
                 arr.[i] <- x.Read args.[0] |> box :?> IStructuralComparable, x.Read args.[1]
 
@@ -206,17 +205,17 @@ type Reader (data: byte[]) =
 #if !FABLE_COMPILER
         setReaderCache.GetOrAdd (t, Func<_, _>(fun (t: Type) ->
             let args = t.GetGenericArguments ()
-            
+
             if args.Length <> 1 then
                 failwithf "Expecting %s, but the data contains a set." t.Name
 
             let setDeserializer = typedefof<SetDeserializer<_>>.MakeGenericType args
             let d = Delegate.CreateDelegate (typeof<Func<int, (Type -> obj), obj>>, setDeserializer.GetMethod "Deserialize") :?> Func<int, (Type -> obj), obj>
-            
+
             fun (len, x: Reader) -> d.Invoke (len, x.Read))) (len, x)
 #else
         let args = t.GetGenericArguments ()
-        
+
         if args.Length <> 1 then
             failwithf "Expecting %s, but the data contains a set." t.Name
 
@@ -241,7 +240,7 @@ type Reader (data: byte[]) =
 
         for i in 0 .. len - 1 do
             arr.[i] <- x.Read elementType
-        
+
         arr
 #endif
 
@@ -257,7 +256,7 @@ type Reader (data: byte[]) =
 #if !FABLE_COMPILER
             let fieldTypes = FSharpType.GetRecordFields t |> Array.map (fun prop -> prop.PropertyType)
             let ctor = FSharpValue.PreComputeRecordConstructor (t, true)
-            
+
             arrayReaderCache.GetOrAdd (t, fun (_, x: Reader) ->
                 ctor (fieldTypes |> Array.map x.Read)) (len, x)
 #else
@@ -291,7 +290,7 @@ type Reader (data: byte[]) =
                             fieldTypes |> Array.map x.Read
 
                     unionConstructorCache.GetOrAdd (case, Func<_, _>(fun case -> FSharpValue.PreComputeUnionConstructor (case, true))) fields) (len, x)
-#else        
+#else
             let tag = x.Read typeof<int> :?> int
             let case = FSharpType.GetUnionCases (t, true) |> Array.find (fun x -> x.Tag = tag)
             let fieldTypes = case.GetFields () |> Array.map (fun x -> x.PropertyType)
@@ -335,24 +334,34 @@ type Reader (data: byte[]) =
 #else
             FSharpValue.MakeTuple (FSharpType.GetTupleElements t |> Array.map x.Read, t)
 #endif
+        elif t = typeof<DateTime> then
+            let dateTimeTicks = x.Read typeof<int64> :?> int64
+            let kindAsInt = x.Read typeof<int64> :?> int64
+            let kind =
+                match kindAsInt with
+                | 1L -> DateTimeKind.Utc
+                | 2L -> DateTimeKind.Local
+                | _ -> DateTimeKind.Unspecified
+            DateTime(ticks=dateTimeTicks, kind=kind) |> box
         elif t = typeof<DateTimeOffset> then
             let dateTimeTicks = x.Read typeof<int64> :?> int64
             let timeSpanMinutes = x.Read typeof<int16> :?> int16
             DateTimeOffset (dateTimeTicks, TimeSpan.FromMinutes (float timeSpanMinutes)) |> box
+
         elif t.IsGenericType && t.GetGenericTypeDefinition () = typedefof<Set<_>> then
             x.ReadSet(len, t)
 #if !FABLE_COMPILER
         elif t = typeof<System.Data.DataTable> then
             match x.ReadRawArray(2, typeof<string>) :?> string array with
-            | [|schema;data|] -> 
+            | [|schema;data|] ->
                 let t = new System.Data.DataTable()
                 t.ReadXmlSchema(new System.IO.StringReader(schema))
                 t.ReadXml(new System.IO.StringReader(data)) |> ignore
                 box t
             | otherwise -> failwithf "Expecting %s at position %d, but the data contains an array." t.Name pos
         elif t = typeof<System.Data.DataSet> then
             match x.ReadRawArray(2, typeof<string>) :?> string array with
-            | [|schema;data|] -> 
+            | [|schema;data|] ->
                 let t = new System.Data.DataSet()
                 t.ReadXmlSchema(new System.IO.StringReader(schema))
                 t.ReadXml(new System.IO.StringReader(data)) |> ignore

Fable.Remoting.MsgPack/Write.fs

@@ -225,8 +225,10 @@ let writeBin (data: byte[]) (out: Stream) =
     write32bitNumber data.Length out false
     out.Write (data, 0, data.Length)
 
-let inline writeDateTime (dt: DateTime) out =
+let inline writeDateTime (dt: DateTime) (out: Stream) =
+    out.WriteByte (Format.fixarr 2uy)
     writeInt64 dt.Ticks out
+    writeInt64 (int64 dt.Kind) out
 
 let inline writeDateTimeOffset (dto: DateTimeOffset) (out: Stream) =
     out.WriteByte (Format.fixarr 2uy)
@@ -559,6 +561,11 @@ module Fable =
 
         out.AddRange data
 
+    let inline private writeDateTime (out: ResizeArray<byte>) (dto: DateTime) =
+        out.Add (Format.fixarr 2uy)
+        writeInt64 dto.Ticks out
+        writeInt64 (int64 dto.Kind) out
+
     let inline private writeDateTimeOffset (out: ResizeArray<byte>) (dto: DateTimeOffset) =
         out.Add (Format.fixarr 2uy)
         writeInt64 dto.Ticks out
@@ -710,7 +717,7 @@ module Fable =
     serializerCache.Add (typeof<byte[]>.FullName, fun x out -> writeBin (x :?> byte[]) out)
     serializerCache.Add (typeof<bigint>.FullName, fun x out -> writeBin ((x :?> bigint).ToByteArray ()) out)
     serializerCache.Add (typeof<Guid>.FullName, fun x out -> writeBin ((x :?> Guid).ToByteArray ()) out)
-    serializerCache.Add (typeof<DateTime>.FullName, fun x out -> writeInt64 (x :?> DateTime).Ticks out)
+    serializerCache.Add (typeof<DateTime>.FullName, fun x out -> writeDateTime out (x :?> DateTime))
     serializerCache.Add (typeof<DateTimeOffset>.FullName, fun x out -> writeDateTimeOffset out (x :?> DateTimeOffset))
     serializerCache.Add (typeof<TimeSpan>.FullName, fun x out -> writeInt64 (x :?> TimeSpan).Ticks out)
     #endif

Fable.Remoting.Server/Fable.Remoting.Server.fsproj

@@ -15,6 +15,7 @@
     </PropertyGroup>
 
     <ItemGroup>
+        <Compile Include="TypeShape.fs" />
         <Compile Include="Types.fs" />
         <Compile Include="Errors.fs" />
         <Compile Include="Diagnostics.fs" />