10 people like it.

Functional Unparsing SQL

A combinator based DSL for composing type-safe parameterized sql queries. Inspired by Olivier Danvy's "Functional Unparsing" paper.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
78: 
79: 
80: 
81: 
82: 
83: 
84: 
85: 

// Functional Unparsing http://www.brics.dk/RS/98/12/BRICS-RS-98-12.pdf

open System
open System.Data
open System.Data.SqlClient


// Type Decls
type SqlText = string
type Counter = int
type Value = obj
type GetParamName = Counter -> SqlText
type GetParameter = SqlText -> Value -> IDataParameter 
type QueryContext = QueryContext of (SqlText * Counter * IDataParameter list * GetParamName * GetParameter)

// Basic Combinators
let sql (value : String) cont (queryContext : QueryContext) = 
    let (QueryContext (sqlText, counter, parameters, getParamName, getParam)) = queryContext
    cont (QueryContext (sqlText + value, counter, parameters, getParamName, getParam))

let ``%o`` cont (queryContext : QueryContext) (value : obj) = 
    let (QueryContext (sqlText, counter, parameters, getParamName, getParam)) = queryContext
    let paramName = getParamName counter
    cont (QueryContext (sqlText + paramName, counter + 1, parameters @ [getParam paramName value], getParamName, getParam))

let ``%d`` cont (queryContext : QueryContext) (value : int) = ``%o`` cont queryContext value
let ``%s`` cont (queryContext : QueryContext) (value : string) = ``%o`` cont queryContext value
let ``%b`` cont (queryContext : QueryContext) (value : bool) = ``%o`` cont queryContext value
let ``%dt``cont (queryContext : QueryContext) (value : DateTime) = ``%o`` cont queryContext value

let ``%L``<'T, 'R> cont (queryContext : QueryContext) (values : 'T list) : 'R = 
    let (QueryContext (sqlText, counter, parameters, getParamName, getParam)) = queryContext
    match values with
    | [] -> cont (QueryContext (sqlText + "(null)", counter, parameters, getParamName, getParam))
    | _ ->
        let (parameters', paramNames) = values 
                                        |> List.mapi (fun index value -> (value :> obj, getParamName (index + counter)))
                                        |> List.map (fun (value, paramName) -> (getParam paramName value, paramName))
                                        |> (fun list -> (List.map fst list, List.map snd list))
        let result = sprintf "(%s)" <| String.Join(", ", paramNames) 
        cont (QueryContext (sqlText + result, counter + List.length paramNames, parameters @ parameters', getParamName, getParam))

// concatenation as composition
let (++) = (<<)

// Prepare-Map-Exec functions
let query (q : (QueryContext -> QueryContext) -> QueryContext -> 'a) : 'a =
    q id (QueryContext ("", 0, [], (fun counter -> sprintf "@p%d" counter), 
                              (fun paramName value -> new SqlParameter(paramName, value) :> _)))

let asTuple2 (reader : IDataReader) : ('a * 'b) = 
    (reader.GetValue 0 :?> 'a, reader.GetValue 1 :?> 'b)
let asTuple3 (reader : IDataReader) : ('a * 'b * 'c) = 
    (reader.GetValue 0 :?> 'a, reader.GetValue 1 :?> 'b, reader.GetValue 2 :?> 'c)

let exec (conn : string) (map : IDataReader -> 'a) (queryContext : QueryContext) : 'a list = 
    let (QueryContext (sqlText, _, parameters, _, _)) = queryContext
    // open conntection
    use sqlConnection = new SqlConnection(conn)
    sqlConnection.Open()
    // execute command
    use command = new SqlCommand(sqlText, sqlConnection) :> IDbCommand
    parameters |> List.iter (fun parameter -> command.Parameters.Add(parameter) |> ignore) 
    use reader = command.ExecuteReader()
    let rec loop (reader : IDataReader) acc = 
        if reader.Read() then
            loop reader (map reader :: acc)
        else
            acc |> List.rev
    loop reader []


// Example

let testQuery age name ids = 
    sql "SELECT name, age"
    ++ sql " FROM Customers" 
    ++ sql " WHERE age = " ++ ``%d`` 
    ++ sql " AND name = " ++ ``%s`` 
    ++ sql " AND id IN " ++ ``%L``<int, _>
    ++ sql " ORDER by id" |> query <| age <| name <| ids

let conn = "ConnectionString here"
for (name, age) in exec conn asTuple2 (testQuery 26 "George" [1..3]) do
    printfn "Name: %s, Age: %d" name age
namespace System
namespace System.Data
namespace System.Data.SqlClient
type SqlText = string

Full name: Script.SqlText
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
type Counter = int

Full name: Script.Counter
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
type Value = obj

Full name: Script.Value
type obj = Object

Full name: Microsoft.FSharp.Core.obj
type GetParamName = Counter -> SqlText

Full name: Script.GetParamName
type GetParameter = SqlText -> Value -> IDataParameter

Full name: Script.GetParameter
type IDataParameter =
  member DbType : DbType with get, set
  member Direction : ParameterDirection with get, set
  member IsNullable : bool
  member ParameterName : string with get, set
  member SourceColumn : string with get, set
  member SourceVersion : DataRowVersion with get, set
  member Value : obj with get, set

Full name: System.Data.IDataParameter
Multiple items
union case QueryContext.QueryContext: (SqlText * Counter * IDataParameter list * GetParamName * GetParameter) -> QueryContext

--------------------
type QueryContext = | QueryContext of (SqlText * Counter * IDataParameter list * GetParamName * GetParameter)

Full name: Script.QueryContext
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val sql : value:String -> cont:(QueryContext -> 'a) -> queryContext:QueryContext -> 'a

Full name: Script.sql
val value : String
Multiple items
type String =
  new : value:char -> string + 7 overloads
  member Chars : int -> char
  member Clone : unit -> obj
  member CompareTo : value:obj -> int + 1 overload
  member Contains : value:string -> bool
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EndsWith : value:string -> bool + 2 overloads
  member Equals : obj:obj -> bool + 2 overloads
  member GetEnumerator : unit -> CharEnumerator
  member GetHashCode : unit -> int
  ...

Full name: System.String

--------------------
String(value: nativeptr<char>) : unit
String(value: nativeptr<sbyte>) : unit
String(value: char []) : unit
String(c: char, count: int) : unit
String(value: nativeptr<char>, startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int) : unit
String(value: char [], startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: Text.Encoding) : unit
val cont : (QueryContext -> 'a)
val queryContext : QueryContext
val sqlText : SqlText
val counter : Counter
val parameters : IDataParameter list
val getParamName : GetParamName
val getParam : GetParameter
val ( %o ) : cont:(QueryContext -> 'a) -> queryContext:QueryContext -> value:obj -> 'a

Full name: Script.( %o )
val value : obj
val paramName : SqlText
val ( %d ) : cont:(QueryContext -> 'a) -> queryContext:QueryContext -> value:int -> 'a

Full name: Script.( %d )
val value : int
val ( %s ) : cont:(QueryContext -> 'a) -> queryContext:QueryContext -> value:string -> 'a

Full name: Script.( %s )
val value : string
val ( %b ) : cont:(QueryContext -> 'a) -> queryContext:QueryContext -> value:bool -> 'a

Full name: Script.( %b )
val value : bool
type bool = Boolean

Full name: Microsoft.FSharp.Core.bool
val ( %dt ) : cont:(QueryContext -> 'a) -> queryContext:QueryContext -> value:DateTime -> 'a

Full name: Script.( %dt )
val value : DateTime
Multiple items
type DateTime =
  struct
    new : ticks:int64 -> DateTime + 10 overloads
    member Add : value:TimeSpan -> DateTime
    member AddDays : value:float -> DateTime
    member AddHours : value:float -> DateTime
    member AddMilliseconds : value:float -> DateTime
    member AddMinutes : value:float -> DateTime
    member AddMonths : months:int -> DateTime
    member AddSeconds : value:float -> DateTime
    member AddTicks : value:int64 -> DateTime
    member AddYears : value:int -> DateTime
    ...
  end

Full name: System.DateTime

--------------------
DateTime()
   (+0 other overloads)
DateTime(ticks: int64) : unit
   (+0 other overloads)
DateTime(ticks: int64, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int, kind: DateTimeKind) : unit
   (+0 other overloads)
val ( %L ) : cont:(QueryContext -> 'R) -> queryContext:QueryContext -> values:'T list -> 'R

Full name: Script.( %L )
val cont : (QueryContext -> 'R)
val values : 'T list
val parameters' : IDataParameter list
val paramNames : SqlText list
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val mapi : mapping:(int -> 'T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.mapi
val index : int
val value : 'T
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
Multiple items
val list : (IDataParameter * SqlText) list

--------------------
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val fst : tuple:('T1 * 'T2) -> 'T1

Full name: Microsoft.FSharp.Core.Operators.fst
val snd : tuple:('T1 * 'T2) -> 'T2

Full name: Microsoft.FSharp.Core.Operators.snd
val result : string
val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf
String.Join(separator: string, values: Collections.Generic.IEnumerable<string>) : string
String.Join<'T>(separator: string, values: Collections.Generic.IEnumerable<'T>) : string
String.Join(separator: string, [<ParamArray>] values: obj []) : string
String.Join(separator: string, [<ParamArray>] value: string []) : string
String.Join(separator: string, value: string [], startIndex: int, count: int) : string
val length : list:'T list -> int

Full name: Microsoft.FSharp.Collections.List.length
val query : q:((QueryContext -> QueryContext) -> QueryContext -> 'a) -> 'a

Full name: Script.query
val q : ((QueryContext -> QueryContext) -> QueryContext -> 'a)
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
val value : Value
Multiple items
type SqlParameter =
  inherit DbParameter
  new : unit -> SqlParameter + 6 overloads
  member CompareInfo : SqlCompareOptions with get, set
  member DbType : DbType with get, set
  member Direction : ParameterDirection with get, set
  member IsNullable : bool with get, set
  member LocaleId : int with get, set
  member Offset : int with get, set
  member ParameterName : string with get, set
  member Precision : byte with get, set
  member ResetDbType : unit -> unit
  ...

Full name: System.Data.SqlClient.SqlParameter

--------------------
SqlParameter() : unit
SqlParameter(parameterName: string, dbType: SqlDbType) : unit
SqlParameter(parameterName: string, value: obj) : unit
SqlParameter(parameterName: string, dbType: SqlDbType, size: int) : unit
SqlParameter(parameterName: string, dbType: SqlDbType, size: int, sourceColumn: string) : unit
SqlParameter(parameterName: string, dbType: SqlDbType, size: int, direction: ParameterDirection, isNullable: bool, precision: byte, scale: byte, sourceColumn: string, sourceVersion: DataRowVersion, value: obj) : unit
SqlParameter(parameterName: string, dbType: SqlDbType, size: int, direction: ParameterDirection, precision: byte, scale: byte, sourceColumn: string, sourceVersion: DataRowVersion, sourceColumnNullMapping: bool, value: obj, xmlSchemaCollectionDatabase: string, xmlSchemaCollectionOwningSchema: string, xmlSchemaCollectionName: string) : unit
val asTuple2 : reader:IDataReader -> 'a * 'b

Full name: Script.asTuple2
val reader : IDataReader
type IDataReader =
  member Close : unit -> unit
  member Depth : int
  member GetSchemaTable : unit -> DataTable
  member IsClosed : bool
  member NextResult : unit -> bool
  member Read : unit -> bool
  member RecordsAffected : int

Full name: System.Data.IDataReader
IDataRecord.GetValue(i: int) : obj
val asTuple3 : reader:IDataReader -> 'a * 'b * 'c

Full name: Script.asTuple3
val exec : conn:string -> map:(IDataReader -> 'a) -> queryContext:QueryContext -> 'a list

Full name: Script.exec
val conn : string
val map : (IDataReader -> 'a)
val sqlConnection : SqlConnection
Multiple items
type SqlConnection =
  inherit DbConnection
  new : unit -> SqlConnection + 1 overload
  member BeginTransaction : unit -> SqlTransaction + 3 overloads
  member ChangeDatabase : database:string -> unit
  member Close : unit -> unit
  member ConnectionString : string with get, set
  member ConnectionTimeout : int
  member CreateCommand : unit -> SqlCommand
  member DataSource : string
  member Database : string
  member EnlistDistributedTransaction : transaction:ITransaction -> unit
  ...

Full name: System.Data.SqlClient.SqlConnection

--------------------
SqlConnection() : unit
SqlConnection(connectionString: string) : unit
val command : IDbCommand
Multiple items
type SqlCommand =
  inherit DbCommand
  new : unit -> SqlCommand + 3 overloads
  member BeginExecuteNonQuery : unit -> IAsyncResult + 1 overload
  member BeginExecuteReader : unit -> IAsyncResult + 3 overloads
  member BeginExecuteXmlReader : unit -> IAsyncResult + 1 overload
  member Cancel : unit -> unit
  member Clone : unit -> SqlCommand
  member CommandText : string with get, set
  member CommandTimeout : int with get, set
  member CommandType : CommandType with get, set
  member Connection : SqlConnection with get, set
  ...

Full name: System.Data.SqlClient.SqlCommand

--------------------
SqlCommand() : unit
SqlCommand(cmdText: string) : unit
SqlCommand(cmdText: string, connection: SqlConnection) : unit
SqlCommand(cmdText: string, connection: SqlConnection, transaction: SqlTransaction) : unit
type IDbCommand =
  member Cancel : unit -> unit
  member CommandText : string with get, set
  member CommandTimeout : int with get, set
  member CommandType : CommandType with get, set
  member Connection : IDbConnection with get, set
  member CreateParameter : unit -> IDbDataParameter
  member ExecuteNonQuery : unit -> int
  member ExecuteReader : unit -> IDataReader + 1 overload
  member ExecuteScalar : unit -> obj
  member Parameters : IDataParameterCollection
  ...

Full name: System.Data.IDbCommand
val iter : action:('T -> unit) -> list:'T list -> unit

Full name: Microsoft.FSharp.Collections.List.iter
val parameter : IDataParameter
property IDbCommand.Parameters: IDataParameterCollection
Collections.IList.Add(value: obj) : int
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
IDbCommand.ExecuteReader() : IDataReader
IDbCommand.ExecuteReader(behavior: CommandBehavior) : IDataReader
val loop : (IDataReader -> 'a list -> 'a list)
val acc : 'a list
IDataReader.Read() : bool
val rev : list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.rev
val testQuery : age:int -> name:string -> ids:int list -> QueryContext

Full name: Script.testQuery
val age : int
val name : string
val ids : int list
val conn : string

Full name: Script.conn
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn

More information

Link:http://fssnip.net/5X
Posted:13 years ago
Author:Nick Palladinos
Tags: sql , combinators , continuations

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.