Search code examples
f#functional-programmingrefactoringmonadsland-of-lisp

Eliminating my explicit state passing via like, monads and stuff


I'm working through the book Land of Lisp in F# (yeah weird, I know). For their first example text adventure, they make use of global variable mutation and I'd like to avoid it. My monad-fu is weak, so right now I'm doing ugly state passing like this:

let pickUp player thing (objects: Map<Location, Thing list>) =
    let objs = objects.[player.Location]
    let attempt = objs |> List.partition (fun o -> o.Name = thing)
    match attempt with
    | [], _ -> "You cannot get that.", player, objs
    | thing :: _, things ->
        let player' = { player with Objects = thing :: player.Objects }
        let msg = sprintf "You are now carrying %s %s" thing.Article thing.Name
        msg, player', things

let player = { Location = Room; Objects = [] }   

let objects =
    [Room, [{ Name = "whiskey"; Article = "some" }; { Name = "bucket"; Article = "a" }];
    Garden, [{ Name = "chain"; Article = "a length of" }]]
    |> Map.ofList

let msg, p', o' = pickUp player "bucket" objects
// etc.

How can I factor out the explicit state to make it prettier? (Assume I have access to a State monad type if it helps; I know there is sample code for it in F# out there.)


Solution

  • If you want to use the state monad to thread the player's inventory and world state through the pickUp function, here's one approach:

    type State<'s,'a> = State of ('s -> 'a * 's)
    
    type StateBuilder<'s>() =
      member x.Return v : State<'s,_> = State(fun s -> v,s)
      member x.Bind(State v, f) : State<'s,_> =
        State(fun s ->
          let (a,s) = v s
          let (State v') = f a
          v' s)
    
    let withState<'s> = StateBuilder<'s>()
    
    let getState = State(fun s -> s,s)
    let putState v = State(fun _ -> (),v)
    
    let runState (State f) init = f init
    
    type Location = Room | Garden
    type Thing = { Name : string; Article : string }
    type Player = { Location : Location; Objects : Thing list }
    
    let pickUp thing =
      withState {
        let! (player, objects:Map<_,_>) = getState
        let objs = objects.[player.Location]
        let attempt = objs |> List.partition (fun o -> o.Name = thing)    
        match attempt with    
        | [], _ -> 
            return "You cannot get that."
        | thing :: _, things ->    
            let player' = { player with Objects = thing :: player.Objects }        
            let objects' = objects.Add(player.Location, things)
            let msg = sprintf "You are now carrying %s %s" thing.Article thing.Name
            do! putState (player', objects')
            return msg
      }
    
    let player = { Location = Room; Objects = [] }   
    let objects =
      [Room, [{ Name = "whiskey"; Article = "some" }; { Name = "bucket"; Article = "a" }]
       Garden, [{ Name = "chain"; Article = "a length of" }]]    
      |> Map.ofList
    
    let (msg, (player', objects')) = 
      (player, objects)
      |> runState (pickUp "bucket")