gistfile1.fs

#r "/home/you/src/thisthing/lib/JSONNet/Newtonsoft.Json.dll"

open System
open System.Collections.Generic // for dictionary
open Newtonsoft.Json

// Identifier type
type Id = System.Guid

module EventStore =

    type VersionedEvent = int * string
    type PersistableTransition = (Id * string[])

    let store = Dictionary<Id,VersionedEvent[]>() // new is for disposables

    // Event serializer
    let toPersistable<'a, 'b> (id: Id, transition: ('a[] * 'b)) =
        let events, _ = transition
        (id, events |> Array.map (JsonConvert.SerializeObject)) // cleaner, no? single-arg methods can be used as Foo.Bar x

    let commit (transitions: PersistableTransition[]) =
        // Function to get next aggregate version
        let getMaxVersion id =
            if store.ContainsKey(id) then
                store.[id]
                 |> Seq.map (fun (version, _) -> version)
                 |> Seq.max // Seq is lazy, avoids intermediate array creation
            else 0

        // Function to convert list of events to list of versioned events
        let toVersionedEvents (id, events) =
            events |> Array.map (fun event -> ((id |> getMaxVersion)+1, event))
            (* alternate take: compute start index once, use mapi
            let start = getMaxVersion id + 1
            events |> Array.mapi (fun i event -> start + i, event)
            *)

        // For each transition either append versioned events to existing or add new
        transitions
         |> Array.iter (fun (id, events) -> // I don't think you want to map
            if store.ContainsKey(id) 
            then store.[id] <- Array.append store.[id] ((id, events) |> toVersionedEvents)
            else store.Add(id, ((id, events) |> toVersionedEvents)))

    let get<'a, 'b> (id: Id, initial: 'b, apply) =
        // Get events for aggregate, deserialize and replay
        let events = 
            store.[id]
             |> Array.map (fun (_, event) -> event)
             |> Array.map (fun itm ->JsonConvert.DeserializeObject<'a>(itm))
        events
         |> Seq.fold apply initial
        (* alternate take: shorter, no array creation?
        let deserialize x = JsonConvert.DeserializeObject<'a>(x)
        store.[id]
        |> Seq.map snd // your might be clearer because of names
        |> Seq.map deserialize
        |> Seq.fold apply initial
        *)

// All of task
module Task =
    type TaskInfo = {
        Name: string;
        Description: string;
        Duedate: System.DateTime;
        Priority: int;
    }

    // Internal task commands
    type Command =
        | New of id: Id * info: TaskInfo
        | Rename of name: string
        | Assign of Id

    // Task events
    type Event =
        | TaskCreated of TaskInfo
        | TaskRenamed of name: string
        | TaskAssigned of Id

    // Task aggregate
    type State = { Info: TaskInfo; AssignedTo: Id; }
    with static member Initial = { Info = { Name = ""; Description = ""; Duedate = DateTime.Now; Priority = 0; }; AssignedTo = System.Guid.NewGuid(); }

    // Represents a task state transition, appends events and keeps state
    type Transition = Event[] * State

    // Applies events to aggregate building current state
    let apply item = function
        | TaskCreated event -> { item with State.Info = event }
        | TaskRenamed event -> { item with State.Info = { item.Info with Name = event } }
        | TaskAssigned event -> { item with AssignedTo = event }

    // Assertions for validating commands
    module private Assert =
        let validName name = if System.String.IsNullOrEmpty(name) then invalidArg "name" "The name must not be null." else name
        let assignable id = if id.Equals(null) then invalidArg "id" "Cannot assign task to null." else id

    // Handles internal task commands
    let exec cmd transition = 
        let originalEvents, item = transition
        // Create function to apply new events and generate next transition
        let apply events = (Array.append originalEvents events, Seq.fold apply item events)
        // Handle command
        match cmd with
            | New(id, info) -> info |> fun info -> [| info |> TaskCreated |] |> apply
            | Rename(name) -> name |> Assert.validName |> fun name -> [| name |> TaskRenamed |] |> apply
            | Assign(id) -> id |> Assert.assignable |> fun id -> [| id |> TaskAssigned |] |> apply

    // Reads aggregate from events store and creates transition from current state
    let read id =
        ([||], (id, State.Initial, apply) |> EventStore.get<Event,State>): Transition

    // Serializes transition to persistable events
    let toPersistable id transition = 
        [| (id, transition) |> EventStore.toPersistable |]

    // Handles external new task command
    let newTask (id: Id, info: TaskInfo, assignedTo: Id) =
        let task: Transition = (Array.empty, State.Initial)
        task
         |> exec ((id, info) |> New)
         |> exec (assignedTo |> Assign)
         |> toPersistable id
         |> EventStore.commit

    // Handles external rename task command
    let rename (id: Id, name: string) =
        read id
         |> exec (name |> Rename)
         |> toPersistable id
         |> EventStore.commit

// External commands
type Command =
    | NewTask of Id * Task.TaskInfo * Id
    | RenameTask of Id * string

// Command handler
let handle cmd =
    match cmd with
     | NewTask(id, info, assignedTo) -> (id, info, assignedTo) |> Task.newTask
     | RenameTask(id, name) -> (id, name) |> Task.rename


// ############################3 Testing it ############################################################
// Create a new task and then rename it
let id = System.Guid.NewGuid()
let assignee = System.Guid.NewGuid()
NewTask(id, {Name = "A new task"; Description = "This is a new task"; Duedate = DateTime.Now; Priority = 0; }, assignee) |> handle
RenameTask(id, "This is a renamed task") |> handle

// Output task from the event store
Task.read id

// Output all tasks from the event store
EventStore.store

This is gold! Thanks :).
One question though. When you did the trick below will it unwrap and pick the correct part of the tuple because it knows the type deserialize expects?

store.[id]
|> Seq.map snd // your might be clearer because of names
|> Seq.map deserialize
|> Seq.fold apply initial