index.fs

gistfile1.txt

let tree = Node(Leaf "one", Node(Leaf "two", Leaf "three"))
type WithCount<'v> = WithCount of (int -> 'v * int)


let build l r = Node(l, r)
let run (WithCount f) (count: int)= f count
 
let pure' v = WithCount (fun count -> (v, count))

let (<*>) f a = 
    WithCount (fun count ->
        let fv, fc = run f count
        let av, ac = run a fc
        let b = fv av
        b, ac)

let putCount c = WithCount (fun _ -> (), c)
let getCount = WithCount (fun c -> c, c)

let buildLeaf v count put =
    let leaf = Leaf (v, count)
    put (count + 1) |> ignore
    leaf

let rec index<'a> =
    function
    | Leaf v ->
        pure' buildLeaf <*> (pure' v) <*> getCount <*> pure' putCount
    | Node(l, r) ->
        pure' build <*> index l <*> index r

[<Fact>]
let ``indexes a tree`` () =
    let withCount = index tree
    let indexed, _ = run withCount 1

    test <@ indexed = Node(Leaf("one", 1), Node(Leaf("two", 2), Leaf("three", 3))) @>