Skip to content

Instantly share code, notes, and snippets.

@mausch
Created July 6, 2010 17:36
Show Gist options
  • Save mausch/465668 to your computer and use it in GitHub Desktop.
Save mausch/465668 to your computer and use it in GitHub Desktop.
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"]
()
@mausch
Copy link
Author

mausch commented Jul 5, 2011

This is now part of the FsSql project

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment