cleanup namespace

fsprojects · Dec 25, 2024 · 99e0337 · 99e0337
1 parent ee9ddf6
commit 99e0337
Show file tree

Hide file tree

Showing 3 changed files with 170 additions and 154 deletions.
diff --git a/FSharp.MongoDB.Driver.Tests/AcceptanceTests.fs b/FSharp.MongoDB.Driver.Tests/AcceptanceTests.fs
@@ -1,11 +1,10 @@
-module ``Acceptance Tests``
+module FSharp.MongoDB.Driver.Tests
 
 open System
 open FsUnit
 open NUnit.Framework
 open MongoDB.Bson
 open MongoDB.Driver
-open FSharp.MongoDB.Driver
 open System.Linq
 open TestUtils
 open MongoDB.Bson.Serialization.Attributes
@@ -45,6 +44,7 @@ type RecordWithCollections =
       IntVal: int
       DoubleVal: double
       ListVal: int list
+      IntValOpt: int ValueOption
       SetVal: Set<string> option
       MapVal: Map<string, int> option
       OptionVal: int option }
@@ -74,7 +74,7 @@ let init() =
     client <- new MongoClient(connectionString)
     client.DropDatabase(dbname)
     db <- client.GetDatabase(dbname)
-    Serializers.Register()
+    Register()
 
 [<OneTimeTearDown>]
 let teardown() =
@@ -256,6 +256,7 @@ let ``It can serialize record with list`` () =
           IntVal = 123
           DoubleVal = 1.23
           ListVal = [1; 2; 3]
+          IntValOpt = ValueSome 42
           SetVal = ["toto"; "titi"; "tata"] |> Set |> Some
           MapVal = ["toto", 42; "titi", 666] |> Map |> Some
           OptionVal = Some 123 }

diff --git a/FSharp.MongoDB.Driver/Serializers.fs b/FSharp.MongoDB.Driver/Serializers.fs
@@ -1,4 +1,4 @@
-namespace FSharp.MongoDB.Driver
+module FSharp.MongoDB.Driver
 
 open System
 open Microsoft.FSharp.Reflection
@@ -7,154 +7,171 @@ open MongoDB.Bson.IO
 open MongoDB.Bson.Serialization
 open MongoDB.Bson.Serialization.Serializers
 
-module Serializers =
-
-    type OptionSerializer<'T>() =
-        inherit SerializerBase<Option<'T>>()
-
-        override _.Serialize(context, _, value) =
-            match value with
-            | None ->
-                context.Writer.WriteNull()
-            | _ -> 
-                let contentSerializer = BsonSerializer.LookupSerializer(typeof<'T>)
-                contentSerializer.Serialize(context, value.Value)
-
-        override _.Deserialize(context, args) =
-            match context.Reader.CurrentBsonType with
-            | BsonType.Null ->
-                context.Reader.ReadNull()
-                None
-            | _ ->
-                let contentSerializer = BsonSerializer.LookupSerializer(typeof<'T>)
-                let obj = contentSerializer.Deserialize(context, args) :?> 'T
-                Some obj
-
-
-    type MapSerializer<'K, 'V when 'K : comparison>() =
-        inherit SerializerBase<Map<'K, 'V>>()
-
-        let contentSerializer = BsonSerializer.LookupSerializer(typeof<System.Collections.Generic.IDictionary<'K, 'V>>)
-
-        override _.Serialize(context, _, value) =
-            let dict = value |> Map.toSeq |> dict
-            contentSerializer.Serialize(context, dict)
-
-        override _.Deserialize(context, args) =
-            let dict = contentSerializer.Deserialize(context, args) :?> System.Collections.Generic.IDictionary<'K, 'V>
-            dict |> Seq.map (|KeyValue|) |> Map.ofSeq
-
-
-    type ListSerializer<'T>() =
-        inherit SerializerBase<List<'T>>()
-
-        let contentSerializer = BsonSerializer.LookupSerializer(typeof<'T[]>)
-
-        override _.Serialize(context, _, value) =
-            let list = value |> List.toArray
-            contentSerializer.Serialize(context, list)
-
-        override _.Deserialize(context, args) =
-            let list = contentSerializer.Deserialize(context, args) :?>'T[]
-            list |> List.ofArray
-
-
-    let fsharpType (typ : Type) =
-        typ.GetCustomAttributes(typeof<CompilationMappingAttribute>, true) 
-        |> Seq.cast<CompilationMappingAttribute>
-        |> Seq.map(fun t -> t.SourceConstructFlags)
-        |> Seq.tryHead
-
-
-    type UnionCaseSerializer<'T>() =
-        inherit SerializerBase<'T>()
-
-        let readItems context args (types : Type seq) =
-            types
-            |> Seq.fold(fun state t ->
-                let serializer = BsonSerializer.LookupSerializer(t)
-                let item = serializer.Deserialize(context, args)
-                item :: state) []
-            |> Seq.toArray |> Array.rev
-
-        override _.Serialize(context, args, value) =
-            let writer = context.Writer
-            writer.WriteStartDocument()
-            let info, values = FSharpValue.GetUnionFields(value, args.NominalType)
-            writer.WriteName(info.Name)
-            writer.WriteStartArray()
-            values 
-            |> Seq.zip(info.GetFields()) 
-            |> Seq.iter (fun (field, value) ->
-                let itemSerializer = BsonSerializer.LookupSerializer(field.PropertyType)
-                itemSerializer.Serialize(context, args, value))
-            writer.WriteEndArray()
-            writer.WriteEndDocument()
-
-        override _.Deserialize(context, args) =
-            let reader = context.Reader
-            reader.ReadStartDocument()
-            let typeName = reader.ReadName()
-            let unionType = 
-                FSharpType.GetUnionCases(args.NominalType) 
-                |> Seq.where (fun case -> case.Name = typeName)
-                |> Seq.head
-            reader.ReadStartArray()
-            let items = readItems context args (unionType.GetFields() |> Seq.map(fun f -> f.PropertyType))
-            reader.ReadEndArray()
-            reader.ReadEndDocument()
-            FSharpValue.MakeUnion(unionType, items) :?> 'T
-
-
-    let private getGenericArgumentOf baseType (typ: Type) =
-        if typ.IsGenericType && typ.GetGenericTypeDefinition() = baseType
-        then Some <| typ.GetGenericArguments()
-        else None
-
-    let inline private createInstance<'T> typ = Activator.CreateInstance(typ) :?> 'T
-    let inline private makeGenericType<'T> typ = typedefof<'T>.MakeGenericType typ
-
-    let specificSerializer<'nominal,'serializer> =
-        getGenericArgumentOf typedefof<'nominal> >> Option.map (makeGenericType<'serializer> >> createInstance<IBsonSerializer>)
-    let listSerializer typ = typ |> specificSerializer<List<_>, ListSerializer<_>>
-    let mapSerializer typ = typ |> specificSerializer<Map<_, _>, MapSerializer<_, _>>
-    let optionSerializer typ = typ |> specificSerializer<Option<_>, OptionSerializer<_>>
-
-    let unionCaseSerializer typ =
-        let gen = makeGenericType<UnionCaseSerializer<_>> >> createInstance<IBsonSerializer>
-        gen [| typ |] |> Some
-
-    type FsharpSerializationProvider(useOptionNull) =
-        let serializers =
-            [ if useOptionNull then SourceConstructFlags.SumType, optionSerializer
-              SourceConstructFlags.ObjectType, mapSerializer
-              SourceConstructFlags.SumType, listSerializer
-              SourceConstructFlags.SumType, unionCaseSerializer ]
-
-        interface IBsonSerializationProvider with
-            member _.GetSerializer(typ : Type) =
-                match fsharpType typ with
-                | Some flag ->
-                    serializers
-                    |> List.filter (fst >> (=) flag)
-                    |> List.map snd
-                    |> List.fold (fun result s -> result |> Option.orElseWith (fun _ -> s typ)) None
-                | _ -> None
-                |> Option.toObj
-
-    let mutable isRegistered = false
-
-    type RegistrationOption = { UseOptionNull: bool }
-    let defaultRegistrationOption = { UseOptionNull = true }
-
-    // Registers all F# serializers
-    let RegisterWithOptions(opt) =
+
+type OptionSerializer<'T>() =
+    inherit SerializerBase<Option<'T>>()
+
+    override _.Serialize(context, _, value) =
+        match value with
+        | None ->
+            context.Writer.WriteNull()
+        | _ -> 
+            let contentSerializer = BsonSerializer.LookupSerializer(typeof<'T>)
+            contentSerializer.Serialize(context, value.Value)
+
+    override _.Deserialize(context, args) =
+        match context.Reader.CurrentBsonType with
+        | BsonType.Null ->
+            context.Reader.ReadNull()
+            None
+        | _ ->
+            let contentSerializer = BsonSerializer.LookupSerializer(typeof<'T>)
+            let obj = contentSerializer.Deserialize(context, args) :?> 'T
+            Some obj
+
+
+type ValueOptionSerializer<'T>() =
+    inherit SerializerBase<ValueOption<'T>>()
+
+    override _.Serialize(context, _, value) =
+        match value with
+        | ValueNone ->
+            context.Writer.WriteNull()
+        | _ -> 
+            let contentSerializer = BsonSerializer.LookupSerializer(typeof<'T>)
+            contentSerializer.Serialize(context, value.Value)
+
+    override _.Deserialize(context, args) =
+        match context.Reader.CurrentBsonType with
+        | BsonType.Null ->
+            context.Reader.ReadNull()
+            ValueNone
+        | _ ->
+            let contentSerializer = BsonSerializer.LookupSerializer(typeof<'T>)
+            let obj = contentSerializer.Deserialize(context, args) :?> 'T
+            ValueSome obj
+
+
+type MapSerializer<'K, 'V when 'K : comparison>() =
+    inherit SerializerBase<Map<'K, 'V>>()
+
+    let contentSerializer = BsonSerializer.LookupSerializer(typeof<System.Collections.Generic.IDictionary<'K, 'V>>)
+
+    override _.Serialize(context, _, value) =
+        let dict = value |> Map.toSeq |> dict
+        contentSerializer.Serialize(context, dict)
+
+    override _.Deserialize(context, args) =
+        let dict = contentSerializer.Deserialize(context, args) :?> System.Collections.Generic.IDictionary<'K, 'V>
+        dict |> Seq.map (|KeyValue|) |> Map.ofSeq
+
+
+type ListSerializer<'T>() =
+    inherit SerializerBase<List<'T>>()
+
+    let contentSerializer = BsonSerializer.LookupSerializer(typeof<'T[]>)
+
+    override _.Serialize(context, _, value) =
+        let list = value |> List.toArray
+        contentSerializer.Serialize(context, list)
+
+    override _.Deserialize(context, args) =
+        let list = contentSerializer.Deserialize(context, args) :?>'T[]
+        list |> List.ofArray
+
+
+let fsharpType (typ : Type) =
+    typ.GetCustomAttributes(typeof<CompilationMappingAttribute>, true) 
+    |> Seq.cast<CompilationMappingAttribute>
+    |> Seq.map(fun t -> t.SourceConstructFlags)
+    |> Seq.tryHead
+
+
+type UnionCaseSerializer<'T>() =
+    inherit SerializerBase<'T>()
+
+    let readItems context args (types : Type seq) =
+        types
+        |> Seq.fold(fun state t ->
+            let serializer = BsonSerializer.LookupSerializer(t)
+            let item = serializer.Deserialize(context, args)
+            item :: state) []
+        |> Seq.toArray |> Array.rev
+
+    override _.Serialize(context, args, value) =
+        let writer = context.Writer
+        writer.WriteStartDocument()
+        let info, values = FSharpValue.GetUnionFields(value, args.NominalType)
+        writer.WriteName(info.Name)
+        writer.WriteStartArray()
+        values 
+        |> Seq.zip(info.GetFields()) 
+        |> Seq.iter (fun (field, value) ->
+            let itemSerializer = BsonSerializer.LookupSerializer(field.PropertyType)
+            itemSerializer.Serialize(context, args, value))
+        writer.WriteEndArray()
+        writer.WriteEndDocument()
+
+    override _.Deserialize(context, args) =
+        let reader = context.Reader
+        reader.ReadStartDocument()
+        let typeName = reader.ReadName()
+        let unionType = 
+            FSharpType.GetUnionCases(args.NominalType) 
+            |> Seq.where (fun case -> case.Name = typeName)
+            |> Seq.head
+        reader.ReadStartArray()
+        let items = readItems context args (unionType.GetFields() |> Seq.map(fun f -> f.PropertyType))
+        reader.ReadEndArray()
+        reader.ReadEndDocument()
+        FSharpValue.MakeUnion(unionType, items) :?> 'T
+
+
+let private getGenericArgumentOf baseType (typ: Type) =
+    if typ.IsGenericType && typ.GetGenericTypeDefinition() = baseType
+    then Some <| typ.GetGenericArguments()
+    else None
+
+let inline private createInstance<'T> typ = Activator.CreateInstance(typ) :?> 'T
+let inline private makeGenericType<'T> typ = typedefof<'T>.MakeGenericType typ
+
+let specificSerializer<'nominal,'serializer> =
+    getGenericArgumentOf typedefof<'nominal> >> Option.map (makeGenericType<'serializer> >> createInstance<IBsonSerializer>)
+let listSerializer typ = typ |> specificSerializer<List<_>, ListSerializer<_>>
+let mapSerializer typ = typ |> specificSerializer<Map<_, _>, MapSerializer<_, _>>
+let optionSerializer typ = typ |> specificSerializer<Option<_>, OptionSerializer<_>>
+let valueOptionSerializer typ = typ |> specificSerializer<ValueOption<_>, ValueOptionSerializer<_>>
+
+let unionCaseSerializer typ =
+    let gen = makeGenericType<UnionCaseSerializer<_>> >> createInstance<IBsonSerializer>
+    gen [| typ |] |> Some
+
+
+
+type FSharpSerializationProvider() =
+    let serializers =
+        [ SourceConstructFlags.SumType, optionSerializer
+          SourceConstructFlags.SumType, valueOptionSerializer
+          SourceConstructFlags.ObjectType, mapSerializer
+          SourceConstructFlags.SumType, listSerializer
+          SourceConstructFlags.SumType, unionCaseSerializer ]
+
+    static let mutable isRegistered = false
+    static member Register() =
         if not isRegistered then
-            BsonSerializer.RegisterSerializationProvider(FsharpSerializationProvider(opt.UseOptionNull))
+            BsonSerializer.RegisterSerializationProvider(FSharpSerializationProvider())
             isRegistered <- true
 
+    interface IBsonSerializationProvider with
+        member _.GetSerializer(typ : Type) =
+            match fsharpType typ with
+            | Some flag ->
+                serializers
+                |> List.filter (fst >> (=) flag)
+                |> List.map snd
+                |> List.fold (fun result s -> result |> Option.orElseWith (fun _ -> s typ)) None
+            | _ -> None
+            |> Option.toObj
 
-type Serializers() =
-    static member Register(?opts: Serializers.RegistrationOption) =
-        Serializers.RegisterWithOptions(opts |> Option.defaultValue Serializers.defaultRegistrationOption)
 
+let Register = FSharpSerializationProvider.Register
diff --git a/README.md b/README.md
@@ -8,6 +8,7 @@ Following types are supported:
 * Map
 * Set
 * Option
+* ValueOption
 * Discriminated Unions
 
 Records are supported as well out of the box with official MongoDB driver. Probably you want to add `CLIMutable` attribute on the record to support automatic ObjectId initialization.
@@ -23,12 +24,9 @@ Install this project via NuGet.
 
 On startup you have to register `FSharp.MongoDB.Driver`:
 ```ocaml
-open FSharp.MongoDB.Driver
-Serializers.Register()
+FSharp.MongoDB.Driver.Register()
 ```
 
-The `Serializers.Register()` call just registers serializers with the MongoDB driver.
-
 # Usage
 Use FSharp.MongoDB.Driver like you normally would in C#.