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"] | |
() |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This comment has been minimized.
This is now part of the FsSql project