manythumbed

  let upup z =
    zipperExpression {
      let! z1 = up z
      let! z2 = up z1
      return z2
    }

  let downup z =
    zipperExpression {
      let! z1 = down z

manythumbed

  type ZipperExpressionBuilder<'a>() =
    member this.Bind ((x: 'a Location option), (rest: 'a Location -> 'a Location option)) =
      match x with
      | Some(x) -> rest x
      | _ -> None
    member this.Return (x: 'a Location) = Some(x)

  let zipperExpression = new ZipperExpressionBuilder<string>()

manythumbed

> zipper tree |> down |> down;;
  zipper tree |> down |> down;;
  -----------------------^^^^

stdin(9,24): error FS0001: Type mismatch. Expecting a string Location option -> 'a
but given a 'b Location -> 'b Location option
The type 'string Location option' does not match the type ''a Location'

manythumbed

  type 'a Tree = Item of 'a | Section of 'a Tree list
  type 'a Path = Top | Node of 'a Tree list * 'a Path * 'a Tree list
  type 'a Location = Loc of 'a Tree * 'a Path

  let left (Loc(t, p)) = 
    match p with
    | Top -> None
    | Node(l::left, up, right) -> Some(Loc(l, Node(left, up, t::right)))
    | Node([], up, right) -> None

manythumbed

  let change t (Loc(_, p)) = Loc(t, p)

  let insert_right r (Loc(t, p)) = 
    match p with
    | Top -> failwith "insert at top"
    | Node(left, up, right) -> Loc(t, Node(left, up, r::right))

  let insert_left l (Loc(t, p)) =
    match p with
    | Top -> failwith "insert at top"

manythumbed

  let zipper t = Loc(t, Top)

  let rec root (Loc (t, p) as l) = 
    match p with 
    | Top -> t
    | _ -> root (up l) 

manythumbed

  let left (Loc(t, p)) = 
    match p with
    | Top -> failwith "left at top"
    | Node(l::left, up, right) -> Loc(l, Node(left, up, t::right))
    | Node([], up, right) -> failwith "left of first"

  let right (Loc(t, p)) = 
    match p with 
    | Top -> failwith "right at top"
    | Node(left, up, r::right) -> Loc(r, Node(t::left, up, right))

manythumbed

  type 'a Tree = Item of 'a | Section of 'a Tree list

  type 'a Path = Top | Node of 'a Tree list * 'a Path * 'a Tree list

  type 'a Location = Loc of 'a Tree * 'a Path

manythumbed

> let tree = Section[Section[Item "a"; Item "*"; Item "b"]; 
                     Item "+";
                     Section[Item "c"; Item "*"; Item "d"]];;
val it : string Tree =
  Section
    [Section [Item "a"; Item "*"; Item "b"]; Item "+";
     Section [Item "p"; Item "*"; Item "d"]]

> zipper tree |> down |> right |> change (Item "-") |> right |> down |> change (Item "p") |> insert_right (Item "-") |> root;;
val it : string Tree =

manythumbed

module Zipper

  type 'a Tree = Item of 'a | Section of 'a Tree list

  type 'a Path = Top | Node of 'a Tree list * 'a Path * 'a Tree list

  type 'a Location = Loc of 'a Tree * 'a Path

  let left (Loc(t, p)) = 
    match p with