free monad

FreeMonad.fs

// Define the types for the inputs and outputs
type AccountID = AccountID of int
type Balance = Balance of decimal
type Deposit = Deposit of int * decimal
type NewBalance = NewBalance of decimal
type LogMessage = string

// Define mock implementations for the operations
let getAccountBalance (AccountID id) = 
    match id with
    | 1 -> Balance 100.0M
    | _ -> Balance 0.0M

let processDeposit (Deposit (id, amount)) =
    match id with
    | 1 -> NewBalance (100.0M + amount)
    | _ -> NewBalance amount

// Define the Free monad constructs including Log
type FaceInstruction<'a> =
    | CheckBalance of AccountID * (Balance -> 'a)
    | PerformDeposit of Deposit * (NewBalance -> 'a)
    | Log of LogMessage * (unit -> 'a)

let private mapI f = function
    | CheckBalance (x, next) -> CheckBalance (x, next >> f)
    | PerformDeposit (x, next) -> PerformDeposit (x, next >> f)
    | Log (msg, next) -> Log (msg, next >> f)

type FaceProgram<'a> =
    | Free of FaceInstruction<FaceProgram<'a>>
    | Pure of 'a

let rec bind f = function
    | Free x -> x |> mapI (bind f) |> Free
    | Pure x -> f x

type FaceBuilder () =
    member this.Bind (x, f) = bind f x
    member this.Return x = Pure x
    member this.ReturnFrom x = x
    member this.Zero () = Pure ()

let face = FaceBuilder ()

// Define operations using the FaceProgram type
let checkAccountBalance accountID = Free (CheckBalance (accountID, Pure))
let makeDeposit deposit = Free (PerformDeposit (deposit, Pure))
let log message = Free (Log (message, Pure)) // Log operation

// Define the interpreter for the operations including handling for Log
let rec interpret = function
    | Pure x -> x
    | Free (CheckBalance (accountID, next)) -> 
        accountID |> getAccountBalance |> next |> interpret
    | Free (PerformDeposit (deposit, next)) -> 
        deposit |> processDeposit |> next |> interpret
    | Free (Log (message, next)) ->
        printfn "%s" message // Side effect: printing the log message
        next () |> interpret // Continue with unit because logging has no meaningful output

// Use the computation expression to define a bank operation workflow
open System

let bankOperations = face {
    do! log "Starting bank operations"
    let! initialBalance = checkAccountBalance (AccountID 1)
    do! log (sprintf "Initial balance: %A" initialBalance)

    let! postDepositBalance = makeDeposit (Deposit (1, 50.0M))
    do! log (sprintf "Balance after deposit: %A" postDepositBalance)

    return postDepositBalance
}

// Run the bank operations and print the result
let result = bankOperations |> interpret
printfn "Final result: %A" result