F#でZipper

F#erな方たちがよくHaskellの話題をしているのですが、さっぱりついていけないので、基本的なことは知っておこうと思い
Learn You a Haskell for Great Good!: A Beginner's Guideを読んでみました。
完全に理解できたとは言いがたいですが、基本的な文法とモナドの考え方がわかって満足です。

読み終えた記念？に、Chaper15にでてきたZipperをF#で書きかえてみました。

type Tree<'T> =

  | Empty

  | Node of 'T * Tree<'T> * Tree<'T>
type Crumb<'T> = 

  | LeftCrumb of 'T * Tree<'T>

  | RightCrumb of 'T * Tree<'T>
type Zipper<'T> = Tree<'T> * Crumb<'T> list
let goLeft (zipper:Zipper<'T>) =

  match zipper with

  | Node(x, l, r), bs -> (l, LeftCrumb(x, r)::bs)

  | _ -> failwith "no node."



let goRight (zipper:Zipper<'T>) =

  match zipper with

  | Node(x, l, r), bs -> (r, RightCrumb(x, l)::bs)

  | _ -> failwith "no node."



let goUp (zipper:Zipper<'T>) =

  match zipper with

  | tree, LeftCrumb(x, r)::bs -> Node(x, tree, r), bs

  | tree, RightCrumb(x, l)::bs -> Node(x, l, tree), bs

  | _ -> failwith "no crumb."



let modify<'T> (f:'T -> 'T) (zipper:Zipper<'T>) =

  match zipper with

  | Node(x, l, r), bs -> Node(f x, l, r), bs

  | Empty, bs -> Empty, bs
let attach<'T> (tree:Tree<'T>) (zipper:Zipper<'T>) =

  match zipper with

  | _, bs -> tree, bs
let rec topMost (zipper:Zipper<'T>) =

  match zipper with

  | tree, [] -> tree, []

  | z -> topMost (goUp z)
let node<'T> v l r = 

  Node (v, l, r)
let freeTree =

  node 'P'

    (node 'O'

      (node 'L'

        (node 'N' Empty Empty)

        (node 'T' Empty Empty)

      )

      (node 'Y'

        (node 'S' Empty Empty)

        (node 'A' Empty Empty)

      )

    )

    (node 'L'

      (node 'W'

        (node 'C' Empty Empty)

        (node 'R' Empty Empty)

      )

      (node 'A'

        (node 'A' Empty Empty)

        (node 'C' Empty Empty)

      )

    )
(freeTree, []) |> goLeft |> goRight |> goUp |> printfn "test goUp : %A"



(freeTree, []) |> goLeft |> goRight |> modify (fun _ -> 'P') |> printfn "test modify : %A"



(freeTree, []) |> goLeft |> goLeft |> goLeft |> topMost |> printfn "test topMost : %A"



(freeTree, []) |> goLeft |> goLeft |> goLeft |> goLeft |> attach (Node('Z', Empty, Empty)) |> printfn "test attach : %A"

Zipperを考えた人はすごい！