Help with trees and zippers

treehelp.elm

import Graphics.Element exposing (show)
import Signal exposing (Address)
import Html exposing (Html, div, button, text, input)
import Html.Events exposing (on, targetValue)
import Html.Attributes exposing (value)
import Maybe exposing (andThen)

--------------
-- Suppose I have text inputs. 
-- The state of these text inputs is the value of the string inside
type alias InputState = 
  { value : String }
  
initInput : InputState 
initInput = 
  { value = "" }
  
  
-- These text inputs support an action, to change the value of the text field. 
type InputAction 
  = SetValue String
  
  
-- A straight and simple update function
updateInput : InputAction -> InputState -> InputState 
updateInput action state = 
  case action of 
    SetValue value -> 
      { state | value <- value }
  
  
-- And a view function
viewInput : Address InputAction -> InputState -> Html
viewInput address state = 
  input
    [ on "input" targetValue (SetValue >> Signal.message address) 
    , value state.value
    ]
    []
    
    
----------------
-- Now suppose that we have a tree of these text inputs.
-- I actually have a very good reason for having inputs in a tree as opposed to 
-- a list. 
type alias State = Tree InputState


-- Given that tree, what does the action look like?
-- Note: were the state a list, the action type would be defined as follows
-- type Action = ChildAction Int InputAction
-- The Int is the index of the list
-- This is useful because when forwarding addresses I can just do
-- Signal.forwardTo address (ChildAction index) 
-- inside a List.indexedMap call
type Action 
  = ChildAction (Zipper InputState) InputAction
  
  
-- I suppose the update function would thus look something like this
update : Action -> State -> State 
update action state = 
  case action of 
    UpdateSection zipper inputAction ->
      treeUpdate (updateInput inputAction) zipper
      |> Maybe.map fst
      |> Maybe.withDefault state
      

-- And the big interrogation is how do I do the view function
-- Assume I just want to draw all these text inputs as if they were in one big list
-- for simplicity sake. Whatever, I don't care how they appear as long as each input
-- only updates itelf
view : Address Action -> State -> Html
view address state = 
  
  
  
-- I'm venturing a guess that I'd need a function that is analogous to List.indexedMap
-- Something that looks like this:
-- zipperMap : (Zipper state -> state -> b) -> Tree state -> Tree b
-- which applies a function on every node in a tree but is aware of the current crumb
-- Then I could do something like this
-- zipperMap (\zipper inputState -> viewInput (Signal.forwardTo address (ChildAction zipper)) inputState) state

  
-----------------
  
  

type Tree state 
  = Branch (List (Tree state)) 
  | Leaf state
  
    
  
-- Crumb contains 2 lists:
-- leafs/branches to the left of your focus
-- leafs/branches to the right of your focus
type Crumb state = Crumb (List (Tree state)) (List (Tree state))

type alias Zipper state = (Tree state, List (Crumb state))

tree : Tree String
tree = Branch [Leaf "foo",Leaf "bar",Branch [Leaf "baz",Branch [],Leaf "qux"]]

break : (a -> Bool) -> List a -> (List a, List a)
break p xs = case (List.head xs, List.tail xs) of
  (Nothing, Nothing) -> ([], [])
  (Just x, Just xs') -> if p x
                        then ([], xs)
                        else let (ys,zs) = break p xs'
                             in (x::ys,zs)

treeInit : Tree state -> Zipper state
treeInit t = (t, [])

treeUp : Zipper state -> Maybe (Zipper state)
treeUp (subtree, bs) = case bs of
  [] -> Nothing
  Crumb l r::bs' -> Just (Branch <| l++[subtree]++r, bs')

treeTo : state -> Zipper state -> Maybe (Zipper state)
treeTo name node = case node of
  (Branch subtrees, bs) ->
    let (l, x::r) = break (\(Leaf name') -> name == name') subtrees
    in Just (x, Crumb l r::bs)
  _ -> Nothing

(!!) : List a -> Int -> Maybe a
xs !! i = case List.tail xs of
  Nothing -> Nothing
  Just xs' -> if i == 0
              then List.head xs
              else xs' !! (i-1)

treeToIndex : Int -> Zipper state -> Maybe (Zipper state)
treeToIndex i (Branch subtrees, bs) =
  let newTree = subtrees!!i
  in case newTree of
    Nothing -> Nothing
    Just newTree ->
      let newCrumb = Crumb (List.take i subtrees) (List.drop (i+1) subtrees)
      in Just (newTree, newCrumb::bs)

treeReplace : state -> Zipper state -> Maybe (Zipper state)
treeReplace new node = case node of
  (Leaf old, bs) -> Just (Leaf new, bs)
  _ -> Nothing

-- the function you're interested in most likely
treeUpdate : (state -> state) -> Zipper state -> Maybe (Zipper state)
treeUpdate f node = case node of
  (Leaf name, bs) -> Just (Leaf (f name), bs)
  _ -> Nothing

{-
main = (tree |> treeInit |> treeToIndex 2)
       `andThen` treeTo "baz" `andThen` treeReplace "xyzzy"
       `andThen` treeUp `andThen` treeUp |> show
-}