PrintfFormat manipulation

module SQL

open System
open System.Data
open System.Data.SqlClient
open System.Text.RegularExpressions
open Microsoft.FSharp.Reflection
open Xunit

let connectionString = "data source=.;user id=sa;password=a;initial catalog=SomeDatabase"

// primitive implementation, doesn't work
let runQuery1 (query: PrintfFormat<'a, _, _, IDataReader>) : 'a = 
    let proc (a: int) (b: string) : IDataReader =
        printfn "%d %s" a b
        null
    unbox proc

let PrintfFormatProc (worker: string * obj list -> 'd)  (query: PrintfFormat<'a, _, _, 'd>) : 'a =
    if not (FSharpType.IsFunction typeof<'a>) then
        unbox (worker (query.Value, []))
    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 proc (types: Type list) (values: obj list) (a: obj) : obj =
            let values = a::values
            match types with
            | [x;_] -> 
                let result = worker (query.Value, List.rev values)
                box result
            | x::y::z::xs -> 
                let cont = proc (y::z::xs) values
                let ft = FSharpType.MakeFunctionType(y,z)
                let cont = FSharpValue.MakeFunction(ft, cont)
                box cont
            | _ -> failwith "shouldn't happen"
        
        let handler = proc types []
        unbox (FSharpValue.MakeFunction(typeof<'a>, handler))

let sqlProcessor (sql: string, values: obj list) : IDataReader =
    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 conn = new SqlConnection(connectionString)
    conn.Open()
    let cmd = conn.CreateCommand()
    cmd.CommandText <- sql
    let createParam i (p: obj) =
        let param = cmd.CreateParameter()
        param.ParameterName <- sprintf "@p%d" i
        param.Value <- p
        cmd.Parameters.Add param |> ignore
    values |> Seq.iteri createParam
    upcast cmd.ExecuteReader(CommandBehavior.CloseConnection)

let runQuery a = PrintfFormatProc sqlProcessor a

[<Fact>]
let runQueryTest() =
    use results = runQuery "select top 5 * from usuario where nroid = %d and nombres = %s" 13598 "pepe"
    while results.Read() do
        printfn "%A" results.["nroid"]
    use results = runQuery "select top 5 * from usuario"
    while results.Read() do
        printfn "%A" results.["nroid"]
    ()

This is now part of the FsSql project