Monads to help with COM cleanup

by Pezi 1. December 2012 23:49

I currently do a lot of Office type automation work where I scan a bunch of email from exchange, download excel attachments, open and transform a bunch of data from them, reconcile these against databases using FLinq, produce graphs and charts with the results using FSharpChart, and so forth.

(p.s - as a side note, F# is awesome at doing this kind of thing, I can knock all kinds of stuff out super fast.  p.p.s - Active patterns with Excel = win)

As anyone who has done any office automation will know, cleaning up the COM objects is a right pain. Any object you bind to a value be it a workbook, sheet, cell, range or anything at all has to be explicitly freed with Marshal.FinalReleaseComObject. If you are not really careful with this you will end up with memory leaks, and EXCEL.EXE (or whatever) running forever in the background even once your program has shut down.  The problem actually goes further than this, if you use the . . . notation to traverse the object models, all the intermediate objects are also bound and need freeing up. However, these ones as they were not explicitly bound you can get away with calling GC.Collect() and GC.WaitForPendingFinalizers().

You can see any number of articles on the interwebs about this issue and all solutions are ugly. F# to the rescue! Here is a simple computation expression I use to deal with this problem. It is not optimal but the interop is horribly slow anyway so it makes no difference.

type ComCleaner(cleanUp) =
    let objects = new System.Collections.Generic.HashSet<obj>()
    let mutable isDisposed = false     

    member this.Zero() = (this :> IDisposable).Dispose()
    member this.Delay(f) = f()
    member this.Bind(x, f) = 
        objects.Add (box x) |> ignore
    member this.Return(x) =         
        (this :> IDisposable).Dispose()
    interface System.IDisposable with
        member x.Dispose() =  
            if not isDisposed then
                isDisposed <- true
                objects |> Seq.iter (Marshal.FinalReleaseComObject >> ignore)
                match cleanUp with Some(f) -> f() | None -> ()        

I thought this was a fairly interesting use of the disposable pattern, by implementing it on the builder class itself. Any objects bound with let! are added to a object hashset. When Zero or Return is hit dispose is called. This also means the whole thing can be bound with the use keyword to ensure dispose really will get called even if an unhandled exception is raised. This is the simplest version - it is relatively easy to add support for combine, looping constructs and so on.

The builder takes a parameter cleanUp - this is a optional function that can be passed in which will be executed on dispose. This facilitates building custom versions of the com cleanup monad, for example here is one I use for Excel.

let xlCom = // excel com cleaner that closes and frees all workbooks then quits and frees excel
    fun (app:Excel.Application) ->         
        new ComCleaner(Some(fun ()->
            if app.Workbooks <> null && app.Workbooks.Count > 0 then app.Workbooks |> Seq.cast<Workbook> |> Seq.iter(fun x -> x.Close(false))
            Marshal.FinalReleaseComObject app |> ignore))

As you can see this performs a whole shutdown of excel and forces proper cleanup of the application object. I also have a function that creates a ComCleaner with no function :

let com = fun () -> new ComCleaner(None) // com cleaner that performs no additional cleanup

Now the basic use for an entire excel data extraction looks like this

let excelData file = 
    let xl = Common.Excel.excelApp()
    use xlc = xlCom xl
    xlc {    
        let! wb = xl.Workbooks.Open(file)
        let! ws = wb.Worksheets.[1] :?> Worksheet
        let! rows = ws.Rows
            |> Seq.cast<Range>
            |> Seq.takeWhile(fun row -> row.Cellsft 1 1 <> "")
            |> Seq.choose(do something here)
            |> Seq.toList }

If you need to bind / free some stuff in one of the lambda functions then you can easily use the normal com cleaner inside like so

|> Seq.choose( fun row -> com() {  do something } )

Things to be wary of are returning unevaluated sequences (obviously) and let! bindings to objects that are already in the hashset or not COM objects at all - in both cases you will get an exception but I prefer it this way as it's a good indicator you have done something very wrong!  You will also need to be careful it if you need to return a COM object, you can do it but will need to not let! bind it and then make sure it is dealt with properly later on.  Generally it should be avoided.


PezHack–Abstracting flow control with monads

by Pezi 13. July 2012 23:10

It’s been forever since I last posted, I worked quite a bit on PezHack and then stopped for a while.  I’m back to it now.  In this post I will describe a technique I used to greatly reduce the amount of code and abstract away some repetitive imperative code.

The Problem

PezHack is a turn based game. The screen does not re-render itself all the time like a real-time game, but only when something changes and at the end of a the player’s turn.  The agent-based approach I used to separate the various sub systems of the game allow me to provide isolation around the graphics processing.   The graphics agent is totally responsible for knowing what it needs to draw and will draw it on demand when it receives the relevant message.  It does not really know anything else about the game state at all except the visual data of the various tiles that are visible, some player data that allow it to draw the various data about the player, and any menus / other UI that it needs to draw.  Other systems can send it messages to inform it of some new visual state it should care about.

Most actions that Pezi can perform require some form of additional input and conditional flow logic.  For example, when you press the ‘e’ key to Eat, first a menu is displayed that shows the stuff in your inventory that is edible, if possible. If not it will display a message and not end the player’s turn.  Assuming the menu is displayed, the player then presses the key that relates to the item they wish to eat from the menu.  If this key is invalid a relevant message is displayed, else the item in question is eaten. What then happens is dependent on the item, it might provide sustenance, or if it’s a mushroom it could perform one of various kinds of effects, and then probably end the player’s turn

This is a common pattern that appears everywhere, and at each stage the graphics need to be re-drawn to show the various messages, menus and so on.  At each stage it might continue or it might not depending the player’s input, and the returns differs at each stage (end the player turn, or not, for example).  In an imperative language we would almost certainly model this control flow with a bunch of nested if/then/else statements which quickly gets ugly.  Because I am using the agent based approach for the graphics, I would also need to post a request to the graphics agent each and every time I needed the changes to show on the screen, so suddenly the actions become a list of imperative statements peppered with common code to keep the screen updated. 


The Solution

This can be drastically improved with the use of a fairly simple monad.  The Maybe monad allows you to remove flow control elements such as nested if / then / else statements, so my monad is based around the Maybe monad with some extra stuff built in to help handle graphics and input. It have called it the Action monad and it works as follows.

  • You supply it two functions and a tuple.  Before, InputPred and Fail 
  • Before is of type (unit->’e) and it is immediately executed with its result bound to a value
  • A cycle is then entered that displays any messages in the queue and draws the screen.  If there are more than three messages, it only shows three and prompts the player to press <space> to show more.
  • Next, InputPred of type (‘e->’f option) is applied the the result of Before
  • If this results in Some ‘f then the monad binds successfully and will continue  with the next expressions, passing along the ‘f result.
  • Otherwise, it looks at the tuple Fail of type (string option * ‘g).  If a string is supplied it is passed to the graphics engine and the message cycle is entered until all messages are processed, and it finally returns ‘g  (in the future i might just make this a function, but at the moment all fail cases only need to show some message to the user rather than perform some other action)

As you can see it is quite generic, and it turns out this monad is quite useful in a variety of areas of the game, not just for actions. I ended up replacing a large part of the core game loop and significantly simplifying it. Here is the code for it first :

type ActionBuilder(graphics:Graphics.GraphicsProcessor) =
    member this.Delay(f) = f()
    member this.Bind((before, inputPred, fail), f) =
        let result = before()
        // cycle through any pending messages that might have been created in before() (or before before!)
        let rec pending state =
            let more =
                if state then graphics.ProcessStatusMessages()
                else true
            if more then 
                let c = TCODConsole.waitForKeypress(true)
                if c.KeyCode = TCODKeyCode.Space then pending true
                else pending false
        pending true
        match inputPred result with
        | Some(x) -> f x
        | None ->
            if  Option.isSome(fst fail) then graphics.QueueStatusMessage ((fst fail).Value) Common.NormalMessageColour
            pending true
            snd fail
    member this.Return(x) = x

Now let’s see how this is used. First I will show the simplest action, which is quit.  When the quit key is pressed, a message appears asking if they really want to quit, and if they then press ‘y’ then a QuitGame response is issued.

let QuitAction (action:ActionBuilder.ActionBuilder) p = action {
        let! _ = ((fun () -> p.g.QueueStatusMessage "Are you sue you wish to quit? y/n" Common.NormalMessageColour),
                  (fun _ -> let c = libtcod.TCODConsole.waitForKeypress(true)
                            if c.Character = 'y' then Some(true) else None),(None,End))
        return QuitGame}

The Before function displays some text asking if the user really wants to quit the game.  The next function then waits for a key press, and if it;s a ‘y' character then Some is returned (with true, just because it needs to return something, even though we don’t care about it).  If they press anything else, then None is returned, which means the last parameter (None,End) is acted upon, which means it prints no text and returns the End message. This stops the action message at that point and End does not end the player’s turn so they are free to do something else before the monsters move.  Assuming they press ‘y’, the rest of the function executes and returns the QuitGame message which eventually results in the game ending.

Now I will return to the Eat action explained above as its significantly more complex:

let EatAction (action:ActionBuilder.ActionBuilder) p = action {                
        let! items = ((fun () -> p.d.Inventory.FilterType (function ItemData.Comestible(_) | ItemData.Mushroom(_) -> true | _ -> false)),
                      (fun comestible -> if comestible.Count > 0 then Some(comestible) else None),(Some "You have nothing to eat", End))        
        let! id = ((fun () -> p.g.DisplayMenu "Eat what?" (ItemData.Inventory.ToMenu items) ""),
                   (fun () -> let c = TC.waitForKeypress(true)
                              items |> Map.tryFindKey( fun k v -> v.Letter = c.Character)), (Some "The things squirrels will try and eat..", End))
        match items.[id].Type with
        | ItemData.Mushroom(data) ->             
            p.w.AddOrUpdateEntity <| (p.k,World.UpdatePlayerData p.p {p.d with Inventory = p.d.Inventory.RemoveItem id }) 
            Items.MushroomAction data <| (p.e,p.w,p.g,p.k)
            p.w.IdentifyMushroom data
            return EndPlayerTurn 1
        | _ -> failwith ""; return End }

The monad is invoked, with the Before function which filters the players inventory to stuff that is edible. The results of this are then passed into the input predicate function (the wonders of type inference make this just work with no type annotations) and checks if the filtered items contain any data, if they don’t it returns None and then finally the message is displayed indicating the player has nothing to eat, and execution halts there returning End (allowing the player to do something else this turn).  Assuming there were items, they are now bound to items.  Another action monad is then invoked that displays a menu containing the filtered items in the Before function. The input pred then takes player input, if it doesn’t match a letter assigned to the item in the menu it prints a message and returns End. otherwise, id is bound to the id that the player selected.   Finally, the item has some action invoked on it – in this case only mushrooms are implemented, and it removes the mushroom from the players inventory (sending commands to the World agent telling it to update the player data), invokes the mushroom’s specific action, issues another message to tell the World agent that this type of mushroom has now been identified, and finally returns a message that says the player’s turn ends for 1 turn.

Pretty cool! The code above is only interested in the higher level stuff that is going on and doesn’t need to care about display and flow control. Data from the first function can be passed to the second function, and early exit of the function is easily possible. The monad significantly reduced the actions code from almost 1000 lines to less than 350, and that includes Eat, Pickup, Drop, Move, Attack, Throw, Descend Level, Quit, Open, Close, Inventory, Wait, plus functions to merge items that have been dropped or thrown with existing stackable items on the floor where they land,  selection menus and “modal” choice menus, plus various other helper functions. 

Some actions such as Throw are really quite complex, you have to pick an item to throw, choose a direction to throw it, then show it being “animated” as it moves along the screen, and then finally (maybe) hit something, and either drop to the floor or attack an enemy which may result in other things happening – now I can just look at the code and see what it’s doing without having to dig about in a lot of essentially redundant nested code.  Actions can also transfer execution to and from other actions.

Functional programming for the win Smile