Last active
September 15, 2024 01:13
-
-
Save OnurGumus/6887feeac085250ebcd0b203399c4df7 to your computer and use it in GitHub Desktop.
async result free monad
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| // Define the types for the inputs and outputs | |
| type AccountID = AccountID of int | |
| type Balance = Balance of decimal | |
| type Deposit = Deposit of AccountID * decimal | |
| type NewBalance = NewBalance of decimal | |
| type LogMessage = string | |
| // Define an error type for your operations | |
| type BankError = | |
| | AccountNotFound of int | |
| | InsufficientFunds of decimal | |
| | DepositFailed of string | |
| | LogError of string | |
| // Add other error cases as needed | |
| // 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 -> Free (mapI (bind f) x) | |
| | Pure x -> f x | |
| type FaceBuilder () = | |
| member _.Bind (x, f) = bind f x | |
| member _.Return x = Pure x | |
| member _.ReturnFrom x = x | |
| member _.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 | |
| 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 (AccountID 1, 50.0M)) | |
| do! log (sprintf "Balance after deposit: %A" postDepositBalance) | |
| return postDepositBalance | |
| } | |
| //---- cut off | |
| // Define mock implementations for the operations as async functions returning Result | |
| let getAccountBalance (AccountID id) : Async<Result<Balance, BankError>> = async { | |
| // Simulate asynchronous operation | |
| do! Async.Sleep 100 | |
| match id with | |
| | 1 -> return Ok (Balance 100.0M) | |
| | _ -> return Error (AccountNotFound id) | |
| } | |
| let processDeposit (Deposit (id, amount)) : Async<Result<NewBalance, BankError>> = async { | |
| // Simulate asynchronous operation | |
| do! Async.Sleep 100 | |
| match id with | |
| | AccountID 1 -> return Ok (NewBalance (100.0M + amount)) | |
| | _ -> return Error (DepositFailed $"Account {id} not found.") | |
| } | |
| let logMessage (msg : LogMessage) : Async<Result<unit, BankError>> = async { | |
| // Simulate asynchronous logging | |
| do! Async.Sleep 50 | |
| try | |
| printfn "%s" msg | |
| return Ok () | |
| with ex -> | |
| return Error (LogError ex.Message) | |
| } | |
| // Define the interpreter for the operations including handling for Log | |
| let rec interpret (program : FaceProgram<'a>) : Async<Result<'a, BankError>> = | |
| async { | |
| match program with | |
| | Pure x -> return Ok x | |
| | Free (CheckBalance (accountID, next)) -> | |
| let! result = getAccountBalance accountID | |
| match result with | |
| | Ok balance -> | |
| return! interpret (next balance) | |
| | Error e -> return Error e | |
| | Free (PerformDeposit (deposit, next)) -> | |
| let! result = processDeposit deposit | |
| match result with | |
| | Ok newBalance -> | |
| return! interpret (next newBalance) | |
| | Error e -> return Error e | |
| | Free (Log (message, next)) -> | |
| let! result = logMessage message | |
| match result with | |
| | Ok () -> | |
| return! interpret (next ()) | |
| | Error e -> return Error e | |
| } | |
| // Use the computation expression to define a bank operation workflow | |
| // Run the bank operations and print the result | |
| async { | |
| let! result = interpret bankOperations | |
| match result with | |
| | Ok finalBalance -> | |
| printfn "Final result: %A" finalBalance | |
| | Error error -> | |
| printfn "An error occurred: %A" error | |
| return () | |
| } |> Async.StartImmediate |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment