Generic Queries and Commands using a MailboxProcessor

Question

I think this question touches on the same area, but I can't see how it can be applied to my situation. Generic reply from agent/mailboxprocessor?

Here's the background. I have some state, lets just say for now it holds just a list of players. There could be more, e.g. Games etc. I also have an initialState which has no players.

type Player = {Name: string; Points: int}
type State = {Players: Player list}
let initialState = {Players = []}

I have two kinds of 'messages' that I need to deal with. Queries, which are functions that map the state to some value, but don't change the state. E.g. Return an int showing the highest point score.

And commands which produce a new state, but can return a value. E.g Add a new player to the collection, and return an id, or whatever.

type Message<'T> =
| Query of (State -> 'T)
| Command of (State -> 'T * State)

And then we have a model that can respond to messages. But which unfortunately uses a mutable State, I'd prefer to use a MailboxProcessor and a message loop.

type Model(state: State) =
  let mutable currentState = state

  let HandleMessage (m: Message<'outp>) =
    match m with
    | Query q -> q currentState
    | Command c ->
        let n, s = c currentState
        currentState <- s
        n

  member this.Query<'T> (q: State -> 'T) =
    HandleMessage (Query q)

  member this.Command<'T> (c: State -> 'T * State) =
    HandleMessage (Command c)


// Query Methods
let HowMany (s: State) = List.length s.Players
let HasAny (s: State) = (HowMany s) > 0
let ShowAll (s: State) = s

// Command Methods
let AddPlayer (p: Player) (s: State) = (p, {s with Players = p::s.Players})

let model  = new Model(initialState)
model.Command (AddPlayer {Name="Sandra"; Points=1000})
model.Query HasAny
model.Query HowMany
model.Query ShowAll

Obviously it would be nice if that State argument was itself generic. But one step at a time.

Everything I've tried to replace that mutable currentState with a MailboxProcessor has failed. The problem is with the Generics and the Static nature of F#, but I can't find a way around it.

The following doesn't work, but it shows what I'd like to do.

type Player = {Name: string; Points: int}
type State = {Players: Player list}
let initialState = {Players = []}

type Message<'T> =
| Query of (State -> 'T) * AsyncReplyChannel<'T>
| Command of (State -> 'T * State) * AsyncReplyChannel<'T>

type Model(state: State) =
  let innerModel =
    MailboxProcessor.Start(fun inbox ->
      let rec messageLoop (state: State) =
        async {
          let! msg = inbox.Receive()
          match (msg: Message<'outp>) with
          | Query (q, replyChannel) ->
              replyChannel.Reply(q state)
              return! messageLoop state
          | Command (c, replyChannel) ->
              let result, newState = c state
              replyChannel.Reply(result)
              return! messageLoop(newState)
        }
      messageLoop initialState)

  member this.Query<'T> (q: State -> 'T) =
    innerModel.PostAndReply(fun chan -> Query(q , chan))

  member this.Command<'T> (c: State -> 'T * State) =
    innerModel.PostAndReply(fun chan -> Command(c, chan))


// Query Methods
let HowMany (s: State) = List.length s.Players
let HasAny (s: State) = (HowMany s) > 0
let ShowAll (s: State) = s

//// Command Methods
let AddPlayer (p: 'T) (s: State) = {s with Players = p::s.Players}

let model  = new Model(initialState)
model.Command (AddPlayer {Name="Joe"; Points=1000})
model.Query HowMany
model.Query HasAny
model.Query ShowAll

Answer 1

The problem is that the generic Message<'T> is being bound to a particular type (Player) when type inference happens on AddPlayer. The subsequent calls require 'T to be int, bool etc.

That is, it is generic only when defined. In use, a particular model must have a particular type.

There are a couple of solutions, but none very elegant, I think.

My preferred approach would be to use a union of all possible Query and Command results, as shown below.

type Player = {Name: string; Points: int}
type State = {Players: Player list}

// I've been overly explicit here!
// You could just use a choice of | Int | Bool | State, etc)
type QueryResult = 
| HowMany of int
| HasAny of bool
| ShowAll of State 

type CommandResult = 
| Player of Player

type Message =
| Query of (State -> QueryResult) * AsyncReplyChannel<QueryResult>
| Command of (State -> CommandResult * State) * AsyncReplyChannel<CommandResult>

type Model(initialState: State) =

    let agent = MailboxProcessor.Start(fun inbox ->

        let rec messageLoop (state: State) =
            async {
                let! msg = inbox.Receive()
                match msg with
                | Query (q, replyChannel) ->
                    let result = q state             
                    replyChannel.Reply(result)
                    return! messageLoop state
                | Command (c, replyChannel) ->
                    let result, newState = c state
                    replyChannel.Reply(result)
                    return! messageLoop(newState)
            }

        messageLoop initialState)

    member this.Query queryFunction =
        agent.PostAndReply(fun chan -> Query(queryFunction, chan))

    member this.Command commandFunction =
        agent.PostAndReply(fun chan -> Command(commandFunction, chan))


// ===========================
// test 
// ===========================

// Query Methods
// Note that the return values have to be lifted to QueryResult
let howMany (s: State) =  HowMany (List.length s.Players)
let hasAny (s: State) = HasAny (List.length s.Players > 0)
let showAll (s: State) = ShowAll s

// Command Methods
// Note that the return values have to be lifted to CommandResult
let addPlayer (p: Player) (s: State) = (Player p, {s with Players = p::s.Players})

// setup a model
let initialState = {Players = []}
let model  = new Model(initialState)
model.Command (addPlayer {Name="Sandra"; Points=1000})
model.Query hasAny   // HasAny true
model.Query howMany  // HowMany 1
model.Query showAll  // ShowAll {...}

Answer 2

As Scott mentioned, the problem is that your Message<'T> type is generic, but the way it is used restricts 'T to just a single type within the body of the agent.

However, the agent does not really need to do anything with the value 'T. It just passes the result from the function (included in the message) to the async reply channel (also included in the message). So, we can solve this by completely hiding the value of type 'T from the agent and making message a value that just carries a function:

type Message =
  | Query of (State -> unit)
  | Command of (State -> State)

You could even use just a function State -> State (with query being a function that always returns the same state), but I wanted to keep the original structure.

Inside the agent, you can now just invoke the function and for commands, switch to the new state:

type Model(state: State) =
  let innerModel =
    MailboxProcessor<Message>.Start(fun inbox ->
      let rec messageLoop (state: State) =
        async {
          let! msg = inbox.Receive()
          match msg with
          | Query q ->
              q state
              return! messageLoop state
          | Command c ->
              let newState = c state
              return! messageLoop(newState)
        }
      messageLoop initialState)

The interesting bit are the members. They will be generic and still use PostAndAsyncReply to create a value of type AsyncReplyChannel<'T>. However, the scope of 'T can be restricted to the body of the functions, because they will now construct Query or Command values that themselves post the reply directly to the channel we just created:

  member this.Query<'T> (q: State -> 'T) =
    innerModel.PostAndReply(fun chan -> Query(fun state ->
      let res = q state
      chan.Reply(res)))

  member this.Command<'T> (c: State -> 'T * State) =
    innerModel.PostAndReply(fun chan -> Command(fun state ->
      let res, newState = c state
      chan.Reply(res)
      newState))

In fact, this is very similar to your original solution. We just had to extract all the code dealing with 'T values from the body of the agent into the generic methods.

EDIT: Adding a version that is also generic over the state:

type Message<'TState> =
  | Query of ('TState -> unit)
  | Command of ('TState -> 'TState)

type Model<'TState>(initialState: 'TState) =
  let innerModel =
    MailboxProcessor<Message<'TState>>.Start(fun inbox ->
      let rec messageLoop (state: 'TState) =
        async {
          let! msg = inbox.Receive()
          match msg with
          | Query q ->
              q state
              return! messageLoop state
          | Command c ->
              let newState = c state
              return! messageLoop(newState)
        }
      messageLoop initialState)

  member this.Query<'T> (q: 'TState -> 'T) =
    innerModel.PostAndReply(fun chan -> Query(fun state ->
      let res = q state
      chan.Reply(res)))

  member this.Command<'T> (c: 'TState -> 'T * 'TState) =
    innerModel.PostAndReply(fun chan -> Command(fun state ->
      let res, newState = c state
      chan.Reply(res)
      newState))