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