From f539756dc70e45051cfc0e26451dfdf6240a0d21 Mon Sep 17 00:00:00 2001 From: albert-du <52804499+albert-du@users.noreply.github.com> Date: Fri, 15 Jul 2022 13:58:49 -0700 Subject: [PATCH 1/3] linq operation --- samples/FSharp.CosmosDb.Samples/Program.fs | 16 ++++++++ src/FSharp.CosmosDb/Cosmos.fs | 11 +++++ src/FSharp.CosmosDb/FSharp.CosmosDb.fsproj | 1 + src/FSharp.CosmosDb/OperationHandling.fs | 22 ++++++++++ src/FSharp.CosmosDb/QueryBuilder.fs | 48 ++++++++++++++++++++++ src/FSharp.CosmosDb/Types.fs | 6 +++ 6 files changed, 104 insertions(+) create mode 100644 src/FSharp.CosmosDb/QueryBuilder.fs diff --git a/samples/FSharp.CosmosDb.Samples/Program.fs b/samples/FSharp.CosmosDb.Samples/Program.fs index 0a34fe1..02b86ad 100644 --- a/samples/FSharp.CosmosDb.Samples/Program.fs +++ b/samples/FSharp.CosmosDb.Samples/Program.fs @@ -38,6 +38,16 @@ let getFamilies conn = |> Cosmos.parameters [ "@lastName", box "Powell" ] |> Cosmos.execAsync +let getFamilyLastNames conn = + conn + |> Cosmos.linq (fun families -> + cosmosQuery { + for family in families do + where (family.LastName = "Powell") + select family.LastName + }) + |> Cosmos.execAsync + let updateFamily conn id pk = conn |> Cosmos.update @@ -112,6 +122,12 @@ let main argv = families |> AsyncSeq.iter (fun f -> printfn "Got: %A" f) + let lastNames = getFamilyLastNames conn + + do! + lastNames + |> AsyncSeq.iter (printfn "Got: %s") + let updatePowell = updateFamily conn "Powell.1" "Powell" do! diff --git a/src/FSharp.CosmosDb/Cosmos.fs b/src/FSharp.CosmosDb/Cosmos.fs index 866e961..898baee 100644 --- a/src/FSharp.CosmosDb/Cosmos.fs +++ b/src/FSharp.CosmosDb/Cosmos.fs @@ -2,6 +2,7 @@ namespace FSharp.CosmosDb open Microsoft.Azure.Cosmos open System +open System.Linq [] module Cosmos = @@ -61,6 +62,15 @@ module Cosmos = Parameters = q.Parameters @ arr } | _ -> failwith "Only the Query discriminated union supports parameters" + // --- LINQ --- // + + let linq<'TSource, 'TResult> (query: IQueryable<'TSource> -> IQueryable<'TResult>) op : ContainerOperation<'TResult> = + Linq + { Connection = op; + Query = fun container -> + container.GetItemLinqQueryable<'TSource>() + |> query } + // --- INSERT --- // let insertMany<'T> (values: 'T list) op = @@ -116,6 +126,7 @@ module Cosmos = let execAsync<'T> (op: ContainerOperation<'T>) = match op with | Query op -> OperationHandling.execQuery getClient op + | Linq op -> OperationHandling.execLinq getClient op | Insert op -> OperationHandling.execInsert getClient op | Update op -> OperationHandling.execUpdate getClient op | Delete op -> OperationHandling.execDelete getClient op diff --git a/src/FSharp.CosmosDb/FSharp.CosmosDb.fsproj b/src/FSharp.CosmosDb/FSharp.CosmosDb.fsproj index 901c294..0052411 100644 --- a/src/FSharp.CosmosDb/FSharp.CosmosDb.fsproj +++ b/src/FSharp.CosmosDb/FSharp.CosmosDb.fsproj @@ -10,6 +10,7 @@ + diff --git a/src/FSharp.CosmosDb/OperationHandling.fs b/src/FSharp.CosmosDb/OperationHandling.fs index dad2010..9e0eec3 100644 --- a/src/FSharp.CosmosDb/OperationHandling.fs +++ b/src/FSharp.CosmosDb/OperationHandling.fs @@ -3,6 +3,7 @@ module internal OperationHandling open FSharp.CosmosDb open Microsoft.Azure.Cosmos +open Microsoft.Azure.Cosmos.Linq open FSharp.Control open System @@ -67,6 +68,27 @@ let execQueryBatch (getClient: ConnectionOperation -> CosmosClient) (op: QueryOp | None -> failwith "Unable to construct a query as some values are missing across the database, container name and query" +let execLinq (getClient: ConnectionOperation -> CosmosClient) (op: LinqOp<'T>) = + let connInfo = op.Connection + let client = getClient connInfo + + let result = + maybe { + let! databaseId = connInfo.DatabaseId + let! containerName = connInfo.ContainerName + + let db = client.GetDatabase databaseId + + let container = db.GetContainer containerName + + return op.Query(container).ToFeedIterator<'T>() + } + + match result with + | Some result -> ofAsyncFeedIterator result + | None -> + failwith "Unable to construct a query as some values are missing across the database, container name and query" + let execInsert (getClient: ConnectionOperation -> CosmosClient) (op: InsertOp<'T>) = let connInfo = op.Connection let client = getClient connInfo diff --git a/src/FSharp.CosmosDb/QueryBuilder.fs b/src/FSharp.CosmosDb/QueryBuilder.fs new file mode 100644 index 0000000..68d8304 --- /dev/null +++ b/src/FSharp.CosmosDb/QueryBuilder.fs @@ -0,0 +1,48 @@ +namespace FSharp.CosmosDb + +open System +open System.Linq +open FSharp.Linq +open FSharp.Quotations +open FSharp.Quotations.DerivedPatterns +open FSharp.Quotations.ExprShape + +type CosmosQueryBuilder() = + inherit QueryBuilder() + + static let rec replace = + // Replace F# functions with BCL equivalents. + function + | SpecificCall <@@ abs @@> (_, [ typ ], args) -> + let e = replace args.Head + if typ = typeof then + <@@ (Math.Abs : int8 -> int8) %%e @@> + elif typ = typeof then + <@@ (Math.Abs : int16 -> int16) %%e @@> + elif typ = typeof then + <@@ (Math.Abs : int32 -> int32) %%e @@> + elif typ = typeof then + <@@ (Math.Abs : int64 -> int64) %%e @@> + elif typ = typeof then + <@@ (Math.Abs : float32 -> float32) %%e @@> + elif typ = typeof then + <@@ (Math.Abs : float -> float) %%e @@> + elif typ = typeof then + <@@ (Math.Abs : decimal -> decimal) %%e @@> + else + failwith $"Invalid argument type for translation of 'abs': {typ.FullName}" + | SpecificCall <@@ acos @@> (_, [ _ ], args) -> + let e = replace args.Head + <@@ (Math.Acos : float -> float) %%e @@> + | ShapeVar v -> Expr.Var v + | ShapeLambda(v, expr) -> Expr.Lambda(v, replace expr) + | ShapeCombination(o, args) -> + RebuildShapeCombination(o, List.map replace args) + + member _.Run(e: Expr>) = + let r = Expr.Cast>(replace e) + base.Run r + +[] +module QueryBuilder = + let cosmosQuery = CosmosQueryBuilder() \ No newline at end of file diff --git a/src/FSharp.CosmosDb/Types.fs b/src/FSharp.CosmosDb/Types.fs index 1278b4a..c1fa235 100644 --- a/src/FSharp.CosmosDb/Types.fs +++ b/src/FSharp.CosmosDb/Types.fs @@ -6,6 +6,7 @@ open System.Threading.Tasks open System.Collections.Concurrent open System open System.Collections.Generic +open System.Linq module internal Caching = let private clientCache = @@ -86,6 +87,10 @@ type QueryOp<'T> = Query: string option Parameters: (string * obj) list } +type LinqOp<'T> = + { Connection: ConnectionOperation + Query: Container -> IQueryable<'T> } + type InsertOp<'T> = { Connection: ConnectionOperation Values: 'T list } @@ -116,6 +121,7 @@ type ReplaceOp<'T> = type ContainerOperation<'T> = | Query of QueryOp<'T> + | Linq of LinqOp<'T> | Insert of InsertOp<'T> | Update of UpdateOp<'T> | Delete of DeleteOp<'T> From 66eb40b391a3ae7a47b3bd66b34547704b6b537e Mon Sep 17 00:00:00 2001 From: albert-du <52804499+albert-du@users.noreply.github.com> Date: Fri, 15 Jul 2022 22:06:25 -0700 Subject: [PATCH 2/3] math functions --- samples/FSharp.CosmosDb.Samples/Program.fs | 2 +- src/FSharp.CosmosDb/QueryBuilder.fs | 210 +++++++++++++++++++-- 2 files changed, 193 insertions(+), 19 deletions(-) diff --git a/samples/FSharp.CosmosDb.Samples/Program.fs b/samples/FSharp.CosmosDb.Samples/Program.fs index 02b86ad..2cb841e 100644 --- a/samples/FSharp.CosmosDb.Samples/Program.fs +++ b/samples/FSharp.CosmosDb.Samples/Program.fs @@ -44,7 +44,7 @@ let getFamilyLastNames conn = cosmosQuery { for family in families do where (family.LastName = "Powell") - select family.LastName + select (truncate 1.4 |> string) }) |> Cosmos.execAsync diff --git a/src/FSharp.CosmosDb/QueryBuilder.fs b/src/FSharp.CosmosDb/QueryBuilder.fs index 68d8304..61fa6dd 100644 --- a/src/FSharp.CosmosDb/QueryBuilder.fs +++ b/src/FSharp.CosmosDb/QueryBuilder.fs @@ -13,31 +13,205 @@ type CosmosQueryBuilder() = static let rec replace = // Replace F# functions with BCL equivalents. function - | SpecificCall <@@ abs @@> (_, [ typ ], args) -> - let e = replace args.Head + | SpecificCall <@@ abs @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + if typ = typeof then - <@@ (Math.Abs : int8 -> int8) %%e @@> + <@@ (Math.Abs: int8 -> int8) %%e @@> elif typ = typeof then - <@@ (Math.Abs : int16 -> int16) %%e @@> + <@@ (Math.Abs: int16 -> int16) %%e @@> elif typ = typeof then - <@@ (Math.Abs : int32 -> int32) %%e @@> + <@@ (Math.Abs: int32 -> int32) %%e @@> elif typ = typeof then - <@@ (Math.Abs : int64 -> int64) %%e @@> + <@@ (Math.Abs: int64 -> int64) %%e @@> elif typ = typeof then - <@@ (Math.Abs : float32 -> float32) %%e @@> + <@@ (Math.Abs: float32 -> float32) %%e @@> elif typ = typeof then - <@@ (Math.Abs : float -> float) %%e @@> + <@@ (Math.Abs: float -> float) %%e @@> elif typ = typeof then - <@@ (Math.Abs : decimal -> decimal) %%e @@> - else - failwith $"Invalid argument type for translation of 'abs': {typ.FullName}" - | SpecificCall <@@ acos @@> (_, [ _ ], args) -> - let e = replace args.Head - <@@ (Math.Acos : float -> float) %%e @@> + <@@ (Math.Abs: decimal -> decimal) %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof abs}': {typ.FullName}" + + | SpecificCall <@@ acos @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Acos(float %%e) @@> + elif typ = typeof then + <@@ Math.Acos %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof acos}': {typ.FullName}" + + | SpecificCall <@@ asin @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Asin(float %%e) @@> + elif typ = typeof then + <@@ Math.Asin %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof asin}': {typ.FullName}" + + | SpecificCall <@@ atan @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Atan(float %%e) @@> + elif typ = typeof then + <@@ Math.Atan %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof atan}': {typ.FullName}" + + | SpecificCall <@@ ceil @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Ceiling(float %%e) @@> + elif typ = typeof then + <@@ (Math.Ceiling: float -> float) %%e @@> + elif typ = typeof then + <@@ (Math.Ceiling: float -> float) %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof ceil}': {typ.FullName}" + + | SpecificCall <@@ cos @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Cos(float %%e) @@> + elif typ = typeof then + <@@ Math.Cos %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof cos}': {typ.FullName}" + + | SpecificCall <@@ exp @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Exp(float %%e) @@> + elif typ = typeof then + <@@ Math.Exp %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof exp}': {typ.FullName}" + + | SpecificCall <@@ floor @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Floor(float %%e) @@> + elif typ = typeof then + <@@ (Math.Floor: float -> float) %%e @@> + elif typ = typeof then + <@@ (Math.Floor: decimal -> decimal) %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof floor}': {typ.FullName}" + + | SpecificCall <@@ log @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Log(float %%e) @@> + elif typ = typeof then + <@@ Math.Log %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof log}': {typ.FullName}" + + | SpecificCall <@@ log10 @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Log10(float %%e) @@> + elif typ = typeof then + <@@ Math.Log10 %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof log10}': {typ.FullName}" + + | SpecificCall <@@ ( ** ) @@> (_, [ typ; _ ], [ x; n ]) + | SpecificCall <@@ pown @@> (_, [ typ; _ ], [ x; n ]) -> + let x = replace x + let n = replace n + + if typ = typeof then + <@@ Math.Pow(%%x, float %%n) @@> + else + <@@ Math.Pow(float %%x, float %%n) @@> + + | SpecificCall <@@ round @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Round(float %%e) @@> + elif typ = typeof then + <@@ (Math.Round: float -> float) %%e @@> + elif typ = typeof then + <@@ (Math.Round: decimal -> decimal) %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof round}': {typ.FullName}" + + | SpecificCall <@@ sign @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ (Math.Sign: int8 -> int) %%e @@> + elif typ = typeof then + <@@ (Math.Sign: int16 -> int) %%e @@> + elif typ = typeof then + <@@ (Math.Sign: int -> int) %%e @@> + elif typ = typeof then + <@@ (Math.Sign: int64 -> int) %%e @@> + elif typ = typeof then + <@@ (Math.Sign: float32 -> int) %%e @@> + elif typ = typeof then + <@@ (Math.Sign: float -> int) %%e @@> + elif typ = typeof then + <@@ (Math.Sign: decimal -> int) %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof sign}': {typ.FullName}" + + | SpecificCall <@@ sin @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Sin(float %%e) @@> + elif typ = typeof then + <@@ Math.Sin %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof sin}': {typ.FullName}" + + | SpecificCall <@@ sqrt @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Sqrt %%e @@> + else + <@@ Math.Sqrt(float %%e) @@> + + | SpecificCall <@@ tan @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Tan(float %%e) @@> + elif typ = typeof then + <@@ Math.Tan %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof tan}': {typ.FullName}" + + | SpecificCall <@@ truncate @@> (_, [ typ ], [ arg ]) -> + let e = replace arg + + if typ = typeof then + <@@ Math.Truncate(float %%e) @@> + elif typ = typeof then + <@@ (Math.Truncate: float -> float) %%e @@> + elif typ = typeof then + <@@ (Math.Truncate: decimal -> decimal) %%e @@> + else + failwith $"Invalid argument type for translation of '{nameof truncate}': {typ.FullName}" + | ShapeVar v -> Expr.Var v - | ShapeLambda(v, expr) -> Expr.Lambda(v, replace expr) - | ShapeCombination(o, args) -> - RebuildShapeCombination(o, List.map replace args) + | ShapeLambda (v, expr) -> Expr.Lambda(v, replace expr) + | ShapeCombination (o, args) -> RebuildShapeCombination(o, List.map replace args) member _.Run(e: Expr>) = let r = Expr.Cast>(replace e) @@ -45,4 +219,4 @@ type CosmosQueryBuilder() = [] module QueryBuilder = - let cosmosQuery = CosmosQueryBuilder() \ No newline at end of file + let cosmosQuery = CosmosQueryBuilder() From 947fb25e2dae8bc1eeee160e17b46e8d6387ddf2 Mon Sep 17 00:00:00 2001 From: albert-du <52804499+albert-du@users.noreply.github.com> Date: Sun, 17 Jul 2022 12:39:23 -0700 Subject: [PATCH 3/3] Pipeline operators --- samples/FSharp.CosmosDb.Samples/Program.fs | 12 ++++++------ src/FSharp.CosmosDb/QueryBuilder.fs | 15 +++++++++++++-- 2 files changed, 19 insertions(+), 8 deletions(-) diff --git a/samples/FSharp.CosmosDb.Samples/Program.fs b/samples/FSharp.CosmosDb.Samples/Program.fs index 2cb841e..e2e3a11 100644 --- a/samples/FSharp.CosmosDb.Samples/Program.fs +++ b/samples/FSharp.CosmosDb.Samples/Program.fs @@ -38,13 +38,13 @@ let getFamilies conn = |> Cosmos.parameters [ "@lastName", box "Powell" ] |> Cosmos.execAsync -let getFamilyLastNames conn = +let getParents conn = conn - |> Cosmos.linq (fun families -> + |> Cosmos.linq (fun families -> cosmosQuery { for family in families do where (family.LastName = "Powell") - select (truncate 1.4 |> string) + select family.Parents }) |> Cosmos.execAsync @@ -122,11 +122,11 @@ let main argv = families |> AsyncSeq.iter (fun f -> printfn "Got: %A" f) - let lastNames = getFamilyLastNames conn + let firstNames = getParents conn do! - lastNames - |> AsyncSeq.iter (printfn "Got: %s") + firstNames + |> AsyncSeq.iter (printfn "Got: %A") let updatePowell = updateFamily conn "Powell.1" "Powell" diff --git a/src/FSharp.CosmosDb/QueryBuilder.fs b/src/FSharp.CosmosDb/QueryBuilder.fs index 61fa6dd..d7311c8 100644 --- a/src/FSharp.CosmosDb/QueryBuilder.fs +++ b/src/FSharp.CosmosDb/QueryBuilder.fs @@ -209,9 +209,20 @@ type CosmosQueryBuilder() = else failwith $"Invalid argument type for translation of '{nameof truncate}': {typ.FullName}" + // Pipeline operator removal. + | SpecificCall <@@ (|>) @@> (_, _, [ x; f ]) -> + let f = replace f + let x = replace x + Expr.Application(f, x) + + | SpecificCall <@@ (<|) @@> (_, _, [ f; x ]) -> + let f = replace f + let x = replace x + Expr.Application(f, x) + | ShapeVar v -> Expr.Var v - | ShapeLambda (v, expr) -> Expr.Lambda(v, replace expr) - | ShapeCombination (o, args) -> RebuildShapeCombination(o, List.map replace args) + | ShapeLambda(v, expr) -> Expr.Lambda(v, replace expr) + | ShapeCombination(o, args) -> RebuildShapeCombination(o, List.map replace args) member _.Run(e: Expr>) = let r = Expr.Cast>(replace e)