Viral F#

Most of the developers have dealt with calling SQL server stored procedures from their applications at least once or twice. In my last project, where intense data mining is done on the SQL side, this is basically all I am doing. There is always a desire to wrap and abstract the ever-repetitive code to get the connection, build an instance of the SqlCommand class, read in the returned dataset. And it is never coming out quite as succinct as expected.

Again, this is a perfect situation for using computation expressions, as we can clearly see the workflow:

1. Connect to the database
2. Set command text
3. Set command parameters (if necessary)
4. Set other command options
5. Execute the command of a necessary type

So at this point, it is easy to figure out how to write the builder for the command-oriented workflow.

Defining the Monadic Type

The gist of this workflow is that we take an instance of SqlCommand and run with it every step of our workflow. Hence, the step is defined like this:

    type CmdSqlMonad<'a> = SqlCommand -> 'a
    let sqlMonad<'a> (f : SqlCommand -> 'a) : CmdSqlMonad<'a> = f

(the operator on line 2 is defined for convenience and to guide the type system).

We can also define some auxiliary methods:

    type sqlParams = (string * obj) []

    let setParameters (sqlParameters : sqlParams) =
        sqlMonad(fun (cmd : SqlCommand) -> sqlParameters |> Seq.iter(fun (name, value) -> cmd.Parameters.AddWithValue(name, value) |> ignore))

    let setType (tp : CommandType) = sqlMonad (fun cmd -> cmd.CommandType  cmd.ExecuteReader())

    let execNonQuery() =
        sqlMonad(fun cmd ->  cmd.ExecuteNonQuery())

    let execScalar() =
        sqlMonad (fun cmd -> cmd.ExecuteScalar())

    let setTimeout(sec) = sqlMonad(fun cmd -> cmd.CommandTimeout

Each of these (except for the last three) are of the type CmdSqlMonad<unit>, as they simply set some properties on our SqlCommand object. This object is propagated all the way through the workflow by our Bind() function:

        member this.Bind(c : CmdSqlMonad<'a>, f : 'a -> CmdSqlMonad<'b>) =
            sqlMonad(fun cmd ->
                let value = c cmd
                f value cmd)

We can start defining the builder now. This builder is parameterized. It takes the connection string and the command name (or any query for that matter):

    type CmdSqlBuilder (connectionString, command) =
        do
            if String.IsNullOrWhiteSpace(connectionString) then invalidArg "connectionString" "connection string must be supplied"

        let connection = new SqlConnection(connectionString)
        let cmd = new SqlCommand(name, connection)

        do
            (retry {
                return connection.Open()
            }) defaultRetryParams

        let dispose () =
            cmd.Dispose()

        interface IDisposable with
            member this.Dispose () =
                dispose()
                GC.SuppressFinalize(this)

        override this.Finalize() = dispose()

(Note the use of “retry” computation expression).

The rest of the stuff is pretty standard:

        member this.Return ( x : 'a) : CmdSqlMonad<'a> = fun cmd -> x
        member this.Run( m : CmdSqlMonad<'a>) = m cmd
        member this.Delay(f : unit -> CmdSqlMonad<'a>) = f()
        member this.ReturnFrom(m : CmdSqlMonad<'a>) = m

We define the Run method to execute the workflow right away with the command that is created in the constructor.

Finally, to define the computation expression:

let sqlCommand(connectionString, name)  = new CmdSqlBuilder(connectionString, name)

At this point, wrapping sprocs is easy:

        let args : sqlParams = [|("@param1", val1 :> obj);  ("@param2", val2 :> obj)|]
        
        sqlCommand (connectionString, name) {
            do! setParameters(args)
            do! setTimeout(10 * 60)
            do! setType(CommandType.StoredProcedure)
            return! execNonQuery()
        }

Or calling a function:

        let args : sqlParams = [|("@param", value :> obj)|]
        
         sqlCommand(connectionString, "select dbo.MyFunc(@param)") {
             do! setParameters [|("@param", searchString :> obj)|]
             return! execScalar()
         }  > string

Or even a simple query:

        let rd = 
            sqlCommand(connectionString, "select * from someTable") {
                return! execReader()
            }

The code is concise and easy to understand.
Here is the complete source:

module CommandBuilder =

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

    type sqlParams = (string * obj) []

    type CmdSqlMonad<'a> = SqlCommand -> 'a

    let sqlMonad<'a> (f : SqlCommand -> 'a) : CmdSqlMonad<'a> = f
    
    let setParameters (sqlParameters : sqlParams) =
        sqlMonad(fun (cmd : SqlCommand) -> sqlParameters |> Seq.iter(fun (name, value) -> cmd.Parameters.AddWithValue(name, value) |> ignore))

    let setType (tp : CommandType) = sqlMonad (fun cmd -> cmd.CommandType <- tp)

    let execReader () = 
        sqlMonad(fun cmd -> cmd.ExecuteReader())

    let execNonQuery() =
        sqlMonad(fun cmd ->  cmd.ExecuteNonQuery())

    let execScalar() =
        sqlMonad (fun cmd -> cmd.ExecuteScalar())

    let command(text) = sqlMonad(fun cmd -> cmd.CommandText <- text)

    let setTimeout(sec) = sqlMonad(fun cmd -> cmd.CommandTimeout <- sec)

    type CmdSqlBuilder (connectionString, name) =
        do
            if String.IsNullOrWhiteSpace(connectionString) then invalidArg "connectionString" "connection string must be supplied"
        
        let connection = new SqlConnection(connectionString)
        let cmd = new SqlCommand(name, connection)

        do 
            cmd.CommandTimeout <- 60 * 20
            (retry {
                return connection.Open()
            }) defaultRetryParams

        let dispose () = 
            cmd.Dispose()

        interface IDisposable with
            member this.Dispose () =
                dispose()
                GC.SuppressFinalize(this)

        override this.Finalize() = dispose()

        member this.Command = cmd
        member this.Return ( x : 'a) : CmdSqlMonad<'a> = fun cmd -> x
        member this.Run( m : CmdSqlMonad<'a>) = m cmd
        member this.Delay(f : unit -> CmdSqlMonad<'a>) = f()
        member this.ReturnFrom(m : CmdSqlMonad<'a>) = m
                     
        member this.Bind(c : CmdSqlMonad<'a>, f : 'a -> CmdSqlMonad<'b>) =
            sqlMonad(fun cmd -> 
                let value = c cmd
                f value cmd)

    let sqlCommand(connection, name)  = new CmdSqlBuilder(connection, name)