Outline Zipper example

gistfile1.elm

-- -- -- type definitions

type Outline = Outline
  { title : String
  , description: String
  , inbox : List Outline
  , children : List Outline
  }

type OutlineCrumb
  = FromInbox
      (List Outline) -- left inbox (reversed)
      (List Outline) -- right inbox
      String -- title
      String -- description
      (List Outline) -- children
  | FromParent
      (List Outline) -- left children (reversed)
      (List Outline) -- right children
      String -- title
      String -- description
      (List Outline) -- inbox

type StringCrumb
  = InTitle
      String -- description
      (List Outline) -- inbox
      (List Outline) -- children
  | InDescription
      String -- title
      (List Outline) -- inbox
      (List Outline) -- children

type alias StringZipper = (String, String, String) -- left (not reversed), selection, right
type alias Zipper = (StringZipper, StringCrumb, List OutlineCrumb)

-- -- -- Outline accessors

unwrap outline = case outline of Outline r -> r

title : Outline -> String
title = unwrap >> .title

description : Outline -> String
description = unwrap >> .description

inbox : Outline -> List Outline
inbox = unwrap >> .inbox

children : Outline -> List Outline
children = unwrap >> .children

-- -- -- helpers

dispatch3 : (a -> b -> c -> z) -> (x -> a) -> (x -> b) -> (x -> c) -> x -> z
dispatch3 comb a b c x = comb (a x) (b x) (c x)

dispatch5 : (a -> b -> c -> d -> e -> z) -> (x -> a) -> (x -> b) -> (x -> c) -> (x -> d) -> (x -> e) -> x -> z
dispatch5 comb a b c d e x = comb (a x) (b x) (c x) (d x) (e x)

pushCrumb : Zipper -> OutlineCrumb -> Zipper
pushCrumb (sz,c1,cs) crumb = (sz,c1,cs ++ [crumb]) -- TODO: don't prepend to Lists

-- -- -- zipper constructors

inTitle : (String -> StringZipper) -> Outline -> Zipper
inTitle fn outline = (,,)
  (outline |> title |> fn)
  (outline |> dispatch3 InTitle description inbox children)
  []

inDescription : (String -> StringZipper) -> Outline -> Zipper
inDescription fn outline = (,,)
  (outline |> description |> fn)
  (outline |> dispatch3 InDescription title inbox children)
  []

inChild : Int -> (Outline -> Zipper) -> Outline -> Zipper
inChild i fn outline = case drop i (outline |> children) of
  [] -> fn outline
  (here::rs) ->
    outline
    |> dispatch5 FromParent
        (children >> take i >> reverse) (always rs)
        title description inbox
    |> pushCrumb (fn here)

inInbox : Int -> (Outline -> Zipper) -> Outline -> Zipper
inInbox i fn outline = case drop i (outline |> inbox) of
  [] -> fn outline
  (here::rs) ->
    outline
    |> dispatch5 FromInbox
        (inbox >> take i >> reverse) (always rs)
        title description children
    |> pushCrumb (fn here)