forked from fsprojects/Rezoom.SQL
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathSQLite.fs
More file actions
139 lines (133 loc) · 6.25 KB
/
SQLite.fs
File metadata and controls
139 lines (133 loc) · 6.25 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
namespace Rezoom.SQL.Compiler.SQLite
open System
open System.Collections.Generic
open System.Configuration
open System.Data
open System.Data.Common
open System.IO
open FSharp.Quotations
open Rezoom.SQL.Compiler
open Rezoom.SQL.Compiler.BackendUtilities
open Rezoom.SQL.Compiler.Translators
open Rezoom.SQL.Mapping
open Rezoom.SQL.Migrations
type private SQLiteLiteral() =
inherit DefaultLiteralTranslator()
override __.BooleanLiteral(t) =
CommandText <| if t then "1" else "0"
override __.DateTimeLiteral(dt) =
CommandText <| "'" + dt.ToString("yyyy'-'MM'-'dd'T'HH':'mm':'ss'.'fffZ") + "'"
type private SQLiteExpression(statement : StatementTranslator, indexer) =
inherit DefaultExprTranslator(statement, indexer)
let literal = SQLiteLiteral()
override __.Literal = upcast literal
override __.TypeName(name, autoIncrement) =
(Seq.singleton << text) <|
match name with
| BooleanTypeName
| IntegerTypeName Integer16
| IntegerTypeName Integer32
| IntegerTypeName Integer64 -> if autoIncrement then "INTEGER" else "INT"
| FloatTypeName Float32
| FloatTypeName Float64 -> "FLOAT"
| DateTimeTypeName // store datetimes as UTC ISO8601 strings -- yyyy-MM-ddTHH:mm:ssZ
| StringTypeName(_) -> "VARCHAR"
| GuidTypeName
| BinaryTypeName(_) -> "BLOB"
| DecimalTypeName
| DateTimeOffsetTypeName -> fail <| sprintf "Unsupported type ``%A``" name
type private SQLiteStatement(indexer : IParameterIndexer) as this =
inherit DefaultStatementTranslator(Name("SQLITE"), indexer)
let expr = SQLiteExpression(this :> StatementTranslator, indexer)
override __.Expr = upcast expr
override __.ColumnsNullableByDefault = true
override __.AlterTable(alter) =
match alter.Alteration with
| RenameTo _
| AddColumn _ ->
base.AlterTable(alter)
| _ ->
fail <|
Error.backendDoesNotSupportFeature
"SQLite" "ALTER TABLE statements other than RENAME TO/ADD COLUMN"
type SQLiteMigrationBackend(settings : ConnectionStringSettings) =
inherit DefaultMigrationBackend(settings)
override this.Initialize() =
let builder = DbConnectionStringBuilder(ConnectionString = settings.ConnectionString)
let dataSource = "Data Source"
if builder.ContainsKey(dataSource) then
match builder.[dataSource] with
| :? string as dataSource ->
if not <| File.Exists(dataSource) then
File.WriteAllBytes(dataSource, [||])
| _ -> ()
base.Initialize()
type SQLiteBackend() =
static let initialModel =
let main, temp = Name("main"), Name("temp")
{ Schemas =
[ Schema.Empty(main)
Schema.Empty(temp)
] |> List.map (fun s -> s.SchemaName, s) |> Map.ofList
DefaultSchema = main
TemporarySchema = temp
Builtin =
{ Functions = SQLiteFunctions.functions
}
BackendCharacteristics =
{ CanDropColumnWithDefaultValue = true
}
}
interface IBackend with
member this.MigrationBackend = <@ fun settings -> new SQLiteMigrationBackend(settings) :> IMigrationBackend @>
member this.InitialModel = initialModel
member this.ParameterTransform(columnType) =
match columnType.Type with
| DateTimeType ->
let transform (expr : Quotations.Expr) =
let xform (dtExpr : Quotations.Expr<DateTime>) =
<@ let utcDt =
let dtExpr = %dtExpr
if dtExpr.Kind = DateTimeKind.Unspecified
then DateTime.SpecifyKind(dtExpr, DateTimeKind.Utc)
else dtExpr.ToUniversalTime()
utcDt.ToString("yyyy'-'MM'-'dd'T'HH':'mm':'ss'.'fffZ") |> box
@>
let xform (dtExpr : Quotations.Expr) =
(xform (Expr.Cast(Expr.Coerce(dtExpr, typeof<DateTime>)))).Raw
let ty = expr.Type
let asObj = Expr.Coerce(expr, typeof<obj>)
if ty.IsConstructedGenericType && ty.GetGenericTypeDefinition() = typedefof<_ option> then
let invokeValue = Expr.Coerce(Expr.PropertyGet(expr, ty.GetProperty("Value")), typeof<obj>)
<@@ if isNull %%asObj then box DBNull.Value else %%xform invokeValue @@>
else
<@@ if isNull %%asObj then box DBNull.Value else %%xform asObj @@>
{ ParameterType = DbType.String
ValueTransform = transform
}
| GuidType ->
let transform (expr : Quotations.Expr) =
let xform (gExpr : Quotations.Expr<Guid>) =
<@ let guid = %gExpr
let bytes = guid.ToByteArray()
box bytes
@>
let xform (gExpr : Quotations.Expr) =
(xform (Expr.Cast(Expr.Coerce(gExpr, typeof<Guid>)))).Raw
let ty = expr.Type
let asObj = Expr.Coerce(expr, typeof<obj>)
if ty.IsConstructedGenericType && ty.GetGenericTypeDefinition() = typedefof<_ option> then
let invokeValue = Expr.Coerce(Expr.PropertyGet(expr, ty.GetProperty("Value")), typeof<obj>)
<@@ if isNull %%asObj then box DBNull.Value else %%xform invokeValue @@>
else
<@@ if isNull %%asObj then box DBNull.Value else %%xform asObj @@>
{ ParameterType = DbType.Binary
ValueTransform = transform
}
| _ -> ParameterTransform.Default(columnType)
member this.ToCommandFragments(indexer, stmts) =
let translator = SQLiteStatement(indexer)
translator.TotalStatements(stmts)
|> BackendUtilities.simplifyFragments
|> ResizeArray
:> _ IReadOnlyList