forki

// 1. Define the monad 
type 'a Result = 
| Value of 'a
| Infinite

let bindF r (f: 'a -> 'a Result) =
    match r with
    | Value x -> f x
    | Infinite -> Infinite

forki

type 'a History =  { 
    Current:'a
    Undos : 'a list
    Redos : 'a list }

let empty x = { Current = x; Undos = []; Redos = [] }
let current history = history.Current

type State<'a, 's> = 's -> 'a * 's

forki

// Define the monad 
type 'a Result = 
| Value of 'a
| Infinite

let bindF r (f: 'a -> 'a Result) =
    match r with
    | Value x -> f x
    | Infinite -> Infinite

forki

// use a computation expression builder
// in order to allow syntactic sugar
type SafeOperationBuilder() =
    member this.Bind (r, f) = bindF r f
    member this.Return x = returnF x

// instanciate the monad
let safe = SafeOperationBuilder()

forki

// Define a safe division 
// which treats "division by zero" as infinity
let divide x y =
    match y with
    | 0.0 -> Infinite
    | _   -> Value(x/y)

forki

// Use the safe division in a computation expression
let totalResistance r1 r2 r3 =
    safe {
        // no DivideByZero exception occurs here
        let! x = divide 1.0 r1
        let! y = divide 1.0 r2
        let! z = divide 1.0 r3
        return divide 1.0 (x + y + z) 
    }

forki

let simpleTextEditorSample = undoable {
    let! _ = add "bla"
    let! _ = add "blub"
    let! _ = add "foo"  
    let! _ = undo
    let! _ = undo
    let! _ = redo
    let! _ = add "bar"
    return () }

forki

// Define the Undo-Monad on top of StateMonad
let undoable = new StateBuilder()

type 'a History =  { 
    Current:'a
    Undos : 'a list
    Redos : 'a list }

let empty x = { Current = x; Undos = []; Redos = [] }

forki

let putToHistory x = undoable {
    let! history = getState
    do! putState 
         { Current = x; 
           Undos = history.Current :: history.Undos
           Redos = [] } }

let exec m s = (m s |> snd).Current

let getCurrent<'a> = undoable {

forki

let fairCoinAndDice = distribution {
    let! d = fairDice 6
    let! c = fairCoin
    return d,c }

fairCoinAndDice
  |> filter (fun (d,c) -> c = Heads && d > 3)
  |> probability
  |> printfn "P(Heads and dice > 3) = %A" // "1/4N"