<commit_before>﻿module Sql

open System
open System.Collections.Generic
open System.Data
open System.Data.SqlClient
open System.Linq
open System.Text.RegularExpressions
open Microsoft.FSharp.Reflection
open FsSqlImpl
open FsSqlPrelude

/// Encapsulates how to create and dispose a database connection
type ConnectionManager = (unit -> IDbConnection) * (IDbConnection -> unit) * (IDbTransaction option)

/// Creates a <see cref="ConnectionManager"/> with an externally-owned connection
let withConnection (conn: IDbConnection) : ConnectionManager =
    let id = Guid.NewGuid().ToString()
    let create() = 
        logf "creating connection from const %s" id
        conn
    let dispose c = logf "disposing connection (but not really) %s" id
    create,dispose,None

let withTransaction (tx: IDbTransaction): ConnectionManager =
    let id = Guid.NewGuid().ToString()
    let create() = 
        logf "creating connection from const %s" id
        tx.Connection
    let dispose c = logf "disposing connection (but not really) %s" id
    create,dispose,Some tx

/// Creates a <see cref="ConnectionManager"/> with an owned connection
let withNewConnection (create: unit -> IDbConnection) : ConnectionManager = 
    let id = Guid.NewGuid().ToString()
    let create() =
        logf "creating connection %s" id
        create()
    let dispose (c: IDisposable) = 
        c.Dispose()
        logf "disposing connection %s" id
    create,dispose,None

let internal withCreateConnection (create: unit -> IDbConnection) : ConnectionManager = 
    let dispose x = ()
    create,dispose,None

let internal doWithConnection (cmgr: ConnectionManager) f =
    let create,dispose,_ = cmgr
    withResource create dispose f
    
let internal PrintfFormatProc (worker: string * obj list -> 'd)  (query: PrintfFormat<'a, _, _, 'd>) : 'a =
    if not (FSharpType.IsFunction typeof<'a>) then
        let result = worker (query.Value, [])
        unbox result
    else
        let rec getFlattenedFunctionElements (functionType: Type) =
            let domain, range = FSharpType.GetFunctionElements functionType
            if not (FSharpType.IsFunction range)
                then domain::[range]
                else domain::getFlattenedFunctionElements(range)
        let types = getFlattenedFunctionElements typeof<'a>
        let rec makeFunctionType (types: Type list) =
            match types with
            | [x;y] -> FSharpType.MakeFunctionType(x,y)
            | x::xs -> FSharpType.MakeFunctionType(x,makeFunctionType xs)
            | _ -> failwith "shouldn't happen"
        let rec proc (types: Type list) (values: obj list) (a: obj) : obj =
            let id = Guid.NewGuid().ToString()
            let values = a::values
            match types with
            | [x;y] -> 
                let result = worker (query.Value, List.rev values)
                box result
            | x::y::z::xs -> 
                let cont = proc (y::z::xs) values
                let ft = makeFunctionType (y::z::xs)
                let cont = FSharpValue.MakeFunction(ft, cont)
                box cont
            | _ -> failwith "shouldn't happen"
        
        let handler = proc types []
        unbox (FSharpValue.MakeFunction(typeof<'a>, handler))

let internal sqlProcessor (cmgr: ConnectionManager) (withCmd: IDbCommand -> IDbConnection -> 'a) (sql: string, values: obj list) =
    let stripFormatting s =
        let i = ref -1
        let eval (rxMatch: Match) =
            incr i
            sprintf "@p%d" !i
        Regex.Replace(s, "%.", eval)
    let sql = stripFormatting sql
    let sqlProcessor' (conn: IDbConnection) = 
        use cmd = conn.CreateCommand()
        cmd.CommandText <- sql
        let _,_,tx = cmgr
        cmd.Transaction <- 
            match tx with
            | None -> null
            | Some t -> t
        let createParam i (p: obj) =
            let param = cmd.CreateParameter()
            //param.DbType <- DbType.
            param.ParameterName <- sprintf "@p%d" i
            param.Value <- p
            cmd.Parameters.Add param |> ignore
        values |> Seq.iteri createParam
        withCmd cmd conn
    doWithConnection cmgr sqlProcessor'

let internal sqlProcessorToDataReader (cmgr: ConnectionManager) b = 
    let create,dispose,_ = cmgr
    let exec (cmd: IDbCommand) (conn: IDbConnection) = 
        let dispose() = dispose conn
        new DataReaderWrapper(cmd.ExecuteReader(), dispose) :> IDataReader
    sqlProcessor (withCreateConnection create) exec b

let internal sqlProcessorNonQuery a b =
    let exec (cmd: IDbCommand) x = 
        cmd.ExecuteNonQuery()
    sqlProcessor a exec b

/// Executes a printf-formatted query and returns a data reader
let execReaderF connectionFactory a = PrintfFormatProc (sqlProcessorToDataReader connectionFactory) a

/// Executes a printf-formatted SQL statement and returns the number of rows affected
let execNonQueryF connectionFactory a = PrintfFormatProc (sqlProcessorNonQuery connectionFactory) a

/// Represents a parameter to a command
type Parameter = {
    DbType: DbType
    Direction: ParameterDirection
    ParameterName: string
    Value: obj
} with
    static member make(parameterName, value: obj) =
        { DbType = Unchecked.defaultof<DbType>
          Direction = ParameterDirection.Input
          ParameterName = parameterName
          Value = value }

/// Adds a parameter to a command
let addParameter (cmd: #IDbCommand) (p: Parameter) =
    let par = cmd.CreateParameter()
    par.DbType <- p.DbType
    par.Direction <- p.Direction
    par.ParameterName <- p.ParameterName
    par.Value <- 
        match p.Value with
        | null -> box DBNull.Value
        | FSharpValue.OptionType -> optionToDBNull p.Value
        | x -> x
    cmd.Parameters.Add par |> ignore
    cmd

let internal prepareCommand (connection: #IDbConnection) (tx: IDbTransaction option) (sql: string) (cmdType: CommandType) (parameters: #seq<Parameter>) =
    let cmd = connection.CreateCommand()
    cmd.CommandText <- sql
    cmd.Transaction <- 
        match tx with
        | None -> null
        | Some t -> t
    cmd.CommandType <- cmdType
    parameters |> Seq.iter (addParameter cmd >> ignore)
    cmd

let internal inferParameterDbType (p: string * obj) = 
    Parameter.make(fst p, snd p)

/// Creates a list of parameters
let parameters (p: #seq<string * obj>) = 
    p |> Seq.map inferParameterDbType

let paramsFromDict (p: #IDictionary<string, obj>) =
    p |> Seq.map (|KeyValue|) |> parameters

/// Executes and returns a data reader
let internal execReaderInternal cmdType (cmgr: ConnectionManager) (sql: string) (parameters: #seq<Parameter>) =
    let create,dispose,tx = cmgr
    let connection = create()
    use cmd = prepareCommand connection tx sql cmdType parameters
    let dispose() = dispose connection
    new DataReaderWrapper(cmd.ExecuteReader(), dispose) :> IDataReader

/// Executes a query and returns a data reader
let execReader connMgr = execReaderInternal CommandType.Text connMgr

/// Executes a stored procedure and returns a data reader
let execSPReader connMgr = execReaderInternal CommandType.StoredProcedure connMgr
<commit_msg>moved command dispose to end of datareader<commit_after>﻿module Sql

open System
open System.Collections.Generic
open System.Data
open System.Data.SqlClient
open System.Linq
open System.Text.RegularExpressions
open Microsoft.FSharp.Reflection
open FsSqlImpl
open FsSqlPrelude

/// Encapsulates how to create and dispose a database connection
type ConnectionManager = (unit -> IDbConnection) * (IDbConnection -> unit) * (IDbTransaction option)

/// Creates a <see cref="ConnectionManager"/> with an externally-owned connection
let withConnection (conn: IDbConnection) : ConnectionManager =
    let id = Guid.NewGuid().ToString()
    let create() = 
        logf "creating connection from const %s" id
        conn
    let dispose c = logf "disposing connection (but not really) %s" id
    create,dispose,None

let withTransaction (tx: IDbTransaction): ConnectionManager =
    let id = Guid.NewGuid().ToString()
    let create() = 
        logf "creating connection from const %s" id
        tx.Connection
    let dispose c = logf "disposing connection (but not really) %s" id
    create,dispose,Some tx

/// Creates a <see cref="ConnectionManager"/> with an owned connection
let withNewConnection (create: unit -> IDbConnection) : ConnectionManager = 
    let id = Guid.NewGuid().ToString()
    let create() =
        logf "creating connection %s" id
        create()
    let dispose (c: IDisposable) = 
        c.Dispose()
        logf "disposing connection %s" id
    create,dispose,None

let internal withCreateConnection (create: unit -> IDbConnection) : ConnectionManager = 
    let dispose x = ()
    create,dispose,None

let internal doWithConnection (cmgr: ConnectionManager) f =
    let create,dispose,_ = cmgr
    withResource create dispose f
    
let internal PrintfFormatProc (worker: string * obj list -> 'd)  (query: PrintfFormat<'a, _, _, 'd>) : 'a =
    if not (FSharpType.IsFunction typeof<'a>) then
        let result = worker (query.Value, [])
        unbox result
    else
        let rec getFlattenedFunctionElements (functionType: Type) =
            let domain, range = FSharpType.GetFunctionElements functionType
            if not (FSharpType.IsFunction range)
                then domain::[range]
                else domain::getFlattenedFunctionElements(range)
        let types = getFlattenedFunctionElements typeof<'a>
        let rec makeFunctionType (types: Type list) =
            match types with
            | [x;y] -> FSharpType.MakeFunctionType(x,y)
            | x::xs -> FSharpType.MakeFunctionType(x,makeFunctionType xs)
            | _ -> failwith "shouldn't happen"
        let rec proc (types: Type list) (values: obj list) (a: obj) : obj =
            let id = Guid.NewGuid().ToString()
            let values = a::values
            match types with
            | [x;y] -> 
                let result = worker (query.Value, List.rev values)
                box result
            | x::y::z::xs -> 
                let cont = proc (y::z::xs) values
                let ft = makeFunctionType (y::z::xs)
                let cont = FSharpValue.MakeFunction(ft, cont)
                box cont
            | _ -> failwith "shouldn't happen"
        
        let handler = proc types []
        unbox (FSharpValue.MakeFunction(typeof<'a>, handler))

let internal sqlProcessor (cmgr: ConnectionManager) (withCmd: IDbCommand -> IDbConnection -> 'a) (sql: string, values: obj list) =
    let stripFormatting s =
        let i = ref -1
        let eval (rxMatch: Match) =
            incr i
            sprintf "@p%d" !i
        Regex.Replace(s, "%.", eval)
    let sql = stripFormatting sql
    let sqlProcessor' (conn: IDbConnection) = 
        use cmd = conn.CreateCommand()
        cmd.CommandText <- sql
        let _,_,tx = cmgr
        cmd.Transaction <- 
            match tx with
            | None -> null
            | Some t -> t
        let createParam i (p: obj) =
            let param = cmd.CreateParameter()
            //param.DbType <- DbType.
            param.ParameterName <- sprintf "@p%d" i
            param.Value <- p
            cmd.Parameters.Add param |> ignore
        values |> Seq.iteri createParam
        withCmd cmd conn
    doWithConnection cmgr sqlProcessor'

let internal sqlProcessorToDataReader (cmgr: ConnectionManager) b = 
    let create,dispose,_ = cmgr
    let exec (cmd: IDbCommand) (conn: IDbConnection) = 
        let dispose() = dispose conn
        new DataReaderWrapper(cmd.ExecuteReader(), dispose) :> IDataReader
    sqlProcessor (withCreateConnection create) exec b

let internal sqlProcessorNonQuery a b =
    let exec (cmd: IDbCommand) x = 
        cmd.ExecuteNonQuery()
    sqlProcessor a exec b

/// Executes a printf-formatted query and returns a data reader
let execReaderF connectionFactory a = PrintfFormatProc (sqlProcessorToDataReader connectionFactory) a

/// Executes a printf-formatted SQL statement and returns the number of rows affected
let execNonQueryF connectionFactory a = PrintfFormatProc (sqlProcessorNonQuery connectionFactory) a

/// Represents a parameter to a command
type Parameter = {
    DbType: DbType
    Direction: ParameterDirection
    ParameterName: string
    Value: obj
} with
    static member make(parameterName, value: obj) =
        { DbType = Unchecked.defaultof<DbType>
          Direction = ParameterDirection.Input
          ParameterName = parameterName
          Value = value }

/// Adds a parameter to a command
let addParameter (cmd: #IDbCommand) (p: Parameter) =
    let par = cmd.CreateParameter()
    par.DbType <- p.DbType
    par.Direction <- p.Direction
    par.ParameterName <- p.ParameterName
    par.Value <- 
        match p.Value with
        | null -> box DBNull.Value
        | FSharpValue.OptionType -> optionToDBNull p.Value
        | x -> x
    cmd.Parameters.Add par |> ignore
    cmd

let internal prepareCommand (connection: #IDbConnection) (tx: IDbTransaction option) (sql: string) (cmdType: CommandType) (parameters: #seq<Parameter>) =
    let cmd = connection.CreateCommand()
    cmd.CommandText <- sql
    cmd.Transaction <- 
        match tx with
        | None -> null
        | Some t -> t
    cmd.CommandType <- cmdType
    parameters |> Seq.iter (addParameter cmd >> ignore)
    cmd

let internal inferParameterDbType (p: string * obj) = 
    Parameter.make(fst p, snd p)

/// Creates a list of parameters
let parameters (p: #seq<string * obj>) = 
    p |> Seq.map inferParameterDbType

let paramsFromDict (p: #IDictionary<string, obj>) =
    p |> Seq.map (|KeyValue|) |> parameters

/// Executes and returns a data reader
let internal execReaderInternal cmdType (cmgr: ConnectionManager) (sql: string) (parameters: #seq<Parameter>) =
    let create,dispose,tx = cmgr
    let connection = create()
    let cmd = prepareCommand connection tx sql cmdType parameters
    let dispose() = 
        cmd.Dispose()
        dispose connection
    new DataReaderWrapper(cmd.ExecuteReader(), dispose) :> IDataReader

/// Executes a query and returns a data reader
let execReader connMgr = execReaderInternal CommandType.Text connMgr

/// Executes a stored procedure and returns a data reader
let execSPReader connMgr = execReaderInternal CommandType.StoredProcedure connMgr

{'fraction_non_alphanumeric': 0.09244339491596056, 'fraction_numerical': 0.00013890818169190166, 'mean_word_length': 2.693945613134941, 'pattern_counts': {'":': 0, '<': 49, '<?xml version=': 0, '>': 87, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '710804', 'n_tokens_mistral': 4055, 'n_tokens_neox': 3929, 'n_words': 1311}