A variation on Matt Moloney's Undo/Redo "Memento" pattern

Article
08/16/2010

Yesterday Matt Moloney posted a nice implementation of the "Memento" pattern, which implements an undo/redo stack. Significant pieces are

The state is held in an agent. This is not 100% needed, but makes for a nice example of using agents in this way.
The agent is encapsulated in an object.
The object can serve as a data context for a Xaml WPF window, reporting whether Undo/Redo is available.
The example shows how to do some WPF scripting with F# where the Xaml code is inline. This can be a good way to learn things like data binding. You could equally read the Xaml from a file created using the designer.

I aboslutely love this sample: it demonstrates yet another example of "oh so lovely" F# design-pattern coding by using something we're all very familiar with (undo/redo) and which we know we want our applications to have.

When I looked at Matt's code, I thought of making a couple of tweaks, which I thought I'd write up here:

First, I adjusted the code to "capture the synchonization context" in the Memento object, and to do this late (when a button is pressed), rather than early. This means that, from the outside, the Memento object is just like any other GUI object - no use of background multi-threading is exposed. This means we could replace the use of an agent to hold the background state if we wished. Further, we are sure to capture the right synchronization context, i.e. the one active when a WPF button is pressed.
.
Second, I adjusted the WPF fragments to use Tomas Petricek's nice idiom for looking up Xaml controls by name with a use of the F# dynamic lookup operator (?). The telltale code for this sort of thing is as follows:

let (?) (w:Control) (s:string) : 'T = (w.FindName(s) :?> 'T)

let redButton : Button = window?redButton

let greenButton : Button = window?greenButton

let blueButton : Button = window?blueButton

let undoButton : Button = window?undoButton

let redoButton : Button = window?redoButton

let grid : Grid = window?grid

I adjusted the "Command" type to be a record - this makes the code a bit more readable
.
I removed used of List/head/List.tail in favour of pattern matching, again to make the code a bit more readable
.
Finally, I adjusted the code so that if you clicked "Red" when the form was already Red, no entry was pushed on the undo/redo stack, likewise for other colors.
.

Further below is the screen shot and code - let myself of Matt know if you think more tweaks are needed to this sample (ok, perhaps a few comments :-) ), or if you think these aren't the right tweaks to make. (Note, if using .NET 3.5, remove the references to System.Xaml).

[ Update: , if you want to remove the use of a background agent in favour of a GUI object that hold mutable state, here is the replacement code. Note this code is pretty much logically equivalent to using an agent and will be easier to debug. Methodologically it is OK and normal in F# to use mutable state to hold the state of a single-threaded GUI application ]

type Memento() =

let mutable undoStack : Command list = []

let mutable redoStack : Command list = []

let propertyChanged = Event<_,_>()

let notify this s = propertyChanged.Trigger(this, PropertyChangedEventArgs(s))

let notifyAll this =

for s in [|"CanUndo";"CanRedo";"UndoList";"RedoList"|] do

notify this s

interface INotifyPropertyChanged with

[<CLIEvent>]

member this.PropertyChanged = propertyChanged.Publish

member this.NewCommand(command:Command) =

undoStack <- command :: undoStack

notifyAll this

member this.Undo() =

match undoStack with

| [] -> ()

| cmd :: rest ->

cmd.Undo();

redoStack <- cmd :: redoStack;

undoStack <- rest

notifyAll this

member this.Redo() =

match redoStack with

| [] -> ()

| cmd :: rest ->

cmd.Redo();

undoStack <- cmd :: undoStack;

redoStack <- rest

notifyAll this

member this.Clear() = undoStack <- []; redoStack <- []

member this.CanUndo = not undoStack.IsEmpty

member this.CanRedo = not redoStack.IsEmpty

member this.UndoList = undoStack |> List.map (fun cmd -> cmd.Name)

member this.RedoList = redoStack |> List.map (fun cmd -> cmd.Name)

]

#r "PresentationCore"

#r "PresentationFramework"

#r "WindowsBase"

#r "System.Xaml"

open System

open System.Linq

open System.Windows

open System.Windows.Input

open System.Windows.Controls

open System.Windows.Data

open System.ComponentModel

open System.Windows.Shapes

open System.Windows.Media

open System.Xaml

open System.IO

open System.Text

open System.Windows.Markup

open System.Threading

type Command = { Name : string;

Undo: (unit -> unit);

Redo: (unit -> unit) }

type MementoMessage =

| UndoList of AsyncReplyChannel<seq<string>>

| RedoList of AsyncReplyChannel<seq<string>>

| UndoCommand

| RedoCommand

| Clear

| NewCommand of (Command * SynchronizationContext)

| CanUndo of AsyncReplyChannel<bool>

| CanRedo of AsyncReplyChannel<bool>

type Memento() =

let (<--) (m:'msg MailboxProcessor) x = m.Post x

let (<->) (m:_ MailboxProcessor) msg = m.PostAndReply(fun replyChannel -> msg replyChannel)

let emptyStack : (Command * SynchronizationContext) list = []

let runInGuiContext (context : SynchronizationContext) f =

context.Post(new SendOrPostCallback(fun _ -> f()),null)

let memento = new MailboxProcessor<MementoMessage>(fun inbox ->

let rec loop undoStack redoStack =

async { let! msgOption = inbox.TryReceive(timeout=0)

match msgOption with

| None ->

do! Async.Sleep(20)