Repository: Zaid-Ajaj/LiteDB.FSharp Branch: master Commit: b63ddf8eda43 Files: 28 Total size: 139.8 KB Directory structure: gitextract_eb8miqj6/ ├── .gitignore ├── .vscode/ │ ├── launch.json │ └── tasks.json ├── LICENSE ├── LiteDB.FSharp/ │ ├── Bson.fs │ ├── Extensions.fs │ ├── FSharpBsonMapper.fs │ ├── Json.fs │ ├── Linq.fs │ ├── LiteDB.FSharp.fsproj │ ├── Patterns.fs │ ├── Query.fs │ └── TypeShapeMapper.fs ├── LiteDB.FSharp.Build/ │ ├── Files.fs │ ├── LiteDB.FSharp.Build.fsproj │ ├── Program.fs │ └── Tools.fs ├── LiteDB.FSharp.Tests/ │ ├── LiteDB.FSharp.Tests.fsproj │ ├── Tests.Bson.fs │ ├── Tests.DBRef.fs │ ├── Tests.InheritedType.fs │ ├── Tests.LiteDatabase.fs │ ├── Tests.Runner.fs │ ├── Tests.Types.fs │ └── paket.references ├── LiteDB.FSharp.sln ├── Nuget.Config └── README.md ================================================ FILE CONTENTS ================================================ ================================================ FILE: .gitignore ================================================ bin obj packages paket-files .fake !.fake/build.fsx/intellisense.fsx dist .vs .idea *.xml .idea/**/* .idea .idea.LiteDB.FSharp .idea/.idea.LiteDB.FSharp .idea/.idea.LiteDB.FSharp/.idea .idea/.idea.LiteDB.FSharp/.idea/*.xml LiteDB.FSharp.userprefs LiteDB.FSharp.sln.DotSettings.user **/*.ionide/** .ionide ================================================ FILE: .vscode/launch.json ================================================ { "version": "0.2.0", "configurations": [ { "name": "Debug Test", "request": "launch", "preLaunchTask": "Build Test", "type": "coreclr", "program": "${workspaceRoot}/LiteDB.FSharp.Tests/bin/Debug/netcoreapp2.0/LiteDB.FSharp.Tests.dll", "args": [], "cwd": "${workspaceRoot}/LiteDB.FSharp.Tests", "stopAtEntry": false, "console": "internalConsole" }, { "name": ".NET Core Attach", "type": "coreclr", "request": "attach", "processId": "${command:pickProcess}" } ] } ================================================ FILE: .vscode/tasks.json ================================================ { "version": "2.0.0", "tasks": [ { "label": "Build Test", "command": "dotnet", "group": "build", "args": [ "build", "LiteDB.FSharp.Tests/LiteDB.FSharp.Tests.fsproj" ], "presentation": { "reveal": "silent" }, "problemMatcher": "$msCompile" } ] } ================================================ FILE: LICENSE ================================================ MIT License Copyright (c) 2017 Zaid Ajaj Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ================================================ FILE: LiteDB.FSharp/Bson.fs ================================================ namespace LiteDB.FSharp open System open System.Globalization open FSharp.Reflection open Newtonsoft.Json open LiteDB open LiteDB /// Utilities to convert between BSON document and F# types [] module Bson = /// Returns the value of entry in the BsonDocument by it's key let read key (doc: BsonDocument) = doc.[key] /// Reads a property from a BsonDocument by it's key as a string let readStr key (doc: BsonDocument) = doc.[key].AsString /// Reads a property from a BsonDocument by it's key and converts it to an integer let readInt key (doc: BsonDocument) = doc.[key].AsString |> int /// Reads a property from a BsonDocument by it's key and converts it to an integer let readBool key (doc: BsonDocument) = doc.[key].AsString |> bool.Parse /// Adds an entry to a `BsonDocument` given a key and a BsonValue let withKeyValue key value (doc: BsonDocument) = doc.Add(key, value) doc /// Reads a field from a BsonDocument as DateTime let readDate (key: string) (doc: BsonDocument) = let date = doc.[key].AsDateTime if date.Kind = DateTimeKind.Local then date.ToUniversalTime() else date /// Removes an entry (property) from a `BsonDocument` by the key of that property let removeEntryByKey (key:string) (doc: BsonDocument) = if (doc.ContainsKey key) then doc.Remove(key) |> ignore doc let private fsharpJsonConverter = FSharpJsonConverter() let mutable internal converters : JsonConverter[] = [| fsharpJsonConverter |] /// Converts a typed entity (normally an F# record) to a BsonDocument. /// Assuming there exists a field called `Id` or `id` of the record that will be mapped to `_id` in the BsonDocument, otherwise an exception is thrown. let serialize<'t> (entity: 't) = let typeName = typeof<'t>.Name let json = JsonConvert.SerializeObject(entity, converters) let doc = LiteDB.JsonSerializer.Deserialize(json) |> unbox for key in doc.Keys do if key.EndsWith("@") then doc.Remove(key) |> ignore doc.Keys |> Seq.tryFind (fun key -> key = "Id" || key = "id" || key = "_id") |> function | Some key -> doc |> withKeyValue "_id" (read key doc) |> removeEntryByKey key | None -> let error = sprintf "Expected type %s to have a unique identifier property of 'Id' or 'id' (exact name)" typeName failwith error /// Converts a BsonDocument to a typed entity given the document the type of the CLR entity. let deserializeByType (entity: BsonDocument) (entityType: Type) = let getCollectionElementType (collectionType:Type)= let typeNames = ["FSharpList`1";"IEnumerable`1";"List`"; "List`1"; "IList`1"; "FSharpOption`1"] let typeName = collectionType.Name if List.contains typeName typeNames then collectionType.GetGenericArguments().[0] |> Array.singleton else if collectionType.IsArray then collectionType.GetElementType() |> Array.singleton else if FSharpType.IsTuple collectionType then collectionType.GetGenericArguments() else failwithf "Could not extract element type from collection of type %s" collectionType.FullName let getKeyFieldName (entityType: Type)= if FSharpType.IsRecord entityType then FSharpType.GetRecordFields entityType |> Seq.tryFind (fun field -> field.Name = "Id" || field.Name = "id") |> function | Some field -> field.Name | None -> "Id" else "Id" let rewriteIdentityKeys (entity:BsonDocument)= let rec rewriteKey (keys:string list) (entity:BsonDocument) (entityType: Type) key = match keys with | [] -> () | y :: ys -> let continueToNext() = rewriteKey ys entity entityType key match y, entity.RawValue.[y] with // during deserialization, turn key-prop _id back into original Id or id | "_id", id -> entity |> withKeyValue key id |> removeEntryByKey "_id" |> (ignore >> continueToNext) | "$id", id -> entity |> withKeyValue key id |> removeEntryByKey "$id" |> (ignore >> continueToNext) |_, (:? BsonDocument as bson) -> // if property is nested record that resulted from DbRef then // also re-write the transformed _id key property back to original Id or id let propType = entityType.GetProperty(y).PropertyType if FSharpType.IsRecord propType then rewriteKey (List.ofSeq bson.RawValue.Keys) bson propType (getKeyFieldName propType) continueToNext() |_, (:? BsonArray as bsonArray) -> // if property is BsonArray then loop through each element // and if that element is a record, then re-write _id back to original let collectionType = entityType.GetProperty(y).PropertyType let elementTypes = getCollectionElementType collectionType for elementType in elementTypes do if FSharpType.IsRecord elementType then let docKey = getKeyFieldName elementType for bson in bsonArray do if bson.IsDocument then let doc = bson.AsDocument let keys = List.ofSeq doc.RawValue.Keys rewriteKey keys doc elementType docKey continueToNext() |_ -> continueToNext() let keys = List.ofSeq entity.RawValue.Keys rewriteKey keys entity entityType (getKeyFieldName entityType) entity rewriteIdentityKeys entity |> LiteDB.JsonSerializer.Serialize |> fun json -> JsonConvert.DeserializeObject(json, entityType, converters) let serializeField(any: obj) : BsonValue = // Entity => Json => Bson let json = JsonConvert.SerializeObject(any, Formatting.None, converters); LiteDB.JsonSerializer.Deserialize(json); /// Deserializes a field of a BsonDocument to a typed entity let deserializeField<'t> (value: BsonValue) = // Bson => Json => Entity<'t> let typeInfo = typeof<'t> value // Bson to Json |> LiteDB.JsonSerializer.Serialize // Json to 't |> fun json -> JsonConvert.DeserializeObject(json, typeInfo, converters) |> unbox<'t> /// Converts a BsonDocument to a typed entity given the document the type of the CLR entity. let deserialize<'t>(entity: BsonDocument) = // if the type is already a BsonDocument, then do not deserialize, just return as is. if typeof<'t>.FullName = typeof.FullName then entity |> unbox<'t> else let typeInfo = typeof<'t> deserializeByType entity typeInfo |> unbox<'t> ================================================ FILE: LiteDB.FSharp/Extensions.fs ================================================ namespace LiteDB.FSharp open LiteDB open System.Linq.Expressions open System open Quotations.Patterns open FSharp.Reflection open System module Extensions = open Microsoft.FSharp.Quotations type LiteCollection<'t> with /// Tries to find a document using the Id of the document. member collection.TryFindById(id: BsonValue) = let result : 't = collection.FindById(id) match box result with | null -> None | _ -> Some result /// Tries to find a document using the given query member collection.TryFind (query: Query) = let skipped = 0 let limit = 1 collection.Find(query, skipped, limit) |> Seq.tryHead /// Tries to find a single document using a quoted query expression member collection.tryFindOne<'t> ([] expr: Expr<'t -> bool>) : Option<'t> = let query = Query.createQueryFromExpr expr collection.TryFind query /// Tries to find a single document using a quoted query expression, if no document matches, an exception is thrown member collection.findOne<'t> ([] expr: Expr<'t -> bool>) : 't = match collection.TryFind(Query.createQueryFromExpr expr) with | Some item -> item | None -> failwith "Could not find a single document that matches the given qeury" /// Searches the collection for documents that match the given query expression member collection.findMany<'t> ([] expr: Expr<'t -> bool>) : seq<'t> = let query = Query.createQueryFromExpr expr collection.Find(query) /// Executes a full search using the Where query member collection.fullSearch<'t, 'u> (expr: Expr<'t -> 'u>) (pred: 'u -> bool) = match expr with | Lambda(_, PropertyGet(_, propInfo, [])) -> let propName = match propInfo.Name with | ("Id" | "id" | "ID") -> "_id" | _ -> propInfo.Name let query = Query.Where(propName, fun bsonValue -> bsonValue |> Bson.deserializeField<'u> |> pred) collection.Find(query) | _ -> let expression = sprintf "%A" expr failwithf "Could not recognize the given expression \n%s\n, it should a simple lambda to select a property, for example: <@ fun record -> record.property @>" expression /// Creates a Query for a full search using a selector expression like `<@ fun record -> record.Name @>` and predicate member collection.where<'t, 'u> (expr: Expr<'t -> 'u>) (pred: 'u -> bool) = match expr with | Lambda(_, PropertyGet(_, propInfo, [])) -> let propName = match propInfo.Name with | ("Id" | "id" | "ID") -> "_id" | _ -> propInfo.Name Query.Where(propName, fun bsonValue -> bsonValue |> Bson.deserializeField<'u> |> pred) | _ -> let expression = sprintf "%A" expr failwithf "Could not recognize the given expression \n%s\n, it should a simple lambda to select a property, for example: <@ fun record -> record.property @>" expression /// Remove all document based on quoted expression query. Returns removed document counts member collection.delete<'t> ([] expr: Expr<'t -> bool>) = let query = Query.createQueryFromExpr expr collection.Delete(query) type LiteRepository with ///Create a new permanent index in all documents inside this collections if index not exists already. member this.EnsureIndex<'T1,'T2> (exp: Expression>) = this.Database.GetCollection<'T1>().EnsureIndex(exp,true) |> ignore [] module LiteRepository = ///Insert an array of new documents into collection. Document Id must be a new value in collection. Can be set buffer size to commit at each N documents let insertItems<'a> (items: seq<'a>) (lr:LiteRepository) = lr.Insert<'a>(items) |> ignore lr ///Insert a new document into collection. Document Id must be a new value in collection let insertItem<'a> (item: 'a) (lr:LiteRepository) = lr.Insert<'a>(item) |> ignore lr ///Update a document into collection. let updateItem<'a> (item: 'a) (lr:LiteRepository) = if lr.Update<'a>(item) = false then failwithf "Failed updated item %A" item else lr ///Returns new instance of LiteQueryable that provides all method to query any entity inside collection. Use fluent API to apply filter/includes an than run any execute command, like ToList() or First() let query<'a> (lr:LiteRepository) = lr.Query<'a>() [] type LiteQueryable = ///Include DBRef field in result query execution static member ``include`` (exp: Expression>) (query: LiteQueryable<'a>) = query.Include(exp) ///Include DBRef field in result query execution static member expand (exp: Expression>) (query: LiteQueryable<'a>) = query.Include(exp) static member first (query: LiteQueryable<'a>) = query.First() static member toList (query: LiteQueryable<'a>) = query.ToEnumerable() |> List.ofSeq ///Add new Query filter when query will be executed. This filter use database index static member where (exp: Expression>) (query: LiteQueryable<'a>) = query.Where exp static member find (exp: Expression>) (query: LiteQueryable<'a>) = query |> LiteQueryable.where exp |> LiteQueryable.first static member tryFirst (query: LiteQueryable<'a>) = query.ToEnumerable() |> Seq.tryHead static member tryFind (exp: Expression>) (query: LiteQueryable<'a>) = query |> LiteQueryable.where exp |> LiteQueryable.tryFirst ================================================ FILE: LiteDB.FSharp/FSharpBsonMapper.fs ================================================ namespace LiteDB.FSharp open LiteDB open System open System.Collections.Generic open System.Linq.Expressions open Newtonsoft.Json open LiteDB type FSharpBsonMapper() = inherit BsonMapper() let entityMappers = Dictionary() member this.DbRef<'T1,'T2> (exp: Expression>) = this.Entity<'T1>().DbRef(exp) |> ignore static member RegisterInheritedConverterType<'T1,'T2>() = let t1 = typeof<'T1> let t2 = typeof<'T2> Cache.inheritedConverterTypes.AddOrUpdate( t1.FullName, HashSet [t2], ( fun _ types -> types.Add(t2) |> ignore; types ) ) |> ignore static member UseCustomJsonConverters(converters: JsonConverter[]) = Bson.converters <- converters override self.ToObject(entityType: System.Type, entity: BsonDocument) = Bson.deserializeByType entity entityType override self.ToObject<'t>(entity: BsonDocument) = Bson.deserialize<'t> entity override self.ToDocument<'t>(entity: 't) = //Add DBRef Feature :set field value with $ref if typeof<'t>.FullName = typeof.FullName then entity |> unbox else let withEntityMap (doc:BsonDocument)= let mapper = entityMappers.Item (entity.GetType()) for memberMapper in mapper.Members do if not (isNull memberMapper.Serialize) then let value = memberMapper.Getter.Invoke(entity) let serialized = memberMapper.Serialize.Invoke(value, self) doc.RawValue.[memberMapper.FieldName] <- serialized doc Bson.serialize<'t> entity |> withEntityMap override self.BuildEntityMapper(entityType)= let mapper = base.BuildEntityMapper(entityType) entityMappers.Add(entityType, mapper) mapper ================================================ FILE: LiteDB.FSharp/Json.fs ================================================ namespace LiteDB.FSharp open LiteDB open System.Globalization open Newtonsoft.Json open Newtonsoft.Json.Linq [] module ReflectionAdapters = open System.Reflection type System.Type with member this.IsValueType = this.GetTypeInfo().IsValueType member this.IsGenericType = this.GetTypeInfo().IsGenericType member this.GetMethod(name) = this.GetTypeInfo().GetMethod(name) member this.GetGenericArguments() = this.GetTypeInfo().GetGenericArguments() member this.MakeGenericType(args) = this.GetTypeInfo().MakeGenericType(args) member this.GetCustomAttributes(inherits : bool) : obj[] = downcast box(CustomAttributeExtensions.GetCustomAttributes(this.GetTypeInfo(), inherits) |> Seq.toArray) open System open FSharp.Reflection open Newtonsoft.Json open Newtonsoft.Json.Converters open System.Reflection open System.Collections.Generic open System.Collections.Concurrent open System.Text.RegularExpressions type Kind = | Other = 0 | Option = 1 | Tuple = 2 | Union = 3 | DateTime = 6 | MapOrDictWithNonStringKey = 7 | Long = 8 | BigInt = 9 | Guid = 10 | Decimal = 11 | Binary = 12 | ObjectId = 13 | Double = 14 | Record = 15 /// Helper for serializing map/dict with non-primitive, non-string keys such as unions and records. /// Performs additional serialization/deserialization of the key object and uses the resulting JSON /// representation of the key object as the string key in the serialized map/dict. type MapSerializer<'k,'v when 'k : comparison>() = static member Deserialize(t:Type, reader:JsonReader, serializer:JsonSerializer) = let dictionary = serializer.Deserialize>(reader) |> Seq.fold (fun (dict:Dictionary<'k,'v>) kvp -> use tempReader = new System.IO.StringReader(kvp.Key) let key = serializer.Deserialize(tempReader, typeof<'k>) :?> 'k dict.Add(key, kvp.Value) dict ) (Dictionary<'k,'v>()) if t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> then dictionary |> Seq.map (|KeyValue|) |> Map.ofSeq :> obj elif t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> then dictionary :> obj else failwith "MapSerializer input type wasn't a Map or a Dictionary" static member Serialize(value: obj, writer:JsonWriter, serializer:JsonSerializer) = let kvpSeq = match value with | :? Map<'k,'v> as mapObj -> mapObj |> Map.toSeq | :? Dictionary<'k,'v> as dictObj -> dictObj |> Seq.map (|KeyValue|) | _ -> failwith "MapSerializer input value wasn't a Map or a Dictionary" writer.WriteStartObject() use tempWriter = new System.IO.StringWriter() kvpSeq |> Seq.iter (fun (k,v) -> let key = tempWriter.GetStringBuilder().Clear() |> ignore serializer.Serialize(tempWriter, k) tempWriter.ToString() writer.WritePropertyName(key) serializer.Serialize(writer, v) ) writer.WriteEndObject() [] type private ConvertableUnionType = | SinglePrivate of UnionCaseInfo | Public of UnionCaseInfo [] module private Cache = let jsonConverterTypes = ConcurrentDictionary() let serializationBinderTypes = ConcurrentDictionary() let inheritedConverterTypes = ConcurrentDictionary>() let inheritedTypeQuickAccessor = ConcurrentDictionary,Type>() let private convertableUnionTypes = ConcurrentDictionary() let (|ConvertableUnionType|_|) (t: Type) = convertableUnionTypes.GetOrAdd(t, (fun _ -> if FSharpType.IsUnion (t) then Some (ConvertableUnionType.Public (FSharpType.GetUnionCases t)) elif FSharpType.IsUnion(t, true) then let ucies = FSharpType.GetUnionCases(t, true) match ucies.Length with | 0 -> None | 1 -> Some (ConvertableUnionType.SinglePrivate ucies.[0]) | i when i > 1 -> None | _ -> failwith "Invalid token" else None )) let isConvertableUnionType t = match t with | ConvertableUnionType _ -> true | _ -> false open Cache open System [] module DefaultValue = type DefaultGen<'t>() = member this.GetDefault() = let typeSignature = typeof<'t>.FullName if typeSignature = typeof.FullName then unbox<'t> 0 elif typeSignature = typeof.FullName then unbox<'t> "" elif typeSignature = typeof.FullName then unbox<'t> 0L elif typeSignature = typeof.FullName then unbox<'t> 0I elif typeSignature = typeof.FullName then unbox<'t> false elif typeSignature = typeof.FullName then unbox<'t> Guid.Empty elif typeSignature = typeof.FullName then unbox<'t> (DateTime(1970, 1, 1, 0, 0, 0)) elif typeof<'t>.Name = "FSharpOption`1" then unbox Option<'t>.None elif typeSignature = typeof.FullName then unbox 0.0 else Unchecked.defaultof<'t> let fromType (inputType: System.Type) : obj = let genericDefaultGenType = typedefof>.MakeGenericType(inputType) let defaultGenerator = Activator.CreateInstance(genericDefaultGenType) let getDefaultMethod = genericDefaultGenType.GetMethods() |> Seq.filter (fun meth -> meth.Name = "GetDefault") |> Seq.head getDefaultMethod.Invoke(defaultGenerator, [||]) /// Converts F# options, tuples and unions to a format understandable /// A derivative of Fable's JsonConverter. Code adapted from Lev Gorodinski's original. /// See https://goo.gl/F6YiQk type FSharpJsonConverter() = inherit Newtonsoft.Json.JsonConverter() let advance(reader: JsonReader) = reader.Read() |> ignore let readElements(reader: JsonReader, itemTypes: Type[], serializer: JsonSerializer) = let rec read index acc = match reader.TokenType with | JsonToken.EndArray -> acc | _ -> let value = serializer.Deserialize(reader, itemTypes.[index]) advance reader read (index + 1) (acc @ [value]) advance reader read 0 List.empty let isRegisteredParentType (tp: Type) = inheritedConverterTypes.ContainsKey(tp.FullName) override x.CanConvert(t) = let kind = jsonConverterTypes.GetOrAdd(t, fun t -> if t.FullName = "System.DateTime" then Kind.DateTime elif t.FullName = "System.Guid" then Kind.Guid elif t.Name = "FSharpOption`1" then Kind.Option elif t.FullName = "System.Int64" then Kind.Long elif t.FullName = "System.Double" then Kind.Double elif t = typeof then Kind.ObjectId elif t.FullName = "System.Numerics.BigInteger" then Kind.BigInt elif t = typeof then Kind.Binary elif FSharpType.IsTuple t then Kind.Tuple elif (isConvertableUnionType t && t.Name <> "FSharpList`1") then Kind.Union elif (FSharpType.IsRecord t) then Kind.Record elif t.IsGenericType && (t.GetGenericTypeDefinition() = typedefof> || t.GetGenericTypeDefinition() = typedefof>) && t.GetGenericArguments().[0] <> typeof then Kind.MapOrDictWithNonStringKey else Kind.Other) match kind with | Kind.Other -> isRegisteredParentType t | _ -> true override x.WriteJson(writer, value, serializer) = if isNull value then serializer.Serialize(writer, value) else let t = value.GetType() match jsonConverterTypes.TryGetValue(t) with | false, _ -> serializer.Serialize(writer, value) | true, Kind.Long -> let numberLong = JObject() let value = sprintf "%+i" (value :?> int64) numberLong.Add(JProperty("$numberLong", value)) numberLong.WriteTo(writer) | true, Kind.Double -> let value = (value :?> double).ToString("R") writer.WriteValue(value) | true, Kind.Guid -> let guidObject = JObject() let guidValue = (value :?> Guid).ToString() guidObject.Add(JProperty("$guid", guidValue)) guidObject.WriteTo(writer) | true, Kind.ObjectId -> let objectId = value |> unbox let oid = JObject() oid.Add(JProperty("$oid", objectId.ToString())) oid.WriteTo(writer) | true, Kind.DateTime -> let dt = value :?> DateTime let dateTime = JObject() dateTime.Add(JProperty("$date", dt.ToString("O", CultureInfo.InvariantCulture))) dateTime.WriteTo(writer) | true, Kind.Binary -> let bytes = value |> unbox let base64 = Convert.ToBase64String(bytes) let binaryBsonField = JObject() binaryBsonField.Add(JProperty("$binary", base64)) binaryBsonField.WriteTo(writer) | true, Kind.Decimal -> let value = (value :?> decimal).ToString() let numberDecimal = JObject() numberDecimal.Add(JProperty("$numberDecimal", value)) numberDecimal.WriteTo(writer) | true, Kind.Option -> let _,fields = FSharpValue.GetUnionFields(value, t) serializer.Serialize(writer, fields.[0]) | true, Kind.Tuple -> let values = FSharpValue.GetTupleFields(value) serializer.Serialize(writer, values) | true, Kind.Union -> let uciName, fields = match t with | ConvertableUnionType convertableUnionType -> match convertableUnionType with | ConvertableUnionType.SinglePrivate uci -> /// make uciName to 'case' as anonymous property name /// so private case union is still querable after Case Name is changed "case", snd (FSharpValue.GetUnionFields(value, t, true)) | ConvertableUnionType.Public _ -> let uci, fields = FSharpValue.GetUnionFields(value, t) uci.Name, fields | _ -> failwithf "%s is not an convertable union type" t.FullName if fields.Length = 0 then serializer.Serialize(writer, uciName) else writer.WriteStartObject() writer.WritePropertyName(uciName) if fields.Length = 1 then serializer.Serialize(writer, fields.[0]) else serializer.Serialize(writer, fields) writer.WriteEndObject() | true, Kind.MapOrDictWithNonStringKey -> let mapTypes = t.GetGenericArguments() let mapSerializer = typedefof>.MakeGenericType mapTypes let mapSerializeMethod = mapSerializer.GetMethod("Serialize") mapSerializeMethod.Invoke(null, [| value; writer; serializer |]) |> ignore | true, Kind.Record -> let fields = FSharpType.GetRecordFields(t) writer.WriteStartObject() for fieldType in fields do let fieldValue = FSharpValue.GetRecordField(value, fieldType) writer.WritePropertyName(fieldType.Name) serializer.Serialize(writer, fieldValue) writer.WriteEndObject() | true, _ -> serializer.Serialize(writer, value) override x.ReadJson(reader, t, existingValue, serializer) = match jsonConverterTypes.TryGetValue(t) with | false, _ -> serializer.Deserialize(reader, t) | true, Kind.Guid -> let jsonObject = JObject.Load(reader) let value = jsonObject.["$guid"].Value() upcast Guid.Parse(value) | true, Kind.ObjectId -> let jsonObject = JObject.Load(reader) let value = jsonObject.["$oid"].Value() upcast ObjectId(value) | true, Kind.Decimal -> let jsonObject = JObject.Load(reader) let value = jsonObject.["$numberDecimal"].Value() upcast Decimal.Parse(value) | true, Kind.Binary -> let jsonObject = JObject.Load(reader) let base64 = jsonObject.["$binary"].Value() let bytes = Convert.FromBase64String(base64) upcast bytes | true, Kind.Long -> let jsonObject = JObject.Load(reader) let value = jsonObject.["$numberLong"].Value() upcast Int64.Parse(value) | true, Kind.Double -> let value = serializer.Deserialize(reader, typeof) :?> string upcast Double.Parse(value) | true, Kind.DateTime -> let jsonObject = JObject.Load(reader) let dateValue = jsonObject.["$date"].Value() let date = DateTime.Parse(dateValue, CultureInfo.InvariantCulture, DateTimeStyles.RoundtripKind) upcast date | true, Kind.Option -> let innerType = t.GetGenericArguments().[0] let innerType = if innerType.IsValueType then (typedefof>).MakeGenericType([|innerType|]) else innerType let cases = FSharpType.GetUnionCases(t) let value = match reader.TokenType with | JsonToken.StartObject -> let jObject = JObject.Load(reader) let path = jObject.First.Path if path.StartsWith("$") then let value = jObject.GetValue(path) value.ToObject(innerType,serializer) else jObject.ToObject(innerType,serializer) | JsonToken.Null -> null | _ -> serializer.Deserialize(reader,innerType) if isNull value then FSharpValue.MakeUnion(cases.[0], [||]) else FSharpValue.MakeUnion(cases.[1], [|value|]) | true, Kind.Tuple -> match reader.TokenType with | JsonToken.StartArray -> let values = readElements(reader, FSharpType.GetTupleElements(t), serializer) FSharpValue.MakeTuple(values |> List.toArray, t) | _ -> failwith "invalid token" | true, Kind.Union -> match reader.TokenType with | JsonToken.String -> let uci = match t with | ConvertableUnionType convertableType -> match convertableType with | ConvertableUnionType.Public ucis -> let name = serializer.Deserialize(reader, typeof) :?> string ucis |> Array.find(fun m -> m.Name = name) | ConvertableUnionType.SinglePrivate uci -> uci | _ -> failwithf "%s is not an convertable union type" t.FullName FSharpValue.MakeUnion(uci, [||], true) | JsonToken.StartObject -> advance reader let uci = match t with | ConvertableUnionType convertableType -> match convertableType with | ConvertableUnionType.Public ucis -> let name = reader.Value :?> string ucis |> Array.find(fun m -> m.Name = name) | ConvertableUnionType.SinglePrivate uci -> uci | _ -> failwithf "%s is not an convertable union type" t.FullName advance reader let itemTypes = uci.GetFields() |> Array.map (fun pi -> pi.PropertyType) if itemTypes.Length > 1 then let values = readElements(reader, itemTypes, serializer) advance reader FSharpValue.MakeUnion(uci, List.toArray values, true) else let value = serializer.Deserialize(reader, itemTypes.[0]) advance reader FSharpValue.MakeUnion(uci, [|value|], true) | JsonToken.Null -> null // for { "union": null } | _ -> failwith "invalid token" | true, Kind.MapOrDictWithNonStringKey -> let mapTypes = t.GetGenericArguments() let mapSerializer = typedefof>.MakeGenericType mapTypes let mapDeserializeMethod = mapSerializer.GetMethod("Deserialize") mapDeserializeMethod.Invoke(null, [| t; reader; serializer |]) | true, Kind.Other when isRegisteredParentType t -> let inheritedTypes = inheritedConverterTypes.[t.FullName] let jObject = JObject.Load(reader) let jsonFields = jObject.Properties() |> Seq.map (fun prop -> prop.Name) |> List.ofSeq let inheritedType = inheritedTypeQuickAccessor.GetOrAdd((t.FullName,jsonFields),fun (_,jsonFields) -> let findType (jsonFields: seq) = inheritedTypes |> Seq.maxBy (fun tp -> let fields = let properties = tp.GetProperties() |> Array.filter(fun prop -> prop.CanWrite) |> Array.map (fun prop -> prop.Name) if properties.Length > 0 then properties else tp.GetFields() |> Array.map (fun fd -> fd.Name) let fieldsLength = Seq.length fields (jsonFields |> Seq.filter(fun jsonField -> Seq.contains jsonField fields ) |> Seq.length),-fieldsLength ) findType jsonFields ) // printfn "found inherited type %s with jsonFields %A" inheritedType.FullName jsonFields jObject.ToObject(inheritedType,serializer) | true, Kind.Record -> let recordJson = JObject.Load(reader) let recordFields = FSharpType.GetRecordFields(t) let recordValues = Array.init recordFields.Length <| fun index -> let recordField = recordFields.[index] let fieldType = recordField.PropertyType let fieldName = recordField.Name match recordJson.TryGetValue fieldName with | true, fieldValueJson -> fieldValueJson.ToObject(fieldType, serializer) | false, _ -> DefaultValue.fromType fieldType FSharpValue.MakeRecord(t, recordValues) | true, _ -> serializer.Deserialize(reader, t) ================================================ FILE: LiteDB.FSharp/Linq.fs ================================================ namespace LiteDB.FSharp open System.Linq.Expressions open System open Microsoft.FSharp.Linq.RuntimeHelpers open Microsoft.FSharp.Quotations module Linq = let convertExpr (expr : Expr<'a -> 'b>) = let linq = LeafExpressionConverter.QuotationToExpression expr let call = linq :?> MethodCallExpression let lambda = call.Arguments.[0] :?> LambdaExpression Expression.Lambda>(lambda.Body, lambda.Parameters) [] type Expr = static member prop(exp:Expression>) = exp ================================================ FILE: LiteDB.FSharp/LiteDB.FSharp.fsproj ================================================  Advanced F# Support for LiteDB (v4.x) with query construction through quotation expressions netstandard2.0 true https://github.com/Zaid-Ajaj/LiteDB.FSharp.git https://github.com/Zaid-Ajaj/LiteDB.FSharp https://github.com/Zaid-Ajaj/LiteDB.FSharp/blob/master/LICENSE fsharp;litedb;embedded;database;document-database Zaid Ajaj 2.16.0 Support tuple conversion, single union as ID. Don't touch DateTime when persisting the values ================================================ FILE: LiteDB.FSharp/Patterns.fs ================================================ namespace LiteDB.FSharp open Quotations.Patterns open FSharp.Reflection module Patterns = open System.Reflection let rec (|UnionValue|_|) = function | NewUnionCase(info, [ ]) -> FSharpValue.MakeUnion(info, [| |]) |> Some | NewUnionCase(info, [ ProvidedValue(value) ]) -> FSharpValue.MakeUnion(info, [| value |]) |> Some | NewUnionCase(info, [ ProvidedValue(arg1); ProvidedValue(arg2); ]) -> FSharpValue.MakeUnion(info, [| arg1; arg2; |]) |> Some | NewUnionCase(info, [ ProvidedValue(arg1); ProvidedValue(arg2); ProvidedValue(arg3) ]) -> FSharpValue.MakeUnion(info, [| arg1; arg2; arg3 |]) |> Some | NewUnionCase(info, [ ProvidedValue(arg1); ProvidedValue(arg2); ProvidedValue(arg3); ProvidedValue(arg4) ]) -> FSharpValue.MakeUnion(info, [| arg1; arg2; arg3; arg4 |]) |> Some | NewUnionCase(info, [ ProvidedValue(arg1); ProvidedValue(arg2); ProvidedValue(arg3); ProvidedValue(arg4); ProvidedValue(arg5) ]) -> FSharpValue.MakeUnion(info, [| arg1; arg2; arg3; arg4; arg4 |]) |> Some | _ -> None and (|NewObjectValue|_|) = function | NewObject(ctorInfo, [ ]) -> System.Activator.CreateInstance(ctorInfo.DeclaringType) |> Some | NewObject(ctorInfo, [ ProvidedValue(arg1); ProvidedValue(arg2) ]) -> System.Activator.CreateInstance(ctorInfo.DeclaringType, arg1, arg2) |> Some | NewObject(ctorInfo, [ ProvidedValue(arg1); ProvidedValue(arg2); ProvidedValue(arg3) ]) -> System.Activator.CreateInstance(ctorInfo.DeclaringType, arg1, arg2, arg3) |> Some | NewObject(ctorInfo, [ ProvidedValue(arg1); ProvidedValue(arg2); ProvidedValue(arg3); ProvidedValue(arg4) ]) -> System.Activator.CreateInstance(ctorInfo.DeclaringType, arg1, arg2, arg3, arg4) |> Some | NewObject(ctorInfo, [ ProvidedValue(arg1); ProvidedValue(arg2); ProvidedValue(arg3); ProvidedValue(arg4); ProvidedValue(arg5) ]) -> System.Activator.CreateInstance(ctorInfo.DeclaringType, arg1, arg2, arg3, arg4, arg5) |> Some | NewObject(ctorInfo, [ ProvidedValue(arg1); ProvidedValue(arg2); ProvidedValue(arg3); ProvidedValue(arg4); ProvidedValue(arg5); ProvidedValue(arg6) ]) -> System.Activator.CreateInstance(ctorInfo.DeclaringType, arg1, arg2, arg3, arg4, arg5, arg6) |> Some | _ -> None and (|RecordValue|_|) = function | NewRecord(recordType, [ ProvidedValue(field) ]) -> FSharpValue.MakeRecord(recordType, [| field |]) |> Some | NewRecord(recordType, [ ProvidedValue(arg1); ProvidedValue(arg2); ]) -> FSharpValue.MakeRecord(recordType, [| arg1; arg2; |]) |> Some | NewRecord(recordType, [ ProvidedValue(arg1); ProvidedValue(arg2); ProvidedValue(arg3); ]) -> FSharpValue.MakeRecord(recordType, [| arg1; arg2; arg3 |]) |> Some | NewRecord(recordType, [ ProvidedValue(arg1); ProvidedValue(arg2); ProvidedValue(arg3); ProvidedValue(arg4) ]) -> FSharpValue.MakeRecord(recordType, [| arg1; arg2; arg3; arg4 |]) |> Some | NewRecord(recordType, [ ProvidedValue(arg1); ProvidedValue(arg2); ProvidedValue(arg3); ProvidedValue(arg4); ProvidedValue(arg5) ]) -> FSharpValue.MakeRecord(recordType, [| arg1; arg2; arg3; arg4; arg4 |]) |> Some | _ -> None and (|Tuples|_|) = function | NewTuple [ProvidedValue(arg1); ProvidedValue(arg2)] -> Some (box [arg1; arg2]) | NewTuple [ProvidedValue(arg1); ProvidedValue(arg2); ProvidedValue(arg3)] -> Some (box [arg1; arg2; arg3]) | NewTuple [ProvidedValue(arg1); ProvidedValue(arg2); ProvidedValue(arg3); ProvidedValue(arg4)] -> Some (box [arg1; arg2; arg3; arg4]) | NewTuple [ProvidedValue(arg1); ProvidedValue(arg2); ProvidedValue(arg3); ProvidedValue(arg4); ProvidedValue(arg5)] -> Some (box [arg1; arg2; arg3; arg4; arg5]) | _ -> None and (|PropertyGetter|_|) = function | PropertyGet (Some (ValueWithName(value, valueType, name)), propInfo, []) -> Some (propInfo.GetValue(value)) | PropertyGet (Some (ProvidedValue(value)), propInfo, []) -> Some (propInfo.GetValue(value)) | _ -> None and (| ProvidedValue |_|) = function | Value(value, _ ) -> Some value | ValueWithName(value, _, _) -> Some value | UnionValue value -> Some value | RecordValue value -> Some value | Tuples value -> Some value | NewObjectValue value -> Some value | PropertyGetter value -> Some value | _ -> None let (|NestedPropertyNameGetter|_|) expr = let rec loop accum expr = match expr with | PropertyGet (expr, propInfo, _) -> match expr with | Some expr -> loop ((propInfo.Name) :: accum) expr | None -> propInfo.Name :: accum | _ -> accum match loop [] expr with | [] -> None | propsNames -> Some (String.concat "." propsNames) let (|LogicOp|_|) (info: MethodInfo) = match info.Name with | "op_Equality" -> Some "=" | "op_NotEqual" -> Some "<>" | "op_GreaterThan" -> Some ">" | "op_LessThan" -> Some "<" | "op_GreaterThanOrEqual" -> Some ">=" | "op_LessThanOrEqual" -> Some "<=" | otherwise -> None let (|StringOp|_|) (info: MethodInfo) = match info.DeclaringType.FullName ,info.Name with | "System.String", name -> Some name | _, _ -> None let (|CoreOp|_|) (info: MethodInfo) = match info.DeclaringType.FullName, info.Name with | "Microsoft.FSharp.Core.Operators", "Not" -> Some "not" | _ -> None let (|PropertyEqual|_|) = function | Call(_, LogicOp "=", [NestedPropertyNameGetter(name); ProvidedValue(value)]) -> Some (name, value) | otherwise -> None let (|PropertyNotEqual|_|) = function | Call(_, LogicOp "<>", [NestedPropertyNameGetter(name); ProvidedValue(value)]) -> Some (name, value) | otherwise -> None let (|NotProperty|_|) = function | Call(_, CoreOp "not", [expr]) -> Some expr | _ -> None let (|ProperyGreaterThan|_|) = function | Call(_, LogicOp ">", [NestedPropertyNameGetter(name); ProvidedValue(value)]) -> Some (name, value) | otherwise -> None let (|StringNullOrWhiteSpace|_|) = function | Call(_, StringOp "IsNullOrWhiteSpace", [NestedPropertyNameGetter(name)]) -> Some (name) | otherwise -> None let (|StringIsNullOrEmpty|_|) = function | Call(_, StringOp "IsNullOrEmpty", [NestedPropertyNameGetter(name)]) -> Some (name) | otherwise -> None let (|StringContains|_|) = function | Call(Some (NestedPropertyNameGetter(name)), StringOp "Contains",[ProvidedValue(value)]) -> Some (name, value) | otherwise -> None let (|ProperyGreaterThanOrEqual|_|) = function | Call(_, LogicOp ">=", [NestedPropertyNameGetter(name); ProvidedValue(value)]) -> Some (name, value) | otherwise -> None let (|PropertyLessThan|_|) = function | Call(_, LogicOp "<", [NestedPropertyNameGetter(name); ProvidedValue(value)]) -> Some (name, value) | otherwise -> None let (|BooleanGet|_|) = function | NestedPropertyNameGetter(name) -> Some name | otherwise -> None let (|PropertyLessThanOrEqual|_|) = function | Call(_, LogicOp "<=", [NestedPropertyNameGetter(name); ProvidedValue(value)]) -> Some (name, value) | otherwise -> None let (|Boolean|_|) = tryUnbox let (|LiteralBooleanValue|_|) = function | Value(Boolean(value), _) -> Some value | otherwise -> None let (|And|_|) = function | IfThenElse (left, right, Value(Boolean(false), _)) -> Some (left, right) | otherwise -> None let (|Or|_|) = function | IfThenElse (left, Value(Boolean(true), _), right) -> Some (left, right) | otherwise -> None ================================================ FILE: LiteDB.FSharp/Query.fs ================================================ namespace LiteDB.FSharp open System open Microsoft.FSharp.Quotations open Microsoft.FSharp.Quotations.Patterns open LiteDB open Microsoft.FSharp.Reflection open Cache module Query = let internal mapper = FSharpBsonMapper() let rec createQueryFromExpr<'t> (expr: Expr) : Query = match expr with | Patterns.PropertyEqual (("Id" | "id" | "ID"), value) when FSharpType.IsUnion (value.GetType()) -> Query.EQ("_id", Bson.serializeField value) | Patterns.PropertyEqual (("Id" | "id" | "ID"), value) -> Query.EQ("_id", BsonValue value) | Patterns.PropertyNotEqual (("Id" | "id" | "ID"), value) -> Query.Not(Query.EQ("_id", BsonValue(value))) | Patterns.ProperyGreaterThan (("Id" | "id" | "ID"), value) -> Query.GT("_id", BsonValue(value)) | Patterns.ProperyGreaterThanOrEqual (("Id" | "id" | "ID"), value) -> Query.GTE("_id", BsonValue(value)) | Patterns.PropertyLessThan (("Id" | "id" | "ID"), value) -> Query.LT("_id", BsonValue(value)) | Patterns.PropertyLessThanOrEqual (("Id" | "id" | "ID"), value) -> Query.LTE("_id", BsonValue(value)) | Patterns.StringContains (propName, value) -> Query.Where(propName, fun bsonValue -> bsonValue |> Bson.deserializeField |> fun strValue -> strValue.Contains(unbox value)) | Patterns.StringNullOrWhiteSpace propName -> Query.Where(propName, fun bsonValue -> bsonValue |> Bson.deserializeField |> String.IsNullOrWhiteSpace) | Patterns.StringIsNullOrEmpty propName -> Query.Where(propName, fun bsonValue -> bsonValue |> Bson.deserializeField |> String.IsNullOrEmpty) | Patterns.PropertyEqual (propName, value) when isConvertableUnionType (value.GetType()) -> Query.EQ(propName, Bson.serializeField value) | Patterns.PropertyEqual (propName, value) when FSharpType.IsRecord (value.GetType()) -> Query.EQ(propName, Bson.serializeField value) | Patterns.PropertyEqual (propName, value) when (value.GetType().IsEnum) -> let bson = match Type.GetTypeCode(value.GetType().GetEnumUnderlyingType()) with | TypeCode.Byte -> BsonValue(value :?> Byte ) | TypeCode.Decimal -> BsonValue(value :?> Decimal) | TypeCode.Double -> BsonValue(value :?> Double ) | TypeCode.Single -> BsonValue(value :?> Single ) | TypeCode.Int16 -> BsonValue(value :?> Int16 ) | TypeCode.Int32 -> BsonValue(value :?> Int32 ) | TypeCode.Int64 -> BsonValue(value :?> Int64 ) | TypeCode.UInt16 -> BsonValue(value :?> UInt16 ) | TypeCode.UInt64 -> BsonValue(value :?> UInt64 ) | TypeCode.UInt32 -> BsonValue(value :?> UInt32 ) | TypeCode.SByte -> BsonValue(value :?> SByte ) | tpCode -> failwithf "tpCode %A is not an enum underlying type" tpCode Query.EQ(propName, bson) | Patterns.PropertyEqual (propName, value) -> Query.EQ(propName, BsonValue(value)) | Patterns.PropertyNotEqual (propName, value) -> Query.Not(Query.EQ(propName, BsonValue(value))) | Patterns.LiteralBooleanValue value -> Query.Where("_id", fun id -> value) | Patterns.ProperyGreaterThan (propName, value) -> Query.GT(propName, BsonValue(value)) | Patterns.ProperyGreaterThanOrEqual (propName, value) -> Query.GTE(propName, BsonValue(value)) | Patterns.PropertyLessThan (propName, value) -> Query.LT(propName, BsonValue(value)) | Patterns.PropertyLessThanOrEqual (propName, value) -> Query.LTE(propName, BsonValue(value)) | Patterns.BooleanGet (propName) -> Query.EQ(propName, BsonValue(true)) | Patterns.And (left, right) -> let queryLeft = createQueryFromExpr left let queryRight = createQueryFromExpr right Query.And(queryLeft, queryRight) | Patterns.Or (left, right) -> let queryLeft = createQueryFromExpr left let queryRight = createQueryFromExpr right Query.Or(queryLeft, queryRight) | Patterns.NotProperty (innerExpr) -> let innerQuery = createQueryFromExpr innerExpr Query.Not(innerQuery) | Lambda (_, expr) -> createQueryFromExpr expr | otherwise -> let serialziedExpr = sprintf "%A" otherwise failwithf "Failed to construct a query from the expression: \n%s\n" serialziedExpr ================================================ FILE: LiteDB.FSharp/TypeShapeMapper.fs ================================================ namespace LiteDB.FSharp module Experimental= open LiteDB open System open TypeShape.Core open TypeShape.Core.Utils open LiteDB.FSharp type Convert<'t> = { To : 't -> BsonValue; From : BsonValue -> 't } [] module Impl = let inline delay (f : unit -> 'T) : BsonValue -> 'T = fun _ -> f() let toKey (x : string) = if (x.ToLower() = "id") then "_id" else x.Trim('@') let private locker = new obj() let private ctx = new TypeGenerationContext() let rec private genPickler<'T> : unit -> Convert<'T> = fun () -> lock locker (fun () -> genPicklerCached<'T> ctx) and private genPicklerCached<'T> (ctx : TypeGenerationContext) : Convert<'T> = let delay (c : Cell>) : Convert<'T> = { To = fun sb -> c.Value.To sb From = fun x -> c.Value.From x } match ctx.InitOrGetCachedValue> delay with | Cached(value = f) -> f | NotCached t -> let p = genPicklerAux<'T> ctx ctx.Commit t p and private genPicklerAux<'T> (ctx : TypeGenerationContext) : Convert<'T> = let mkParser (parser : 't -> BsonValue) (writer : BsonValue -> 't) : Convert<'T> = { To = fun x -> (unbox parser) x From = fun x -> (unbox writer) x } let mkMemberPickler (shape : IShapeMember<'Class>) = shape.Accept { new IMemberVisitor<'Class, ('Class -> BsonValue) * (BsonValue -> 'Class -> 'Class)> with member __.Visit(shape : ShapeMember<'Class, 'Field>) = let fP = genPicklerCached<'Field> ctx let printer = fun x -> shape.Get x |> fP.To let parser = fun (bson : BsonValue) -> if (bson.IsDocument) then let doc = bson.AsDocument fun x -> let res = shape.Set x (fP.From doc.[toKey shape.Label]) res else fun x -> x printer, parser } let combineMemberPicklers (v : BsonValue -> 'Class) (members : IShapeMember<'Class> []) = let (printers, parsers) = members |> Array.map mkMemberPickler |> Array.unzip let names = members |> Array.map (fun x -> x.Label) |> Array.map toKey let printer = fun x -> let doc = new BsonDocument() let arr = printers |> Array.zip names for i in 0..printers.Length - 1 do doc.[names.[i]] <- printers.[i] x arr |> Array.iter (fun (name, printer) -> doc.[name] <- printer x) doc :> BsonValue let parser = fun bson -> let mutable res = v bson for p in parsers do res <- p bson res res mkParser printer parser if (typeof<'T>.Name = typeof.Name) then mkParser (fun x -> x :> BsonValue) (fun x -> x.AsDocument) else match shapeof<'T> with | Shape.Unit -> mkParser (fun _ -> BsonValue.Null) (fun _ -> ()) | Shape.Bool -> mkParser (fun x -> unbox x |> BsonValue) (fun v -> if (v.IsNull) then false else unbox v.RawValue) | Shape.Byte -> mkParser (fun (x : byte) -> x |> BsonValue) (fun v -> unbox v.RawValue) | Shape.Int32 -> mkParser (fun (x : int) -> x |> BsonValue) (fun v -> unbox v.RawValue) | Shape.Int64 -> mkParser (fun x -> unbox x |> BsonValue) (fun v -> unbox v.RawValue) | Shape.String -> mkParser (fun x -> unbox x |> BsonValue) (fun v -> unbox v.RawValue) | Shape.Guid -> mkParser (fun x -> unbox x |> BsonValue) (fun v -> unbox v.RawValue) | Shape.Decimal -> mkParser (fun x -> unbox x |> BsonValue) (fun v -> unbox v.RawValue) | Shape.Double -> mkParser (fun x -> unbox x |> BsonValue) (fun v -> unbox v.RawValue) | Shape.DateTime -> mkParser (fun x -> unbox x |> BsonValue) (fun v -> unbox v.RawValue) | Shape.FSharpOption s -> s.Element.Accept { new ITypeVisitor> with member __.Visit<'t>() = let tP = genPicklerCached<'t> ctx let printer = function | None -> BsonValue.Null | Some t -> tP.To t let parser = fun (v : BsonValue) -> let vv = if (not v.IsNull) then tP.From v |> Some else None vv mkParser printer parser } | Shape.FSharpList s -> s.Element.Accept { new ITypeVisitor> with member __.Visit<'t>() = let eP = genPicklerCached<'t> ctx let printer (x : 't list) = let ts = x let res = ResizeArray(ts.Length) for t in ts do res.Add(eP.To t) res |> BsonArray :> BsonValue let parser = fun (v : BsonValue) -> if (v.IsArray) then v.AsArray |> Seq.map eP.From |> List.ofSeq else [] mkParser printer parser } | Shape.Enum s -> s.Accept { new IEnumVisitor> with member __.Visit<'t, 'u when 't : enum<'u> and 't : struct and 't :> ValueType and 't : (new : unit -> 't)>() = let eP = genPicklerCached<'t> ctx let printer = fun x -> let ts = unbox<'t> x |> LanguagePrimitives.EnumToValue ts |> BsonValue let parser = fun (v : BsonValue) -> let res : 't = LanguagePrimitives.EnumOfValue(unbox<'u> v.RawValue) res mkParser printer parser } | Shape.ByteArray as s -> s.Accept { new ITypeVisitor> with member __.Visit<'t>() = let eP = genPicklerCached<'t> ctx let printer = fun x -> let ts = unbox x ts |> BsonValue let parser = fun (v : BsonValue) -> if (v.IsBinary) then v.AsBinary else [||] mkParser printer parser } | Shape.Array s when s.Rank = 1 -> s.Element.Accept { new ITypeVisitor> with member __.Visit<'t>() = let eP = genPicklerCached<'t> ctx let printer = fun x -> let ts = unbox<'t array> x ts |> Array.map eP.To |> BsonArray :> BsonValue let parser = fun (v : BsonValue) -> if (v.IsArray) then v.AsArray |> Seq.map eP.From |> Array.ofSeq else [||] mkParser printer parser } | Shape.FSharpMap s -> s.Accept { new IFSharpMapVisitor> with member __.Visit<'k, 'v when 'k : comparison>() = let kp = genPicklerCached<'k> ctx let vp = genPicklerCached<'v> ctx let printer = fun x -> let m = unbox> x let mutable doc = new BsonDocument() let res = ResizeArray(m.Count) for (kv) in m do let doc = new BsonDocument() doc.["key"] <- kp.To kv.Key doc.["value"] <- vp.To kv.Value res.Add doc doc.["values"] <- BsonArray res doc :> BsonValue let parser = fun (v : BsonValue) -> if (v.IsDocument) then let d = v.AsDocument if (d.ContainsKey "values") then let arr = v.AsDocument.["values"].AsArray let mutable map = Map.empty for v in arr do let d = v.AsDocument map <- map |> Map.add (kp.From d.["key"]) (vp.From d.["value"]) map else Map.empty else Map.empty mkParser printer parser } | Shape.Tuple(:? (ShapeTuple<'T>) as shape) -> combineMemberPicklers (delay shape.CreateUninitialized) shape.Elements | Shape.FSharpRecord(:? (ShapeFSharpRecord<'T>) as shape) -> combineMemberPicklers (delay shape.CreateUninitialized) shape.Fields | Shape.FSharpUnion(:? (ShapeFSharpUnion<'T>) as shape) -> let mkUnionCaseInfo (case : ShapeFSharpUnionCase<'T>) = let hasFields = case.Fields.Length > 0 let init = delay case.CreateUninitialized let pickler = combineMemberPicklers (init) case.Fields let printer = fun x -> if (hasFields) then let doc = new BsonDocument() doc.["__case"] <- case.CaseInfo.Name |> BsonValue doc.["Items"] <- pickler.To x doc |> BsonValue else (case.CaseInfo.Name |> BsonValue) let parser = fun v -> if (hasFields) then pickler.From v else init v mkParser printer parser let caseInfo = shape.UnionCases |> Array.map mkUnionCaseInfo { To = fun x -> let tag = shape.GetTag x let printer = caseInfo.[tag] printer.To x From = fun v -> if (v.IsDocument) then let doc = v.AsDocument let case = doc.["__case"].AsString let index = shape.UnionCases |> Array.findIndex (fun x -> x.CaseInfo.Name = case) let v = doc.[case] let printer = caseInfo.[index] printer.From doc.["Items"] else if (v.IsString) then let str = v.AsString let index = shape.UnionCases |> Array.findIndex (fun x -> x.CaseInfo.Name = str) let printer = caseInfo.[index] printer.From v else raise (ArgumentException("Invalid type!!!")) } | Shape.Poco((:? (ShapePoco<'T>) as shape)) -> combineMemberPicklers (delay shape.CreateUninitialized) (shape.Fields |> Array.filter (fun s -> s.IsPublic)) | _ -> failwithf "unsupported type '%O'" typeof<'T> type TypeShapeMapper() = inherit FSharpBsonMapper() override self.ToObject(entityType : System.Type, entity : BsonDocument) = Bson.deserializeByType entity entityType override self.ToObject<'t>(entity : BsonDocument) = try let pickler = genPickler<'t>() let res = pickler.From(entity :> BsonValue) res with exn -> Bson.deserialize<'t> entity override self.ToDocument<'t>(entity : 't) = try let pickler = genPickler<'t>() let res = (pickler.To entity) :?> BsonDocument res with exn -> if typeof<'t>.FullName = typeof.FullName then entity |> unbox else base.ToDocument entity ================================================ FILE: LiteDB.FSharp.Build/Files.fs ================================================ [] module Files open System.IO open System.Linq /// Recursively tries to find the parent of a file starting from a directory let rec findParent (directory: string) (fileToFind: string) = let path = if Directory.Exists(directory) then directory else Directory.GetParent(directory).FullName let files = Directory.GetFiles(path) if files.Any(fun file -> Path.GetFileName(file).ToLower() = fileToFind.ToLower()) then path else findParent (DirectoryInfo(path).Parent.FullName) fileToFind ================================================ FILE: LiteDB.FSharp.Build/LiteDB.FSharp.Build.fsproj ================================================  Exe net5.0 ================================================ FILE: LiteDB.FSharp.Build/Program.fs ================================================ module Program open System open System.IO open Fake.IO open Fake.Core let path xs = Path.Combine(Array.ofList xs) let solutionRoot = Files.findParent __SOURCE_DIRECTORY__ "LiteDB.FSharp.sln"; let src = path [ solutionRoot; "LiteDB.FSharp" ] let tests = path [ solutionRoot; "LiteDB.FSharp.Tests" ] let test() = if Shell.Exec(Tools.dotnet, "run", tests) <> 0 then failwith "tests failed" let build() = if Shell.Exec(Tools.dotnet, "build --configuration Release", solutionRoot) <> 0 then failwith "tests failed" let pack() = Shell.deleteDir (path [ "src"; "bin" ]) Shell.deleteDir (path [ "src"; "obj" ]) if Shell.Exec(Tools.dotnet, "pack --configuration Release", src) <> 0 then failwith "Pack failed" let publish() = Shell.deleteDir (path [ src; "bin" ]) Shell.deleteDir (path [ src; "obj" ]) if Shell.Exec(Tools.dotnet, "pack --configuration Release", src) <> 0 then failwith "Pack failed" else let nugetKey = match Environment.environVarOrNone "NUGET_KEY" with | Some nugetKey -> nugetKey | None -> failwith "The Nuget API key must be set in a NUGET_KEY environmental variable" let nugetPath = Directory.GetFiles(path [ src; "bin"; "Release" ]) |> Seq.head |> Path.GetFullPath if Shell.Exec(Tools.dotnet, sprintf "nuget push %s -s nuget.org -k %s" nugetPath nugetKey, src) <> 0 then failwith "Publish failed" [] let main (args: string[]) = try match args with | [| "build" |] -> build() | [| "test" |] -> test() | [| "pack" |] -> pack() | [| "publish" |] -> publish() | _ -> printfn "Unknown args %A" args 0 with ex -> printfn "%A" ex 1 ================================================ FILE: LiteDB.FSharp.Build/Tools.fs ================================================ [] module Tools open System open System.IO open Fake.Core module CreateProcess = /// Creates a cross platfrom command from the given program and arguments. /// /// For example: /// /// ```fsharp /// CreateProcess.xplatCommand "npm" [ "install" ] /// ``` /// /// Will be the following on windows /// /// ```fsharp /// CreateProcess.fromRawCommand "cmd" [ "/C"; "npm"; "install" ] /// ``` /// And the following otherwise /// /// ```fsharp /// CreateProcess.fromRawCommand "npm" [ "install" ] /// ``` let xplatCommand program args = let program', args' = if Environment.isWindows then "cmd", List.concat [ [ "/C"; program ]; args ] else program, args CreateProcess.fromRawCommand program' args' let executablePath (tool: string) = let locator = if Environment.isWindows then "C:\Windows\System32\where.exe" else "/usr/bin/which" let locatorOutput = CreateProcess.xplatCommand locator [ tool ] |> CreateProcess.redirectOutput |> Proc.run if locatorOutput.ExitCode <> 0 then failwithf "Could not determine the executable path of '%s'" tool locatorOutput.Result.Output |> String.splitStr Environment.NewLine |> List.filter (fun path -> (Environment.isWindows && Path.HasExtension(path)) || Environment.isUnix) |> List.tryFind File.Exists |> function | Some executable -> executable | None -> failwithf "The executable paht '%s' was not found" tool let dotnet = executablePath "dotnet" ================================================ FILE: LiteDB.FSharp.Tests/LiteDB.FSharp.Tests.fsproj ================================================ Exe net5.0 ================================================ FILE: LiteDB.FSharp.Tests/Tests.Bson.fs ================================================ module Tests.Bson open Expecto open System open System.IO open LiteDB open LiteDB.FSharp open Tests.Types let pass() = Expect.isTrue true "passed" let fail() = Expect.isTrue false "failed" let bsonConversions = testList "Bson conversions" [ testCase "Fields are mapped correctly with indetifier Id" <| fun _ -> let person = { Id = 1; Name = "Mike" } let doc = Bson.serialize person Expect.equal 2 doc.Keys.Count "Generated BSON document has 2 keys" Expect.equal (Bson.readInt "_id" doc) 1 "_id property is serialized correctly" Expect.equal (Bson.readStr "Name" doc) "Mike" "Name property is serialized correctly" testCase "Fields are mapped correctly with indetifier lowercase id" <| fun _ -> let record = { id = 1; age = 19 } let doc = Bson.serialize record Expect.equal 2 doc.Keys.Count "Generated BSON document has 2 keys" Expect.equal (Bson.readInt "_id" doc) 1 "_id is serialized correctly" Expect.equal (Bson.readInt "age" doc) 19 "age property is serialized correctly" testCase "Members are ignored when persisted" <| fun _ -> let record : RecWithMember = { Id = 1; Name = "John" } let doc = Bson.serialize record Expect.equal 2 doc.Keys.Count "Generated BSON document has 2 keys" Expect.isTrue (doc.ContainsKey "_id") "Document has _id key" Expect.isTrue (doc.ContainsKey "Name") "Document has name key" testCase "simple records with lowercase id" <| fun _ -> let record = { id = 1; age = 19 } let doc = Bson.serialize record match Bson.deserialize doc with | { id = 1; age = 19 } -> pass() | otherwise -> fail() testCase "Bson serialization and deserialization of ObjectId works" <| fun _ -> let id = ObjectId.NewObjectId() let record = { id = id } let doc = Bson.serialize record match Bson.deserialize doc with | { id = x } when x = id -> pass() | otherwise -> fail() testCase "records with float" <| fun _ -> let record = {id = 1; float = 8.5039370078740166} let doc = Bson.serialize record match Bson.deserialize doc with | {id = 1; float = 8.5039370078740166} -> pass() | otherwise -> fail() testCase "records with enum" <| fun _ -> let record = { id = 1; color = ConsoleColor.Gray } let doc = Bson.serialize record match Bson.deserialize doc with | { id = 1; color = ConsoleColor.Gray } -> pass() | otherwise -> fail() testCase "records with decimals" <| fun _ -> let record = { id = 1; number = 20.0M } let doc = Bson.serialize record match Bson.deserialize doc with | { id = 1; number = 20.0M } -> pass() | otherwise -> fail() testCase "Records with maps containing DU's" <| fun _ -> let properties : Map = [ "age", Num 20; "firstName", Value.String "John"] |> Map.ofList let record : RecordWithMapDU = { Id = 1; Properties = properties } let doc = Bson.serialize record match Bson.deserialize doc with | record' when record' = record -> pass() | otherwise -> fail() testCase "records with guid" <| fun _ -> let guidValue = Guid.NewGuid() let record = { id = 1; guid = guidValue } let doc = Bson.serialize record match Bson.deserialize doc with | { id = 1; guid = value } -> match value = guidValue with | true -> pass() | false -> fail() | otherwise -> fail() testCase "records with long/int64" <| fun _ -> let record = { id = 1; long = 20L } let doc = Bson.serialize record match Bson.deserialize doc with | { id = 1; long = 20L } -> pass() | otherwise -> fail() testCase "record with array" <| fun _ -> let record: RecordWithArray = { id = 1; arr = [| 1 .. 5 |] } let doc = Bson.serialize record match Bson.deserialize doc with | { id = 1; arr = [| 1;2;3;4;5 |] } -> pass() | otherwise -> fail() testCase "record with optional array" <| fun _ -> let recordNone = { id = 1; arr = None } let docNone = Bson.serialize recordNone match Bson.deserialize docNone with | { id = 1; arr = None } -> pass() | otherwise -> fail() let recordSome = { id = 1; arr = Some([| 1 .. 5 |]) } let docSome = Bson.serialize recordSome match Bson.deserialize docSome with | { id = 1; arr = Some([| 1;2;3;4;5 |]) } -> pass() | otherwise -> fail() testCase "record with resizeArray" <| fun _ -> let record: RecordWithResizeArray = { id = 1; resizeArray = ResizeArray [ 1 .. 5 ] } let doc = Bson.serialize record let result = Bson.deserialize doc match result.id, List.ofSeq result.resizeArray with | 1, [ 1;2;3;4;5 ] -> pass() | otherwise -> fail() testCase "record with map" <| fun _ -> let map = Map.empty |> Map.add "Hello" "There" |> Map.add "Anyone" "Here" let record = { id = 1; map = map } let doc = Bson.serialize record match Bson.deserialize doc with | { id = 1; map = x } -> match x.["Hello"], x.["Anyone"] with | "There", "Here" -> pass() | otherwise -> fail() | otherwisee -> fail() testCase "simple records" <| fun _ -> let person = { Id = 1; Name = "Mike" } let doc = Bson.serialize person let reincarnated = Bson.deserialize doc match reincarnated with | { Id = 1; Name = "Mike" } -> pass() | otherwise -> fail() testCase "records with DateTime" <| fun _ -> let time = DateTime(2017, 10, 15, 10, 15, 0) let record = { id = 1; created = time } let doc = Bson.serialize record match Bson.deserialize doc with | { id = 1; created = timeCreated } -> Expect.equal 2017 timeCreated.Year "Year is mapped correctly" Expect.equal 10 timeCreated.Month "Month is mapped correctly" Expect.equal 15 timeCreated.Day "Day is mapped correctly" Expect.equal 10 timeCreated.Hour "Hour is mapped correctly" Expect.equal 15 timeCreated.Minute "Minute is mapped correctly" Expect.equal 0 timeCreated.Second "Second is mapped correctly" | otherwise -> fail() testCase "Bson.readDate works" <| fun _ -> let time = DateTime(2017, 10, 15, 10, 15, 0) let record = { id = 1; created = time } let doc = Bson.serialize record let deserialized = Bson.readDate "created" doc Expect.equal time.Year deserialized.Year "Year is correctly read" Expect.equal time.Month deserialized.Month "Month is correctly read" Expect.equal time.Day deserialized.Day "Day is correctly read" Expect.equal time.Hour deserialized.Hour "Hour is mapped correctly" Expect.equal time.Minute deserialized.Minute "Minute is mapped correctly" Expect.equal time.Second deserialized.Second "Second is mapped correctly" testCase "records with unions" <| fun _ -> let fstRecord = { Id = 1; Union = One } let sndRecord = { Id = 2; Union = Two } let fstDoc, sndDoc = Bson.serialize fstRecord, Bson.serialize sndRecord match Bson.deserialize fstDoc with | { Id = 1; Union = One } -> pass() | otherwise -> fail() match Bson.deserialize sndDoc with | { Id = 2; Union = Two } -> pass() | otherwise -> fail() testCase "records with single private case union" <| fun _ -> let record = { Id = 1; YoungPerson = YoungPerson.Create ("Mike", 30, PhoneNumber.Create 16511825922L) } let doc = Bson.serialize record match Bson.deserialize doc with | { Id = 1; YoungPerson = youngPerson } -> match youngPerson.Name, youngPerson.Age, youngPerson.PhoneNumber.Value with | "Mike", 30, 16511825922L -> pass() | _ -> fail() | _ -> fail() testCase "multiple private case unions in records is not convertable" <| fun _ -> #if DEBUG pass() #endif /// mark RELEASE to make Debugger happy #if RELEASE let record = { Id = 1; Size = Size.CreateEUR 40. } let doc = Bson.serialize record try Bson.deserialize doc |> ignore fail() with ex -> /// multiple private case unions is not convertable pass() #endif testCase "records with lists" <| fun _ -> let fstRecord = { Id = 1; List = [1 .. 10] } let doc = Bson.serialize fstRecord match Bson.deserialize doc with | { Id = 1; List = xs } -> match Seq.sum xs with | 55 -> pass() | otherwise -> fail() | otherwise -> fail() testCase "record with generic union" <| fun _ -> let record = { Id = 1; GenericUnion = Just "kidding" } let doc = Bson.serialize record match Bson.deserialize> doc with | { Id = 1; GenericUnion = Just "kidding" } -> pass() | otherwise -> fail() testCase "records with complex unions" <| fun _ -> let shape = Composite [ Circle 2.0; Composite [ Circle 4.0; Rect(2.0, 5.0) ] ] let record = { Id = 1; Shape = shape } let doc = Bson.serialize record match Bson.deserialize doc with | { Id = 1; Shape = deserialized } -> match deserialized = shape with | true -> pass() | false -> fail() | otherwise -> fail() testCase "Reading Bson values as DateTime works" <| fun _ -> let record = { id = 1; created = DateTime(2017, 10, 15, 10, 20, 45) } let doc = Bson.serialize record let createdField = Bson.read "created" doc let created1 = Bson.readDate "created" doc let created2 = Bson.deserializeField createdField Expect.equal created1.Year 2017 "Year is deserialized correctly" Expect.equal created2.Year 2017 "Year is deserialized correctly" Expect.equal created1.Month 10 "Month is deserialized correctly" Expect.equal created2.Month 10 "Month is deserialized correctly" Expect.equal created1.Day 15 "Day is deserialized correctly" Expect.equal created2.Day 15 "Day is deserialized correctly" Expect.equal created1.Hour 10 "Hour is deserialized correctly" Expect.equal created2.Hour 10 "Hour is deserialized correctly" Expect.equal created1.Minute 20 "Minute is deserialized correctly" Expect.equal created2.Minute 20 "Minute is deserialized correctly" Expect.equal created1.Second 45 "Second is deserialized correctly" Expect.equal created2.Second 45 "Second is deserialized correctly" testCase "Bson (de)serialization for options of value type works when value is None" <| fun _ -> let record = { id = 1; optionOfValueType = None } let doc = Bson.serialize record doc |> Bson.read "optionOfValueType" |> Bson.deserializeField> |> function | None -> pass() | other -> fail() match Bson.deserialize doc with | { id = 1; optionOfValueType = None } -> pass() | otherwise -> fail() testCase "Bson (de)serialization for options of value type works when value is Some" <| fun _ -> let record = { id = 1; optionOfValueType = Some 1 } let doc = Bson.serialize record doc |> Bson.read "optionOfValueType" |> Bson.deserializeField> |> function | Some 1 -> pass() | other -> fail() match Bson.deserialize doc with | { id = 1; optionOfValueType = Some 1 } -> pass() | otherwise -> fail() testCase "Bson (de)serialization for options of reference type works when value is None" <| fun _ -> let record = { id = 1; optionOfReferenceType = None } let doc = Bson.serialize record doc |> Bson.read "optionOfReferenceType" |> Bson.deserializeField> |> function | None -> pass() | other -> fail() match Bson.deserialize doc with | { id = 1; optionOfReferenceType = None } -> pass() | otherwise -> fail() testCase "Bson (de)serialization for options of reference type works when value is Some" <| fun _ -> let record = { id = 1; optionOfReferenceType = Some {Id = 0; Name = "Name"} } let doc = Bson.serialize record doc |> Bson.read "optionOfReferenceType" |> Bson.deserializeField> |> function | Some {Id = 0; Name = "Name"} -> pass() | other -> fail() match Bson.deserialize doc with | { id = 1; optionOfReferenceType = Some {Id = 0; Name = "Name"} } -> pass() | otherwise -> fail() testCase "Binary data is serialized correctly" <| fun _ -> let bytes = Array.map byte [| 1 .. 10 |] let record = {id = 1; data = bytes } let doc = Bson.serialize record // doc = { id: 1, data: { $binary: base64(bytes) } } Bson.read "data" doc |> fun value -> value.AsBinary |> fun xs -> match xs = bytes with | true -> pass() | false -> fail() testCase "Bson deserialization of binary data works" <| fun _ -> let bytes = [| byte 1; byte 2 |] let record = {id = 1; data = bytes } let doc = Bson.serialize record match Bson.deserialize doc with | { id = 1; data = xs } when xs = bytes -> pass() | otherwise -> fail() testCase "Bson (de)serialization of tuple data works" <| fun _ -> let record = {id = 1; tuple = ("Mike", 30) } let doc = Bson.serialize record match Bson.deserialize doc with | { id = 1; tuple = ("Mike", 30) } -> pass() | otherwise -> fail() testCase "(De)serialization of field work" <| fun _ -> let sample = Generic (Just 5) let serialized = Bson.serializeField sample match Bson.deserializeField> serialized with | Generic (Just 5) -> pass() | otherwise -> fail() testCase "deserializing complex union from BsonValue" <| fun _ -> let shape = Composite [ Circle 2.0; Composite [ Circle 4.0; Rect(2.0, 5.0) ] ] let record = { Id = 1; Shape = shape } let doc = Bson.serialize record let serializedShape = Bson.read "Shape" doc let deserializedShape = Bson.deserializeField serializedShape match deserializedShape = shape with | true -> pass() | false -> fail() ] ================================================ FILE: LiteDB.FSharp.Tests/Tests.DBRef.fs ================================================ module Tests.DBRef open Expecto open System open System.IO open LiteDB open LiteDB.FSharp open LiteDB.FSharp.Experimental open Tests.Types open LiteDB.FSharp.Linq open LiteDB.FSharp.Extensions let pass() = Expect.isTrue true "passed" let fail() = Expect.isTrue false "failed" let useDataBase (mapper:FSharpBsonMapper) (f: LiteRepository -> unit) = mapper.DbRef(fun c -> c.Company) mapper.DbRef(fun c -> c.EOrders) use memoryStream = new MemoryStream() use db = new LiteRepository(memoryStream, mapper) f db let dbRefTests mapper= testList "DBRef Tests" [ testCase "CLIType DBRef Token Test" <| fun _ -> useDataBase mapper<| fun db -> let company = { Id = 1; Name = "InitializedCompanyName"} let order = { Id = 1; Company = company; EOrders = []} db |> LiteRepository.insertItem company |> LiteRepository.insertItem order |> LiteRepository.updateItem { Id = 1; Name = "UpdatedCompanyName" } |> LiteRepository.query |> LiteQueryable.expand (Expr.prop (fun o -> o.Company)) |> LiteQueryable.first |> function | { Id = 1; Company = {Id = 1; Name = "UpdatedCompanyName"}; EOrders = []} -> pass() | _ -> fail() testCase "CLIType DBRef token without include Test" <| fun _ -> useDataBase mapper<| fun db -> let company = {Id = 1; Name = "InitializedCompanyName"} let order = { Id = 1; Company = company; EOrders = []} db.Insert(company) |> ignore db.Insert(order) |> ignore let m = db.Query().FirstOrDefault() Expect.equal m.Company.Id 1 "CLIType DBRef NestedId token Test Corrently" testCase "CLIType DBRef NestedId token Test" <| fun _ -> useDataBase mapper<| fun db -> let company = {Id = 1; Name = "InitializedCompanyName"} let order = { Id = 1; Company = company; EOrders = []} db.Insert(company) |> ignore db.Insert(order) |> ignore let m = db.Query().Include(convertExpr <@ fun c -> c.Company @> ).FirstOrDefault() Expect.equal m.Company.Id 1 "CLIType DBRef NestedId token Test Corrently" testCase "CLIType DBRef with List token Test" <| fun _ -> useDataBase mapper<| fun db-> let e1 = {Id = 1; OrderNumRange="test1"; Items = []} let e2 = {Id = 2; OrderNumRange="test2"; Items = []} let order = { Id = 1 Company = { Id = 1; Name ="test"} EOrders = [e1; e2] } db.Insert([e1;e2]) |> ignore db.Insert(order) |> ignore db.Update({ Id = 1 ; OrderNumRange = "Hello"; Items = [] }) |> ignore let m = db.Query().Include(convertExpr <@ fun c -> c.EOrders @>).FirstOrDefault() Expect.equal m.EOrders.[0].OrderNumRange "Hello" "CLIType DBRef with List token Test Corrently" testCase "CLIType DBRef with list NestedId token Test" <| fun _ -> useDataBase mapper<| fun db-> let e1= {Id=1; OrderNumRange="test1"; Items = []} let e2= {Id=2; OrderNumRange="test2"; Items = []} let order= { Id = 1 Company ={Id =1; Name ="test"} EOrders =[e1;e2]} db.Insert([e1;e2]) |> ignore db.Insert(order) |> ignore let m = db.Query().Include(convertExpr <@ fun c -> c.EOrders @>).FirstOrDefault() Expect.equal m.EOrders.[0].Id 1 "CLIType DBRef with list NestedId token Test Corrently" ] ================================================ FILE: LiteDB.FSharp.Tests/Tests.InheritedType.fs ================================================ module Tests.InheritedType open Expecto open System open System.IO open LiteDB open LiteDB.FSharp open Tests.Types open LiteDB.FSharp.Linq open LiteDB.FSharp.Extensions open LiteDB.FSharp.Experimental let pass() = Expect.isTrue true "passed" let fail() = Expect.isTrue false "failed" type Item1 = val mutable Id : int val mutable Art : string val mutable Name : string val mutable Number : int interface IItem with member this.Art = this.Art member this.Id = this.Id member this.Name = this.Name member this.Number = this.Number val mutable Barcode : string interface IBarcode with member this.Barcode = this.Barcode new (id, art, name, number, barcode) = { Id = id; Art = art; Name = name; Number = number; Barcode = barcode } type Item2 = val mutable Id : int val mutable Art : string val mutable Name : string val mutable Number : int interface IItem with member this.Art = this.Art member this.Id = this.Id member this.Name = this.Name member this.Number = this.Number val mutable Size : int interface ISize with member this.Size = this.Size val mutable Color : string interface IColor with member this.Color = this.Color new (id, art, name, number, size, color) = { Id = id; Art = art; Name = name; Number = number; Size = size; Color = color } [] type Item1OfRecord = { Id : int Art : string Name : string Number : int Barcode: string } interface IItem with member this.Art = this.Art member this.Id = this.Id member this.Name = this.Name member this.Number = this.Number interface IBarcode with member this.Barcode = this.Barcode [] type Item2OfRecord = { Id : int Art : string Name : string Number : int Size : int Color : string } interface IItem with member this.Art = this.Art member this.Id = this.Id member this.Name = this.Name member this.Number = this.Number interface ISize with member this.Size = this.Size interface IColor with member this.Color = this.Color let useDatabase mapper (f: LiteRepository -> unit) = use memoryStream = new MemoryStream() FSharpBsonMapper.RegisterInheritedConverterType() FSharpBsonMapper.RegisterInheritedConverterType() FSharpBsonMapper.RegisterInheritedConverterType() FSharpBsonMapper.RegisterInheritedConverterType() use db = new LiteRepository(memoryStream, mapper) f db let inheritedTypeTests mapper= testList "InheritedTypeTests Tests" [ testCase "EOrder with items that has different types" <| fun _ -> useDatabase mapper <| fun db -> let item1 = Item1 ( id = 0, art = "art", name = "name", number = 1000, barcode = "7254301" ) let item2 = Item2 ( id = 0, art = "art", name = "name", number = 1000, color = "red" , size = 39 ) let eorder = { Id = 1; Items = [item1;item2]; OrderNumRange = "" } let queryedEOrder = db |> LiteRepository.insertItem eorder |> LiteRepository.query |> LiteQueryable.first match queryedEOrder.Items with | [item1;item2] -> match item1,item2 with | :? IBarcode,:? IColor -> pass() | _ -> fail() | _ -> fail() testCase "EOrder with record items that has different types" <| fun _ -> useDatabase mapper <| fun db -> let item1 = { Id = 0 Art = "art" Name = "name" Number = 1000 Barcode = "7254301" } let item2 = { Id = 0 Art = "art" Name = "name" Number = 1000 Color = "red" Size = 39 } let eorder = { Id = 1; Items = [item1;item2]; OrderNumRange = "" } let queryedEOrder = db |> LiteRepository.insertItem eorder |> LiteRepository.query |> LiteQueryable.first match queryedEOrder.Items with | [item1;item2] -> match item1,item2 with | :? IBarcode,:? IColor -> pass() | _ -> fail() | _ -> fail() ] ================================================ FILE: LiteDB.FSharp.Tests/Tests.LiteDatabase.fs ================================================ module Tests.LiteDatabase open Expecto open System open System.IO open LiteDB open LiteDB.FSharp open LiteDB.FSharp.Extensions open LiteDB.FSharp.Experimental open Tests.Types open Expecto.Logging open System.Collections.Generic type MaritalStatus = Single | Married type PersonDocument = { Id: int Name: string DateAdded: DateTime Age: int Status: MaritalStatus } type RecordWithBoolean = { Id: int; HasValue: bool } type RecordWithStr = { Id : int; Name: string } type NestedRecord = { Id: int; Inner : PersonDocument } type RecordWithOptionalDate = { Id : int Released : Option } type MutableBoolean = { Id: int mutable MutableBoolean : bool } type RecordWithOptionalRecord = { Id : int Record : Option } type RecOptGuid = { Id: int OtherId: Option } let pass() = Expect.isTrue true "passed" let fail() = Expect.isTrue false "failed" let useDatabase mapper (f: LiteDatabase -> unit) = use memoryStream = new MemoryStream() use db = new LiteDatabase(memoryStream, mapper) f db let useJsonMapperDatabase (f: LiteDatabase -> unit) = let mapper = new FSharpBsonMapper() use memoryStream = new MemoryStream() use db = new LiteDatabase(memoryStream, mapper) f db let liteDatabaseUsage mapper = testList "LiteDatabase usage" [ testCase "Persisting documents with mutable fields should work" <| fun _ -> useDatabase mapper <| fun db -> let records = db.GetCollection("booleans") records.Insert { Id = 1; MutableBoolean = false } |> ignore records.FindAll() |> Seq.toList |> function | [ { Id = 1; MutableBoolean = false } ] -> pass() | otherwise -> fail() testCase "findOne works when Id is a single case union" <| fun _ -> useJsonMapperDatabase <| fun db -> let records = db.GetCollection("documents") let record = { Id = SingleCaseDU 20; Value = "John" } records.Insert(record) |> ignore records.findOne (fun document -> document.Id = SingleCaseDU 20) |> function | { Id = SingleCaseDU 20; Value = "John" } -> pass() | otherwise -> fail() testCase "Query expression with single private case union is supported" <| fun _ -> useJsonMapperDatabase <| fun db -> let records = db.GetCollection("documents") let record = { Id = 1; YoungPerson = YoungPerson.Create ("Mike", 30, PhoneNumber.Create 16511825922L) } records.Insert(record) |> ignore records.findOne (fun document -> document.YoungPerson = record.YoungPerson) |> function | { Id = 1; YoungPerson = youngPerson } -> match youngPerson.Name, youngPerson.Age, youngPerson.PhoneNumber.Value with | "Mike", 30, 16511825922L -> pass() | _ -> fail() | otherwise -> fail() testCase "Uninitialized values are populated with default values" <| fun _ -> useDatabase mapper<| fun db -> let records = db.GetCollection("documents") let initialDoc = BsonDocument() initialDoc.Add(KeyValuePair("_id", BsonValue(1))) // adding { _id: 1 } records.Insert initialDoc |> ignore // reading { Id: int; HasValue: bool } where HasValue should be deserialized to false by default let typedRecords = db.GetCollection("documents") let firstRec = typedRecords.FindAll() |> Seq.head Expect.equal 1 firstRec.Id "Deserialized ID is correct" Expect.equal false firstRec.HasValue "Deserialized boolean has default value of false" testCase "Inserting typed document then reading it as BsonDocument should work" <| fun _ -> useDatabase mapper<| fun db -> let typedRecords = db.GetCollection("booleans") typedRecords.Insert { Id = 1; HasValue = true } |> ignore let documents = db.GetCollection("booleans") let firstDoc = documents.FindAll() |> Seq.head Expect.equal (Bson.readInt "_id" firstDoc) 1 "Id of BsonDocument is 1" Expect.equal (Bson.readBool "HasValue" firstDoc) true "Id of BsonDocument is 1" testCase "Inserting and FindById work" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; DateAdded = time; Status = Single } people.Insert(person) |> ignore let p = people.FindById(BsonValue(1)) match p with | { Id = 1; Name = "Mike"; Age = 10; Status = Single; DateAdded = x } -> Expect.equal 2017 x.Year "Year is mapped correctly" Expect.equal 10 x.Month "Month is mapped correctly" Expect.equal 15 x.Day "Day is mapped correctly" | otherwise -> fail() testCase "Inserting and findOne with quoted expressions work" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; DateAdded = time; Status = Single } people.Insert(person) |> ignore let p = people.findOne <@ fun person -> person.Id = 1 @> match p with | { Id = 1; Name = "Mike"; Age = 10; Status = Single; DateAdded = x } -> Expect.equal 2017 x.Year "Year is mapped correctly" Expect.equal 10 x.Month "Month is mapped correctly" Expect.equal 15 x.Day "Day is mapped correctly" | otherwise -> fail() testCase "Query expression with literal boolean value is supported" <| fun _ -> useDatabase mapper<| fun db -> let docs = db.GetCollection("docs") let doc = BsonDocument() doc.Add(KeyValuePair("_id", BsonValue(42))) docs.Insert doc |> ignore let inserted = docs.findOne(fun doc -> true) Expect.equal 1 inserted.Keys.Count "Doc has one key (_id)" Expect.equal 42 (Bson.readInt "_id" inserted) "_id = 42" testCase "Query expression with enum value is supported" <| fun _ -> useDatabase mapper<| fun db -> let docs = db.GetCollection() docs.Insert { id = 1; color = ConsoleColor.Gray } |> ignore match docs.tryFindOne(fun doc -> doc.color = ConsoleColor.Gray ) with | Some { id = 1; color = ConsoleColor.Gray } -> pass() | _ -> fail() testCase "Documents with optional DateTime = Some can be used" <| fun _ -> useDatabase mapper<| fun db -> let docs = db.GetCollection() docs.Insert { Id = 1; Released = Some DateTime.Now } |> ignore docs.FindAll() |> Seq.tryHead |> function | None -> fail() | Some doc -> match doc.Id, doc.Released with | 1, Some date -> pass() | _ -> fail() testCase "Documents with optional Guid = Some can be used" <| fun _ -> useDatabase mapper<| fun db -> let docs = db.GetCollection() docs.Insert { Id = 1; OtherId = Some (Guid.NewGuid()) } |> ignore docs.FindAll() |> Seq.tryHead |> function | None -> fail() | Some doc -> match doc.Id, doc.OtherId with | 1, Some guid -> pass() | _ -> fail() testCase "Documents with optional Guid = None can be used" <| fun _ -> useDatabase mapper<| fun db -> let docs = db.GetCollection() docs.Insert { Id = 1; OtherId = None } |> ignore docs.FindAll() |> Seq.tryHead |> function | None -> fail() | Some doc -> match doc.Id, doc.OtherId with | 1, None -> pass() | _ -> fail() testCase "Documents with optional DateTime = None can be used" <| fun _ -> useDatabase mapper<| fun db -> let docs = db.GetCollection() docs.Insert { Id = 1; Released = None } |> ignore docs.FindAll() |> Seq.tryHead |> function | None -> fail() | Some doc -> match doc.Id, doc.Released with | 1, None -> pass() | _ -> fail() testCase "Documents with optional Record = Some can be used" <| fun _ -> useDatabase mapper<| fun db -> let docs = db.GetCollection() docs.Insert { Id = 1; Record = Some {Id = 1; Name = "Name"} } |> ignore docs.FindAll() |> Seq.tryHead |> function | None -> fail() | Some doc -> match doc.Id, doc.Record with | 1, Some {Id = 1; Name = "Name"} -> pass() | _ -> fail() testCase "TryFindById extension works" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; DateAdded = time; Status = Single } people.Insert(person) |> ignore // try find an existing person match people.TryFindById(BsonValue(1)) with | Some person -> pass() | None -> fail() // try find a non-existing person match people.TryFindById(BsonValue(500)) with | Some person -> fail() | None -> pass() testCase "Search by Query.Between integer field works" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore let query = Query.And(Query.GT("Age", BsonValue(5)), Query.LT("Age", BsonValue(15))) people.Find(query) |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "Search by compound query expression works" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore people.findMany <@ fun person -> person.Age > 5 && person.Age < 15 @> |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "Search ID by compound query expression works" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore people.findMany <@ fun person -> person.Id > 0 @> |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "Extracting values from getter works" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let mike = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(mike) |> ignore people.findMany <@ fun person -> person.Name = mike.Name @> |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "Extracting values from right nested getter works" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let mike = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } let nestedRecord = { Id = 1; Inner = mike } people.Insert(mike) |> ignore people.findMany <@ fun person -> person.Name = nestedRecord.Inner.Name @> |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "Extracting values from left nested getter works" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("nestedRecord") let time = DateTime(2017, 10, 15) let mike = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } let nestedRecord = { Id = 1; Inner = mike } people.Insert(nestedRecord) |> ignore people.findMany <@ fun person -> person.Inner.Name = mike.Name @> |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "TryFind extension method works" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore match people.TryFind(Query.EQ("Name", BsonValue("Mike"))) with | Some insertedPerson when insertedPerson = person -> match people.TryFind(Query.EQ("Name", BsonValue("John"))) with | None -> pass() | otherwise -> fail() | otherwise -> fail() testCase "tryFindOne works" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore match people.tryFindOne <@ fun person -> person.Name = "Mike" @> with | Some insertedPerson when insertedPerson = person -> match people.tryFindOne <@ fun person -> person.Name = "John" @> with | None -> pass() | otherwise -> fail() | otherwise -> fail() testCase "Search by Exact Name works" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore let query = Query.EQ("Name", BsonValue("Mike")) people.Find(query) |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "Search by Exact Age works" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore let query = Query.EQ("Age", BsonValue(10)) people.Find(query) |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "Search by Exact Age works with expressions" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore people.findMany <@ fun person -> person.Age = 10 @> |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "Search by Exact Age works with auto-quoted expressions" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore people.findMany (fun person -> person.Age = 10) |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "String.IsNullOrWhitespace works in query expression" <| fun _ -> useDatabase mapper<| fun db -> let values = db.GetCollection() values.Insert({ Id = 1; Name = "" }) |> ignore values.tryFindOne <@ fun value -> String.IsNullOrWhiteSpace value.Name @> |> function | Some { Id = 1; Name = "" } -> pass() | _ -> fail() testCase "String.IsNullOrEmpty works in query expression" <| fun _ -> useDatabase mapper<| fun db -> let values = db.GetCollection() values.Insert({ Id = 1; Name = "" }) |> ignore values.tryFindOne <@ fun value -> String.IsNullOrEmpty value.Name @> |> function | Some { Id = 1; Name = "" } -> pass() | _ -> fail() testCase "String.IsNullOrEmpty works in auto-quoted query expression" <| fun _ -> useDatabase mapper<| fun db -> let values = db.GetCollection() values.Insert({ Id = 1; Name = "" }) |> ignore values.tryFindOne (fun value -> String.IsNullOrEmpty value.Name) |> function | Some { Id = 1; Name = "" } -> pass() | _ -> fail() testCase "String.Contains works in query expression" <| fun _ -> useDatabase mapper<| fun db -> let values = db.GetCollection() values.Insert({ Id = 1; Name = "Friday" }) |> ignore values.tryFindOne <@ fun value -> value.Name.Contains("Fri") @> |> function | Some { Id = 1; Name = "Friday" } -> pass() | _ -> fail() values.tryFindOne <@ fun value -> value.Name.Contains("Hello") @> |> function | None -> pass() | _ -> fail() testCase "String.Contains works in conposite query expression" <| fun _ -> useDatabase mapper<| fun db -> let values = db.GetCollection() values.Insert({ Id = 1; Name = "Friday" }) |> ignore values.tryFindOne <@ fun value -> value.Name.Contains("Fri") && value.Name.Contains("Hello") @> |> function | None -> pass() | _ -> fail() values.findMany <@ fun value -> value.Name.Contains("Fri") || value.Name.Contains("Hello") @> |> Seq.length |> function | 1 -> pass() | _ -> fail() testCase "String.Contains works in conposite auto-quoted query expression" <| fun _ -> useDatabase mapper<| fun db -> let values = db.GetCollection() values.Insert({ Id = 1; Name = "Friday" }) |> ignore values.tryFindOne (fun value -> value.Name.Contains("Fri") && value.Name.Contains("Hello")) |> function | None -> pass() | _ -> fail() values.findMany (fun value -> value.Name.Contains("Fri") || value.Name.Contains("Hello")) |> Seq.length |> function | 1 -> pass() | _ -> fail() testCase "Search between time intervals using Query.And" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore let dateFrom = DateTime(2017, 01, 01) |> BsonValue let dateTo = DateTime(2018, 01, 01) |> BsonValue let query = Query.And(Query.GT("DateAdded", dateFrom), Query.LT("DateAdded", dateTo)) people.Find(query) |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "Search between time intervals using quoted expressions" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore people.findMany <@ fun person -> person.DateAdded > DateTime(2017, 01, 01) && person.DateAdded < DateTime(2018, 01, 01) @> |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "Search between time intervals using auto-quoted expressions" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore people.findMany (fun person -> person.DateAdded > DateTime(2017, 01, 01) && person.DateAdded < DateTime(2018, 01, 01)) |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "Search between time intervals using Query.Between" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore let dateFrom = DateTime(2017, 01, 01) |> BsonValue let dateTo = DateTime(2018, 01, 01) |> BsonValue let query = Query.Between("DateAdded", dateFrom, dateTo) people.Find(query) |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "Search by using expression on boolean properties" <| fun _ -> useDatabase mapper<| fun db -> let values = db.GetCollection() values.Insert({ Id = 1; HasValue = true }) |> ignore let foundItem = values.tryFindOne <@ fun item -> item.HasValue @> match foundItem with | Some value -> pass() | None -> fail() testCase "Search by expression OR works" <| fun _ -> useDatabase mapper<| fun db -> let values = db.GetCollection() values.Insert({ Id = 1; HasValue = true }) |> ignore values.Insert({ Id = 2; HasValue = false }) |> ignore values.findMany <@ fun item -> item.Id = 2 || item.HasValue @> |> Seq.length |> function | 2 -> pass() | _ -> fail() testCase "Search by created where expression" <| fun _ -> useDatabase mapper<| fun db -> let values = db.GetCollection() values.Insert({ Id = 1; HasValue = true }) |> ignore values.Insert({ Id = 2; HasValue = false }) |> ignore let query = values.where <@ fun value -> value.HasValue @> id values.Find(query) |> Seq.length |> function | 1 -> pass() | _ -> fail() testCase "Search by created where expression and id selector" <| fun _ -> useDatabase mapper<| fun db -> let values = db.GetCollection() values.Insert({ Id = 1; HasValue = true }) |> ignore values.Insert({ Id = 2; HasValue = false }) |> ignore let query = values.where <@ fun value -> value.Id @> (fun id -> id = 1 || id = 2) values.Find(query) |> Seq.length |> function | 2 -> pass() | _ -> fail() testCase "Search by expression OR works with NOT operator" <| fun _ -> useDatabase mapper<| fun db -> let values = db.GetCollection() values.Insert({ Id = 1; HasValue = true }) |> ignore values.Insert({ Id = 2; HasValue = false }) |> ignore values.findMany <@ fun item -> not (item.Id = 2 || item.HasValue) @> |> Seq.length |> function | 0 -> pass() | _ -> fail() testCase "Search by discriminated unions works" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore let query = Query.EQ("Status", BsonValue("Married")) let foundPerson = people.FindOne(query) match foundPerson with | { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } -> pass() | otherwise -> fail() testCase "Search by discriminated unions using expressions" <| fun _ -> useDatabase mapper<| fun db -> let people = db.GetCollection("people") let time = DateTime(2017, 10, 15) let person = { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } people.Insert(person) |> ignore let foundPerson = people.findOne <@ fun person -> person.Status = Married @> match foundPerson with | { Id = 1; Name = "Mike"; Age = 10; Status = Married; DateAdded = time } -> pass() | otherwise -> fail() testCase "Full custom search works by BsonValue deserialization" <| fun _ -> useJsonMapperDatabase <| fun db -> let records = db.GetCollection "Shapes" let shape = Composite [ Circle 2.0; Composite [ Circle 4.0; Rect(2.0, 5.0) ] ] let record = { Id = 1; Shape = shape } records.Insert(record) |> ignore let searchQuery = Query.Where("Shape", fun bsonValue -> let shapeValue = Bson.deserializeField bsonValue match shapeValue with | Composite [ Circle 2.0; other ] -> true | otherwise -> false ) records.Find(searchQuery) |> Seq.length |> function | 1 -> pass() | n -> fail() testCase "Full custom search works by using expressions" <| fun _ -> useJsonMapperDatabase <| fun db -> let records = db.GetCollection "Shapes" let shape = Composite [ Circle 2.0; Composite [ Circle 4.0; Rect(2.0, 5.0) ] ] let record = { Id = 1; Shape = shape } records.Insert(record) |> ignore let searchResults = records.fullSearch <@ fun r -> r.Shape @> (fun shape -> match shape with | Composite [ Circle 2.0; other ] -> true | otherwise -> false) searchResults |> Seq.length |> function | 1 -> pass() | n -> fail() ] ================================================ FILE: LiteDB.FSharp.Tests/Tests.Runner.fs ================================================ module Runner open Expecto open Expecto.Logging open LiteDB.FSharp open LiteDB.FSharp.Experimental open Tests.Bson open Tests.LiteDatabase open Tests.DBRef open Tests.InheritedType let testConfig = { Expecto.Tests.defaultConfig with parallelWorkers = 1 verbosity = LogLevel.Debug } let defaultValueTests = testList "DefaultValue.fromType" [ testCase "Works for booleans" <| fun _ -> let value = DefaultValue.fromType (typeof) |> unbox Expect.equal false value "Default boolean value is false" testCase "Works with optionals" <| fun _ -> let value = DefaultValue.fromType (typeof>) |> unbox> Expect.equal None value "Option<'t> has None a default value" testCase "Default of string is an empty string" <| fun _ -> let value = DefaultValue.fromType (typeof) |> unbox Expect.equal "" value "An empty string is the default string" ] let liteDbTests mapper name = testList name [ defaultValueTests bsonConversions liteDatabaseUsage mapper dbRefTests mapper inheritedTypeTests mapper ] [] let main argv = let bsonJsonMapper = FSharpBsonMapper() let typeShapeMapper = TypeShapeMapper() :> FSharpBsonMapper let tests = testList "Parameterized tests" [ liteDbTests bsonJsonMapper "JSON Mapper Tests" liteDbTests typeShapeMapper "TypeShape Mapper Tests" ] runTests testConfig tests ================================================ FILE: LiteDB.FSharp.Tests/Tests.Types.fs ================================================ module Tests.Types open System open LiteDB.FSharp type Person = { Id: int; Name: string } type LowerCaseId = { id: int; age:int } type SimpleUnion = One | Two type PhoneNumber = private PhoneNumber of int64 with member x.Value = let (PhoneNumber v) = x v static member Create(phoneNumber: int64) = match phoneNumber.ToString().Length with | 11 -> PhoneNumber phoneNumber | _ -> failwithf "phone number %d 's length should be 11" phoneNumber type YoungPerson = private YoungPerson of name: string * age: int * phoneNumber: PhoneNumber with member x.Name = let (YoungPerson (name, age, phoneNumber)) = x name member x.PhoneNumber = let (YoungPerson (name, age, phoneNumber)) = x phoneNumber member x.Age = let (YoungPerson (name, age, phoneNumber)) = x age static member Create(name, age, phoneNumber) = if age < 35 then YoungPerson(name, age, phoneNumber) else failwithf "Young person's age should be <= %d" 35 type Size = private | US of float | EUR of float | UK of float with static member CreateEUR(eur: float) = if eur >= 19. && eur <= 46. && eur % 0.5 = 0. then Size.EUR eur else failwithf "%f is not a valid eur value" eur type RecordWithSimpleUnion = { Id: int; Union: SimpleUnion } type RecordWithSinglePrivateUnion = { Id: int; YoungPerson: YoungPerson } type RecordWithMultiplePrivateUnions = { Id: int; Size: Size } type RecordWithList = { Id: int; List: int list } type Maybe<'a> = Just of 'a | Nothing type RecordWithGenericUnion<'t> = { Id: int; GenericUnion: Maybe<'t> } type RecordWithDateTime = { id: int; created: DateTime } type RecordWithMap = { id : int; map: Map } type RecordWithArray = { id: int; arr: int[] } type RecordWithOptionalArray = { id: int; arr: int[] option } type RecordWithResizeArray = { id: int; resizeArray: ResizeArray } type RecordWithDecimal = { id: int; number: decimal } type RecordWithEnum = { id: int; color: ConsoleColor } type RecordWithLong = { id: int; long: int64 } type RecordWithFloat = { id: int; float: float } type RecordWithGuid = { id: int; guid: Guid } type RecordWithBytes = { id: int; data:byte[] } type RecordWithTuple = { id: int; tuple: string * int } type RecordWithObjectId = { id: LiteDB.ObjectId } type RecordWithOptionOfValueType = { id:int; optionOfValueType: Option } type RecordWithOptionOfReferenceType = { id:int; optionOfReferenceType : Option } type Shape = | Circle of float | Rect of float * float | Composite of Shape list type Value = Num of int | String of string type RecordWithMapDU = { Id: int; Properties: Map } type RecordWithShape = { Id: int; Shape: Shape } type ComplexUnion<'t> = | Any of 't | Int of int | String of string | Generic of Maybe<'t> type SingleCaseDU = SingleCaseDU of int type RecordWithSingleCaseId = { Id : SingleCaseDU; Value : string } type IColor = abstract member Color : string type IBarcode = abstract member Barcode : string type ISize = abstract member Size : int type IItem = abstract member Id : int abstract member Art : string abstract member Name : string abstract member Number : int type RecWithMember = { Id: int Name: string } with member this.Ignored() = sprintf "%d %s" this.Id this.Name member this.IgnoredToo = sprintf "%d %s" this.Id this.Name [] type Company= { Id: int Name: string} [] type EOrder= { Id: int Items : IItem list OrderNumRange: string } [] type Order= { Id : int Company : Company EOrders : EOrder list} ================================================ FILE: LiteDB.FSharp.Tests/paket.references ================================================ FSharp.Core Expecto LiteDB Newtonsoft.Json ================================================ FILE: LiteDB.FSharp.sln ================================================  Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio Version 16 VisualStudioVersion = 16.0.31025.194 MinimumVisualStudioVersion = 10.0.40219.1 Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "LiteDB.FSharp", "LiteDB.FSharp\LiteDB.FSharp.fsproj", "{9A8AA256-B139-4AEA-9CEF-460BA8045617}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "LiteDB.FSharp.Tests", "LiteDB.FSharp.Tests\LiteDB.FSharp.Tests.fsproj", "{AD38A1E8-B7E8-4E50-AFEF-E293E19558D2}" EndProject Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{E8AC7A8B-A12C-477D-BF6A-4CBEA9F43742}" ProjectSection(SolutionItems) = preProject .gitignore = .gitignore LICENSE = LICENSE README.md = README.md EndProjectSection EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "LiteDB.FSharp.Build", "LiteDB.FSharp.Build\LiteDB.FSharp.Build.fsproj", "{352793C3-F915-41DF-97D0-A018B421C3C0}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU Release|Any CPU = Release|Any CPU EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {9A8AA256-B139-4AEA-9CEF-460BA8045617}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {9A8AA256-B139-4AEA-9CEF-460BA8045617}.Debug|Any CPU.Build.0 = Debug|Any CPU {9A8AA256-B139-4AEA-9CEF-460BA8045617}.Release|Any CPU.ActiveCfg = Release|Any CPU {9A8AA256-B139-4AEA-9CEF-460BA8045617}.Release|Any CPU.Build.0 = Release|Any CPU {AD38A1E8-B7E8-4E50-AFEF-E293E19558D2}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {AD38A1E8-B7E8-4E50-AFEF-E293E19558D2}.Debug|Any CPU.Build.0 = Debug|Any CPU {AD38A1E8-B7E8-4E50-AFEF-E293E19558D2}.Release|Any CPU.ActiveCfg = Release|Any CPU {AD38A1E8-B7E8-4E50-AFEF-E293E19558D2}.Release|Any CPU.Build.0 = Release|Any CPU {352793C3-F915-41DF-97D0-A018B421C3C0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {352793C3-F915-41DF-97D0-A018B421C3C0}.Debug|Any CPU.Build.0 = Debug|Any CPU {352793C3-F915-41DF-97D0-A018B421C3C0}.Release|Any CPU.ActiveCfg = Release|Any CPU {352793C3-F915-41DF-97D0-A018B421C3C0}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution SolutionGuid = {C58409B5-3F75-45F9-B586-A000C288F8D0} EndGlobalSection EndGlobal ================================================ FILE: Nuget.Config ================================================ ================================================ FILE: README.md ================================================ # LiteDB.FSharp [![Build Status](https://travis-ci.org/Zaid-Ajaj/LiteDB.FSharp.svg?branch=master)](https://travis-ci.org/Zaid-Ajaj/LiteDB.FSharp) [![Nuget](https://img.shields.io/nuget/v/LiteDB.FSharp.svg?colorB=green)](https://www.nuget.org/packages/LiteDB.FSharp) F# Support for [LiteDB](https://github.com/mbdavid/LiteDB) > This package relies on LiteDB 4.14 >= version > 5.0 > Support for v5 is work in progress and might require a full rewrite. LiteDB.FSharp provides serialization utilities making it possible for LiteDB to understand F# types such as records, unions, maps etc. with support for type-safe query expression through F# quotations ### Usage LiteDB.FSharp comes with a custom `BsonMapper` called `FSharpBsonMapper` that you would pass to a `LiteDatabase` instance during initialization: ```fsharp open LiteDB open LiteDB.FSharp open LiteDB.FSharp.Extensions let mapper = FSharpBsonMapper() use db = new LiteDatabase("simple.db", mapper) ``` LiteDB.FSharp is made mainly to work with records as representations of the persisted documents. The library *requires* that records have a primary key called `Id` or `id`. This field is then mapped to `_id` when converted to a bson document for indexing. ```fsharp type Genre = Rock | Pop | Metal type Album = { Id: int Name: string DateReleased: DateTime Genre: Genre } ``` Get a typed collection from the database: ```fsharp let albums = db.GetCollection("albums") ``` ### Insert documents ```fsharp let metallica = { Id = 1; Name = "Metallica"; Genre = Metal; DateReleased = DateTime(1991, 8, 12) } albums.Insert(metallica) ``` ### Query one document by Id ```fsharp // result : Album let result = albums.findOne <@ fun album -> album.Id = 1 @> // OR let id = BsonValue(1) // result : Album let result = albums.FindById(id) ``` ### Query many documents depending on the value of a field ```fsharp // metallicaAlbums : Seq let metallicaAlbums = albums.findMany <@ fun album -> album.Name = "Metallica" @> // OR let name = BsonValue("Metallica") let query = Query.EQ("Name", name) // metallicaAlbums : Seq let metallicaAlbums = albums.Find(query) ``` ### Query documents by value of discriminated union ```fsharp // find all albums where Genre = Rock // rockAlbums : Seq let rockAlbums = albums.findMany <@ fun album -> album.Genre = Rock @> // OR let genre = BsonValue("Rock") let query = Query.EQ("Genre", genre) // rockAlbums : Seq let rockAlbums = albums.Find(query) ``` ### Query documents between or time intervals ```fsharp // find all albums released last year let now = DateTime.Now let dateFrom = DateTime(now.Year - 1, 01, 01) |> BsonValue let dateTo = DateTime(now.Year, 01, 01) |> BsonValue let query = Query.Between("DateReleased", dateFrom, dateTo) // albumsLastYear : Seq let albumsLastYear = albums.Find(query) ``` ### Customized Full Search using quoted expressions ```fs // Filtering albums released a year divisble by 5 // filtered : Seq let filtered = albums.fullSearch <@ fun album -> album.DateReleased @> (fun dateReleased -> dateReleased.Year % 5 = 0) ``` ### Customized Full Search using Query.Where The function `Query.Where` expects a field name and a filter function of type `BsonValue -> bool`. You can deserialize the `BsonValue` using `Bson.deserializeField<'t>` where `'t` is the type of the serialized value. ```fsharp // Filtering albums released a year divisble by 5 let searchQuery = Query.Where("DateReleased", fun bsonValue -> // dateReleased : DateTime let dateReleased = Bson.deserializeField bsonValue let year = dateReleased.Year year % 5 = 0 ) let searchResult = albums.Find(searchQuery) ``` ### Query.Where: Filtering documents by matching with values of a nested DU ```fsharp type Shape = | Circle of float | Rect of float * float | Composite of Shape list type RecordWithShape = { Id: int; Shape: Shape } let records = db.GetCollection("shapes") let shape = Composite [ Circle 2.0; Composite [ Circle 4.0; Rect(2.0, 5.0) ] ] let record = { Id = 1; Shape = shape } records.Insert(record) |> ignore let searchQuery = Query.Where("Shape", fun bsonValue -> let shapeValue = Bson.deserializeField bsonValue match shapeValue with | Composite [ Circle 2.0; other ] -> true | otherwise -> false ) records.Find(searchQuery) |> Seq.length |> function | 1 -> pass() // passed! | n -> fail() ``` ### Id auto-incremented Add CLIMutableAttribute to record type and set Id 0 ```fsharp [] type Album = { Id: int Name: string DateReleased: DateTime Genre: Genre } let metallica = { Id = 0; Name = "Metallica"; Genre = Metal; DateReleased = DateTime(1991, 8, 12) } ``` ### DbRef just as https://github.com/mbdavid/LiteDB/wiki/DbRef ```fsharp open LiteDB.FSharp.Linq [] type Company= { Id : int Name : string} [] type Order= { Id :int Company :Company } let mapper = FSharpBsonMapper() mapper.DbRef(fun c -> c.Company) ``` ### Inheritence `Item1` and `Item2` are inherited from `IItem` we must register the type relations first globally ```fsharp FSharpBsonMapper.RegisterInheritedConverterType() FSharpBsonMapper.RegisterInheritedConverterType() ``` By conversion, The inherited type must has mutable field for serializable and deserializable ```fsharp val mutable Id : int ``` *Note*: Because [json converter](https://github.com/Zaid-Ajaj/LiteDB.FSharp/blob/master/LiteDB.FSharp/Json.fs) find inherited type by comparing the fields names from inherited type and database ```fsharp let findType (jsonFields: seq) = inheritedTypes |> Seq.maxBy (fun tp -> let fields = tp.GetFields() |> Seq.map (fun fd -> fd.Name) let fieldsLength = Seq.length fields (jsonFields |> Seq.filter(fun jsonField -> Seq.contains jsonField fields ) |> Seq.length),-fieldsLength ) ``` This means that we should not implement the some interface with different fields For example,we should not do below implementations ```fsharp type Item1 = val mutable Id : int val mutable Art : string val mutable Name : string val mutable Number : int interface IItem with member this.Art = this.Art member this.Id = this.Id member this.Name = this.Name member this.Number = this.Number /// unexpected codes type Item2 = val mutable Id2 : int val mutable Art2 : string val mutable Name2 : string val mutable Number2 : int interface IItem with member this.Art = this.Art2 member this.Id = this.Id2 member this.Name = this.Name2 member this.Number = this.Number2 /// expected codes type Item2 = val mutable Id : int val mutable Art : string val mutable Name : string val mutable Number : int interface IItem with member this.Art = this.Art member this.Id = this.Id member this.Name = this.Name member this.Number = this.Number ``` Full sample codes: ```fsharp /// classlibray.fs [] type EOrder= { Id: int Items : IItem list OrderNumRange: string } /// consumer.fs type Item1 = /// val mutable will make field serializable and deserializable val mutable Id : int val mutable Art : string val mutable Name : string val mutable Number : int interface IItem with member this.Art = this.Art member this.Id = this.Id member this.Name = this.Name member this.Number = this.Number val mutable Barcode : string interface IBarcode with member this.Barcode = this.Barcode /// type constructor new (id, art, name, number, barcode) = { Id = id; Art = art; Name = name; Number = number; Barcode = barcode } type Item2 = val mutable Id : int val mutable Art : string val mutable Name : string val mutable Number : int interface IItem with member this.Art = this.Art member this.Id = this.Id member this.Name = this.Name member this.Number = this.Number val mutable Size : int interface ISize with member this.Size = this.Size val mutable Color : string interface IColor with member this.Color = this.Color new (id, art, name, number, size, color) = { Id = id; Art = art; Name = name; Number = number; Size = size; Color = color } FSharpBsonMapper.RegisterInheritedConverterType() FSharpBsonMapper.RegisterInheritedConverterType() let item1 = Item1 ( id = 0, art = "art", name = "name", number = 1000, barcode = "7254301" ) let item2 = Item2 ( id = 0, art = "art", name = "name", number = 1000, color = "red" , size = 39 ) let eorder = { Id = 1; Items = [item1;item2]; OrderNumRange = "" } let queryedEOrder = db |> LiteRepository.insertItem eorder |> LiteRepository.query |> LiteQueryable.first match queryedEOrder.Items with | [item1;item2] -> match item1,item2 with | :? IBarcode,:? IColor -> pass() | _ -> fail() | _ -> fail() ```