mirror of
				https://github.com/KevinMidboe/linguist.git
				synced 2025-10-29 17:50:22 +00:00 
			
		
		
		
	Adding more F# .fs samples. Fixes #1814
This commit is contained in:
		
							
								
								
									
										65
									
								
								samples/F#/JsonFormat.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										65
									
								
								samples/F#/JsonFormat.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,65 @@ | |||||||
|  | namespace Nessos.FsPickler.Json | ||||||
|  |  | ||||||
|  |     open System | ||||||
|  |     open System.IO | ||||||
|  |     open System.Text | ||||||
|  |  | ||||||
|  |     open Newtonsoft.Json | ||||||
|  |  | ||||||
|  |     open Nessos.FsPickler | ||||||
|  |  | ||||||
|  |     /// <summary> | ||||||
|  |     ///     Factory methods for the Json serialization format. | ||||||
|  |     /// </summary> | ||||||
|  |     type JsonPickleFormatProvider internal (indent, omitHeader) as self = | ||||||
|  |  | ||||||
|  |         let isCustomSeq isTopLevelSequence =  | ||||||
|  |             isTopLevelSequence && self.OmitHeader && self.UseCustomTopLevelSequenceSeparator | ||||||
|  |  | ||||||
|  |         let mutable sequenceSeparator = " " | ||||||
|  |  | ||||||
|  |         member val Indent = indent with get,set | ||||||
|  |         member val OmitHeader = omitHeader with get,set | ||||||
|  |         member val UseCustomTopLevelSequenceSeparator = false with get,set | ||||||
|  |  | ||||||
|  |         member __.SequenceSeparator | ||||||
|  |             with get () = sequenceSeparator | ||||||
|  |             and set sep = | ||||||
|  |                 if sep <> null && String.IsNullOrWhiteSpace sep then | ||||||
|  |                     sequenceSeparator <- sep | ||||||
|  |                 else | ||||||
|  |                     invalidArg "SequenceSeparator" "should be non-null whitespace." | ||||||
|  |  | ||||||
|  |         interface ITextPickleFormatProvider with | ||||||
|  |             member __.Name = "Json" | ||||||
|  |  | ||||||
|  |             // see discussion : https://github.com/nessos/FsPickler/issues/17 | ||||||
|  |             member __.DefaultEncoding = new UTF8Encoding(false) :> Encoding | ||||||
|  |  | ||||||
|  |             member __.CreateWriter (stream, encoding, isTopLevelSequence, leaveOpen) = | ||||||
|  | #if NET40 | ||||||
|  |                 if leaveOpen then raise <| new NotSupportedException("'leaveOpen' not supported in .NET 40.") | ||||||
|  |                 let sw = new StreamWriter(stream, encoding) | ||||||
|  | #else | ||||||
|  |                 let sw = new StreamWriter(stream, encoding, 1024, leaveOpen) | ||||||
|  | #endif | ||||||
|  |                 let jw = new JsonTextWriter(sw) | ||||||
|  |                 new JsonPickleWriter(jw, __.OmitHeader, __.Indent, isCustomSeq isTopLevelSequence, sequenceSeparator, leaveOpen) :> _ | ||||||
|  |  | ||||||
|  |             member __.CreateReader (stream, encoding, isTopLevelSequence, leaveOpen) = | ||||||
|  | #if NET40 | ||||||
|  |                 if leaveOpen then raise <| new NotSupportedException("'leaveOpen' not supported in .NET 40.") | ||||||
|  |                 let sr = new StreamReader(stream, encoding) | ||||||
|  | #else | ||||||
|  |                 let sr = new StreamReader(stream, encoding, true, 1024, leaveOpen) | ||||||
|  | #endif | ||||||
|  |                 let jr = new JsonTextReader(sr) | ||||||
|  |                 new JsonPickleReader(jr, __.OmitHeader, isCustomSeq isTopLevelSequence, leaveOpen) :> _ | ||||||
|  |  | ||||||
|  |             member __.CreateWriter (textWriter, isTopLevelSequence, leaveOpen) = | ||||||
|  |                 let jw = new JsonTextWriter(textWriter) | ||||||
|  |                 new JsonPickleWriter(jw, __.OmitHeader, __.Indent, isCustomSeq isTopLevelSequence, sequenceSeparator, leaveOpen) :> _ | ||||||
|  |  | ||||||
|  |             member __.CreateReader (textReader, isTopLevelSequence, leaveOpen) = | ||||||
|  |                 let jr = new JsonTextReader(textReader) | ||||||
|  |                 new JsonPickleReader(jr, __.OmitHeader, isCustomSeq isTopLevelSequence, leaveOpen) :> _ | ||||||
							
								
								
									
										202
									
								
								samples/F#/JsonReader.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										202
									
								
								samples/F#/JsonReader.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,202 @@ | |||||||
|  | namespace Nessos.FsPickler.Json | ||||||
|  |  | ||||||
|  |     open System | ||||||
|  |     open System.Collections.Generic | ||||||
|  |     open System.Globalization | ||||||
|  |     open System.IO | ||||||
|  |     open System.Numerics | ||||||
|  |     open System.Text | ||||||
|  |  | ||||||
|  |     open Newtonsoft.Json | ||||||
|  |  | ||||||
|  |     open Nessos.FsPickler | ||||||
|  |  | ||||||
|  |     /// <summary> | ||||||
|  |     ///     Json format deserializer | ||||||
|  |     /// </summary> | ||||||
|  |     type internal JsonPickleReader (jsonReader : JsonReader, omitHeader, isTopLevelSequence, leaveOpen) = | ||||||
|  |  | ||||||
|  |         do | ||||||
|  |             jsonReader.CloseInput <- not leaveOpen | ||||||
|  |             jsonReader.SupportMultipleContent <- isTopLevelSequence | ||||||
|  |  | ||||||
|  |         let isBsonReader = match jsonReader with :? Bson.BsonReader -> true | _ -> false | ||||||
|  |  | ||||||
|  |         let mutable depth = 0 | ||||||
|  |         let arrayStack = new Stack<int> () | ||||||
|  |         do arrayStack.Push Int32.MinValue | ||||||
|  |  | ||||||
|  |         // do not write tag if omitting header or array element | ||||||
|  |         let omitTag () = (omitHeader && depth = 0) || arrayStack.Peek() = depth - 1 | ||||||
|  |  | ||||||
|  |         interface IPickleFormatReader with | ||||||
|  |              | ||||||
|  |             member __.BeginReadRoot (tag : string) = | ||||||
|  |                 do jsonReader.Read() |> ignore | ||||||
|  |                      | ||||||
|  |                 if omitHeader then () else | ||||||
|  |  | ||||||
|  |                 if jsonReader.TokenType <> JsonToken.StartObject then raise <| new FormatException("invalid json root object.") | ||||||
|  |                 else | ||||||
|  |                     do jsonReader.MoveNext() | ||||||
|  |                     let version = jsonReader.ReadPrimitiveAs<string> false "FsPickler" | ||||||
|  |                     if version <> jsonFormatVersion then | ||||||
|  |                         let v = Version(version) | ||||||
|  |                         raise <| new FormatException(sprintf "Invalid FsPickler format version %O." version) | ||||||
|  |  | ||||||
|  |                     let sTag = jsonReader.ReadPrimitiveAs<string> false "type" | ||||||
|  |                     if tag <> sTag then | ||||||
|  |                         raise <| new InvalidPickleTypeException(tag, sTag) | ||||||
|  |  | ||||||
|  |             member __.EndReadRoot () =  | ||||||
|  |                 if not omitHeader then jsonReader.Read() |> ignore | ||||||
|  |  | ||||||
|  |             member __.BeginReadObject (tag : string) = | ||||||
|  |                  | ||||||
|  |                 if not <| omitTag () then | ||||||
|  |                     jsonReader.ReadProperty tag | ||||||
|  |                     jsonReader.MoveNext () | ||||||
|  |  | ||||||
|  |                 if isTopLevelSequence && depth = 0 then | ||||||
|  |                     arrayStack.Push depth | ||||||
|  |                     depth <- depth + 1 | ||||||
|  |                     ObjectFlags.IsSequenceHeader | ||||||
|  |  | ||||||
|  |                 else | ||||||
|  |                     match jsonReader.TokenType with | ||||||
|  |                     | JsonToken.Null -> ObjectFlags.IsNull | ||||||
|  |                     | JsonToken.StartArray -> | ||||||
|  |                         jsonReader.MoveNext() | ||||||
|  |                         arrayStack.Push depth | ||||||
|  |                         depth <- depth + 1 | ||||||
|  |                         ObjectFlags.IsSequenceHeader | ||||||
|  |  | ||||||
|  |                     | JsonToken.StartObject -> | ||||||
|  |                         do jsonReader.MoveNext() | ||||||
|  |                         depth <- depth + 1 | ||||||
|  |  | ||||||
|  |                         if jsonReader.ValueAs<string> () = "_flags" then | ||||||
|  |                             jsonReader.MoveNext() | ||||||
|  |                             let csvFlags = jsonReader.ValueAs<string>() | ||||||
|  |                             jsonReader.MoveNext() | ||||||
|  |                             parseFlagCsv csvFlags | ||||||
|  |                         else | ||||||
|  |                             ObjectFlags.None | ||||||
|  |  | ||||||
|  |                     | token -> raise <| new FormatException(sprintf "expected start of Json object but was '%O'." token) | ||||||
|  |  | ||||||
|  |  | ||||||
|  |             member __.EndReadObject () = | ||||||
|  |                 if isTopLevelSequence && depth = 1 then | ||||||
|  |                     arrayStack.Pop () |> ignore | ||||||
|  |                     depth <- depth - 1 | ||||||
|  |                     jsonReader.Read() |> ignore | ||||||
|  |                 else | ||||||
|  |                     match jsonReader.TokenType with | ||||||
|  |                     | JsonToken.Null -> () | ||||||
|  |                     | JsonToken.EndObject -> depth <- depth - 1 | ||||||
|  |                     | JsonToken.EndArray -> | ||||||
|  |                         arrayStack.Pop() |> ignore | ||||||
|  |                         depth <- depth - 1 | ||||||
|  |  | ||||||
|  |                     | token -> raise <| new FormatException(sprintf "expected end of Json object but was '%O'." token) | ||||||
|  |  | ||||||
|  |                     if omitHeader && depth = 0 then () | ||||||
|  |                     else jsonReader.Read() |> ignore | ||||||
|  |  | ||||||
|  |             member __.SerializeUnionCaseNames = true | ||||||
|  |  | ||||||
|  |             member __.PreferLengthPrefixInSequences = false | ||||||
|  |             member __.ReadNextSequenceElement () =  | ||||||
|  |                 if isTopLevelSequence && depth = 1 then | ||||||
|  |                     jsonReader.TokenType <> JsonToken.None | ||||||
|  |                 else | ||||||
|  |                     jsonReader.TokenType <> JsonToken.EndArray | ||||||
|  |  | ||||||
|  |             member __.ReadCachedObjectId () = jsonReader.ReadPrimitiveAs<int64> false "id" | ||||||
|  |  | ||||||
|  |             member __.ReadBoolean tag = jsonReader.ReadPrimitiveAs<bool> (omitTag ()) tag | ||||||
|  |             member __.ReadByte tag = jsonReader.ReadPrimitiveAs<int64> (omitTag ()) tag |> byte | ||||||
|  |             member __.ReadSByte tag = jsonReader.ReadPrimitiveAs<int64> (omitTag ()) tag |> sbyte | ||||||
|  |  | ||||||
|  |             member __.ReadInt16 tag = jsonReader.ReadPrimitiveAs<int64> (omitTag ()) tag |> int16 | ||||||
|  |             member __.ReadInt32 tag = jsonReader.ReadPrimitiveAs<int64> (omitTag ()) tag |> int | ||||||
|  |             member __.ReadInt64 tag = jsonReader.ReadPrimitiveAs<int64> (omitTag ()) tag | ||||||
|  |  | ||||||
|  |             member __.ReadUInt16 tag = jsonReader.ReadPrimitiveAs<int64> (omitTag ()) tag |> uint16 | ||||||
|  |             member __.ReadUInt32 tag = jsonReader.ReadPrimitiveAs<int64> (omitTag ()) tag |> uint32 | ||||||
|  |             member __.ReadUInt64 tag = jsonReader.ReadPrimitiveAs<int64> (omitTag ()) tag |> uint64 | ||||||
|  |  | ||||||
|  |             member __.ReadSingle tag = | ||||||
|  |                 if not <| omitTag () then | ||||||
|  |                     jsonReader.ReadProperty tag | ||||||
|  |                     jsonReader.MoveNext() | ||||||
|  |  | ||||||
|  |                 let value = | ||||||
|  |                     match jsonReader.TokenType with | ||||||
|  |                     | JsonToken.Float -> jsonReader.ValueAs<double> () |> single | ||||||
|  |                     | JsonToken.String -> Single.Parse(jsonReader.ValueAs<string>(), CultureInfo.InvariantCulture) | ||||||
|  |                     | _ -> raise <| new FormatException("not a float.") | ||||||
|  |  | ||||||
|  |                 jsonReader.Read() |> ignore | ||||||
|  |                 value | ||||||
|  |                  | ||||||
|  |             member __.ReadDouble tag = | ||||||
|  |                 if not <| omitTag () then | ||||||
|  |                     jsonReader.ReadProperty tag | ||||||
|  |                     jsonReader.MoveNext() | ||||||
|  |  | ||||||
|  |                 let value = | ||||||
|  |                     match jsonReader.TokenType with | ||||||
|  |                     | JsonToken.Float -> jsonReader.ValueAs<double> () | ||||||
|  |                     | JsonToken.String -> Double.Parse(jsonReader.ValueAs<string>(), CultureInfo.InvariantCulture) | ||||||
|  |                     | _ -> raise <| new FormatException("not a float.") | ||||||
|  |  | ||||||
|  |                 jsonReader.Read() |> ignore | ||||||
|  |                 value | ||||||
|  |  | ||||||
|  |             member __.ReadChar tag = let value = jsonReader.ReadPrimitiveAs<string> (omitTag ()) tag in value.[0] | ||||||
|  |             member __.ReadString tag = jsonReader.ReadPrimitiveAs<string> (omitTag ()) tag | ||||||
|  |             member __.ReadBigInteger tag = jsonReader.ReadPrimitiveAs<string> (omitTag ()) tag |> BigInteger.Parse | ||||||
|  |  | ||||||
|  |             member __.ReadGuid tag =  | ||||||
|  |                 if isBsonReader then  | ||||||
|  |                     jsonReader.ReadPrimitiveAs<Guid> (omitTag ()) tag | ||||||
|  |                 else | ||||||
|  |                     jsonReader.ReadPrimitiveAs<string> (omitTag ()) tag |> Guid.Parse | ||||||
|  |  | ||||||
|  |             member __.ReadTimeSpan tag = jsonReader.ReadPrimitiveAs<string> (omitTag ()) tag |> TimeSpan.Parse | ||||||
|  |             member __.ReadDecimal tag = jsonReader.ReadPrimitiveAs<string> (omitTag ()) tag |> decimal | ||||||
|  |  | ||||||
|  |             // BSON spec mandates the use of Unix time;  | ||||||
|  |             // this has millisecond precision which results in loss of accuracy w.r.t. ticks | ||||||
|  |             // since the goal of FsPickler is to offer faithful representations of .NET objects | ||||||
|  |             // we choose to override the spec and serialize ticks outright. | ||||||
|  |             // see also https://json.codeplex.com/discussions/212067  | ||||||
|  |             member __.ReadDate tag =  | ||||||
|  |                 if isBsonReader then | ||||||
|  |                     let ticks = jsonReader.ReadPrimitiveAs<int64> (omitTag ()) tag | ||||||
|  |                     DateTime(ticks) | ||||||
|  |                 else | ||||||
|  |                     jsonReader.ReadPrimitiveAs<DateTime> (omitTag ()) tag | ||||||
|  |  | ||||||
|  |             member __.ReadBytes tag = | ||||||
|  |                 if not <| omitTag () then | ||||||
|  |                     jsonReader.ReadProperty tag | ||||||
|  |                     jsonReader.Read() |> ignore | ||||||
|  |  | ||||||
|  |                 let bytes = | ||||||
|  |                     if jsonReader.TokenType = JsonToken.Null then null | ||||||
|  |                     elif isBsonReader then jsonReader.ValueAs<byte []> () | ||||||
|  |                     else | ||||||
|  |                         let base64 = jsonReader.ValueAs<string> () | ||||||
|  |                         Convert.FromBase64String base64 | ||||||
|  |  | ||||||
|  |                 jsonReader.Read() |> ignore | ||||||
|  |  | ||||||
|  |                 bytes | ||||||
|  |  | ||||||
|  |             member __.IsPrimitiveArraySerializationSupported = false | ||||||
|  |             member __.ReadPrimitiveArray _ _ = raise <| new NotImplementedException() | ||||||
|  |  | ||||||
|  |             member __.Dispose () = (jsonReader :> IDisposable).Dispose() | ||||||
							
								
								
									
										85
									
								
								samples/F#/JsonSerializer.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										85
									
								
								samples/F#/JsonSerializer.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,85 @@ | |||||||
|  | namespace Nessos.FsPickler.Json | ||||||
|  |  | ||||||
|  |     open System | ||||||
|  |  | ||||||
|  |     open Nessos.FsPickler | ||||||
|  |  | ||||||
|  |     type internal OAttribute = System.Runtime.InteropServices.OptionalAttribute | ||||||
|  |     type internal DAttribute = System.Runtime.InteropServices.DefaultParameterValueAttribute | ||||||
|  |  | ||||||
|  |     /// <summary> | ||||||
|  |     ///     Json pickler instance. | ||||||
|  |     /// </summary> | ||||||
|  |     type JsonSerializer = | ||||||
|  |         inherit FsPicklerTextSerializer | ||||||
|  |          | ||||||
|  |         val private format : JsonPickleFormatProvider | ||||||
|  |  | ||||||
|  |         /// <summary> | ||||||
|  |         ///     Initializes a new Json pickler instance. | ||||||
|  |         /// </summary> | ||||||
|  |         /// <param name="indent">indent out Json pickles.</param> | ||||||
|  |         /// <param name="omitHeader">omit FsPickler header in Json pickles.</param> | ||||||
|  |         /// <param name="typeConverter">specify a custom type name converter.</param> | ||||||
|  |         new ([<O;D(null)>] ?indent, [<O;D(null)>] ?omitHeader, [<O;D(null)>] ?typeConverter) = | ||||||
|  |             let indent = defaultArg indent false | ||||||
|  |             let omitHeader = defaultArg omitHeader false | ||||||
|  |             let json = new JsonPickleFormatProvider(indent, omitHeader) | ||||||
|  |             {  | ||||||
|  |                 inherit FsPicklerTextSerializer(json, ?typeConverter = typeConverter) | ||||||
|  |                 format = json     | ||||||
|  |             } | ||||||
|  |  | ||||||
|  |         /// <summary> | ||||||
|  |         ///     Gets or sets whether Json output should be indented. | ||||||
|  |         /// </summary> | ||||||
|  |         member x.Indent | ||||||
|  |             with get () = x.format.Indent | ||||||
|  |             and set b = x.format.Indent <- b | ||||||
|  |  | ||||||
|  |         /// <summary> | ||||||
|  |         ///     Gets or sets whether FsPickler headers should be ignored in pickle format. | ||||||
|  |         /// </summary> | ||||||
|  |         member x.OmitHeader | ||||||
|  |             with get () = x.format.OmitHeader | ||||||
|  |             and set b = x.format.OmitHeader <- b | ||||||
|  |  | ||||||
|  |         /// <summary> | ||||||
|  |         ///     Gets or sets a non-null whitespace string that serves as a custom, top-level sequence separator. | ||||||
|  |         /// </summary> | ||||||
|  |         member x.SequenceSeparator | ||||||
|  |             with get () = x.format.SequenceSeparator | ||||||
|  |             and set sep = x.format.SequenceSeparator <- sep | ||||||
|  |  | ||||||
|  |         /// <summary> | ||||||
|  |         ///     Gets or sets whether top-level sequences should be serialized using the custom separator. | ||||||
|  |         /// </summary> | ||||||
|  |         member x.UseCustomTopLevelSequenceSeparator | ||||||
|  |             with get () = x.format.UseCustomTopLevelSequenceSeparator | ||||||
|  |             and set e = x.format.UseCustomTopLevelSequenceSeparator <- e | ||||||
|  |  | ||||||
|  |     /// <summary> | ||||||
|  |     ///     BSON pickler instance. | ||||||
|  |     /// </summary> | ||||||
|  |     type BsonSerializer([<O;D(null)>] ?typeConverter) = | ||||||
|  |         inherit FsPicklerSerializer(new BsonPickleFormatProvider(), ?typeConverter = typeConverter) | ||||||
|  |  | ||||||
|  |  | ||||||
|  |     /// FsPickler static methods. | ||||||
|  |     type FsPickler = | ||||||
|  |  | ||||||
|  |         /// <summary> | ||||||
|  |         ///     Initializes a new Json pickler instance. | ||||||
|  |         /// </summary> | ||||||
|  |         /// <param name="indent">indent out Json pickles.</param> | ||||||
|  |         /// <param name="omitHeader">omit FsPickler header in Json pickles.</param> | ||||||
|  |         /// <param name="typeConverter">specify a custom type name converter.</param> | ||||||
|  |         static member CreateJson([<O;D(null)>] ?indent, [<O;D(null)>] ?omitHeader, [<O;D(null)>] ?typeConverter) =  | ||||||
|  |             new JsonSerializer(?indent = indent, ?omitHeader = omitHeader, ?typeConverter = typeConverter) | ||||||
|  |  | ||||||
|  |         /// <summary> | ||||||
|  |         ///     Initializes a new Bson pickler instance. | ||||||
|  |         /// </summary> | ||||||
|  |         /// <param name="typeConverter">specify a custom type name converter.</param> | ||||||
|  |         static member CreateBson([<O;D(null)>] ?typeConverter) =  | ||||||
|  |             new BsonSerializer(?typeConverter = typeConverter) | ||||||
							
								
								
									
										142
									
								
								samples/F#/JsonWriter.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										142
									
								
								samples/F#/JsonWriter.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,142 @@ | |||||||
|  | namespace Nessos.FsPickler.Json | ||||||
|  |  | ||||||
|  |     open System | ||||||
|  |     open System.IO | ||||||
|  |     open System.Collections.Generic | ||||||
|  |  | ||||||
|  |     open Newtonsoft.Json | ||||||
|  |  | ||||||
|  |     open Nessos.FsPickler | ||||||
|  |  | ||||||
|  |     /// <summary> | ||||||
|  |     ///     Json format serializer. | ||||||
|  |     /// </summary> | ||||||
|  |     type internal JsonPickleWriter (jsonWriter : JsonWriter, omitHeader, indented, isTopLevelSequence, separator, leaveOpen) = | ||||||
|  |  | ||||||
|  |         do  | ||||||
|  |             jsonWriter.Formatting <- if indented then Formatting.Indented else Formatting.None | ||||||
|  |             jsonWriter.CloseOutput <- not leaveOpen | ||||||
|  |  | ||||||
|  |         let isBsonWriter = match jsonWriter with :? Bson.BsonWriter -> true | _ -> false | ||||||
|  |  | ||||||
|  |         let mutable depth = 0 | ||||||
|  |         let mutable isTopLevelSequenceHead = false | ||||||
|  |         let mutable currentValueIsNull = false | ||||||
|  |  | ||||||
|  |         let arrayStack = new Stack<int> () | ||||||
|  |         do arrayStack.Push Int32.MinValue | ||||||
|  |  | ||||||
|  |         // do not write tag if omitting header or array element | ||||||
|  |         let omitTag () = (omitHeader && depth = 0) || arrayStack.Peek() = depth - 1 | ||||||
|  |  | ||||||
|  |         interface IPickleFormatWriter with | ||||||
|  |              | ||||||
|  |             member __.BeginWriteRoot (tag : string) = | ||||||
|  |                 if omitHeader then () else | ||||||
|  |  | ||||||
|  |                 jsonWriter.WriteStartObject() | ||||||
|  |                 writePrimitive jsonWriter false "FsPickler" jsonFormatVersion | ||||||
|  |                 writePrimitive jsonWriter false "type" tag | ||||||
|  |  | ||||||
|  |             member __.EndWriteRoot () =  | ||||||
|  |                 if not omitHeader then jsonWriter.WriteEnd() | ||||||
|  |  | ||||||
|  |             member __.BeginWriteObject (tag : string) (flags : ObjectFlags) = | ||||||
|  |  | ||||||
|  |                 if not <| omitTag () then | ||||||
|  |                     jsonWriter.WritePropertyName tag | ||||||
|  |  | ||||||
|  |                 if flags.HasFlag ObjectFlags.IsNull then | ||||||
|  |                     currentValueIsNull <- true | ||||||
|  |                     jsonWriter.WriteNull() | ||||||
|  |  | ||||||
|  |                 elif flags.HasFlag ObjectFlags.IsSequenceHeader then | ||||||
|  |                     if isTopLevelSequence && depth = 0 then | ||||||
|  |                         isTopLevelSequenceHead <- true | ||||||
|  |                     else | ||||||
|  |                         jsonWriter.WriteStartArray() | ||||||
|  |  | ||||||
|  |                     arrayStack.Push depth | ||||||
|  |                     depth <- depth + 1 | ||||||
|  |                 else | ||||||
|  |                     jsonWriter.WriteStartObject() | ||||||
|  |                     depth <- depth + 1 | ||||||
|  |  | ||||||
|  |                     if flags = ObjectFlags.None then () | ||||||
|  |                     else | ||||||
|  |                         let flagCsv = mkFlagCsv flags | ||||||
|  |                         writePrimitive jsonWriter false "_flags" flagCsv | ||||||
|  |  | ||||||
|  |             member __.EndWriteObject () =  | ||||||
|  |                 if currentValueIsNull then  | ||||||
|  |                     currentValueIsNull <- false | ||||||
|  |                 else | ||||||
|  |                     depth <- depth - 1 | ||||||
|  |                     if arrayStack.Peek () = depth then | ||||||
|  |                         if isTopLevelSequence && depth = 0 then () | ||||||
|  |                         else | ||||||
|  |                             jsonWriter.WriteEndArray() | ||||||
|  |  | ||||||
|  |                         arrayStack.Pop () |> ignore | ||||||
|  |                     else | ||||||
|  |                         jsonWriter.WriteEndObject() | ||||||
|  |  | ||||||
|  |             member __.SerializeUnionCaseNames = true | ||||||
|  |  | ||||||
|  |             member __.PreferLengthPrefixInSequences = false | ||||||
|  |             member __.WriteNextSequenceElement hasNext = | ||||||
|  |                 if isTopLevelSequence && depth = 1 then | ||||||
|  |                     if isTopLevelSequenceHead then | ||||||
|  |                         isTopLevelSequenceHead <- false | ||||||
|  |                     else | ||||||
|  |                         jsonWriter.WriteWhitespace separator | ||||||
|  |  | ||||||
|  |             member __.WriteCachedObjectId id = writePrimitive jsonWriter false "id" id | ||||||
|  |  | ||||||
|  |             member __.WriteBoolean (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |             member __.WriteByte (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |             member __.WriteSByte (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |  | ||||||
|  |             member __.WriteInt16 (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |             member __.WriteInt32 (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |             member __.WriteInt64 (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |  | ||||||
|  |             member __.WriteUInt16 (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |             member __.WriteUInt32 (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |             member __.WriteUInt64 (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |  | ||||||
|  |             member __.WriteSingle (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |             member __.WriteDouble (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |             member __.WriteDecimal (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag (string value) | ||||||
|  |  | ||||||
|  |             member __.WriteChar (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |             member __.WriteString (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |             member __.WriteBigInteger (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag (string value) | ||||||
|  |  | ||||||
|  |             member __.WriteGuid (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |             member __.WriteTimeSpan (tag : string) value = writePrimitive jsonWriter (omitTag ()) tag (string value) | ||||||
|  |  | ||||||
|  |             // BSON spec mandates the use of Unix time;  | ||||||
|  |             // this has millisecond precision which results in loss of accuracy w.r.t. ticks | ||||||
|  |             // since the goal of FsPickler is to offer faithful representations of .NET objects | ||||||
|  |             // we choose to override the spec and serialize ticks outright. | ||||||
|  |             // see also https://json.codeplex.com/discussions/212067  | ||||||
|  |             member __.WriteDate (tag : string) value =  | ||||||
|  |                 if isBsonWriter then | ||||||
|  |                     writePrimitive jsonWriter (omitTag ()) tag value.Ticks | ||||||
|  |                 else | ||||||
|  |                     writePrimitive jsonWriter (omitTag ()) tag value | ||||||
|  |  | ||||||
|  |             member __.WriteBytes (tag : string) (value : byte []) = | ||||||
|  |                 if not <| omitTag () then  | ||||||
|  |                     jsonWriter.WritePropertyName tag | ||||||
|  |  | ||||||
|  |                 if obj.ReferenceEquals(value, null) then | ||||||
|  |                     jsonWriter.WriteNull() | ||||||
|  |                 else | ||||||
|  |                     jsonWriter.WriteValue value | ||||||
|  |  | ||||||
|  |             member __.IsPrimitiveArraySerializationSupported = false | ||||||
|  |             member __.WritePrimitiveArray _ _ = raise <| NotSupportedException() | ||||||
|  |  | ||||||
|  |             member __.Dispose () = jsonWriter.Flush() | ||||||
							
								
								
									
										68
									
								
								samples/F#/PerformanceTesters.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										68
									
								
								samples/F#/PerformanceTesters.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,68 @@ | |||||||
|  | namespace Nessos.FsPickler.Tests | ||||||
|  |  | ||||||
|  |     open PerfUtil | ||||||
|  |     open PerfUtil.NUnit | ||||||
|  |  | ||||||
|  |     open NUnit.Framework | ||||||
|  |  | ||||||
|  |     open Nessos.FsPickler | ||||||
|  |     open Nessos.FsPickler.Json | ||||||
|  |  | ||||||
|  |     [<AbstractClass>] | ||||||
|  |     type PerfTester () = | ||||||
|  |         inherit NUnitPerf<Serializer> () | ||||||
|  |  | ||||||
|  |         let tests = PerfTest.OfModuleMarker<PerformanceTests.Marker> () | ||||||
|  |  | ||||||
|  |         override __.PerfTests = tests | ||||||
|  |  | ||||||
|  |  | ||||||
|  |     type ``Serializer Comparison`` () = | ||||||
|  |         inherit PerfTester() | ||||||
|  |  | ||||||
|  |         let fsp = FsPickler.initBinary() | ||||||
|  |         let bfs = new BinaryFormatterSerializer() :> Serializer | ||||||
|  |         let ndc = new NetDataContractSerializer() :> Serializer | ||||||
|  |         let jdn = new JsonDotNetSerializer() :> Serializer | ||||||
|  |         let bdn = new JsonDotNetBsonSerializer () :> Serializer | ||||||
|  |         let pbn = new ProtoBufSerializer() :> Serializer | ||||||
|  |         let ssj = new ServiceStackJsonSerializer() :> Serializer | ||||||
|  |         let sst = new ServiceStackTypeSerializer() :> Serializer | ||||||
|  |  | ||||||
|  |         let comparer = new WeightedComparer(spaceFactor = 0.2, leastAcceptableImprovementFactor = 1.) | ||||||
|  |         let tester = new ImplementationComparer<_>(fsp, [bfs;ndc;jdn;bdn;pbn;ssj;sst], throwOnError = true, warmup = true, comparer = comparer) | ||||||
|  |  | ||||||
|  |         override __.PerfTester = tester :> _ | ||||||
|  |          | ||||||
|  |  | ||||||
|  |     type ``FsPickler Formats Comparison`` () = | ||||||
|  |         inherit PerfTester () | ||||||
|  |  | ||||||
|  |         let binary = FsPickler.initBinary() | ||||||
|  |         let json = FsPickler.initJson() | ||||||
|  |         let bson = FsPickler.initBson() | ||||||
|  |         let xml = FsPickler.initXml() | ||||||
|  |  | ||||||
|  |         let tester = new ImplementationComparer<_>(binary, [json ; bson; xml], warmup = true, throwOnError = false) | ||||||
|  |  | ||||||
|  |         override __.PerfTester = tester :> _ | ||||||
|  |  | ||||||
|  |  | ||||||
|  |     type ``Past FsPickler Versions Comparison`` () = | ||||||
|  |         inherit PerfTester () | ||||||
|  |  | ||||||
|  |         let persistResults = true | ||||||
|  |         let persistenceFile = "fspPerf.xml" | ||||||
|  |  | ||||||
|  |         let fsp = FsPickler.initBinary() | ||||||
|  |         let version = typeof<FsPickler>.Assembly.GetName().Version | ||||||
|  |         let comparer = new WeightedComparer(spaceFactor = 0.2, leastAcceptableImprovementFactor = 0.8) | ||||||
|  |         let tester =  | ||||||
|  |             new PastImplementationComparer<Serializer>( | ||||||
|  |                 fsp, version, historyFile = persistenceFile, throwOnError = true, warmup = true, comparer = comparer) | ||||||
|  |  | ||||||
|  |         override __.PerfTester = tester :> _ | ||||||
|  |  | ||||||
|  |         [<TestFixtureTearDown>] | ||||||
|  |         member __.Persist() = | ||||||
|  |             if persistResults then tester.PersistCurrentResults () | ||||||
							
								
								
									
										207
									
								
								samples/F#/PerformanceTests.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										207
									
								
								samples/F#/PerformanceTests.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,207 @@ | |||||||
|  | namespace Nessos.FsPickler.Tests | ||||||
|  |  | ||||||
|  |     open System | ||||||
|  |     open System.Collections.Generic | ||||||
|  |  | ||||||
|  |     open PerfUtil | ||||||
|  |  | ||||||
|  |     open Nessos.FsPickler | ||||||
|  |     open Nessos.FsPickler.Tests.Serializer | ||||||
|  |     open Nessos.FsPickler.Tests.TestTypes | ||||||
|  |  | ||||||
|  |     module PerformanceTests = | ||||||
|  |  | ||||||
|  |         type Marker = class end | ||||||
|  |  | ||||||
|  |         let guid = Guid.NewGuid() | ||||||
|  |  | ||||||
|  |         [<PerfTest(1000)>] | ||||||
|  |         let ``Value: Guid`` s = roundtrip guid s | ||||||
|  |  | ||||||
|  |         let date = DateTime.Now | ||||||
|  |  | ||||||
|  |         [<PerfTest(1000)>] | ||||||
|  |         let ``Value: DateTime`` s = roundtrip date s | ||||||
|  |  | ||||||
|  |         [<PerfTest(10000)>] | ||||||
|  |         let ``Value: String`` s = roundtrip stringValue s | ||||||
|  |  | ||||||
|  |  | ||||||
|  |         let boxed = box ([| 1 .. 1000 |], "lorem ipsum") | ||||||
|  |  | ||||||
|  |         [<PerfTest(1000)>] | ||||||
|  |         let ``Boxed Object`` s = roundtrip boxed s | ||||||
|  |  | ||||||
|  |         let fsClass = new Class(42, stringValue) | ||||||
|  |  | ||||||
|  |         [<PerfTest(10000)>] | ||||||
|  |         let ``Class: Simple F# Class`` s = roundtrip fsClass s | ||||||
|  |  | ||||||
|  |         let serializableClass = new SerializableClass<_>(42, stringValue, [|1..1000|]) | ||||||
|  |  | ||||||
|  |         [<PerfTest(10000)>] | ||||||
|  |         let ``Class: ISerializable`` s = roundtrip serializableClass s | ||||||
|  |  | ||||||
|  |         let boxedClass = box(Some 42) | ||||||
|  |  | ||||||
|  |         [<PerfTest(10000)>] | ||||||
|  |         let ``Subtype Resolution`` s = roundtrip boxedClass s | ||||||
|  |  | ||||||
|  |         let floatArray = Array.init 100000 (fun i -> float i) | ||||||
|  |  | ||||||
|  |         [<PerfTest(10)>] | ||||||
|  |         let ``Array: Float`` s = roundtrip floatArray s | ||||||
|  |  | ||||||
|  |         let intArray = Array.init 100000 id | ||||||
|  |  | ||||||
|  |         [<PerfTest(10)>] | ||||||
|  |         let ``Array: Int`` s = roundtrip intArray s | ||||||
|  |  | ||||||
|  |         let stringArray = Array.init 10000 (fun i -> stringValue + string i) | ||||||
|  |          | ||||||
|  |         [<PerfTest(100)>] | ||||||
|  |         let ``Array: String`` s = roundtrip stringArray s | ||||||
|  |  | ||||||
|  |         let kvarr = [|1..10000|] |> Array.map (fun i -> i, string i) | ||||||
|  |  | ||||||
|  |         [<PerfTest(100)>] | ||||||
|  |         let ``Array: Key-Value Pairs`` s = roundtrip kvarr s | ||||||
|  |  | ||||||
|  |         let duArray = [| for i in 1 .. 10000 -> (Something ("asdasdasdas", i)) |] | ||||||
|  |  | ||||||
|  |         [<PerfTest(100)>] | ||||||
|  |         let ``Array: Discriminated Unions`` s = roundtrip duArray s | ||||||
|  |  | ||||||
|  |         let objArray =  | ||||||
|  |             [|  | ||||||
|  |                 box 2; box 3; box "hello" ; box <| Some 3; box(2,3) ;  | ||||||
|  |                 box <| new Class(2, stringValue) ; box <| new SerializableClass<int option>(2, stringValue, Some 12);  | ||||||
|  |                 box stringValue  | ||||||
|  |             |] | ||||||
|  |  | ||||||
|  |         [<PerfTest(1000)>] | ||||||
|  |         let ``Array: Objects`` s = roundtrip objArray s | ||||||
|  |  | ||||||
|  |  | ||||||
|  |         let array3D = Array3D.init 100 100 100 (fun i j k -> float (i * j + k)) | ||||||
|  |  | ||||||
|  |         [<PerfTest(10)>] | ||||||
|  |         let ``Array: Rank-3 Float`` s = roundtrip array3D s | ||||||
|  |  | ||||||
|  |         let bclDict = dict [ for i in 1 .. 1000 -> (string i, i)] | ||||||
|  |  | ||||||
|  |         [<PerfTest(100)>] | ||||||
|  |         let ``.NET Dictionary`` s = roundtrip bclDict s | ||||||
|  |  | ||||||
|  |         let bclStack = new Stack<string>([for i in 1 .. 1000 -> string i]) | ||||||
|  |  | ||||||
|  |         [<PerfTest(100)>] | ||||||
|  |         let ``.NET Stack`` s = roundtrip bclStack s | ||||||
|  |  | ||||||
|  |         let bclList = new List<string * int>([for i in 1 .. 1000 -> string i, i]) | ||||||
|  |  | ||||||
|  |         [<PerfTest(100)>] | ||||||
|  |         let ``.NET List`` s = roundtrip bclList s | ||||||
|  |  | ||||||
|  |         let bclSet = new SortedSet<_>([for i in 1 .. 1000 -> string i]) | ||||||
|  |  | ||||||
|  |         [<PerfTest(100)>] | ||||||
|  |         let ``.NET Set`` s = roundtrip bclSet s | ||||||
|  |  | ||||||
|  |         let smallTuple = (1, DateTime.Now,"hello") | ||||||
|  |  | ||||||
|  |         [<PerfTest(10000)>] | ||||||
|  |         let ``FSharp: Tuple Small`` s = roundtrip smallTuple s | ||||||
|  |  | ||||||
|  |         let largeTuple = (stringValue, 1, 2, 3, true, "", Some(3.14, [2]), 3, 2, 1, stringValue) | ||||||
|  |  | ||||||
|  |         [<PerfTest(10000)>] | ||||||
|  |         let ``FSharp: Tuple Large`` s = | ||||||
|  |             roundtrip largeTuple s | ||||||
|  |  | ||||||
|  |         let intList = [1..1000] | ||||||
|  |  | ||||||
|  |         [<PerfTest(1000)>] | ||||||
|  |         let ``FSharp: List Int`` s = roundtrip intList s | ||||||
|  |  | ||||||
|  |         let stringList = [ for i in 1 .. 1000 -> stringValue + string i ] | ||||||
|  |  | ||||||
|  |         [<PerfTest(1000)>] | ||||||
|  |         let ``FSharp: List String`` s = roundtrip stringList s | ||||||
|  |  | ||||||
|  |         let pairList = [ for i in 1 .. 1000 -> (string i, i) ] | ||||||
|  |  | ||||||
|  |         [<PerfTest(1000)>] | ||||||
|  |         let ``FSharp: List Key-Value`` s = roundtrip pairList s | ||||||
|  |  | ||||||
|  |         let nestedLst = let n = [1..1000] in [for _ in 1 .. 100 -> n] | ||||||
|  |  | ||||||
|  |         [<PerfTest(1000)>] | ||||||
|  |         let ``FSharp: List Nested`` s = roundtrip nestedLst s | ||||||
|  |  | ||||||
|  |         let union = SomethingElse(stringValue, 42, box (Some 42)) | ||||||
|  |  | ||||||
|  |         [<PerfTest(10000)>] | ||||||
|  |         let ``FSharp: Union`` s = roundtrip union s | ||||||
|  |  | ||||||
|  |         let record = { Int = 42 ; String = stringValue ; Tuple = (13, "") } | ||||||
|  |  | ||||||
|  |         [<PerfTest(10000)>] | ||||||
|  |         let ``FSharp: Record`` s = roundtrip record s | ||||||
|  |  | ||||||
|  |         let peano = int2Peano 100 | ||||||
|  |  | ||||||
|  |         [<PerfTest(100)>] | ||||||
|  |         let ``FSharp: Peano Rectype`` s = roundtrip peano s | ||||||
|  |  | ||||||
|  |         let closure = (@) [ Some([1..100], Set.ofList [1..100]) ] | ||||||
|  |  | ||||||
|  |         [<PerfTest(1000)>] | ||||||
|  |         let ``FSharp: Curried Function`` s = roundtrip closure s | ||||||
|  |  | ||||||
|  |         let binTree = mkTree 10 | ||||||
|  |  | ||||||
|  |         [<PerfTest(100)>] | ||||||
|  |         let ``FSharp: Binary Tree`` s = roundtrip binTree s | ||||||
|  |  | ||||||
|  |         let intSet = [1..1000] |> List.map string |> set | ||||||
|  |  | ||||||
|  |         [<PerfTest(1000)>] | ||||||
|  |         let ``FSharp: Set`` s = roundtrip intSet s | ||||||
|  |  | ||||||
|  |         let fsMap = [1..1000] |> Seq.map (fun i -> (string i,i)) |> Map.ofSeq | ||||||
|  |  | ||||||
|  |         [<PerfTest(1000)>] | ||||||
|  |         let ``FSharp: Map`` s = roundtrip fsMap s | ||||||
|  |  | ||||||
|  |         let testType = typeof<int * string option * Map<int * string [], string ref option>> | ||||||
|  |  | ||||||
|  |         [<PerfTest(1000)>] | ||||||
|  |         let ``Reflection: Type`` s = roundtrip testType s | ||||||
|  |  | ||||||
|  |         let quotationSmall = <@ fun x -> pown 2 x @> | ||||||
|  |  | ||||||
|  |         let quotationLarge = | ||||||
|  |             <@ | ||||||
|  |                 async { | ||||||
|  |                     let rec fibAsync n = | ||||||
|  |                         async { | ||||||
|  |                             match n with | ||||||
|  |                             | _ when n < 0 -> return invalidArg "negative" "n" | ||||||
|  |                             | _ when n < 2 -> return n | ||||||
|  |                             | n -> | ||||||
|  |                                 let! fn = fibAsync (n-1) | ||||||
|  |                                 let! fnn = fibAsync (n-2) | ||||||
|  |                                 return fn + fnn | ||||||
|  |                         } | ||||||
|  |  | ||||||
|  |                     let! values = [1..100] |> Seq.map fibAsync |> Async.Parallel | ||||||
|  |                     return Seq.sum values | ||||||
|  |                 } | ||||||
|  |             @> | ||||||
|  |  | ||||||
|  |         [<PerfTest(10000)>] | ||||||
|  |         let ``FSharp: Quotation Small`` s = roundtrip quotationSmall s | ||||||
|  |  | ||||||
|  |         [<PerfTest(1000)>] | ||||||
|  |         let ``FSharp: Quotation Large`` s = roundtrip quotationLarge s | ||||||
		Reference in New Issue
	
	Block a user