Skip to content

Commit

Permalink
try to make memory-footsprint smaller
Browse files Browse the repository at this point in the history
  • Loading branch information
@Thorium
Thorium committed Sep 15, 2024
1 parent 7933e2b commit 91d7233
Show file tree
Hide file tree
Showing 18 changed files with 237 additions and 207 deletions.
109 changes: 63 additions & 46 deletions src/SQLProvider.DesignTime/SqlDesignTime.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,8 +22,24 @@ type internal SqlRuntimeInfo (config : TypeProviderConfig) =
//| Choice2Of2(paths, errors) -> Assembly.GetExecutingAssembly()
member __.RuntimeAssembly = runtimeAssembly

type internal CacheKey =
(struct ( string * // ConnectionString URL
string * // ConnectionString Name
DatabaseProviderTypes * // db vendor
string * // Assembly resolution path for db connectors and custom types
int * // Individuals Amount
NullableColumnType * // Use option types?
string * // Schema owner currently only used for oracle
CaseSensitivityChange * // Should we do ToUpper or ToLower when generating table names?
string * // Table names list (Oracle and MSSQL Only)
string * // Context schema path
OdbcQuoteCharacter * // Quote characters (Odbc only)
SQLiteLibrary * // Use System.Data.SQLite or Mono.Data.SQLite or select automatically (SQLite only)
string * // SSDT Path
string)) //typeName

module internal DesignTimeCache =
let cache = System.Collections.Concurrent.ConcurrentDictionary<_,Lazy<ProvidedTypeDefinition>>()
let cache = System.Collections.Concurrent.ConcurrentDictionary<CacheKey,Lazy<ProvidedTypeDefinition>>()

type internal ParameterValue =
| UserProvided of string * string * Type
Expand All @@ -46,7 +62,7 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
let [<Literal>] FSHARP_DATA_SQL = "FSharp.Data.Sql"
let empty = fun (_:Expr list) -> <@@ () @@>

let rec createTypes(connectionString, conStringName,dbVendor,resolutionPath,individualsAmount,useOptionTypes,owner,caseSensitivity, tableNames, contextSchemaPath, odbcquote, sqliteLibrary, ssdtPath, rootTypeName) =
let rec createTypes(struct(connectionString, conStringName,dbVendor,resolutionPath,individualsAmount,useOptionTypes,owner,caseSensitivity, tableNames, contextSchemaPath, odbcquote, sqliteLibrary, ssdtPath, rootTypeName)) =
let resolutionPath =
if String.IsNullOrWhiteSpace resolutionPath
then config.ResolutionFolder
Expand Down Expand Up @@ -93,7 +109,7 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
lazy
match con with
| Some con -> prov.GetTables(con,caseSensitivity)
| None -> prov.GetSchemaCache().Tables |> Seq.map (fun kv -> kv.Value) |> Seq.toList
| None -> prov.GetSchemaCache().Tables |> Seq.map (fun kv -> kv.Value) |> Seq.toArray

let tableColumns =
lazy
Expand All @@ -114,7 +130,7 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
let rel =
match prov.GetSchemaCache().Relationships.TryGetValue(t.FullName) with
| true,rel -> rel
| false,_ -> ([],[])
| false,_ -> ([||],[||])
(cols,rel))]

let sprocData =
Expand Down Expand Up @@ -147,7 +163,7 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
let baseTypes =
lazy
dict [ let tablesforced = tables.Force()
if List.isEmpty tablesforced then
if Array.isEmpty tablesforced then
let hint =
match con with
| Some con ->
Expand Down Expand Up @@ -296,11 +312,13 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
lazy
dict [ for table in tables.Force() do
let name = table.FullName
let (et,_,_,_) = baseTypes.Force().[name]
let ct = ProvidedTypeDefinition(table.FullName, Some typeof<obj>,isErased=true)
ct.AddInterfaceImplementationsDelayed( fun () -> [ProvidedTypeBuilder.MakeGenericType(typedefof<System.Linq.IQueryable<_>>,[et :> Type]); typeof<ISqlDataContext>])
let it = createIndividualsType table
yield table.FullName,(ct,it) ]
match baseTypes.Force().TryGetValue name with
| true, (et,_,_,_) ->
let ct = ProvidedTypeDefinition(name, Some typeof<obj>,isErased=true)
ct.AddInterfaceImplementationsDelayed( fun () -> [ProvidedTypeBuilder.MakeGenericType(typedefof<System.Linq.IQueryable<_>>,[et :> Type]); typeof<ISqlDataContext>])
let it = createIndividualsType table
yield name,(ct,it)
| false, _ -> ()]

// add the attributes and relationships
for KeyValue(key,(t,_,_,_)) in baseTypes.Force() do
Expand Down Expand Up @@ -353,38 +371,41 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
let relProps =
let getRelationshipName = Utilities.uniqueName()
let bts = baseTypes.Force()
let ty = typedefof<System.Linq.IQueryable<_>>
[ for r in children do
if bts.ContainsKey(r.ForeignTable) then
let (tt,_,_,_) = bts.[r.ForeignTable]
let ty = typedefof<System.Linq.IQueryable<_>>
let ty = ty.MakeGenericType tt
let constraintName = r.Name
let niceName = getRelationshipName (sprintf "%s by %s" r.ForeignTable r.PrimaryKey)
let prop = ProvidedProperty(niceName,ty, getterCode = fun args ->
let pt = r.PrimaryTable
let pk = r.PrimaryKey
let ft = r.ForeignTable
let fk = r.ForeignKey
let a0 = args.[0]
<@@ (%%a0 : SqlEntity).DataContext.CreateRelated((%%a0 : SqlEntity),constraintName,pt,pk,ft,fk,RelationshipDirection.Children) @@> )
prop.AddXmlDoc(sprintf "Related %s entities from the foreign side of the relationship, where the primary key is %s and the foreign key is %s. Constraint: %s" r.ForeignTable r.PrimaryKey r.ForeignKey constraintName)
yield prop ] @
match bts.TryGetValue r.ForeignTable with
| true, (tt,_,_,_) ->
let ty = ty.MakeGenericType tt
let constraintName = r.Name
let niceName = getRelationshipName (sprintf "%s by %s" r.ForeignTable r.PrimaryKey)
let prop = ProvidedProperty(niceName,ty, getterCode = fun args ->
let pt = r.PrimaryTable
let pk = r.PrimaryKey
let ft = r.ForeignTable
let fk = r.ForeignKey
let a0 = args.[0]
<@@ (%%a0 : SqlEntity).DataContext.CreateRelated((%%a0 : SqlEntity),constraintName,pt,pk,ft,fk,RelationshipDirection.Children) @@> )
prop.AddXmlDoc(sprintf "Related %s entities from the foreign side of the relationship, where the primary key is %s and the foreign key is %s. Constraint: %s" r.ForeignTable r.PrimaryKey r.ForeignKey constraintName)
yield prop
| false, _ -> ()
] @
[ for r in parents do
if bts.ContainsKey(r.PrimaryTable) then
let (tt,_,_,_) = (bts.[r.PrimaryTable])
let ty = typedefof<System.Linq.IQueryable<_>>
let ty = ty.MakeGenericType tt
let constraintName = r.Name
let niceName = getRelationshipName (sprintf "%s by %s" r.PrimaryTable r.PrimaryKey)
let prop = ProvidedProperty(niceName,ty, getterCode = fun args ->
let pt = r.PrimaryTable
let pk = r.PrimaryKey
let ft = r.ForeignTable
let fk = r.ForeignKey
let a0 = args.[0]
<@@ (%%a0 : SqlEntity).DataContext.CreateRelated((%%a0 : SqlEntity),constraintName,pt, pk,ft, fk,RelationshipDirection.Parents) @@> )
prop.AddXmlDoc(sprintf "Related %s entities from the primary side of the relationship, where the primary key is %s and the foreign key is %s. Constraint: %s" r.PrimaryTable r.PrimaryKey r.ForeignKey constraintName)
yield prop ]
match bts.TryGetValue r.PrimaryTable with
| true, (tt,_,_,_) ->
let ty = ty.MakeGenericType tt
let constraintName = r.Name
let niceName = getRelationshipName (sprintf "%s by %s" r.PrimaryTable r.PrimaryKey)
let prop = ProvidedProperty(niceName,ty, getterCode = fun args ->
let pt = r.PrimaryTable
let pk = r.PrimaryKey
let ft = r.ForeignTable
let fk = r.ForeignKey
let a0 = args.[0]
<@@ (%%a0 : SqlEntity).DataContext.CreateRelated((%%a0 : SqlEntity),constraintName,pt, pk,ft, fk,RelationshipDirection.Parents) @@> )
prop.AddXmlDoc(sprintf "Related %s entities from the primary side of the relationship, where the primary key is %s and the foreign key is %s. Constraint: %s" r.PrimaryTable r.PrimaryKey r.ForeignKey constraintName)
yield prop
| false, _ -> ()
]
attProps @ relProps)

let generateSprocMethod (container:ProvidedTypeDefinition) (con:IDbConnection option) (sproc:CompileTimeSprocDefinition) =
Expand Down Expand Up @@ -608,7 +629,6 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
Expr.NewArray(
typeof<string*obj>,
args
|> Seq.toList
|> List.mapi(fun i v -> Expr.NewTuple [ Expr.Value normalParameters.[i].Name
Expr.Coerce(v, typeof<obj>) ] ))
<@@
Expand All @@ -630,7 +650,6 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
Expr.NewArray(
typeof<string*obj>,
args
|> Seq.toList
|> List.mapi(fun i v -> Expr.NewTuple [ Expr.Value backwardCompatibilityOnly.[i].Name
Expr.Coerce(v, typeof<obj>) ] ))
<@@
Expand Down Expand Up @@ -670,7 +689,6 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
Expr.NewArray(
typeof<string*obj>,
args
|> Seq.toList
|> List.mapi(fun i v -> Expr.NewTuple [ Expr.Value normalParameters.[i].Name
Expr.Coerce(v, typeof<obj>) ] ))
<@@
Expand Down Expand Up @@ -702,7 +720,6 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
Expr.NewArray(
typeof<string*obj>,
args
|> Seq.toList
|> List.mapi(fun i v -> Expr.NewTuple [ Expr.Value backwardCompatibilityOnly.[i].Name
Expr.Coerce(v, typeof<obj>) ] ))
<@@
Expand All @@ -726,7 +743,6 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
Expr.NewArray(
typeof<string*obj>,
args
|> Seq.toList
|> List.mapi(fun i v -> Expr.NewTuple [ Expr.Value minimalParameters.[i].Name
Expr.Coerce(v, typeof<obj>) ] ))
<@@
Expand Down Expand Up @@ -1081,6 +1097,7 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
do paramSqlType.DefineStaticParameters([dbVendor;conString;connStringName;resolutionPath;individualsAmount;optionTypes;owner;caseSensitivity; tableNames; contextSchemaPath; odbcquote; sqliteLibrary; ssdtPath], fun typeName args ->

let arguments =
struct (
args.[1] :?> string, // ConnectionString URL
args.[2] :?> string, // ConnectionString Name
args.[0] :?> DatabaseProviderTypes, // db vendor
Expand All @@ -1094,7 +1111,7 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
args.[10] :?> OdbcQuoteCharacter, // Quote characters (Odbc only)
args.[11] :?> SQLiteLibrary, // Use System.Data.SQLite or Mono.Data.SQLite or select automatically (SQLite only)
args.[12] :?> string, // SSDT Path
typeName
typeName)

let addCache args =
lazy
Expand Down
6 changes: 3 additions & 3 deletions src/SQLProvider.Runtime/Providers.DuckDb.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -529,7 +529,7 @@ type internal DuckDbProvider(resolutionPath, contextSchemaPath, owner:string, re
use reader = com.ExecuteReader()
[ while reader.Read() do
let table ={ Schema = reader.GetString(0); Name = reader.GetString(1); Type=reader.GetString(2) }
yield schemaCache.Tables.GetOrAdd(table |> quotedTableName,table) ]
yield schemaCache.Tables.GetOrAdd(table |> quotedTableName,table) ] |> List.toArray
executeSql DuckDb.createCommand (sprintf "select TABLE_SCHEMA, TABLE_NAME, TABLE_TYPE from INFORMATION_SCHEMA.TABLES where %s in (%s)" caseChane (String.Join(",", dbName))) con)

member __.GetPrimaryKey(table) =
Expand Down Expand Up @@ -615,13 +615,13 @@ type internal DuckDbProvider(resolutionPath, contextSchemaPath, owner:string, re
let children =
[ while reader.Read() do
yield { Name = reader.GetString(0); PrimaryTable=Table.CreateQuotedFullName(reader.GetString(2),reader.GetString(1), "\"", "\""); PrimaryKey=reader.GetString(3)
ForeignTable=Table.CreateQuotedFullName(reader.GetString(5),reader.GetString(4), "\"", "\""); ForeignKey=reader.GetString(6) } ]
ForeignTable=Table.CreateQuotedFullName(reader.GetString(5),reader.GetString(4), "\"", "\""); ForeignKey=reader.GetString(6) } ] |> List.toArray
reader.Dispose()
//use com = (this:>ISqlProvider).CreateCommand(con,(sprintf "%s AND KCU1.REFERENCED_TABLE_NAME = $table" baseQuery))
//com.Parameters.Add((this:>ISqlProvider).CreateCommandParameter(QueryParameter.Create("table", 0), (DuckDb.ripQuotes table.Name))) |> ignore
//if con.State <> ConnectionState.Open then con.Open()
//use reader = com.ExecuteReader()
let parents = List.empty
let parents = Array.empty
//[ while reader.Read() do
// yield { Name = reader.GetString(0); PrimaryTable=Table.CreateQuotedFullName(reader.GetString(2),reader.GetString(1), "\"", "\""); PrimaryKey=reader.GetString(3)
// ForeignTable= Table.CreateQuotedFullName(reader.GetString(5),reader.GetString(4), "\"", "\""); ForeignKey=reader.GetString(6) } ]
Expand Down
6 changes: 3 additions & 3 deletions src/SQLProvider.Runtime/Providers.Firebird.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -606,7 +606,7 @@ type internal FirebirdProvider(resolutionPath, contextSchemaPath, owner, referen
use reader = Firebird.executeSql Firebird.createCommand (sprintf "select 'Dbo', trim(RDB$RELATION_NAME), 'BASE TABLE' from RDB$RELATIONS") con
[ while reader.Read() do
let table ={ Schema = reader.GetString(0); Name = reader.GetString(1).Trim(); Type=reader.GetString(2) }
yield schemaCache.Tables.GetOrAdd(table.Name,table) ])
yield schemaCache.Tables.GetOrAdd(table.Name,table) ] |> List.toArray)

member __.GetPrimaryKey(table) =
match schemaCache.PrimaryKeys.TryGetValue table.Name with
Expand Down Expand Up @@ -693,13 +693,13 @@ type internal FirebirdProvider(resolutionPath, contextSchemaPath, owner, referen
let children =
[ while reader.Read() do
yield { Name = reader.GetString(0); PrimaryTable=Table.CreateFullName(reader.GetString(2),reader.GetString(1)); PrimaryKey=reader.GetString(3)
ForeignTable=Table.CreateFullName(reader.GetString(5),reader.GetString(4)); ForeignKey=reader.GetString(6) } ]
ForeignTable=Table.CreateFullName(reader.GetString(5),reader.GetString(4)); ForeignKey=reader.GetString(6) } ] |> List.toArray
reader.Dispose()
use reader = Firebird.executeSql Firebird.createCommand (sprintf "%s WHERE RCref.RDB$RELATION_NAME = '%s'" baseQuery (Firebird.ripQuotes table.Name) ) con
let parents =
[ while reader.Read() do
yield { Name = reader.GetString(0); PrimaryTable=Table.CreateFullName(reader.GetString(2),reader.GetString(1)); PrimaryKey=reader.GetString(3)
ForeignTable= Table.CreateFullName(reader.GetString(5),reader.GetString(4)); ForeignKey=reader.GetString(6) } ]
ForeignTable= Table.CreateFullName(reader.GetString(5),reader.GetString(4)); ForeignKey=reader.GetString(6) } ] |> List.toArray
(children,parents))
res)

Expand Down
Loading

0 comments on commit 91d7233

Please sign in to comment.