F# scripts demonstrating a custom state monad. Related blog post: http://fsharpforfunandprofit.com/posts/monadster/

monadster.fsx

(*
monadster.fsx

Demonstrates how the state monad works
See also monadster2.fsx for the refactored version using computation expressions.

Related blog post: http://fsharpforfunandprofit.com/posts/monadster/


*)

// =================================================================================
// The Common Context (Label,VitalForce)
// =================================================================================

/// All body parts have a label
type Label = string

/// The Animal Electricity needed to create a live part
type VitalForce = {units:int}

// get one unit of vital force and return the unit and the remaining
let getVitalForce vitalForce = 
    let oneUnit = {units = 1}
    let remaining = {units = vitalForce.units-1}  // decrement
    oneUnit, remaining  // return both

// =================================================================================
// The Left Leg 
// =================================================================================

// Dr Frankenfunctor has a dead left leg lying around in the lab
type DeadLeftLeg = DeadLeftLeg of Label 

// and can make a live left leg from it
type LiveLeftLeg = LiveLeftLeg of Label * VitalForce

// how to make a live thing?  -- First approach
module Approach1 = 

    // version 1 -- the input is a tuple of DeadLeftLeg * VitalForce 
    type MakeLiveLeftLeg = 
        DeadLeftLeg * VitalForce -> LiveLeftLeg * VitalForce 

    let makeLiveLeftLeg (deadLeftLeg,vitalForce) = 
        // get the label from the dead leg using pattern matching
        let (DeadLeftLeg label) = deadLeftLeg
        // get one unit of vital force
        let oneUnit, remainingVitalForce = getVitalForce vitalForce 
        // create a live leg from the label and vital force
        let liveLeftLeg = LiveLeftLeg (label,oneUnit)
        // return the leg and the remaining vital force
        liveLeftLeg, remainingVitalForce    


// version 2 -- the input is a curried version. 
module Approach2 = 

    // First param is DeadLeftLeg, and then VitalForce is a separate param
    type MakeLiveLeftLeg = 
        DeadLeftLeg -> VitalForce -> LiveLeftLeg * VitalForce 

    let makeLiveLeftLeg deadLeftLeg vitalForce = 
        let (DeadLeftLeg label) = deadLeftLeg
        let oneUnit, remainingVitalForce = getVitalForce vitalForce 
        let liveLeftLeg = LiveLeftLeg (label,oneUnit)
        liveLeftLeg, remainingVitalForce    

// version 3 -- the input is a DeadLeftLeg, returning a generator function
module Approach3 = 

    type MakeLiveLeftLeg = 
        DeadLeftLeg -> (VitalForce -> LiveLeftLeg * VitalForce)

    let makeLiveLeftLeg deadLeftLeg = 
        // create an inner intermediate function
        let becomeAlive vitalForce = 
            let (DeadLeftLeg label) = deadLeftLeg
            let oneUnit, remainingVitalForce = getVitalForce vitalForce 
            let liveLeftLeg = LiveLeftLeg (label,oneUnit)
            liveLeftLeg, remainingVitalForce    
        // return it
        becomeAlive 


// Demonstrates how currying works
module CurryingExample = 

    // currying example - two parameters
    let add_v1 x y = 
        x + y

    // currying example - one parameter
    let add_v2 x = 
        fun y -> x + y

    // currying example - intermediate function
    let add_v3 x = 
        let addX y = x + y
        addX // return the function


// =================================================================================
// Creating the Monadster type
// =================================================================================


// version 4 -- make the function generic
module Approach4 = 

    type M<'LiveBodyPart> = 
        VitalForce -> 'LiveBodyPart * VitalForce

    let makeLiveLeftLeg deadLeftLeg :M<LiveLeftLeg> = 
        let becomeAlive vitalForce = 
            let (DeadLeftLeg label) = deadLeftLeg
            let oneUnit, remainingVitalForce = getVitalForce vitalForce 
            let liveLeftLeg = LiveLeftLeg (label,oneUnit)
            liveLeftLeg, remainingVitalForce    
        becomeAlive


// final version -- wrap Monadster body part recipe with "M"
type M<'LiveBodyPart> = 
    M of (VitalForce -> 'LiveBodyPart * VitalForce)

// the creation function looks like this now
let makeLiveLeftLegM deadLeftLeg  = 
    let becomeAlive vitalForce = 
        let (DeadLeftLeg label) = deadLeftLeg
        let oneUnit, remainingVitalForce = getVitalForce vitalForce 
        let liveLeftLeg = LiveLeftLeg (label,oneUnit)
        liveLeftLeg, remainingVitalForce    
    M becomeAlive  // wrap the function in a single case union

// and the function signature is:
// val makeLiveLeftLegM : DeadLeftLeg -> M<LiveLeftLeg>

// ---------------------------------------------------------------------------------
// Testing the left leg
// ---------------------------------------------------------------------------------


/// create Left Leg
let deadLeftLeg = DeadLeftLeg "Boris"
let leftLegM = makeLiveLeftLegM deadLeftLeg

// pretend that vital force is available
let vf = {units = 10}

let (M innerFn) = leftLegM 
let liveLeftLeg, remainingAfterLeftLeg = innerFn vf
//val liveLeftLeg : LiveLeftLeg = 
//    LiveLeftLeg ("Boris",{units = 1;})
//val remainingAfterLeftLeg : VitalForce = 
//    {units = 9;}

// encapsulate the function call that "runs" the recipe
let runM (M f) vitalForce = f vitalForce 

let liveLeftLeg2, remainingAfterLeftLeg2 = runM leftLegM vf  

// =================================================================================
// The Right Leg
// =================================================================================

// no right legs were available -- see the definition of LiveBody later for the workaround

// =================================================================================
// The Left Arm
// =================================================================================

// Dr Frankenfunctor has a dead but broken left arm lying around in the lab
type DeadLeftBrokenArm = DeadLeftBrokenArm of Label 

// You can have a live version of the broken arm too.
type LiveLeftBrokenArm = LiveLeftBrokenArm of Label * VitalForce

// There is a live version of a heathly arm, but no dead version
type LiveLeftArm = LiveLeftArm of Label * VitalForce

// However, Dr Frankenfunctor CAN turn a broken left arm into a heathly left arm
type HealBrokenArm = LiveLeftBrokenArm -> LiveLeftArm 

// implementation of HealBrokenArm 
let healBrokenArm (LiveLeftBrokenArm (label,vf)) = LiveLeftArm (label,vf)

// version 1 - explicit, hard-coded arm type
module HealArm_v1 = 

    /// convert a M<LiveLeftBrokenArm> into a M<LiveLeftArm>
    let makeHealedLeftArm brokenArmM = 

        // create a new inner function that takes a vitalForce parameter
        let healWhileAlive vitalForce = 
            // run the incoming brokenArmM with the vitalForce 
            // to get a broken arm
            let brokenArm,remainingVitalForce = runM brokenArmM vitalForce 
            
            // heal the broken arm
            let healedArm = healBrokenArm brokenArm

            // return the healed arm and the remaining VitalForce
            healedArm, remainingVitalForce

        // wrap the inner function and return it
        M healWhileAlive  

    /// Make generic by passing in a "f" to do the transform
    /// As a result, it convert a M<'a> into a M<'b>
    let makeGenericTransform f brokenArmM = 

        // create a new inner function that takes a vitalForce parameter
        let healWhileAlive vitalForce = 
            let brokenArm,remainingVitalForce = runM brokenArmM vitalForce 
            
            // heal the broken arm using passed in f
            let healedArm = f brokenArm
            healedArm, remainingVitalForce

        M healWhileAlive  

// ---------------------------------------------------------------------------------
// Introducing mapM
// ---------------------------------------------------------------------------------

// A generic map that works with ANY body part
let mapM f bodyPartM = 
    let transformWhileAlive vitalForce = 
        let bodyPart,remainingVitalForce = runM bodyPartM vitalForce 
        let updatedBodyPart = f bodyPart
        updatedBodyPart, remainingVitalForce
    M transformWhileAlive 

// signature
// mapM : f:('a -> 'b) -> M<'a> -> M<'b>

// so final version is simple
let healBrokenArmM = mapM healBrokenArm

// ---------------------------------------------------------------------------------
// The importance of mapM
// ---------------------------------------------------------------------------------

// some examples of map
module TheImportanceOfMap = 

    // map works with options
    let healBrokenArmO = Option.map healBrokenArm
    // LiveLeftBrokenArm option -> LiveLeftArm option

    // map works with lists
    let healBrokenArmL = List.map healBrokenArm
    // LiveLeftBrokenArm list -> LiveLeftArm list

// conversely, mapM will work with ANY normal type
module MapMWorksWithAllTypes = 

    let isEven x = (x%2 = 0)   // int -> bool
    // map it
    let isEvenM = mapM isEven  // M<int> -> M<bool>

    let isEmpty x = (String.length x)=0  // string -> bool
    // map it
    let isEmptyM = mapM isEmpty          // M<string> -> M<bool>

// ---------------------------------------------------------------------------------
// Testing the left arm
// ---------------------------------------------------------------------------------

let makeLiveLeftBrokenArm deadLeftBrokenArm = 
    let (DeadLeftBrokenArm label) = deadLeftBrokenArm
    let becomeAlive vitalForce = 
        let oneUnit, remainingVitalForce = getVitalForce vitalForce 
        let liveLeftBrokenArm = LiveLeftBrokenArm (label,oneUnit)
        liveLeftBrokenArm, remainingVitalForce    
    M becomeAlive

/// create a dead Left Broken Arm
let deadLeftBrokenArm = DeadLeftBrokenArm "Victor"

/// create a M<BrokenLeftArm> from the dead one
let leftBrokenArmM = makeLiveLeftBrokenArm deadLeftBrokenArm 

/// create a M<LeftArm> using mapM and healBrokenArm 
let leftArmM = leftBrokenArmM  |> mapM healBrokenArm 


// now we can run it with the vital force
//let vf = {units = 10}
let liveLeftArm, remainingAfterLeftArm = runM leftArmM vf
//val liveLeftArm : LiveLeftArm = LiveLeftArm ("Victor",{units = 1;})
//val remainingAfterLeftArm : VitalForce = {units = 9;}


// =================================================================================
// The Right Arm
// =================================================================================

// Dr Frankenfunctor has TWO bits of a right arm, not a whole one
type DeadRightLowerArm = DeadRightLowerArm of Label 
type DeadRightUpperArm = DeadRightUpperArm of Label 

// which she can turn into LIVE ones
type LiveRightLowerArm = LiveRightLowerArm of Label * VitalForce
type LiveRightUpperArm = LiveRightUpperArm of Label * VitalForce

// and then combine the two live parts to make a whole arm
type LiveRightArm = {
    lowerArm : LiveRightLowerArm
    upperArm : LiveRightUpperArm
    }

let armSurgery lowerArm upperArm =
    {lowerArm=lowerArm; upperArm=upperArm}

/// convert a M<LiveRightLowerArm> and  M<LiveRightUpperArm> into a M<LiveRightArm>
let makeArmSurgeryM_v1 lowerArmM upperArmM =

    // create a new inner function that takes a vitalForce parameter
    let becomeAlive vitalForce = 
        // run the incoming lowerArmM with the vitalForce 
        // to get the lower arm
        let liveLowerArm,remainingVitalForce = runM lowerArmM vitalForce 
        
        // run the incoming upperArmM with the remainingVitalForce 
        // to get the upper arm
        let liveUpperArm,remainingVitalForce2 = runM upperArmM remainingVitalForce 

        // do the surgery to create a liveRightArm
        let liveRightArm = armSurgery liveLowerArm liveUpperArm

        // return the whole arm and the SECOND remaining VitalForce
        liveRightArm, remainingVitalForce2  
          
    // wrap the inner function and return it
    M becomeAlive  

// This has the correct signature
// M<LiveRightLowerArm> -> M<LiveRightUpperArm> -> M<LiveRightArm>

// ---------------------------------------------------------------------------------
// Introducing map2M
// ---------------------------------------------------------------------------------

// Here is a generic version
let map2M f m1 m2 =
    let becomeAlive vitalForce = 
        let v1,remainingVitalForce = runM m1 vitalForce 
        let v2,remainingVitalForce2 = runM m2 remainingVitalForce  
        let v3 = f v1 v2
        v3, remainingVitalForce2    
    M becomeAlive  
// f:('a -> 'b -> 'c) -> M<'a> -> M<'b> -> M<'c>

// we can then define armSurgeryM using map2M
// let armSurgeryM  = map2M armSurgery 


// ---------------------------------------------------------------------------------
// Testing the right arm
// ---------------------------------------------------------------------------------

let makeLiveRightLowerArm (DeadRightLowerArm label) = 
    let becomeAlive vitalForce = 
        let oneUnit, remainingVitalForce = getVitalForce vitalForce 
        let liveRightLowerArm = LiveRightLowerArm (label,oneUnit)
        liveRightLowerArm, remainingVitalForce    
    M becomeAlive

let makeLiveRightUpperArm (DeadRightUpperArm label) = 
    let becomeAlive vitalForce = 
        let oneUnit, remainingVitalForce = getVitalForce vitalForce 
        let liveRightUpperArm = LiveRightUpperArm (label,oneUnit)
        liveRightUpperArm, remainingVitalForce    
    M becomeAlive


// create the parts
let deadRightLowerArm = DeadRightLowerArm "Tom"
let lowerRightArmM = makeLiveRightLowerArm deadRightLowerArm 

let deadRightUpperArm = DeadRightUpperArm "Jerry"
let upperRightArmM = makeLiveRightUpperArm deadRightUpperArm

// create a function to make a whole arm
let armSurgeryM  = map2M armSurgery 
let rightArmM = armSurgeryM lowerRightArmM upperRightArmM 

let liveRightArm, remainingFromRightArm = runM rightArmM vf  
//val liveRightArm : LiveRightArm =
//  {lowerArm = LiveRightLowerArm ("Tom",{units = 1;});
//   upperArm = LiveRightUpperArm ("Jerry",{units = 1;});}
//val remainingFromRightArm : VitalForce = {units = 8;}


// =================================================================================
// The Head
// =================================================================================

// Dr Frankenfunctor has a dead brain and a skull
type DeadBrain = DeadBrain of Label 
type Skull = Skull  of Label 

// Only the brain needs to be made live
type LiveBrain = LiveBrain of Label * VitalForce

// and then the live brain is combined with the skull to make a head
type LiveHead = {
    brain : LiveBrain
    skull : Skull // not live
    }

let headSurgery brain skull =
    {brain=brain; skull=skull}


// Now we need an M<Skull> 
// But the Skull doesn't need any vital force.
// We just need to "lift" it into the world of M<_>

let wrapSkullInM skull = 
    let becomeAlive vitalForce = 
        skull, vitalForce 
    M becomeAlive
// val wrapSkullInM : 'a -> M<'a>

// ---------------------------------------------------------------------------------
// Introducing returnM
// ---------------------------------------------------------------------------------

// generic version
let returnM x = 
    let becomeAlive vitalForce = 
        x, vitalForce 
    M becomeAlive
// val returnM : 'a -> M<'a>


// ---------------------------------------------------------------------------------
// Testing the head
// ---------------------------------------------------------------------------------

let makeLiveBrain (DeadBrain label) = 
    let becomeAlive vitalForce = 
        let oneUnit, remainingVitalForce = getVitalForce vitalForce 
        let liveBrain = LiveBrain (label,oneUnit)
        liveBrain, remainingVitalForce    
    M becomeAlive


// create the dead parts
let deadBrain = DeadBrain "Abby Normal"
let skull = Skull "Yorick"

// create "M" versions
let liveBrainM = makeLiveBrain deadBrain
let skullM = returnM skull

// combine the parts
let headSurgeryM = map2M headSurgery
let headM = headSurgeryM liveBrainM skullM

// run the head with vital force
let liveHead, remainingFromHead = runM headM vf
//val liveHead : LiveHead = {brain = LiveBrain ("Abby normal",{units = 1;});
//                           skull = Skull "Yorick";}
//val remainingFromHead : VitalForce = {units = 9;}



// =================================================================================
// The Beating Heart 
// =================================================================================

// Dr Frankenfunctor has a dead heart
type DeadHeart = DeadHeart of Label 

// First, a live heart needs to be made
type LiveHeart = LiveHeart of Label * VitalForce

// and then a beating heart must be made from a LiveHeart 
// and some more vital force
type BeatingHeart = BeatingHeart of LiveHeart * VitalForce

let makeLiveHeart (DeadHeart label) = 
    let becomeAlive vitalForce = 
        let oneUnit, remainingVitalForce = getVitalForce vitalForce 
        let liveHeart = LiveHeart (label,oneUnit)
        liveHeart, remainingVitalForce    
    M becomeAlive

let makeBeatingHeart liveHeart = 

    let becomeAlive vitalForce = 
        let oneUnit, remainingVitalForce = getVitalForce vitalForce 
        let beatingHeart = BeatingHeart (liveHeart, oneUnit)
        beatingHeart, remainingVitalForce    
    M becomeAlive

//val makeLiveHeart : DeadHeart -> M<LiveHeart>
//val makeBeatingHeart : LiveHeart -> M<BeatingHeart>


// ---------------------------------------------------------------------------------
// how to connect the two M-generating functions?
// ---------------------------------------------------------------------------------

// problem is, I can only get a live heart from inside an M,
// not on its own :(

(*
let makeBeatingHeartFromLiveHeartM liveHeartM = 

    let becomeAlive vitalForce = 
        // extract the liveHeart from liveHeartM 
        let liveHeart, remainingVitalForce = runM liveHeartM vitalForce 

        // use the liveHeart to create a beatingHeartM
        let beatingHeartM = makeBeatingHeart liveHeart

        // what goes here?

        // return a beatingHeart and remaining vital force    
        beatingHeart, remainingVitalForce    

    // wrap the inner function and return it    
    M becomeAlive 
*)

let makeBeatingHeartFromLiveHeartM liveHeartM = 

    let becomeAlive vitalForce = 
        // extract the liveHeart from liveHeartM 
        let liveHeart, remainingVitalForce = runM liveHeartM vitalForce 

        // use the liveHeart to create a beatingHeartM
        let beatingHeartM = makeBeatingHeart liveHeart

        // run beatingHeartM to get a beatingHeart
        let beatingHeart, remainingVitalForce2 = runM beatingHeartM remainingVitalForce 

        // return a beatingHeart and remaining vital force    
        beatingHeart, remainingVitalForce2    

    // wrap the inner function and return it
    M becomeAlive

// ---------------------------------------------------------------------------------
// Introducing bindM
// ---------------------------------------------------------------------------------

let bindM f bodyPartM = 

    let becomeAlive vitalForce = 
        let bodyPart, remainingVitalForce = runM bodyPartM vitalForce 
        let newBodyPartM = f bodyPart 
        let newBodyPart, remainingVitalForce2 = runM newBodyPartM remainingVitalForce 
        newBodyPart, remainingVitalForce2    
    M becomeAlive

// val bindM : f:('a -> M<'b>) -> M<'a> -> M<'b>

// alternate version
let bindM' f bodyPartM = 

    let becomeAlive vitalForce = 
        let bodyPart, remainingVitalForce = runM bodyPartM vitalForce 
        runM (f bodyPart) remainingVitalForce 
    M becomeAlive

// bindM in use
(*
// create a dead heart
let deadHeart = DeadHeart "Anne"

// create a live heart generator (M<LiveHeart>)
let liveHeartM = makeLiveHeart deadHeart

// create a beating heart generator (M<BeatingHeart>)
// from liveHeartM and the makeBeatingHeart function
let beatingHeartM = bindM makeBeatingHeart liveHeartM 
*)

// or simpler
(*
let beatingHeartM =
    DeadHeart "Anne" 
    |> makeLiveHeart 
    |> bindM makeBeatingHeart 
*)



// ---------------------------------------------------------------------------------
// Testing the heart
// ---------------------------------------------------------------------------------


let beatingHeartM =
    DeadHeart "Anne" 
    |> makeLiveHeart 
    |> bindM makeBeatingHeart 

let beatingHeart, remainingFromHeart = runM beatingHeartM vf

//val beatingHeart : BeatingHeart = 
//    BeatingHeart ("Anne",{units = 2;})
//val remainingFromHeart : VitalForce = 
//    {units = 8;}



// =================================================================================
// The whole body
// =================================================================================


// the live body is assembled from the subcomponents
type LiveBody = {
    leftLeg: LiveLeftLeg
    rightLeg : LiveLeftLeg
    leftArm : LiveLeftArm
    rightArm : LiveRightArm
    head : LiveHead
    heart : BeatingHeart
    }

// how to create this type? there are 6 fields!

// we could create a series of map functions.
// e.g. map3M looks like this
let map3M f m1 m2 m3 =
    let becomeAlive vitalForce = 
        let v1,remainingVitalForce = runM m1 vitalForce 
        let v2,remainingVitalForce2 = runM m2 remainingVitalForce  
        let v3,remainingVitalForce3 = runM m3 remainingVitalForce2  
        let v4 = f v1 v2 v3
        v4, remainingVitalForce3    
    M becomeAlive  

// but that is tedious.

// ---------------------------------------------------------------------------------
// Introducing applyM
// ---------------------------------------------------------------------------------

// let's use a generic way

let applyM mf mx =
    let becomeAlive vitalForce = 
        let f,remainingVitalForce = runM mf vitalForce 
        let x,remainingVitalForce2 = runM mx remainingVitalForce  
        let y = f x
        y, remainingVitalForce2    
    M becomeAlive  

// val applyM : M<('a -> 'b)> -> M<'a> -> M<'b>

// a function to create the body
let createBody leftLeg rightLeg leftArm rightArm head beatingHeart =
    {
    leftLeg = leftLeg
    rightLeg = rightLeg
    leftArm = leftArm
    rightArm = rightArm
    head = head
    heart = beatingHeart 
    }
// val createBody : LiveLeftLeg -> LiveLeftLeg -> LiveLeftArm -> LiveRightArm -> LiveHead -> BeatingHeart -> LiveBody

// clone the left leg
let rightLegM = leftLegM


// this is an example of using applyM, but in a ugly way
module UglyApplicativeExample = 
    let sixParamM = returnM createBody           // move to M-world
    let fiveParamM = applyM sixParamM leftLegM   // apply first M-param
    let fourParamM = applyM fiveParamM rightLegM // apply second M-param
    let threeParamM = applyM fourParamM leftArmM
    let twoParamM = applyM threeParamM rightArmM
    let oneParamM = applyM twoParamM headM 
    let bodyM = applyM oneParamM beatingHeartM   // result is a M<LiveBody>

// short cut
let (<*>) = applyM

// this is an example of using applyM in a nicer way
module InfixApplicativeExample = 
    let bodyM = 
        returnM createBody 
        <*> leftLegM
        <*> rightLegM
        <*> leftArmM
        <*> rightArmM
        <*> headM 
        <*> beatingHeartM

// another short cut 
let (<!>) = mapM


let bodyM = 
    createBody 
    <!> leftLegM
    <*> rightLegM
    <*> leftArmM
    <*> rightArmM
    <*> headM 
    <*> beatingHeartM

// ---------------------------------------------------------------------------------
// Testing the whole body
// ---------------------------------------------------------------------------------

// It's alive!
let liveBody, remainingFromBody = runM bodyM vf  

//val liveBody : LiveBody =
//  {leftLeg = LiveLeftLeg ("Boris",{units = 1;});
//   rightLeg = LiveLeftLeg ("Boris",{units = 1;});
//   leftArm = LiveLeftArm ("Victor",{units = 1;});
//   rightArm = {lowerArm = LiveRightLowerArm ("Tom",{units = 1;});
//               upperArm = LiveRightUpperArm ("Jerry",{units = 1;});};
//   head = {brain = LiveBrain ("Abby Normal",{units = 1;});
//           skull = Skull "Yorick";};
//   heart = BeatingHeart (LiveHeart ("Anne",{units = 1;}),{units = 1;});}

//val remainingFromBody : VitalForce = {units = 2;}

monadster2.fsx

(*
monadster2.fsx

The monadster code refactored to use computation expressions
See also monadster.fsx for the original version.

Related blog post: http://fsharpforfunandprofit.com/posts/monadster/


*)

// =================================================================================
// The Common Context (Label,VitalForce)
// =================================================================================

/// All body parts have a label
type Label = string

/// The Animal Electricity needed to create a live part
type VitalForce = {units:int}

// get one unit of vital force and return the unit and the remaining
let getVitalForce vitalForce = 
    let oneUnit = {units = 1}
    let remaining = {units = vitalForce.units-1}  // decrement
    oneUnit, remaining  // return both


// =================================================================================
// Monadster type and associated functions
// =================================================================================

// Wrap Monadster body part recipe with "M"
type M<'LiveBodyPart> = 
    M of (VitalForce -> 'LiveBodyPart * VitalForce)

// encapsulate the function call that "runs" the recipe
let runM (M f) vitalForce = f vitalForce 

// lift a value to M
let returnM x = 
    let becomeAlive vitalForce = 
        x, vitalForce 
    M becomeAlive
// val returnM : 'a -> M<'a>

// transform a function
let bindM f xM = 
    let becomeAlive vitalForce = 
        let x, remainingVitalForce = runM xM vitalForce 
        runM (f x) remainingVitalForce 
    M becomeAlive


// ---------------------------------------------------------------------------------
// Creating a monster
// ---------------------------------------------------------------------------------

type MonsterBuilder()=
    member this.Return(x) = returnM x
    member this.ReturnFrom(xM) = xM
    member this.Bind(xM,f) = bindM f xM

let monster = new MonsterBuilder()


// usage
(*
monster {
    let! x = xM  // unwrap an M<X> into an X and bind to "x"
    return y     // wrap a Y and return an M<Y>
    }
*)


// ---------------------------------------------------------------------------------
// Redefining mapM and the others
// ---------------------------------------------------------------------------------

// mapM can be implemented using monster
let mapM f xM = 
    monster {
        let! x = xM  // unwrap the M<X>
        return f x   // return M of (f x)
        }

// val mapM : f:('a -> 'b) -> M<'a> -> M<'b>

// map2M can be implemented using monster
let map2M f xM yM = 
    monster {
        let! x = xM  // unwrap M<X>
        let! y = yM  // unwrap M<Y>
        return f x y // return M of (f x y)
        }
// val map2M : f:('a -> 'b -> 'c) -> M<'a> -> M<'b> -> M<'c>

// applyM can be implemented using monster
let applyM fM xM = 
    monster {
        let! f = fM  // unwrap M<F>
        let! x = xM  // unwrap M<X>
        return f x   // return M of (f x)
        }
// val applyM : M<('a -> 'b)> -> M<'a> -> M<'b>

// short cuts
let (<*>) = applyM
let (<!>) = mapM

// =================================================================================
// Get/Put state
// =================================================================================

let getM = 
    let doSomethingWhileLive vitalForce = 
        // return the current vital force in the first element of the tuple
        vitalForce, vitalForce 
    M doSomethingWhileLive 

// getterM is a M-value containing vital force
// val getterM : M<VitalForce> 

let putM newVitalForce  = 
    let doSomethingWhileLive vitalForce = 
        // return nothing in the first element of the tuple
        // return the newVitalForce in the second element of the tuple
        (), newVitalForce
    M doSomethingWhileLive 

// setterM is a function
// val setterM : VitalForce -> M<unit>

// =================================================================================
// Combining the getM and putM functions
// =================================================================================

// combine get and put to extract one unit
let useUpOneUnitM = 
    monster {
        let! vitalForce = getM
        let oneUnit, remainingVitalForce = getVitalForce vitalForce 
        do! putM remainingVitalForce 
        return oneUnit
        }

// useUpOneUnitM is a M-value containing vital force
// val useUpOneUnitM : M<VitalForce>

// =================================================================================
// The Left Leg 
// =================================================================================

// Dr Frankenfunctor has a dead left leg lying around in the lab
type DeadLeftLeg = DeadLeftLeg of Label 

// and can make a live left leg from it
type LiveLeftLeg = LiveLeftLeg of Label * VitalForce

// old version with explicit handling of vital force
let makeLiveLeftLegM_old deadLeftLeg  = 
    let becomeAlive vitalForce = 
        let (DeadLeftLeg label) = deadLeftLeg
        let oneUnit, remainingVitalForce = getVitalForce vitalForce 
        let liveLeftLeg = LiveLeftLeg (label,oneUnit)
        liveLeftLeg, remainingVitalForce    
    M becomeAlive  // wrap the function in a single case union

// new version with implicit handling of vital force
let makeLiveLeftLegM deadLeftLeg = 
    monster {
        let (DeadLeftLeg label) = deadLeftLeg
        let! oneUnit = useUpOneUnitM
        return LiveLeftLeg (label,oneUnit)
        }

/// create Left Leg
let deadLeftLeg = DeadLeftLeg "Boris"
let leftLegM = makeLiveLeftLegM deadLeftLeg

// pretend that vital force is available
let vf = {units = 10}

let liveLeftLeg, remainingAfterLeftLeg = runM leftLegM vf  
//val liveLeftLeg : LiveLeftLeg = 
//    LiveLeftLeg ("Boris",{units = 1;})
//val remainingAfterLeftLeg : VitalForce = 
//    {units = 9;}

// =================================================================================
// The Right Leg
// =================================================================================

// no right legs were available -- see the definition of LiveBody later for the workaround

// =================================================================================
// The Left Arm
// =================================================================================

// Dr Frankenfunctor has a dead but broken left arm lying around in the lab
type DeadLeftBrokenArm = DeadLeftBrokenArm of Label 

// You can have a live version of the broken arm too.
type LiveLeftBrokenArm = LiveLeftBrokenArm of Label * VitalForce

// There is a live version of a heathly arm, but no dead version
type LiveLeftArm = LiveLeftArm of Label * VitalForce

// implementation of HealBrokenArm 
let healBrokenArm (LiveLeftBrokenArm (label,vf)) = LiveLeftArm (label,vf)

// ---------------------------------------------------------------------------------
// Testing the left arm
// ---------------------------------------------------------------------------------

let makeLiveLeftBrokenArm deadLeftBrokenArm = 
    monster {
        let (DeadLeftBrokenArm label) = deadLeftBrokenArm
        let! oneUnit = useUpOneUnitM
        return LiveLeftBrokenArm (label,oneUnit)
        }

/// create a dead Left Broken Arm
let deadLeftBrokenArm = DeadLeftBrokenArm "Victor"

/// create a M<BrokenLeftArm> from the dead one
let leftBrokenArmM = makeLiveLeftBrokenArm deadLeftBrokenArm 

/// create a M<LeftArm> using mapM and healBrokenArm 
let leftArmM = leftBrokenArmM  |> mapM healBrokenArm 


// now we can run it with the vital force
//let vf = {units = 10}
let liveLeftArm, remainingAfterLeftArm = runM leftArmM vf
//val liveLeftArm : LiveLeftArm = LiveLeftArm ("Victor",{units = 1;})
//val remainingAfterLeftArm : VitalForce = {units = 9;}


// =================================================================================
// The Right Arm
// =================================================================================

// Dr Frankenfunctor has TWO bits of a right arm, not a whole one
type DeadRightLowerArm = DeadRightLowerArm of Label 
type DeadRightUpperArm = DeadRightUpperArm of Label 

// which she can turn into LIVE ones
type LiveRightLowerArm = LiveRightLowerArm of Label * VitalForce
type LiveRightUpperArm = LiveRightUpperArm of Label * VitalForce

// and then combine the two live parts to make a whole arm
type LiveRightArm = {
    lowerArm : LiveRightLowerArm
    upperArm : LiveRightUpperArm
    }

let armSurgery lowerArm upperArm =
    {lowerArm=lowerArm; upperArm=upperArm}

// ---------------------------------------------------------------------------------
// Testing the right arm
// ---------------------------------------------------------------------------------

let makeLiveRightLowerArm (DeadRightLowerArm label) = 
    monster {
        let! oneUnit = useUpOneUnitM
        return LiveRightLowerArm (label,oneUnit)
        }

let makeLiveRightUpperArm (DeadRightUpperArm label) = 
    monster {
        let! oneUnit = useUpOneUnitM
        return LiveRightUpperArm (label,oneUnit)
        }

// create the M-parts
let lowerRightArmM = DeadRightLowerArm "Tom" |> makeLiveRightLowerArm 
let upperRightArmM = DeadRightUpperArm "Jerry" |> makeLiveRightUpperArm 

// turn armSurgery into an M-function 
let armSurgeryM  = map2M armSurgery 

// do surgery to combine the two M-parts into a new M-part
let rightArmM = armSurgeryM lowerRightArmM upperRightArmM 

// simpler version of rightArmM that eliminates need for 
// special `armSurgery` and `armSurgeryM ` functions
let rightArmM_simpler = monster {
    let! lowerArm = DeadRightLowerArm "Tom" |> makeLiveRightLowerArm 
    let! upperArm = DeadRightUpperArm "Jerry" |> makeLiveRightUpperArm 
    return {lowerArm=lowerArm; upperArm=upperArm}
    }

// run it
let liveRightArm, remainingFromRightArm = runM rightArmM vf  
//val liveRightArm : LiveRightArm =
//  {lowerArm = LiveRightLowerArm ("Tom",{units = 1;});
//   upperArm = LiveRightUpperArm ("Jerry",{units = 1;});}
//val remainingFromRightArm : VitalForce = {units = 8;}


// =================================================================================
// The Head
// =================================================================================

// Dr Frankenfunctor has a dead brain and a skull
type DeadBrain = DeadBrain of Label 
type Skull = Skull  of Label 

// Only the brain needs to be made live
type LiveBrain = LiveBrain of Label * VitalForce

// and then the live brain is combined with the skull to make a head
type LiveHead = {
    brain : LiveBrain
    skull : Skull // not live
    }

let headSurgery brain skull =
    {brain=brain; skull=skull}


// ---------------------------------------------------------------------------------
// Testing the head
// ---------------------------------------------------------------------------------

let makeLiveBrain (DeadBrain label) = 
    monster {
        let! oneUnit = useUpOneUnitM
        return LiveBrain (label,oneUnit)
        }

// create the dead parts
let deadBrain = DeadBrain "Abby Normal"
let skull = Skull "Yorick"

// create "M" versions
let liveBrainM = makeLiveBrain deadBrain
let skullM = returnM skull

// combine the parts
let headSurgeryM = map2M headSurgery
let headM = headSurgeryM liveBrainM skullM

// simpler version of rightArmM that eliminates need for 
// special `headSurgery` and `headSurgeryM ` functions
let headM_simpler = monster {
    let! brain= makeLiveBrain deadBrain
    return {brain=brain; skull=skull}
    }


// run the head with vital force
let liveHead, remainingFromHead = runM headM vf
//val liveHead : LiveHead = {brain = LiveBrain ("Abby normal",{units = 1;});
//                           skull = Skull "Yorick";}
//val remainingFromHead : VitalForce = {units = 9;}


// =================================================================================
// The Beating Heart 
// =================================================================================

// Dr Frankenfunctor has a dead heart
type DeadHeart = DeadHeart of Label 

// First, a live heart needs to be made
type LiveHeart = LiveHeart of Label * VitalForce

// and then a beating heart must be made from a LiveHeart 
// and some more vital force
type BeatingHeart = BeatingHeart of LiveHeart * VitalForce

let makeLiveHeart (DeadHeart label) = 
    monster {
        let! oneUnit = useUpOneUnitM
        return LiveHeart (label,oneUnit)
        }

let makeBeatingHeart liveHeart = 
    monster {
        let! oneUnit = useUpOneUnitM
        return BeatingHeart (liveHeart,oneUnit)
        }

//val makeLiveHeart : DeadHeart -> M<LiveHeart>
//val makeBeatingHeart : LiveHeart -> M<BeatingHeart>


// ---------------------------------------------------------------------------------
// Testing the heart
// ---------------------------------------------------------------------------------


let beatingHeartM =
    monster {
        let! liveHeart = DeadHeart "Anne" |> makeLiveHeart 
        return! makeBeatingHeart liveHeart
        }

let beatingHeart, remainingFromHeart = runM beatingHeartM vf

//val beatingHeart : BeatingHeart = 
//    BeatingHeart (LiveHeart ("Anne",{units = 1;}),{units = 1;})
//val remainingFromHeart : VitalForce = 
//    {units = 8;}



// =================================================================================
// The whole body
// =================================================================================


// the live body is assembled from the subcomponents
type LiveBody = {
    leftLeg: LiveLeftLeg
    rightLeg : LiveLeftLeg
    leftArm : LiveLeftArm
    rightArm : LiveRightArm
    head : LiveHead
    heart : BeatingHeart
    }

// ---------------------------------------------------------------------------------
// Creating the body using applicatives
// ---------------------------------------------------------------------------------

// a function to create the body
let createBody leftLeg rightLeg leftArm rightArm head beatingHeart =
    {
    leftLeg = leftLeg
    rightLeg = rightLeg
    leftArm = leftArm
    rightArm = rightArm
    head = head
    heart = beatingHeart 
    }
// val createBody : LiveLeftLeg -> LiveLeftLeg -> LiveLeftArm -> LiveRightArm -> LiveHead -> BeatingHeart -> LiveBody

// clone the left leg
let rightLegM = leftLegM

let bodyM_v1 = 
    createBody 
    <!> leftLegM
    <*> rightLegM
    <*> leftArmM
    <*> rightArmM
    <*> headM 
    <*> beatingHeartM

// ---------------------------------------------------------------------------------
// Creating the body using bind
// ---------------------------------------------------------------------------------

// a function to create a M-body given all the M-parts
let createBodyM leftLegM rightLegM leftArmM rightArmM headM beatingHeartM = 
    monster {
        let! leftLeg = leftLegM
        let! rightLeg = rightLegM
        let! leftArm = leftArmM
        let! rightArm = rightArmM
        let! head = headM 
        let! beatingHeart = beatingHeartM

        // create the record
        return {
            leftLeg = leftLeg
            rightLeg = rightLeg
            leftArm = leftArm
            rightArm = rightArm
            head = head
            heart = beatingHeart 
            }
        }

// create the M-body 
let bodyM = createBodyM leftLegM rightLegM leftArmM rightArmM headM beatingHeartM


// ---------------------------------------------------------------------------------
// Testing the whole body
// ---------------------------------------------------------------------------------

let liveBody, remainingFromBody = runM bodyM vf

//val liveBody : LiveBody =
//  {leftLeg = LiveLeftLeg ("Boris",{units = 1;});
//   rightLeg = LiveLeftLeg ("Boris",{units = 1;});
//   leftArm = LiveLeftArm ("Victor",{units = 1;});
//   rightArm = {lowerArm = LiveRightLowerArm ("Tom",{units = 1;});
//               upperArm = LiveRightUpperArm ("Jerry",{units = 1;});};
//   head = {brain = LiveBrain ("Abby Normal",{units = 1;});
//           skull = Skull "Yorick";};
//   heart = BeatingHeart (LiveHeart ("Anne",{units = 1;}),{units = 1;});}

//val remainingFromBody : VitalForce = {units = 2;}

monadster3.fsx

(*
monadster3.fsx

Demonstrates how the state monad works using computation expressions
See also monadster.fsx for the original version.

Related blog post: http://fsharpforfunandprofit.com/posts/monadster/


*)

// =================================================================================
// State type and associated functions
// =================================================================================

type S<'State,'Value> = 
    S of ('State -> 'Value * 'State)

// encapsulate the function call that "runs" the state
let runS (S f) state = f state

// lift a value to the S-world 
let returnS x = 
    let run state = 
        x, state
    S run

// lift a monadic function to the S-world 
let bindS f xS = 
    let run state = 
        let x, newState = runS xS state
        runS (f x) newState 
    S run


// ---------------------------------------------------------------------------------
// Creating a state
// ---------------------------------------------------------------------------------

type StateBuilder()=
    member this.Return(x) = returnS x
    member this.ReturnFrom(xS) = xS
    member this.Bind(xS,f) = bindS f xS

let state = new StateBuilder()

// ---------------------------------------------------------------------------------
// Redefining mapS and the others
// ---------------------------------------------------------------------------------

// mapS can be implemented using state
let mapS f xS = state {
    let! x = xS  // unwrap the S<X>
    return f x   // return S of (f x)
    }

// val mapS : f:('a -> 'b) -> M<'a> -> M<'b>

// map2S can be implemented using state
let map2S f xM yM = state {
    let! x = xM  // unwrap M<X>
    let! y = yM  // unwrap M<Y>
    return f x y // return M of (f x y)
    }
// val map2S : f:('a -> 'b -> 'c) -> M<'a> -> M<'b> -> M<'c>

// applyS can be implemented using state
let applyS fM xM = state {
    let! f = fM  // unwrap M<F>
    let! x = xM  // unwrap M<X>
    return f x   // return M of (f x)
    }
// val applyS : M<('a -> 'b)> -> M<'a> -> M<'b>

// short cuts
let (<*>) = applyS
let (<!>) = mapS

// =================================================================================
// Get/Set state
// =================================================================================

let getS = 
    let run state = 
        // return the current state in the first element of the tuple
        state, state
    S run
// val getS : S<State> 

let putS newState = 
    let run _ = 
        // return nothing in the first element of the tuple
        // return the newState in the second element of the tuple
        (), newState
    S run
// val putS : 'State -> S<unit>

// =================================================================================
// The Common Context (Label,VitalForce)
// =================================================================================

/// All body parts have a label
type Label = string

/// The Animal Electricity needed to create a live part
type VitalForce = {units:int}

// get one unit of vital force and return the unit and the remaining
let getVitalForce vitalForce = 
    let oneUnit = {units = 1}
    let remaining = {units = vitalForce.units-1}  // decrement
    oneUnit, remaining  // return both

// pretend that vital force is available
let vf = {units = 10}

// =================================================================================
// Combining the getM and putM functions
// =================================================================================

// combine get and put to extract one unit
let useUpOneUnitS = state {
    let! vitalForce = getS
    let oneUnit, remainingVitalForce = getVitalForce vitalForce 
    do! putS remainingVitalForce 
    return oneUnit
    }

// =================================================================================
// The Left Leg 
// =================================================================================

// Dr Frankenfunctor has a dead left leg lying around in the lab
type DeadLeftLeg = DeadLeftLeg of Label 

// and can make a live left leg from it
type LiveLeftLeg = LiveLeftLeg of Label * VitalForce


// new version with implicit handling of vital force
let makeLiveLeftLegS (DeadLeftLeg label) = state {
    let! oneUnit = useUpOneUnitS
    return LiveLeftLeg (label,oneUnit)
    }

/// create Left Leg
let deadLeftLeg = DeadLeftLeg "Boris"
let leftLegS = makeLiveLeftLegS deadLeftLeg

let liveLeftLeg, remainingAfterLeftLeg = runS leftLegS vf  
//val liveLeftLeg : LiveLeftLeg = 
//    LiveLeftLeg ("Boris",{units = 1;})
//val remainingAfterLeftLeg : VitalForce = 
//    {units = 9;}

// =================================================================================
// The Right Leg
// =================================================================================

// no right legs were available -- see the definition of LiveBody later for the workaround

// =================================================================================
// The Left Arm
// =================================================================================

// Dr Frankenfunctor has a dead but broken left arm lying around in the lab
type DeadLeftBrokenArm = DeadLeftBrokenArm of Label 

// You can have a live version of the broken arm too.
type LiveLeftBrokenArm = LiveLeftBrokenArm of Label * VitalForce

// There is a live version of a heathly arm, but no dead version
type LiveLeftArm = LiveLeftArm of Label * VitalForce

// implementation of HealBrokenArm 
let healBrokenArm (LiveLeftBrokenArm (label,vf)) = LiveLeftArm (label,vf)

// ---------------------------------------------------------------------------------
// Testing the left arm
// ---------------------------------------------------------------------------------

let makeLiveLeftBrokenArm deadLeftBrokenArm = state {
    let (DeadLeftBrokenArm label) = deadLeftBrokenArm
    let! oneUnit = useUpOneUnitS
    return LiveLeftBrokenArm (label,oneUnit)
    }

/// create a dead Left Broken Arm
let deadLeftBrokenArm = DeadLeftBrokenArm "Victor"

/// create a M<BrokenLeftArm> from the dead one
let leftBrokenArmS = makeLiveLeftBrokenArm deadLeftBrokenArm 

/// create a M<LeftArm> using mapS and healBrokenArm 
let leftArmS = leftBrokenArmS  |> mapS healBrokenArm 


// now we can run it with the vital force
//let vf = {units = 10}
let liveLeftArm, remainingAfterLeftArm = runS leftArmS vf
//val liveLeftArm : LiveLeftArm = LiveLeftArm ("Victor",{units = 1;})
//val remainingAfterLeftArm : VitalForce = {units = 9;}


// =================================================================================
// The Right Arm
// =================================================================================

// Dr Frankenfunctor has TWO bits of a right arm, not a whole one
type DeadRightLowerArm = DeadRightLowerArm of Label 
type DeadRightUpperArm = DeadRightUpperArm of Label 

// which she can turn into LIVE ones
type LiveRightLowerArm = LiveRightLowerArm of Label * VitalForce
type LiveRightUpperArm = LiveRightUpperArm of Label * VitalForce

// and then combine the two live parts to make a whole arm
type LiveRightArm = {
    lowerArm : LiveRightLowerArm
    upperArm : LiveRightUpperArm
    }

// ---------------------------------------------------------------------------------
// Testing the right arm
// ---------------------------------------------------------------------------------

let makeLiveRightLowerArm (DeadRightLowerArm label) = state {
    let! oneUnit = useUpOneUnitS
    return LiveRightLowerArm (label,oneUnit)
    }

let makeLiveRightUpperArm (DeadRightUpperArm label) = state {
    let! oneUnit = useUpOneUnitS
    return LiveRightUpperArm (label,oneUnit)
    }

let rightArmS = state {
    let! lowerArm = DeadRightLowerArm "Tom" |> makeLiveRightLowerArm 
    let! upperArm = DeadRightUpperArm "Jerry" |> makeLiveRightUpperArm 
    return {lowerArm=lowerArm; upperArm=upperArm}
    }


// run it
let liveRightArm, remainingFromRightArm = runS rightArmS vf  
//val liveRightArm : LiveRightArm =
//  {lowerArm = LiveRightLowerArm ("Tom",{units = 1;});
//   upperArm = LiveRightUpperArm ("Jerry",{units = 1;});}
//val remainingFromRightArm : VitalForce = {units = 8;}


// =================================================================================
// The Head
// =================================================================================

// Dr Frankenfunctor has a dead brain and a skull
type DeadBrain = DeadBrain of Label 
type Skull = Skull  of Label 

// Only the brain needs to be made live
type LiveBrain = LiveBrain of Label * VitalForce

// and then the live brain is combined with the skull to make a head
type LiveHead = {
    brain : LiveBrain
    skull : Skull // not live
    }

// ---------------------------------------------------------------------------------
// Testing the head
// ---------------------------------------------------------------------------------

let makeLiveBrain (DeadBrain label) = state {
    let! oneUnit = useUpOneUnitS
    return LiveBrain (label,oneUnit)
    }

// create the dead parts
let deadBrain = DeadBrain "Abby Normal"
let skull = Skull "Yorick"

// combine the parts
let headS = state {
    let! brain = makeLiveBrain deadBrain
    return {brain=brain; skull=skull}
    }

// run the head with vital force
let liveHead, remainingFromHead = runS headS vf
//val liveHead : LiveHead = {brain = LiveBrain ("Abby normal",{units = 1;});
//                           skull = Skull "Yorick";}
//val remainingFromHead : VitalForce = {units = 9;}


// =================================================================================
// The Beating Heart 
// =================================================================================

// Dr Frankenfunctor has a dead heart
type DeadHeart = DeadHeart of Label 

// First, a live heart needs to be made
type LiveHeart = LiveHeart of Label * VitalForce

// and then a beating heart must be made from a LiveHeart 
// and some more vital force
type BeatingHeart = BeatingHeart of LiveHeart * VitalForce

let makeLiveHeart (DeadHeart label) = state {
    let! oneUnit = useUpOneUnitS
    return LiveHeart (label,oneUnit)
    }

let makeBeatingHeart liveHeart = state {
    let! oneUnit = useUpOneUnitS
    return BeatingHeart (liveHeart,oneUnit)
    }

//val makeLiveHeart : DeadHeart -> S<LiveHeart>
//val makeBeatingHeart : LiveHeart -> S<BeatingHeart>


// ---------------------------------------------------------------------------------
// Testing the heart
// ---------------------------------------------------------------------------------


let beatingHeartS = state {
    let! liveHeart = DeadHeart "Anne" |> makeLiveHeart 
    return! makeBeatingHeart liveHeart
    }

let beatingHeart, remainingFromHeart = runS beatingHeartS vf

//val beatingHeart : BeatingHeart = 
//    BeatingHeart (LiveHeart ("Anne",{units = 1;}),{units = 1;})
//val remainingFromHeart : VitalForce = 
//    {units = 8;}



// =================================================================================
// The whole body
// =================================================================================


// the live body is assembled from the subcomponents
type LiveBody = {
    leftLeg: LiveLeftLeg
    rightLeg : LiveLeftLeg
    leftArm : LiveLeftArm
    rightArm : LiveRightArm
    head : LiveHead
    heart : BeatingHeart
    }

// ---------------------------------------------------------------------------------
// Creating the body using state
// ---------------------------------------------------------------------------------

let bodyS = state {
    let! leftLeg = leftLegS
    let! rightLeg = leftLegS
    let! leftArm = leftArmS
    let! rightArm = rightArmS
    let! head = headS 
    let! beatingHeart = beatingHeartS 

    // create the record
    return {
        leftLeg = leftLeg
        rightLeg = rightLeg
        leftArm = leftArm
        rightArm = rightArm
        head = head
        heart = beatingHeart 
        }
    }


// ---------------------------------------------------------------------------------
// Testing the whole body
// ---------------------------------------------------------------------------------

let liveBody, remainingFromBody = runS bodyS vf

//val liveBody : LiveBody =
//  {leftLeg = LiveLeftLeg ("Boris",{units = 1;});
//   rightLeg = LiveLeftLeg ("Boris",{units = 1;});
//   leftArm = LiveLeftArm ("Victor",{units = 1;});
//   rightArm = {lowerArm = LiveRightLowerArm ("Tom",{units = 1;});
//               upperArm = LiveRightUpperArm ("Jerry",{units = 1;});};
//   head = {brain = LiveBrain ("Abby Normal",{units = 1;});
//           skull = Skull "Yorick";};
//   heart = BeatingHeart (LiveHeart ("Anne",{units = 1;}),{units = 1;});}

//val remainingFromBody : VitalForce = {units = 2;}



// =================================================================================
// Example of using state expressions for a stack
// =================================================================================

// ---------------------------------------------------------------------------------
// Define a stack and helpers
// ---------------------------------------------------------------------------------

// define the type to use as the state
type Stack<'a> = Stack of 'a list

// define pop outside of state expressions
let popStack (Stack contents) = 
    match contents with
    | [] -> failwith "Stack underflow"
    | head::tail ->     
        head, (Stack tail)

// define push outside of state expressions
let pushStack newTop (Stack contents) = 
    Stack (newTop::contents)

// define an empty stack
let emptyStack = Stack []

// get the value of the stack when run 
// starting with the empty stack
let getValue stackM = 
    runS stackM emptyStack |> fst


// ---------------------------------------------------------------------------------
// define the customized getter and putter
// ---------------------------------------------------------------------------------

let pop() = state {
    let! stack = getS
    let top, remainingStack = popStack stack
    do! putS remainingStack 
    return top
    }

let push newTop = state {
    let! stack = getS
    let newStack = pushStack newTop stack
    do! putS newStack 
    return ()
    }

// ---------------------------------------------------------------------------------
// hello world
// ---------------------------------------------------------------------------------

let helloWorldS = state {
    do! push "world"
    do! push "hello" 
    let! top1 = pop()
    let! top2 = pop()
    let combined = top1 + " " + top2 
    return combined 
    }

let helloWorld = getValue helloWorldS // "hello world"

// ---------------------------------------------------------------------------------
// stack calculator
// ---------------------------------------------------------------------------------

let one = state {do! push 1}
let two = state {do! push 2}

let add = state {
    let! top1 = pop()
    let! top2 = pop()
    do! push (top1 + top2)
    }

let three = state {
    do! one
    do! two
    do! add
    }

let five = state {
    do! two
    do! three
    do! add
    }

let calculate stackOperations = state {
    do! stackOperations
    let! top = pop()
    return top 
    }

let threeN = calculate three |> getValue // 3
let fiveN = calculate five |> getValue   // 5