From 85bfdc07231c6b6c93f505df5517790b14e94ed8 Mon Sep 17 00:00:00 2001 From: Sebastian Faltoni Date: Tue, 30 Jun 2015 17:59:26 +0200 Subject: [PATCH 01/11] upgraded mongodb driver and modified code to the new model --- MongoDB.FSharp.Tests/AcceptanceTests.fs | 273 ++++++++++-------- .../MongoDB.FSharp.Tests.fsproj | 49 +++- MongoDB.FSharp.Tests/TestUtils.fs | 5 +- MongoDB.FSharp.Tests/packages.config | 4 + MongoDB.FSharp.nuspec | 6 +- MongoDB.FSharp.sln | 12 +- MongoDB.FSharp/MongoDB.FSharp.fsproj | 48 ++- MongoDB.FSharp/SerializationOptions.fs | 38 --- MongoDB.FSharp/Serializers.fs | 146 +++++----- MongoDB.FSharp/packages.config | 8 +- 10 files changed, 305 insertions(+), 284 deletions(-) diff --git a/MongoDB.FSharp.Tests/AcceptanceTests.fs b/MongoDB.FSharp.Tests/AcceptanceTests.fs index 23f7475..ece36d4 100644 --- a/MongoDB.FSharp.Tests/AcceptanceTests.fs +++ b/MongoDB.FSharp.Tests/AcceptanceTests.fs @@ -14,7 +14,7 @@ open Microsoft.FSharp.Linq open TestUtils type ObjectWithList() = - member val Id : BsonObjectId = BsonObjectId.GenerateNewId() with get, set + member val Id : BsonObjectId = BsonObjectId(ObjectId.GenerateNewId()) with get, set member val List : string list = [] with get, set type RecordType = { @@ -41,173 +41,200 @@ type DimmerSwitch = | On type ObjectWithOptions() = - member val Id : BsonObjectId = BsonObjectId.GenerateNewId() with get, set + member val Id : BsonObjectId = BsonObjectId(ObjectId.GenerateNewId()) with get, set member val Age : int option = None with get, set type ObjectWithDimmer() = - member val Id : BsonObjectId = BsonObjectId.GenerateNewId() with get, set + member val Id : BsonObjectId = BsonObjectId(ObjectId.GenerateNewId()) with get, set member val Switch : DimmerSwitch = Off with get, set type ObjectWithDimmers() = - member val Id : BsonObjectId = BsonObjectId.GenerateNewId() with get, set + member val Id : BsonObjectId = BsonObjectId(ObjectId.GenerateNewId()) with get, set member val Kitchen : DimmerSwitch = Off with get, set member val Bedroom1 : DimmerSwitch = Off with get, set member val Bedroom2 : DimmerSwitch = Off with get, set type ``When serializing lists``() = - let db = MongoDatabase.Create "mongodb://localhost/test" + let conn = new MongoClient("mongodb://localhost") + let db = conn.GetDatabase("test") do Serializers.Register() interface System.IDisposable with member this.Dispose() = - db.DropCollection "objects" |> ignore - db.DropCollection "persons" |> ignore + db.DropCollectionAsync "objects" |> awaitTask |> ignore + db.DropCollectionAsync "persons" |> awaitTask |> ignore /// Seems to be fixed in version 1.5 of the C# driver [] member this.``It can serialize an object with a list``() = - let collection = db.GetCollection "objects" - let obj = ObjectWithList() - obj.List <- [ "hello"; "world" ] - collection.Save obj |> ignore - - let genCollection = db.GetCollection "objects" - let fromDb = genCollection.FindOne(new QueryDocument("_id", obj.Id)) - let array = fromDb.["List"].AsBsonArray - Assert.Equal(2, array.Count) + async { + let collection = db.GetCollection "objects" + let obj = ObjectWithList() + obj.List <- [ "hello"; "world" ] + do! collection.InsertOneAsync obj |> awaitTask + + let genCollection = db.GetCollection "objects" + let! fromDb = genCollection.Find(fun x -> x.Id = obj.Id).FirstAsync() + |> Async.AwaitTask + let array = fromDb.List + Assert.Equal(2, array.Length) + } |> Async.StartImmediate [] member this.``It can deserialze lists``() = - let list = BsonArray([ "hello"; "world" ]) - let id = BsonObjectId.GenerateNewId() - let document = BsonDocument([ BsonElement("_id", id); BsonElement("List", list) ]) - let collection = db.GetCollection "objects" - collection.Save document |> ignore - - let collection = db.GetCollection "objects" - let fromDb = collection.FindOne(new QueryDocument("_id", id)) - let array = fromDb.List - Assert.Equal(2, array.Length) + async { + let list = BsonArray([ "hello"; "world" ]) + let id = BsonObjectId(ObjectId.GenerateNewId()) + let document = BsonDocument([ BsonElement("_id", id); BsonElement("List", list) ]) + let collection = db.GetCollection "objects" + do! collection.InsertOneAsync document |> awaitTask + + let collection = db.GetCollection "objects" + let! fromDb = collection.Find(fun x -> x.Id = id).FirstAsync() + |> Async.AwaitTask + let array = fromDb.List + Assert.Equal(2, array.Length) + } |> Async.StartImmediate [] member this.``It can serialize records``() = - let collection = db.GetCollection "objects" - let obj = { Id = BsonObjectId.GenerateNewId(); Name = "test" } - collection.Save obj |> ignore + async { + let collection = db.GetCollection "objects" + let obj = { Id = BsonObjectId(ObjectId.GenerateNewId()); Name = "test" } + do! collection.InsertOneAsync obj |> awaitTask - let genCollection = db.GetCollection "objects" - let fromDb = genCollection.FindOne(new QueryDocument("_id", obj.Id)) - let test = fromDb.["Name"].AsString - Assert.Equal("test", test) + let genCollection = db.GetCollection "objects" + let! fromDb = collection.Find(fun x -> x.Id = obj.Id).FirstAsync() + |> Async.AwaitTask + Assert.Equal("test", fromDb.Name) + } |> Async.StartImmediate [] member this.``It can deserialize records``() = - let id = BsonObjectId.GenerateNewId() - let document = BsonDocument([BsonElement("_id", id); BsonElement("Name", BsonString("value"))]) - let collection = db.GetCollection "objects" - collection.Save(document) |> ignore - - let collection = db.GetCollection("objects") - let fromDb = collection.FindOneById(id) - Assert.NotNull(fromDb) - Assert.Equal("value", fromDb.Name) + async { + let id = BsonObjectId(ObjectId.GenerateNewId()) + let document = BsonDocument([BsonElement("_id", id); BsonElement("Name", BsonString("value"))]) + let collection = db.GetCollection "objects" + do! collection.InsertOneAsync(document) |> awaitTask + + let collection = db.GetCollection("objects") + let! fromDb = collection.Find(fun x -> x.Id = id).FirstAsync() + |> Async.AwaitTask + Assert.NotNull(fromDb) + Assert.Equal("value", fromDb.Name) + }|> Async.StartImmediate [] member this.``It can serialize and deserialize nested records``() = - let collection = db.GetCollection "persons" - let obj = { Id = BsonObjectId.GenerateNewId(); PersonName = "test"; Age = 33; Childs = [{ChildName = "Adrian"; Age = 3}] } - collection.Save obj |> ignore - - let genCollection = db.GetCollection "persons" - let person = query { - for p in genCollection.AsQueryable() do - where (p.Id = obj.Id) - select p - headOrDefault - } + async { + let collection = db.GetCollection "persons" + let obj = { Id = BsonObjectId(ObjectId.GenerateNewId()); + PersonName = "test"; + Age = 33; + Childs = [{ChildName = "Adrian"; + Age = 3}] } + do! collection.InsertOneAsync obj |> awaitTask - Assert.NotNull person - Assert.Equal("test",person.PersonName) - Assert.Equal(33,person.Age) - Assert.Equal(1 ,person.Childs |> Seq.length) + let genCollection = db.GetCollection "persons" + let! person = genCollection.Find(fun x -> x.Id = obj.Id).FirstAsync() + |> Async.AwaitTask - let child = person.Childs |> Seq.head + Assert.NotNull person + Assert.Equal("test",person.PersonName) + Assert.Equal(33,person.Age) + Assert.Equal(1 ,person.Childs |> Seq.length) - Assert.Equal("Adrian", child.ChildName) - Assert.Equal(3, child.Age) + let child = person.Childs |> Seq.head + + Assert.Equal("Adrian", child.ChildName) + Assert.Equal(3, child.Age) + }|> Async.StartImmediate [] member this.``It can serialize option types``() = - let collection = db.GetCollection "objects" - let obj = ObjectWithOptions() - obj.Age <- Some 42 - collection.Save obj |> ignore - - let collection = db.GetCollection "objects" - let fromDb = collection.FindOneById(obj.Id) - let age = fromDb.GetElement("Age") - Assert.NotNull(age); - Assert.Equal("Some", age.Value.AsBsonDocument.GetElement("_t").Value.AsString) - let value = age.Value.AsBsonDocument.GetElement("_v").Value - Assert.True(value.IsBsonArray) - let array = value.AsBsonArray - Assert.Equal(1, array.Count) - Assert.Equal(42, array.[0].AsInt32) + async { + let collection = db.GetCollection "objects" + let obj = ObjectWithOptions() + obj.Age <- Some 42 + do! collection.InsertOneAsync obj |> awaitTask + + let collection = db.GetCollection "objects" + let! fromDb = collection.Find(fun (x:BsonDocument) -> + (unbox (x.GetElement( "_id").Value)) = obj.Id).FirstAsync() + |> Async.AwaitTask + let age = fromDb.GetElement("Age") + Assert.NotNull(age); + Assert.Equal("Some", age.Value.ToBsonDocument().GetElement("_t").Value.AsString) + let value = age.Value.AsBsonDocument.GetElement("_v").Value + Assert.True(value.IsBsonArray) + let array = value.AsBsonArray + Assert.Equal(1, array.Count) + Assert.Equal(42, array.[0].AsInt32) + } |> Async.StartImmediate [] member this.``It can serialize DimmerSwitch types``() = - let collection = db.GetCollection "objects" - let obj = ObjectWithDimmer() - obj.Switch <- DimMarquee(42, "loser") - collection.Save obj |> ignore - - let collection = db.GetCollection "objects" - let fromDb = collection.FindOneById(obj.Id) - let switch = fromDb.GetElement("Switch") - Assert.NotNull(switch); - Assert.Equal("DimMarquee", switch.Value.AsBsonDocument.GetElement("_t").Value.AsString) - let value = switch.Value.AsBsonDocument.GetElement("_v").Value - Assert.True(value.IsBsonArray) - let array = value.AsBsonArray - Assert.Equal(2, array.Count) - Assert.Equal(42, array.[0].AsInt32) - Assert.Equal("loser", array.[1].AsString) - + async { + let collection = db.GetCollection "objects" + let obj = ObjectWithDimmer() + obj.Switch <- DimMarquee(42, "loser") + do! db.GetCollection("objects").InsertOneAsync (obj) |> awaitTask + + let collection = db.GetCollection "objects" + let! fromDb = collection.Find(fun (x:BsonDocument) -> + (unbox (x.GetElement( "_id").Value)) = obj.Id).FirstAsync() + |> Async.AwaitTask + let switch = fromDb.GetElement("Switch") + Assert.NotNull(switch); + Assert.Equal("DimMarquee", switch.Value.AsBsonDocument.GetElement("_t").Value.AsString) + let value = switch.Value.AsBsonDocument.GetElement("_v").Value + Assert.True(value.IsBsonArray) + let array = value.AsBsonArray + Assert.Equal(2, array.Count) + Assert.Equal(42, array.[0].AsInt32) + Assert.Equal("loser", array.[1].AsString) + } [] member this.``It can deserialize option types``() = - let id = BsonObjectId.GenerateNewId() - let arrayPart = BsonArray([ BsonInt32(42) ]) - let structure = BsonDocument(BsonElement("_t", BsonString("Some")), BsonElement("_v", arrayPart)) - let document = BsonDocument(BsonElement("_id", id), BsonElement("Age", structure)) - let collection = db.GetCollection "objects" - collection.Save(document) |> ignore - - let collection = db.GetCollection "objects" - let fromDb = collection.FindOneById id - match fromDb.Age with - | Some 42 -> () - | _ -> fail "expected Some 42 but got something else" + async { + let id = BsonObjectId(ObjectId.GenerateNewId()) + let arrayPart = BsonArray([ BsonInt32(42) ]) + + let structure = BsonDocument([| BsonElement("_t", BsonString("Some")); BsonElement("_v", arrayPart) |].AsEnumerable()) + let document = BsonDocument([|BsonElement("_id", id); BsonElement("Age", structure)|].AsEnumerable()) + let collection = db.GetCollection "objects" + do! collection.InsertOneAsync(document) |> awaitTask + + let collection = db.GetCollection "objects" + let! fromDb = collection.Find(fun x -> x.Id = id).FirstAsync() + |> Async.AwaitTask + match fromDb.Age with + | Some 42 -> () + | _ -> fail "expected Some 42 but got something else" + } |> Async.StartImmediate [] member this.``We can integrate serialize & deserialize on DimmerSwitches``() = - let collection = db.GetCollection "objects" - let obj = ObjectWithDimmers() - obj.Kitchen <- Off - obj.Bedroom1 <- Dim 42 - obj.Bedroom2 <- DimMarquee(12, "when I was little...") - collection.Save obj |> ignore - - let fromDb = collection.FindOneById obj.Id - match fromDb.Kitchen with - | Off -> () - | _ -> fail "Kitchen light wasn't off" - - match fromDb.Bedroom1 with - | Dim 42 -> () - | _ -> fail "Bedroom1 light wasn't dim enough" - - match fromDb.Bedroom2 with - | DimMarquee(12, "when I was little...") -> () - | _ -> fail "Bedroom2 doesn't have the party we thought" \ No newline at end of file + async { + let collection = db.GetCollection "objects" + let obj = ObjectWithDimmers() + obj.Kitchen <- Off + obj.Bedroom1 <- Dim 42 + obj.Bedroom2 <- DimMarquee(12, "when I was little...") + do! collection.InsertOneAsync obj |> awaitTask + + let! fromDb = collection.Find(fun x -> x.Id = obj.Id).FirstAsync() |> Async.AwaitTask + match fromDb.Kitchen with + | Off -> () + | _ -> fail "Kitchen light wasn't off" + + match fromDb.Bedroom1 with + | Dim 42 -> () + | _ -> fail "Bedroom1 light wasn't dim enough" + + match fromDb.Bedroom2 with + | DimMarquee(12, "when I was little...") -> () + | _ -> fail "Bedroom2 doesn't have the party we thought" + } \ No newline at end of file diff --git a/MongoDB.FSharp.Tests/MongoDB.FSharp.Tests.fsproj b/MongoDB.FSharp.Tests/MongoDB.FSharp.Tests.fsproj index a23ad59..fec2117 100644 --- a/MongoDB.FSharp.Tests/MongoDB.FSharp.Tests.fsproj +++ b/MongoDB.FSharp.Tests/MongoDB.FSharp.Tests.fsproj @@ -14,6 +14,7 @@ ..\ true + 4.3.1.0 true @@ -34,16 +35,45 @@ 3 bin\Release\MongoDB.FSharp.Tests.XML + + 11 + + + + + $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets + + + + + $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets + + + + + + + + + + + + - + + ..\packages\FSharp.Core.3.1.2.1\lib\net40\FSharp.Core.dll True - ..\packages\mongocsharpdriver.1.8.1\lib\net35\MongoDB.Bson.dll + ..\packages\MongoDB.Bson.2.0.1\lib\net45\MongoDB.Bson.dll True - ..\packages\mongocsharpdriver.1.8.1\lib\net35\MongoDB.Driver.dll + ..\packages\MongoDB.Driver.2.0.1\lib\net45\MongoDB.Driver.dll + True + + + ..\packages\MongoDB.Driver.Core.2.0.1\lib\net45\MongoDB.Driver.Core.dll True @@ -57,25 +87,12 @@ ..\packages\xunit.1.9.1\lib\net20\xunit.dll True - - - - - - - - MongoDB.FSharp {7cbeb93a-1590-42db-9e40-61630e79304a} True - - 11 - - - + Sebastian Faltoni, Tim Kellogg + Sebastian Faltoni + https://github.com/nukedbit/MongoDB.FSharp/blob/master/License.txt + https://github.com/nukedbit/MongoDB.FSharp false Silent utilities to make the official MongoDB driver feel natural to work with in F# Initial release, should work but not recommended for production Copyright 2015 + + + f# fsharp mongodB nosql utility diff --git a/MongoDB.FSharp.sln b/MongoDB.FSharp.sln index 3ab6a0a..f8645fa 100644 --- a/MongoDB.FSharp.sln +++ b/MongoDB.FSharp.sln @@ -19,7 +19,7 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution README.md = README.md EndProjectSection EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MongoDB.FSharp", "MongoDB.FSharp\MongoDB.FSharp.fsproj", "{7CBEB93A-1590-42DB-9E40-61630E79304A}" +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MongoDB.Driver.FSharp", "MongoDB.FSharp\MongoDB.Driver.FSharp.fsproj", "{7CBEB93A-1590-42DB-9E40-61630E79304A}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MongoDB.FSharp.Tests", "MongoDB.FSharp.Tests\MongoDB.FSharp.Tests.fsproj", "{DE725DAC-C637-4DA7-A30D-69061D33D1B2}" EndProject diff --git a/MongoDB.FSharp/MongoDB.FSharp.fsproj b/MongoDB.FSharp/MongoDB.Driver.FSharp.fsproj similarity index 97% rename from MongoDB.FSharp/MongoDB.FSharp.fsproj rename to MongoDB.FSharp/MongoDB.Driver.FSharp.fsproj index 87172ff..4f76d36 100644 --- a/MongoDB.FSharp/MongoDB.FSharp.fsproj +++ b/MongoDB.FSharp/MongoDB.Driver.FSharp.fsproj @@ -8,9 +8,9 @@ 7cbeb93a-1590-42db-9e40-61630e79304a Library MongoDB.FSharp - MongoDB.FSharp + MongoDB.Driver.FSharp v4.5 - MongoDB.FSharp + MongoDB.Driver.FSharp ..\ true diff --git a/MongoDB.FSharp/SerializationOptions.fs b/MongoDB.FSharp/SerializationOptions.fs index 52395f2..4a6c4b9 100644 --- a/MongoDB.FSharp/SerializationOptions.fs +++ b/MongoDB.FSharp/SerializationOptions.fs @@ -1,10 +1,6 @@ -namespace MongoDB.FSharp +namespace MongoDB.Driver.FSharp -open System -open MongoDB.Bson -open MongoDB.Bson.Serialization -open MongoDB.Bson.Serialization.Options -open MongoDB.Bson.Serialization.Serializers +open MongoDB.Bson module SerializationOptions = type System.Object with diff --git a/MongoDB.FSharp/Serializers.fs b/MongoDB.FSharp/Serializers.fs index 420acce..b84f794 100644 --- a/MongoDB.FSharp/Serializers.fs +++ b/MongoDB.FSharp/Serializers.fs @@ -1,12 +1,11 @@ -namespace MongoDB.FSharp +namespace MongoDB.Driver.FSharp open System open System.Reflection open Microsoft.FSharp.Reflection open MongoDB.Bson open MongoDB.Bson.IO -open MongoDB.Bson.Serialization -open MongoDB.Bson.Serialization.Options +open MongoDB.Bson.Serialization open MongoDB.Bson.Serialization.Serializers open SerializationOptions @@ -25,7 +24,7 @@ module Serializers = this.WriteStartArray() this.WriteEndArray() - type ListSerializer<'T when 'T:equality>() as this = + type ListSerializer<'T when 'T:equality>() = inherit SerializerBase>() override this.Deserialize(context:BsonDeserializationContext , args:BsonDeserializationArgs) : 'T list = @@ -152,11 +151,6 @@ module Serializers = let classMapSerializer = Activator.CreateInstance((typedefof>.MakeGenericType(typedefof<'T>)), [ classMap ] |> Seq.cast |> Seq.toArray) :?> IBsonSerializer - -// let typ = typeof.Assembly.GetType("MongoDB.Bson.Serialization.BsonClassMapSerializer<`>") -// let ctor = typ.GetConstructor([ typeof ] |> Seq.toArray) -// ctor.Invoke([ classMap ] |> Seq.cast |> Seq.toArray) :?> IBsonSerializer - let getter = match classMap.IdMemberMap with | null -> None diff --git a/package.ps1 b/package.ps1 index 7f2242a..a74c8b2 100644 --- a/package.ps1 +++ b/package.ps1 @@ -1,4 +1,4 @@ mkdir dist -Force | Out-Null -mkdir build\lib\net40\ -Force | Out-Null -cp .\MongoDB.FSharp\bin\Release\MongoDB.FSharp.* .\build\lib\net40\ +mkdir build\lib\net45\ -Force | Out-Null +cp .\MongoDB.FSharp\bin\Release\MongoDB.FSharp.* .\build\lib\net45\ .\.nuget\NuGet.exe pack -OutputDirectory .\dist\ -BasePath .\build\ From 49f0ce4e69518d62d787b0274e69d14fdf3c725a Mon Sep 17 00:00:00 2001 From: Sebastian Faltoni Date: Mon, 6 Jul 2015 15:18:10 +0200 Subject: [PATCH 07/11] modified package script to use new dll names --- package.ps1 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/package.ps1 b/package.ps1 index a74c8b2..811e9c9 100644 --- a/package.ps1 +++ b/package.ps1 @@ -1,4 +1,4 @@ mkdir dist -Force | Out-Null mkdir build\lib\net45\ -Force | Out-Null -cp .\MongoDB.FSharp\bin\Release\MongoDB.FSharp.* .\build\lib\net45\ +cp .\MongoDB.FSharp\bin\Release\MongoDB.Driver.FSharp.* .\build\lib\net45\ .\.nuget\NuGet.exe pack -OutputDirectory .\dist\ -BasePath .\build\ From 94c74ae7b7b739dc7e61421bb2240eec908121ce Mon Sep 17 00:00:00 2001 From: Sebastian Faltoni Date: Mon, 6 Jul 2015 15:26:35 +0200 Subject: [PATCH 08/11] changed title of package --- MongoDB.FSharp.nuspec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/MongoDB.FSharp.nuspec b/MongoDB.FSharp.nuspec index a3ae5e2..3ce76df 100644 --- a/MongoDB.FSharp.nuspec +++ b/MongoDB.FSharp.nuspec @@ -3,7 +3,7 @@ MongoDB.Driver.FSharp 0.2.0 - MongoDB.FSharp + MongoDB.Driver.FSharp Sebastian Faltoni, Tim Kellogg Sebastian Faltoni https://github.com/nukedbit/MongoDB.FSharp/blob/master/License.txt From df0505c9c7f32c38fba3e8a62e179a0db21b85fe Mon Sep 17 00:00:00 2001 From: Sebastian Faltoni Date: Tue, 7 Jul 2015 11:28:40 +0200 Subject: [PATCH 09/11] removed async blocks on tests and fixed package owner --- MongoDB.FSharp.Tests/AcceptanceTests.fs | 230 ++++++++++++------------ MongoDB.FSharp.nuspec | 2 +- MongoDB.FSharp/Serializers.fs | 1 - 3 files changed, 115 insertions(+), 118 deletions(-) diff --git a/MongoDB.FSharp.Tests/AcceptanceTests.fs b/MongoDB.FSharp.Tests/AcceptanceTests.fs index e210197..377706d 100644 --- a/MongoDB.FSharp.Tests/AcceptanceTests.fs +++ b/MongoDB.FSharp.Tests/AcceptanceTests.fs @@ -69,168 +69,167 @@ type ``When serializing lists``() = /// Seems to be fixed in version 1.5 of the C# driver [] member this.``It can serialize an object with a list``() = - async { - let collection = db.GetCollection "objects" - let obj = ObjectWithList() - obj.List <- [ "hello"; "world" ] - do! collection.InsertOneAsync obj |> AwaitVoidTask - - let genCollection = db.GetCollection "objects" - let! fromDb = genCollection.Find(fun x -> x.Id = obj.Id).FirstAsync() - |> Async.AwaitTask - let array = fromDb.List - Assert.Equal(2, array.Length) - } |> Async.RunSynchronously + let collection = db.GetCollection "objects" + let obj = ObjectWithList() + obj.List <- [ "hello"; "world" ] + collection.InsertOneAsync obj |> AwaitVoidTask |> ignore + + let genCollection = db.GetCollection "objects" + let fromDb = genCollection.Find(fun x -> x.Id = obj.Id).FirstAsync() + |> Async.AwaitTask |> Async.RunSynchronously + let array = fromDb.List + Assert.Equal(2, array.Length) [] - member this.``It can deserialze lists``() = - async { - let list = BsonArray([ "hello"; "world" ]) - let id = BsonObjectId(ObjectId.GenerateNewId()) - let document = BsonDocument([ BsonElement("_id", id); BsonElement("List", list) ]) - let collection = db.GetCollection "objects" - do! collection.InsertOneAsync document |> AwaitVoidTask - - let collection = db.GetCollection "objects" - let! fromDb = collection.Find(fun x -> x.Id = id).FirstAsync() - |> Async.AwaitTask - let array = fromDb.List - Assert.Equal(2, array.Length) - } |> Async.StartImmediate + member this.``It can deserialze lists``() = + let list = BsonArray([ "hello"; "world" ]) + let id = BsonObjectId(ObjectId.GenerateNewId()) + let document = BsonDocument([ BsonElement("_id", id); BsonElement("List", list) ]) + let collection = db.GetCollection "objects" + collection.InsertOneAsync document |> AwaitVoidTask |> ignore + + let collection = db.GetCollection "objects" + let fromDb = collection.Find(fun x -> x.Id = id).FirstAsync() + |> Async.AwaitTask |> Async.RunSynchronously + let array = fromDb.List + Assert.Equal(2, array.Length) [] member this.``It can serialize records``() = - async { - let collection = db.GetCollection "objects" - let obj = { Id = BsonObjectId(ObjectId.GenerateNewId()); Name = "test" } - do! collection.InsertOneAsync obj |> AwaitVoidTask + let collection = db.GetCollection "objects" + let obj = { Id = BsonObjectId(ObjectId.GenerateNewId()); Name = "test" } + collection.InsertOneAsync obj |> AwaitVoidTask |> ignore - let genCollection = db.GetCollection "objects" - let! fromDb = collection.Find(fun x -> x.Id = obj.Id).FirstAsync() - |> Async.AwaitTask - Assert.Equal("test", fromDb.Name) - } |> Async.RunSynchronously + let genCollection = db.GetCollection "objects" + let fromDb = collection.Find(fun x -> x.Id = obj.Id).FirstAsync() + |> Async.AwaitTask + |> Async.RunSynchronously + Assert.Equal("test", fromDb.Name) [] member this.``It can deserialize records``() = - async { - let id = BsonObjectId(ObjectId.GenerateNewId()) - let document = BsonDocument([BsonElement("_id", id); BsonElement("Name", BsonString("value"))]) - let collection = db.GetCollection "objects" - do! collection.InsertOneAsync(document) |> AwaitVoidTask - - let collection = db.GetCollection("objects") - let! fromDb = collection.Find(fun x -> x.Id = id).FirstAsync() - |> Async.AwaitTask - Assert.NotNull(fromDb) - Assert.Equal("value", fromDb.Name) - }|> Async.RunSynchronously + let id = BsonObjectId(ObjectId.GenerateNewId()) + let document = BsonDocument([BsonElement("_id", id); BsonElement("Name", BsonString("value"))]) + let collection = db.GetCollection "objects" + collection.InsertOneAsync(document) |> AwaitVoidTask |> ignore + + let collection = db.GetCollection("objects") + let fromDb = collection.Find(fun x -> x.Id = id).FirstAsync() + |> Async.AwaitTask + |> Async.RunSynchronously + Assert.NotNull(fromDb) + Assert.Equal("value", fromDb.Name) [] member this.``It can serialize and deserialize nested records``() = - async { - let collection = db.GetCollection "persons" - let obj = { Id = BsonObjectId(ObjectId.GenerateNewId()); - PersonName = "test"; - Age = 33; - Childs = [{ChildName = "Adrian"; - Age = 3}] } - do! collection.InsertOneAsync obj |> AwaitVoidTask + let collection = db.GetCollection "persons" + let obj = { Id = BsonObjectId(ObjectId.GenerateNewId()); + PersonName = "test"; + Age = 33; + Childs = [{ChildName = "Adrian"; + Age = 3}] } + collection.InsertOneAsync obj |> AwaitVoidTask |> ignore - let genCollection = db.GetCollection "persons" - let! person = genCollection.Find(fun x -> x.Id = obj.Id).FirstAsync() - |> Async.AwaitTask + let genCollection = db.GetCollection "persons" + let person = genCollection.Find(fun x -> x.Id = obj.Id).FirstAsync() + |> Async.AwaitTask + |> Async.RunSynchronously - Assert.NotNull person - Assert.Equal("test",person.PersonName) - Assert.Equal(33,person.Age) - Assert.Equal(1 ,person.Childs |> Seq.length) + Assert.NotNull person + Assert.Equal("test",person.PersonName) + Assert.Equal(33,person.Age) + Assert.Equal(1 ,person.Childs |> Seq.length) - let child = person.Childs |> Seq.head + let child = person.Childs |> Seq.head - Assert.Equal("Adrian", child.ChildName) - Assert.Equal(3, child.Age) - }|> Async.RunSynchronously + Assert.Equal("Adrian", child.ChildName) + Assert.Equal(3, child.Age) [] member this.``It can serialize option types``() = - async { - let collection = db.GetCollection "objects" - let obj = ObjectWithOptions() - obj.Age <- Some 42 - do! collection.InsertOneAsync obj |> AwaitVoidTask - - let collection = db.GetCollection "objects" - let filter = new BsonDocumentFilterDefinition<_>(new BsonDocument() - |> (fun d -> d.Add("_id",obj.Id))) - let! fromDb = collection.Find(filter).FirstAsync() - |> Async.AwaitTask - let age = fromDb.GetElement("Age") - Assert.NotNull(age); - Assert.Equal("Some", age.Value.ToBsonDocument().GetElement("_t").Value.AsString) - let value = age.Value.AsBsonDocument.GetElement("_v").Value - Assert.True(value.IsBsonArray) - let array = value.AsBsonArray - Assert.Equal(1, array.Count) - Assert.Equal(42, array.[0].AsInt32) - } |> Async.RunSynchronously + let collection = db.GetCollection "objects" + let obj = ObjectWithOptions() + obj.Age <- Some 42 + collection.InsertOneAsync obj + |> AwaitVoidTask + |> ignore + + let collection = db.GetCollection "objects" + let filter = new BsonDocumentFilterDefinition<_>(new BsonDocument() + |> (fun d -> d.Add("_id",obj.Id))) + let fromDb = collection.Find(filter).FirstAsync() + |> Async.AwaitTask + |> Async.RunSynchronously + let age = fromDb.GetElement("Age") + Assert.NotNull(age); + Assert.Equal("Some", age.Value.ToBsonDocument().GetElement("_t").Value.AsString) + let value = age.Value.AsBsonDocument.GetElement("_v").Value + Assert.True(value.IsBsonArray) + let array = value.AsBsonArray + Assert.Equal(1, array.Count) + Assert.Equal(42, array.[0].AsInt32) [] member this.``It can serialize DimmerSwitch types``() = - async { - let collection = db.GetCollection "objects" - let obj = ObjectWithDimmer() - obj.Switch <- DimMarquee(42, "loser") - do! db.GetCollection("objects").InsertOneAsync (obj) |> AwaitVoidTask - - let collection = db.GetCollection "objects" + let collection = db.GetCollection "objects" + let obj = ObjectWithDimmer() + obj.Switch <- DimMarquee(42, "loser") + db.GetCollection("objects").InsertOneAsync (obj) + |> AwaitVoidTask + |> ignore + + let collection = db.GetCollection "objects" - let filter = new BsonDocumentFilterDefinition<_>(new BsonDocument() - |> (fun d -> d.Add("_id",obj.Id))) - let! fromDb = collection.Find(filter).FirstAsync() - |> Async.AwaitTask - let switch = fromDb.GetElement("Switch") - Assert.NotNull(switch); - Assert.Equal("DimMarquee", switch.Value.AsBsonDocument.GetElement("_t").Value.AsString) - let value = switch.Value.AsBsonDocument.GetElement("_v").Value - Assert.True(value.IsBsonArray) - let array = value.AsBsonArray - Assert.Equal(2, array.Count) - Assert.Equal(42, array.[0].AsInt32) - Assert.Equal("loser", array.[1].AsString) - } |> Async.RunSynchronously + let filter = new BsonDocumentFilterDefinition<_>(new BsonDocument() + |> (fun d -> d.Add("_id",obj.Id))) + let fromDb = collection.Find(filter).FirstAsync() + |> Async.AwaitTask + |> Async.RunSynchronously + let switch = fromDb.GetElement("Switch") + Assert.NotNull(switch); + Assert.Equal("DimMarquee", switch.Value.AsBsonDocument.GetElement("_t").Value.AsString) + let value = switch.Value.AsBsonDocument.GetElement("_v").Value + Assert.True(value.IsBsonArray) + let array = value.AsBsonArray + Assert.Equal(2, array.Count) + Assert.Equal(42, array.[0].AsInt32) + Assert.Equal("loser", array.[1].AsString) [] member this.``It can deserialize option types``() = - async { let id = BsonObjectId(ObjectId.GenerateNewId()) let arrayPart = BsonArray([ BsonInt32(42) ]) let structure = BsonDocument([| BsonElement("_t", BsonString("Some")); BsonElement("_v", arrayPart) |].AsEnumerable()) let document = BsonDocument([|BsonElement("_id", id); BsonElement("Age", structure)|].AsEnumerable()) let collection = db.GetCollection "objects" - do! collection.InsertOneAsync(document) |> AwaitVoidTask + collection.InsertOneAsync(document) + |> AwaitVoidTask + |> ignore let collection = db.GetCollection "objects" - let! fromDb = collection.Find(fun x -> x.Id = id).FirstAsync() + let fromDb = collection.Find(fun x -> x.Id = id).FirstAsync() |> Async.AwaitTask + |> Async.RunSynchronously match fromDb.Age with | Some 42 -> () | _ -> fail "expected Some 42 but got something else" - } |> Async.RunSynchronously [] member this.``We can integrate serialize & deserialize on DimmerSwitches``() = - async { let collection = db.GetCollection "objects" let obj = ObjectWithDimmers() obj.Kitchen <- Off obj.Bedroom1 <- Dim 42 obj.Bedroom2 <- DimMarquee(12, "when I was little...") - do! collection.InsertOneAsync obj |> AwaitVoidTask + collection.InsertOneAsync obj + |> AwaitVoidTask + |> ignore - let! fromDb = collection.Find(fun x -> x.Id = obj.Id).FirstAsync() |> Async.AwaitTask + let fromDb = collection.Find(fun x -> x.Id = obj.Id).FirstAsync() + |> Async.AwaitTask + |> Async.RunSynchronously match fromDb.Kitchen with | Off -> () | _ -> fail "Kitchen light wasn't off" @@ -241,5 +240,4 @@ type ``When serializing lists``() = match fromDb.Bedroom2 with | DimMarquee(12, "when I was little...") -> () - | _ -> fail "Bedroom2 doesn't have the party we thought" - } |> Async.RunSynchronously \ No newline at end of file + | _ -> fail "Bedroom2 doesn't have the party we thought" \ No newline at end of file diff --git a/MongoDB.FSharp.nuspec b/MongoDB.FSharp.nuspec index 3ce76df..adaaf06 100644 --- a/MongoDB.FSharp.nuspec +++ b/MongoDB.FSharp.nuspec @@ -5,7 +5,7 @@ 0.2.0 MongoDB.Driver.FSharp Sebastian Faltoni, Tim Kellogg - Sebastian Faltoni + Tim Kellogg https://github.com/nukedbit/MongoDB.FSharp/blob/master/License.txt https://github.com/nukedbit/MongoDB.FSharp false diff --git a/MongoDB.FSharp/Serializers.fs b/MongoDB.FSharp/Serializers.fs index b84f794..c350882 100644 --- a/MongoDB.FSharp/Serializers.fs +++ b/MongoDB.FSharp/Serializers.fs @@ -66,7 +66,6 @@ module Serializers = context.Writer.WriteStartArray() context.Writer.WriteEndArray() else - let actualType = value.GetType() //this.VerifyTypes(nominalType, actualType, typeof>) let lst = box value :?> list<'T> From e70a80f8be319a58c15c447814a5136e7ea1acc9 Mon Sep 17 00:00:00 2001 From: Sebastian Faltoni Date: Tue, 7 Jul 2015 15:02:51 +0200 Subject: [PATCH 10/11] mongodb must be at least 2.0.1 or it won't work for a missing constructor exception --- MongoDB.FSharp.Tests/AcceptanceTests.fs | 16 +++++++--------- MongoDB.FSharp.nuspec | 2 +- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/MongoDB.FSharp.Tests/AcceptanceTests.fs b/MongoDB.FSharp.Tests/AcceptanceTests.fs index 377706d..567f70b 100644 --- a/MongoDB.FSharp.Tests/AcceptanceTests.fs +++ b/MongoDB.FSharp.Tests/AcceptanceTests.fs @@ -72,7 +72,7 @@ type ``When serializing lists``() = let collection = db.GetCollection "objects" let obj = ObjectWithList() obj.List <- [ "hello"; "world" ] - collection.InsertOneAsync obj |> AwaitVoidTask |> ignore + collection.InsertOneAsync obj |> AwaitVoidTask |> Async.RunSynchronously let genCollection = db.GetCollection "objects" let fromDb = genCollection.Find(fun x -> x.Id = obj.Id).FirstAsync() @@ -86,7 +86,7 @@ type ``When serializing lists``() = let id = BsonObjectId(ObjectId.GenerateNewId()) let document = BsonDocument([ BsonElement("_id", id); BsonElement("List", list) ]) let collection = db.GetCollection "objects" - collection.InsertOneAsync document |> AwaitVoidTask |> ignore + collection.InsertOneAsync document |> AwaitVoidTask |> Async.RunSynchronously let collection = db.GetCollection "objects" let fromDb = collection.Find(fun x -> x.Id = id).FirstAsync() @@ -111,7 +111,7 @@ type ``When serializing lists``() = let id = BsonObjectId(ObjectId.GenerateNewId()) let document = BsonDocument([BsonElement("_id", id); BsonElement("Name", BsonString("value"))]) let collection = db.GetCollection "objects" - collection.InsertOneAsync(document) |> AwaitVoidTask |> ignore + collection.InsertOneAsync(document) |> AwaitVoidTask |> Async.RunSynchronously let collection = db.GetCollection("objects") let fromDb = collection.Find(fun x -> x.Id = id).FirstAsync() @@ -128,7 +128,7 @@ type ``When serializing lists``() = Age = 33; Childs = [{ChildName = "Adrian"; Age = 3}] } - collection.InsertOneAsync obj |> AwaitVoidTask |> ignore + collection.InsertOneAsync obj |> AwaitVoidTask |> Async.RunSynchronously let genCollection = db.GetCollection "persons" let person = genCollection.Find(fun x -> x.Id = obj.Id).FirstAsync() @@ -153,7 +153,7 @@ type ``When serializing lists``() = obj.Age <- Some 42 collection.InsertOneAsync obj |> AwaitVoidTask - |> ignore + |> Async.RunSynchronously let collection = db.GetCollection "objects" let filter = new BsonDocumentFilterDefinition<_>(new BsonDocument() @@ -172,12 +172,11 @@ type ``When serializing lists``() = [] member this.``It can serialize DimmerSwitch types``() = - let collection = db.GetCollection "objects" let obj = ObjectWithDimmer() obj.Switch <- DimMarquee(42, "loser") db.GetCollection("objects").InsertOneAsync (obj) |> AwaitVoidTask - |> ignore + |> Async.RunSynchronously let collection = db.GetCollection "objects" @@ -199,8 +198,7 @@ type ``When serializing lists``() = [] member this.``It can deserialize option types``() = let id = BsonObjectId(ObjectId.GenerateNewId()) - let arrayPart = BsonArray([ BsonInt32(42) ]) - + let arrayPart = BsonArray([ BsonInt32(42) ]) let structure = BsonDocument([| BsonElement("_t", BsonString("Some")); BsonElement("_v", arrayPart) |].AsEnumerable()) let document = BsonDocument([|BsonElement("_id", id); BsonElement("Age", structure)|].AsEnumerable()) let collection = db.GetCollection "objects" diff --git a/MongoDB.FSharp.nuspec b/MongoDB.FSharp.nuspec index adaaf06..1c4a7a5 100644 --- a/MongoDB.FSharp.nuspec +++ b/MongoDB.FSharp.nuspec @@ -13,7 +13,7 @@ Initial release, should work but not recommended for production Copyright 2015 - + f# fsharp mongodB nosql utility From b11bd70188b42b46c097cd969747b4557f9816ed Mon Sep 17 00:00:00 2001 From: Sebastian Faltoni Date: Fri, 17 Jul 2015 16:44:08 +0200 Subject: [PATCH 11/11] introduced option type serializer --- MongoDB.FSharp.Tests/AcceptanceTests.fs | 1 - MongoDB.FSharp/MongoDB.Driver.FSharp.fsproj | 6 +- MongoDB.FSharp/Serializers.fs | 317 +++++++++++--------- 3 files changed, 176 insertions(+), 148 deletions(-) diff --git a/MongoDB.FSharp.Tests/AcceptanceTests.fs b/MongoDB.FSharp.Tests/AcceptanceTests.fs index 567f70b..f3ad802 100644 --- a/MongoDB.FSharp.Tests/AcceptanceTests.fs +++ b/MongoDB.FSharp.Tests/AcceptanceTests.fs @@ -100,7 +100,6 @@ type ``When serializing lists``() = let obj = { Id = BsonObjectId(ObjectId.GenerateNewId()); Name = "test" } collection.InsertOneAsync obj |> AwaitVoidTask |> ignore - let genCollection = db.GetCollection "objects" let fromDb = collection.Find(fun x -> x.Id = obj.Id).FirstAsync() |> Async.AwaitTask |> Async.RunSynchronously diff --git a/MongoDB.FSharp/MongoDB.Driver.FSharp.fsproj b/MongoDB.FSharp/MongoDB.Driver.FSharp.fsproj index 4f76d36..68e5c84 100644 --- a/MongoDB.FSharp/MongoDB.Driver.FSharp.fsproj +++ b/MongoDB.FSharp/MongoDB.Driver.FSharp.fsproj @@ -25,6 +25,9 @@ DEBUG;TRACE 3 bin\Debug\MongoDB.FSharp.XML + Program + D:\Users\faltonis\git\catalog-monitor\CatalogMonitor.Service\bin\Debug\CatalogMonitor.Service.exe + true pdbonly @@ -65,15 +68,12 @@ ..\packages\MongoDB.Bson.2.0.1\lib\net45\MongoDB.Bson.dll - True ..\packages\MongoDB.Driver.2.0.1\lib\net45\MongoDB.Driver.dll - True ..\packages\MongoDB.Driver.Core.2.0.1\lib\net45\MongoDB.Driver.Core.dll - True diff --git a/MongoDB.FSharp/Serializers.fs b/MongoDB.FSharp/Serializers.fs index c350882..1a8b1d4 100644 --- a/MongoDB.FSharp/Serializers.fs +++ b/MongoDB.FSharp/Serializers.fs @@ -5,32 +5,29 @@ open System.Reflection open Microsoft.FSharp.Reflection open MongoDB.Bson open MongoDB.Bson.IO -open MongoDB.Bson.Serialization +open MongoDB.Bson.Serialization open MongoDB.Bson.Serialization.Serializers - open SerializationOptions -module Seq = - let tryHead s = - if Seq.isEmpty s then - None - else - Some (s |> Seq.head) - -module Serializers = +module Seq = + let tryHead s = + if Seq.isEmpty s then None + else Some(s |> Seq.head) +module Serializers = + open MongoDB.Bson.Serialization.Attributes + type MongoDB.Bson.IO.BsonWriter with - member inline this.WriteEmptyArray() = + member inline this.WriteEmptyArray() = this.WriteStartArray() this.WriteEndArray() - - type ListSerializer<'T when 'T:equality>() = + + type ListSerializer<'T when 'T : equality>() = inherit SerializerBase>() - - override this.Deserialize(context:BsonDeserializationContext , args:BsonDeserializationArgs) : 'T list = - - let readArray() = - seq { + + override this.Deserialize(context : BsonDeserializationContext, args : BsonDeserializationArgs) : 'T list = + let readArray() = + seq { context.Reader.ReadStartArray() let convention = BsonSerializer.LookupDiscriminatorConvention(typeof<'T>) while context.Reader.ReadBsonType() <> BsonType.EndOfDocument do @@ -40,8 +37,8 @@ module Serializers = yield element :?> 'T context.Reader.ReadEndArray() } - - let readArrayFromObject () = + + let readArrayFromObject() = context.Reader.ReadStartDocument() context.Reader.ReadString("_t") |> ignore context.Reader.ReadName("_v") @@ -51,212 +48,244 @@ module Serializers = let bsonType = context.Reader.GetCurrentBsonType() match bsonType with - | BsonType.Null -> + | BsonType.Null -> context.Reader.ReadNull() Unchecked.defaultof<'T list> | BsonType.Array -> (readArray() |> List.ofSeq :> obj) :?> 'T list - | BsonType.Document -> readArrayFromObject () + | BsonType.Document -> readArrayFromObject() | _ -> - let msg = sprintf "Can't deserialize a %s from BsonType %s" args.NominalType.FullName (bsonType.ToString()) - raise(InvalidOperationException(msg)) + let msg = + sprintf "Can't deserialize a %s from BsonType %s" args.NominalType.FullName (bsonType.ToString()) + raise (InvalidOperationException(msg)) - override this.Serialize(context:BsonSerializationContext, args:BsonSerializationArgs, value:'T list) = - if value = Unchecked.defaultof<'T list> then + override this.Serialize(context : BsonSerializationContext, args : BsonSerializationArgs, value : 'T list) = + if value = Unchecked.defaultof<'T list> then // There aren't supposed to be null values in F# context.Writer.WriteStartArray() context.Writer.WriteEndArray() - else + else //this.VerifyTypes(nominalType, actualType, typeof>) - let lst = box value :?> list<'T> context.Writer.WriteStartArray() - - lst |> List.iter (fun x -> BsonSerializer.Serialize (context.Writer,typeof<'T>, x)) - + lst |> List.iter (fun x -> BsonSerializer.Serialize(context.Writer, typeof<'T>, x)) context.Writer.WriteEndArray() - - - - interface IBsonArraySerializer with - member x.TryGetItemSerializationInfo(serializationInfo: byref): bool = + + interface IBsonArraySerializer with + member x.TryGetItemSerializationInfo(serializationInfo : byref) : bool = let elementName = null let nominalType = typeof<'T> let serializer = BsonSerializer.LookupSerializer nominalType - serializationInfo <- BsonSerializationInfo(elementName, serializer, nominalType) + serializationInfo <- BsonSerializationInfo(elementName, serializer, nominalType) true - - - let fsharpType (typ : Type) = - typ.GetCustomAttributes(typeof, true) + + let fsharpType (typ : Type) = + typ.GetCustomAttributes(typeof, true) |> Seq.cast - |> Seq.map(fun t -> t.SourceConstructFlags) + |> Seq.map (fun t -> t.SourceConstructFlags) |> Seq.tryHead - - let getClassMap isClassMapRegistered (actualType : Type) = - let rec getMember (_type : Type) name other = + + let getClassMap isClassMapRegistered (actualType : Type) = + let rec getMember (_type : Type) name other = let memberInfos = _type.GetMember name - if not (memberInfos |> Seq.isEmpty) then - Some(Seq.head memberInfos) - elif other <> null then - getMember _type other null - else - None - - if not (isClassMapRegistered actualType) then + if not (memberInfos |> Seq.isEmpty) then Some(Seq.head memberInfos) + elif other <> null then getMember _type other null + else None + if not (isClassMapRegistered actualType) then let genericType = typedefof>.MakeGenericType(actualType) let classMap = Activator.CreateInstance(genericType) :?> BsonClassMap - classMap.AutoMap() - // TODO: don't just map properties -> anything public, maybe consider using C#'s conventions to some extent - actualType.GetProperties() + actualType.GetProperties() |> Seq.where (fun prop -> - classMap.AllMemberMaps |> Seq.exists (fun mm -> mm.MemberInfo = (prop :> MemberInfo)) |> not - ) + classMap.AllMemberMaps + |> Seq.exists (fun mm -> mm.MemberInfo = (prop :> MemberInfo)) + |> not) |> Seq.where (fun prop -> prop.GetGetMethod() <> null) - |> Seq.iter (fun prop -> classMap.MapMember(prop :> MemberInfo) |> ignore ) - + |> Seq.iter (fun prop -> classMap.MapMember(prop :> MemberInfo) |> ignore) // TODO: use conventions match getMember actualType "Id" "_id" with | Some memberInfo -> classMap.MapIdMember memberInfo |> ignore | None -> () - - match fsharpType actualType with + match fsharpType actualType with | Some SourceConstructFlags.RecordType -> // Map creator function. Requires Mongo >1.8 - match actualType.GetConstructors() |> Seq.sortBy (fun c -> c.GetParameters().Length) |> Seq.tryHead with + match actualType.GetConstructors() + |> Seq.sortBy (fun c -> c.GetParameters().Length) + |> Seq.tryHead with | Some c -> - let parms = classMap.DeclaredMemberMaps |> Seq.map (fun m -> m.ElementName) |> Array.ofSeq - classMap.MapConstructor (c, parms) |> ignore + let parms = + classMap.DeclaredMemberMaps + |> Seq.map (fun (m : BsonMemberMap) -> m.MemberName) + |> Array.ofSeq + classMap.MapConstructor(c, parms) |> ignore | None -> () | _ -> () - classMap.Freeze() |> Some - else - None - - let ensureClassMapRegistered actualType = - let fn = BsonClassMap.IsClassMapRegistered + else None + + let ensureClassMapRegistered actualType = + let fn = BsonClassMap.IsClassMapRegistered match getClassMap fn actualType with | Some map -> map |> BsonClassMap.RegisterClassMap Some map - | None -> - None - - type RecordSerializer<'T>(classMap : BsonClassMap) = + | None -> None + + type RecordSerializer<'T>(classMap : BsonClassMap) = inherit MongoDB.Bson.Serialization.BsonClassMapSerializer<'T>(classMap) - - let classMapSerializer = - Activator.CreateInstance((typedefof>.MakeGenericType(typedefof<'T>)), - [ classMap ] |> Seq.cast |> Seq.toArray) :?> IBsonSerializer + + let classMapSerializer = + Activator.CreateInstance((typedefof> + .MakeGenericType(typedefof<'T>)), + [ classMap ] + |> Seq.cast + |> Seq.toArray) :?> IBsonSerializer + let getter = match classMap.IdMemberMap with | null -> None | mm -> Some(mm.Getter) - + let idProvider = classMapSerializer :?> IBsonIdProvider - override this.Serialize(ctx:BsonSerializationContext, args:BsonSerializationArgs, value:'T) = - classMapSerializer.Serialize(ctx,args,value) - - interface IBsonDocumentSerializer with - member x.TryGetMemberSerializationInfo(memberName: string, serializationInfo: byref): bool = - let m = classMap.AllMemberMaps |> Seq.tryFind (fun x -> x.MemberName = memberName) - match m with - | Some(x) -> - serializationInfo <- (new BsonSerializationInfo(x.ElementName, x.GetSerializer(), x.MemberType)) - true - | None -> false + override this.Serialize(ctx : BsonSerializationContext, args : BsonSerializationArgs, value : 'T) = + classMapSerializer.Serialize(ctx, args, value) + + interface IBsonDocumentSerializer with + member x.TryGetMemberSerializationInfo(memberName : string, serializationInfo : byref) : bool = + let getMemberName (map : BsonMemberMap) = + match map.MemberInfo.GetCustomAttribute(typedefof) :?> BsonElementAttribute with + | null -> map.ElementName + | a -> a.ElementName - + let m = classMap.AllMemberMaps |> Seq.tryFind (fun x -> (getMemberName x) = memberName) + match m with + | Some(x) -> + serializationInfo <- (new BsonSerializationInfo(x.ElementName, x.GetSerializer(), x.MemberType)) + true + | None -> false + interface IBsonIdProvider with - member this.GetDocumentId(document : Object, id : Object byref, nominalType : Type byref, idGenerator : IIdGenerator byref) = + + member this.GetDocumentId(document : Object, id : Object byref, nominalType : Type byref, + idGenerator : IIdGenerator byref) = match getter with | Some(i) -> - id <- i.DynamicInvoke(([document] |> Array.ofList)) + id <- i.DynamicInvoke(([ document ] |> Array.ofList)) idProvider.GetDocumentId(document, ref id, ref nominalType, ref idGenerator) | None -> false - + member this.SetDocumentId(document : Object, id : Object) = idProvider.SetDocumentId(document, id) - - + type UnionCaseSerializer<'T>() = inherit SerializerBase<'T>() - - let readItems (types : Type seq) (ctx:BsonDeserializationContext) = - types |> Seq.fold(fun state t -> - let serializer = BsonSerializer.LookupSerializer(t) - let mutable a = new BsonDeserializationArgs() - a.NominalType <- t - let item = serializer.Deserialize(ctx, a) - item :: state - ) [] - |> Seq.toArray |> Array.rev - - override x.Deserialize(ctx:BsonDeserializationContext, args:BsonDeserializationArgs) = + + let readItems (types : Type seq) (ctx : BsonDeserializationContext) = + types + |> Seq.fold (fun state t -> + let serializer = BsonSerializer.LookupSerializer(t) + let mutable a = new BsonDeserializationArgs() + a.NominalType <- t + let item = serializer.Deserialize(ctx, a) + item :: state) [] + |> Seq.toArray + |> Array.rev + + override x.Deserialize(ctx : BsonDeserializationContext, args : BsonDeserializationArgs) = let reader = ctx.Reader reader.ReadStartDocument() reader.ReadName("_t") let typeName = reader.ReadString() + let unionType = - FSharpType.GetUnionCases(args.NominalType) - |> Seq.where (fun case -> case.Name = typeName) |> Seq.head + FSharpType.GetUnionCases(args.NominalType) + |> Seq.where (fun case -> case.Name = typeName) + |> Seq.head reader.ReadStartArray() - let items = readItems (unionType.GetFields() |> Seq.map(fun f -> f.PropertyType)) ctx + let items = readItems (unionType.GetFields() |> Seq.map (fun f -> f.PropertyType)) ctx reader.ReadEndArray() reader.ReadEndDocument() FSharpValue.MakeUnion(unionType, items) :?> 'T - - override x.Serialize(ctx:BsonSerializationContext, args:BsonSerializationArgs, value:'T) = + + override x.Serialize(ctx : BsonSerializationContext, args : BsonSerializationArgs, value : 'T) = let writer = ctx.Writer writer.WriteStartDocument() - let info, values = FSharpValue.GetUnionFields(value, value.GetType()) + let info, values = FSharpValue.GetUnionFields(value, typeof<'T>) writer.WriteName("_t") writer.WriteString(info.Name) writer.WriteName("_v") writer.WriteStartArray() - values |> Seq.zip(info.GetFields()) |> Seq.iter (fun (field, value) -> - let itemSerializer = BsonSerializer.LookupSerializer(field.PropertyType) - itemSerializer.Serialize(ctx, value) - ) + values + |> Seq.zip (info.GetFields()) + |> Seq.iter (fun (field, value) -> + let itemSerializer = BsonSerializer.LookupSerializer(field.PropertyType) + itemSerializer.Serialize(ctx, value)) writer.WriteEndArray() writer.WriteEndDocument() - - - type FsharpSerializationProvider() = - + + type OptionTypeSerializer<'T, 'U>() = + inherit SerializerBase<'T>() + + override x.Deserialize(ctx : BsonDeserializationContext, args : BsonDeserializationArgs) = + let reader = ctx.Reader + let t = typeof<'T> + let innerType = t.GenericTypeArguments.[0] + reader.ReadStartDocument() + reader.ReadName("_t") + let typeName = reader.ReadString() + let opt = + if typeName = "Some" then + reader.ReadName("_v") + Some(Unchecked.unbox<'U> (BsonSerializer.Deserialize(reader, innerType))) + else None + + reader.ReadEndDocument() + (box opt) :?> 'T + + override x.Serialize(ctx : BsonSerializationContext, args : BsonSerializationArgs, value : 'T) = + let writer = ctx.Writer + writer.WriteStartDocument() + writer.WriteName("_t") + if box (value) = null then writer.WriteString("None") + else writer.WriteString("Some") + if box (value) <> null then + writer.WriteName("_v") + let v = value.GetType().GetProperty("Value").GetValue(value) + let serializer = BsonSerializer.LookupSerializer(v.GetType()) + serializer.Serialize(ctx, v) + writer.WriteEndDocument() + + type FsharpSerializationProvider() = interface IBsonSerializationProvider with - member this.GetSerializer(typ : Type) = + member this.GetSerializer(typ : Type) = let t = fsharpType typ match t with - | Some SourceConstructFlags.RecordType -> + | Some SourceConstructFlags.RecordType -> match ensureClassMapRegistered typ with - | Some classMap -> Activator.CreateInstance( - (typedefof>.MakeGenericType(typ)), - classMap) :?> IBsonSerializer + | Some classMap -> + Activator.CreateInstance((typedefof>.MakeGenericType(typ)), classMap) :?> IBsonSerializer // return null means to try the next provider to see if it has a better answer | None -> null - // other F# types, when we're ready (list, seq, discriminated union) - | Some SourceConstructFlags.SumType -> + | Some SourceConstructFlags.SumType -> // Maybe it's a list? - if typ.IsGenericType && typ.GetGenericTypeDefinition() = typedefof> then - typedefof>.MakeGenericType(typ.GetGenericArguments()) - |> Activator.CreateInstance :?> IBsonSerializer - elif FSharpType.IsUnion typ then - typedefof>.MakeGenericType(typ) - |> Activator.CreateInstance :?> IBsonSerializer - else - null - + if typ.IsGenericType && typ.GetGenericTypeDefinition() = typedefof> then + typedefof>.MakeGenericType(typ.GetGenericArguments()) + |> Activator.CreateInstance :?> IBsonSerializer + elif FSharpType.IsUnion typ then + if typ.Name = "FSharpOption`1" then + let args = [|typ;typ.GetGenericArguments().[0]|] |> Array.ofSeq + typedefof>.MakeGenericType(args) |> Activator.CreateInstance :?> IBsonSerializer + else + typedefof>.MakeGenericType(typ) |> Activator.CreateInstance :?> IBsonSerializer + else null | Some SourceConstructFlags.UnionCase -> UnionCaseSerializer() :> IBsonSerializer | _ -> null - + let mutable isRegistered = false - + /// Registers all F# serializers - let Register() = - if not isRegistered then + let Register() = + if not isRegistered then BsonSerializer.RegisterSerializationProvider(FsharpSerializationProvider()) BsonSerializer.RegisterGenericSerializerDefinition(typeof>, typeof>) - isRegistered <- true \ No newline at end of file + isRegistered <- true