Archive

Archive for the ‘computation expression’ Category

Exploring Monadic Landscape: Sql Command Computation Expression

April 10, 2012 1 comment

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)

Retry Monad: An Implementation

March 17, 2012 Leave a comment

One application that seems quite intuitively to be a good case for “monadization” is that of retrying a function call upon an exception that is thrown while executing it. This may be needed for inherently unreliable operations, dependent on a network connection, for example. Discussions of this can be easily found. Here is one on StackOverflow.

The complete solution is on F# Snippets. Here is the explanation.

Any monad has these components:

  1. Monadic type: M<‘a>
  2. Return function that creates a monadic type from a value of type ‘a
  3. Bind function that is capable of linking monads together

So, in this order. We first define our monadic type:

    type RetryMonad<'a> = RetryParams -> 'a
    let rm<'a> (f : RetryParams -> 'a) : RetryMonad<'a> = f

RetryMonad is just a function, that takes RetryParams type and returns a value. How is this helpful? Well, an operation or a sequence of operations of any kind can be easily wrapped into a retry monad:

    let fn1 (x:float) (y:float) = rm (fun rp -> x * y)

I have also defined the “rm” operator for purely decorative purposes: it displays “RetryMonad” whenever it is used instead of RetryParams -> ‘a.

    let fn1 (x:float) (y:float) = rm (fun rp -> x * y)

rm operator gives us a printout of

val fn1 : float -> float -> RetryMonad<float>

in F# interactive. Otherwise it would look:

val fn1 : float -> float -> 'a -> float

RetryParams simply encapsulates our retry configuration: how many retries to perform and how long to wait between them.

    type RetryParams = {
        maxRetries : int; waitBetweenRetries : int
        }

    let defaultRetryParams = {maxRetries = 3; waitBetweenRetries = 1000}

Next we define the builder class where Bind and Return are defined, together with Delay and Run required by F#.

type RetryBuilder () =
   member this.Return (x : 'a) = fun defaultRetryParams -> x
   member this.Run(m : RetryMonad<'a>) = m
   member this.Delay(f : unit -> RetryMonad<'a>) = f ()

Next defining the Bind function is the most interesting part. Bind has a signature:

(RetryMonad * ‘a -> RetryMonad) -> RetryMonad. In other words it knows how to do two things: 1. Extract the actual value from RetryMonad, i.e. execute the underlying function with retries, and 2. pass the result onward to the next monad in the chain.

        member this.Bind (p : RetryMonad<'a>, f : 'a -> RetryMonad<'b>)  =
            rm (fun retryParams -> 
                let value = retryFunc p retryParams //extract the value
                f value retryParams                //... and pass it on
            )

Here retryFunc is doing all the work of executing a function with retries:

    let internal retryFunc<'a> (f : RetryMonad<'a>) =
        rm (fun retryParams -> 
            let rec execWithRetry f i e =
                match i with
                | n when n = retryParams.maxRetries -> raise e
                | _ -> 
                    try
                        f retryParams //actual execution
                    with 
                    | e -> Thread.Sleep(retryParams.waitBetweenRetries); execWithRetry f (i + 1) e
            execWithRetry f 0 (Exception())
            ) 

Notice here that retryParams are available to the function during execution. This opens up possibilities of how the function may tune its actions depending on the retry policy. In this example there is not much to do, but RetryParams may theoretically be a more sophisticated type.

retryFunc throws the exception it gets from the function if there is an unrecoverable failure.
Since execWithRetry is tail recursive, there is no punishment normally associated with recursion (dipping into the stack, etc). In functional languages this is essentially a “while” loop.

This is it! The only thing left to do is to create an instance of the builder:

let retry = RetryBuilder()

An example program is below. Since we are chaining monads of the RetryMonad type, actual functions need to first be “wrapped” in it. See definitions of fn1 and fn2. “rm” in the body of those functions is just for “show”, not strictly necessary.

let Main(args) =
    
    let fn1 (x:float) (y:float) = rm (fun rp -> x * y)
    let fn2 (x:float) (y:float) = rm (fun rp -> if y = 0. then raise (invalidArg "y" "cannot be 0") else x / y)

    try
        let x = 
            (retry {
                let! a = fn1 7. 5.
                let! b = fn1 a 10.
                return b
            }) defaultRetryParams 

        printfn "first retry: %f" x

        let retryParams = {maxRetries = 5; waitBetweenRetries = 100}

        let ym = 
            retry {
                let! a = fn1 7. 5.
                let! b = fn1 a a
                let! c = fn2 b 0.
                return c
            }

        let y = ym retryParams
        0
    with
        e -> Console.WriteLine(e.Message); 1

This is slightly contrived, of course but you can see it in action if you insert some debugging output into the body of the functions, like I did in the complete solution:

Attempt 1
Result: 35. MaxRetries: 3. Wait: 1000.
Attempt 1
Result: 350. MaxRetries: 3. Wait: 1000.
first retry: 350.000000

Attempt 1
Result: 35. MaxRetries: 5. Wait: 100.
Attempt 1
Result: 1225. MaxRetries: 5. Wait: 100.
Attempt 1
Attempt 2
Attempt 3
Attempt 4
Attempt 5
cannot be 0
Parameter name: y

The Push Monad: Introduction

March 16, 2012 Leave a comment

Chapter 5 of Friendly F# has a great practical explanation of F# computation expressions often called “monads” from their use in computer science and Haskell. The material in Chapter 5 of the book does a lot to demystify the concept, theoretical coverage of which is done well in this Wikipedia article.

Monads are an example of things best grasped by actually doing. So I set out to implement one in my project.

What Friendly F# discussion instills above all (confirmed by the Wiki article) is that a monad in functional programming is a great way to subsume some common side effects or patterns under an explicit syntax that serves several purposes:

  • Unclutter the code
  • Make the pattern visible thus improving readability, while at the same time
  • Avoiding “action at a distance” anti-pattern, where things seem to happen magically but it is extremely hard to figure out what is actually responsible for the magic

In this particular case, the monadic pattern is implied by the Push language: all programs are 100% robust, i.e. all syntactically correct programs execute without throwing an exception and the state of the system is preserved. This means that every time something occurs that makes execution of an operation impossible, we need to “unwind” the system and return it to its state before execution had started. It would be nice to factor all of that out of the implementation so we can concentrate exclusively on semantics of the operations.

So, while implementing Push operations the following must be done:

  1. See if there are enough arguments on stack(s). If there were less than enough exit.
  2. Start executing the operation. If the operation cannot be completed return everything back to the stack(s), exit. Else:
  3. Push result to the appropriate stack.

For instance, here is an implementation of one of Push operations written without the use of monads:

        [<PushOperation("%")>]
        static member Mod() =
            match processArgs2 Float.Me.MyType with
            | [a1; a2] -> 
                if a2.Raw<float>() = 0. 
                then 
                    pushResult a1
                    pushResult a2
                else
                    let quot = Math.Floor(Math.Floor(a1.Raw<float>()) / Math.Floor(a2.Raw<float>()))
                    let res =  a1.Raw<float>() - quot * a2.Raw<float>()
                    pushResult(Float(res))
            | _ -> ()

Here all the steps are recognizable:

  1. Pop two arguments from the FLOAT stack using processArgs2. If it returns anything but a list of two values exit.
  2. Check if the second argument is 0. If so, return arguments back to the stack and exit, otherwise execute the operation.
  3. Push the result back to the FLOAT stack

Here is the monadic version:

    [<PushOperation("%")>]
    static member Mod() =
        let getMod stack = 
            push {
                let! right = popOne stack
                let! left = popOne<float> stack
                if right <> 0. then
                    let quot = Math.Floor(Math.Floor(left) / Math.Floor(right))
                    return! result stack (left - quot * right)
            }
        getMod Float.Me.MyType

We no longer need to explicitly handle the pattern mentioned above. All the steps and branches are contained within our definition of the “push” monad, so no magic here. The reader of the code knows where to look for explanation of the side effects.

If there are less than 2 values on top of the FLOAT stack, execution will not go forward and previous arguments will be returned to the stack.

If the right argument is 0, “unwinding” of the state will also happen automatically without any need to handle this case explicitly.

One other convenience: we can now factor out extracting the value from an object we get from the top of a stack (by calling its Raw<‘a>() function). This is done by implementing the monad and presented through compiler sugar of “let!” assignment. A great improvement on maintainability and ease of implementation.

“Under the hood” details to be discussed in the next post.

Push Operation. A Few Words on Computation Expressions/Monads

January 30, 2012 Leave a comment

As we have seen in the previous post, it is easy to implement Push types and operations:

  [<PushType("FLOAT")>]
    type Float =
        inherit PushTypeBase

        new () = {inherit PushTypeBase ()}
        new (f : float) = {inherit PushTypeBase(f)}

        static member Me = Float()

        [<PushOperation("/")>]
        static member Divide() =
            match processArgs2 Float.Me.MyType with
            | [a1; a2] -> 
                if a2.Raw<float>() = 0. 
                then 
                    pushResult a1
                    pushResult a2
                else pushResult(Float(a1.Raw<float>() / a2.Raw<float>()))
            | _ -> ()

Here is an example of an implementation of FLOAT./ operation: a division of two integers on top of the stack.

Since in Push an operation is denoted by “OP_TYPE.OP_NAME”, it is convenient from the implementation standpoint to group operations that are unique to a specific type under the definition of this type. Operations are declared static and that declaration is enforced by the system.

Methods, implementing operations take no arguments, since all of the information is implied in implementation: we know exactly the type of stack we are working with, as well as how to obtain arguments from it.

Minimizing Code Duplication. Generic Operations.

Some push operations are “generic” in a sense, that each type implements one. E.g.: DUP, YANK, SWAP, etc manipulate stacks of their type (i.e. INTEGER.DUP pushes a duplicate of the top of the INTEGER stack).

In order to minimize code duplication, it is possible to define “Generic” Push types. These types do not have names and no stack is created for them. They are simply “bags of operations”.

Generic stock operations are implemented as follows:

    [<GenericPushType>]
    type Ops ()=
        [<GenericPushOperation("<", AppliesTo=[|"INTEGER"; "FLOAT"|])>]
        static member Lt tp =
            dualOp (<) tp Bool.Me.MyType

        [<GenericPushOperation(">", AppliesTo=[|"INTEGER"; "FLOAT"|])>]
        static member Gt tp =
            dualOp (>) tp Bool.Me.MyType

        [<GenericPushOperation("=")>]
        static member Eq tp =
            dualOp (=) tp Bool.Me.MyType
          
        [<GenericPushOperation("DUP", Description = "Pushes the duplicate of the top of the stack")>]
        static member dup tp =
            if stockTypes.Stacks.[tp].length = 0 then ()
            else 
                stockTypes.pushResult (peek stockTypes.Stacks.[tp])

        [<GenericPushOperation("POP", Description = "Pops the top of the stack")>]
        static member pop tp =
            processArgs1 tp |> ignore

        [<GenericPushOperation("ROT", Description = "Rotates 3 top stack entries")>]
        static member rot tp =
            pushResult (new Integer(2L))
            Ops.yank tp

The type that bags these operations is decorated with GenericPushType attribute. No name is specified, since this is not a “type” at all, just a bag of operations. Each operation is decorated with GenericPushOperation attribute, that besides the name and the description of the operation can have an AppliesTo argument that filters out the types to which the operation applies. So, for example operations “>”, “<", "=" apply to numeric types only.

The signature of a method that implements a generic operation is slightly different than that of a regular operation. There is a string argument denoting the type of the operation. This is used to determine on which stack to perform the operation. The type argument can be any of the current types: "INTEGER", "FLOAT", etc.

A Word about Monads

All Push operations have a very similar structure. They do the following:

  1. Pop one or two arguments from the stack. If the stack has fewer arguments – quit.
  2. Present the top of the stack as the right-hand argument and the next value on the stack as the left-hand one.
  3. Make sure the conditions for performing the operation are met. E.g., if the operation is “/”, top of the stack is not 0. If they are not met, push the arguments back and return.
  4. Execute the operation.
  5. Push the result onto the appropriate stack.

The devide operation on the FLOAT type goes through exactly these steps:

        [<PushOperation("/")>]
        static member Divide() =
            match processArgs2 Float.Me.MyType with
            | [a1; a2] -> 
                if a2.Raw<float>() = 0. 
                then 
                    pushResult a1
                    pushResult a2
                else pushResult(Float(a1.Raw<float>() / a2.Raw<float>()))
            | _ -> ()

The following helper functions are almost ubiquitously used.
processArgs2 (processArg1) – pops 2 (1) arguments from the top of the stack and presents them in the right order. If it returns anything but a list of two objects of the right type, the operation does nothing.
pushResult – pushes result of the operation to the appropriate stack. Or in this case returns arguments to the stack, if one of them is 0.

Basically, code for all operations looks very similar. Which leads us to think that computation expressions (aka “Monads”) are a good fit for implementing operations. Monads allow for an easy way to factor out the common “side effects” of the code being executed, and just let us concentrate on functionality. So, for example, the computation expression-based implementation of the division operation above looks like this:


    [<PushOperation("/")>]
    static member Divide() =
        let divide stack = 
            push {
                let! right = popOne stack
                let! left = popOne stack
                if right <> 0. then
                    return! (result stack (left / right))
            }
        divide Float.Me.MyType

Note:

  • in this case we do not need to special-case the fact that arguments are returned to the stack if the operation cannot be performed. We were able to include that functionality into the implementation of the “push” computation expression.
  • No need to call Raw() to extract values. This is also encoded in the computation expression.
  • No special provision is made for the case when there are fewer than two arguments. Again, the computation expression takes care of that.
  • The code is easier to read. All of the “common” functionality is factored out of the “push{}”.

Monadic implementation will be discussed in detail in the future posts.

Implementing a Generic Op in C#

For testing, I have implemented a TOSTRING operation for INTEGER type as a generic operation. This operation represents the top of the INTEGER stack as string literal and pushes the result to the LITERAL stack:

   [GenericPushType]
    public class IntegerOpExtension
    {
        [GenericPushOperation("TOSTRING", 
            Description="Converts top integer to a literal", 
            AppliesTo= new string [] {"INTEGER"})]
        public static void ConvertToString()
        {
            if(TypeFactory.isEmptyStack("INTEGER"))
            {
                return;
            }

            long val = TypeFactory.processArgs1("INTEGER").Raw<long>();

            TypeFactory.pushResult (new Literal(val.ToString()));
        }
    }
Categories: C#, computation expression, F#, monad, Push Tags:
Follow

Get every new post delivered to your Inbox.