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