Wip for TODO in Elm

gistfile1.elm

import Graphics.Input as Input
import Text as T
import Keyboard as K


-- utility
ith : Int -> [a] -> a
ith index = head . drop index 

replaceIth : [a] -> Int -> (a -> a) -> [a]
replaceIth list index updater =
  take index list ++ (ith index list |> updater) :: drop (index+1) list
  
emptyField : Input.FieldState
emptyField = {string = "", selectionStart = 0, selectionEnd = 0}

-- model
type Id = Int

type Todo = { text : String, id : Id, done : Bool }
-- TODO Looks like I've found a bug with parser here
defaultTodo = { done = False, text = "", id = 0 }

type State = { id : Id, todos : [Todo] }
defaultState = { id = 0, todos = [] }

data Command = Add String | Swap Id | RemoveDone

add : State -> String -> State
add state string = 
  let
    newTodo = { defaultTodo | text <- string
                             , id <- state.id }
  in
    { state | id <- state.id + 1
            , todos <- newTodo :: state.todos}


swap : State -> Id -> State
swap state i = 
  let
    swapper todo = if todo.id == i
                   then { todo | done <- not todo.done } 
                   else todo
    newTodos = state.todos |> map swapper
  in
    { state | todos <- newTodos }

removeDone : State -> State
removeDone state =
    { state | todos <- filter (not . .done) state.todos }

dispatchCommand : Command -> State -> State
dispatchCommand command state =
  case command of
    Add s  -> add state s
    Swap i -> swap state i
    RemoveDone -> removeDone state

-- signals
tfs = Input.fields emptyField
(removeDoneButton, removeDoneSignal) =
  let (e, s) = Input.button "Remove done"
  in (e, sampleOn s (constant RemoveDone))

addTodoSignal : Signal Command
addTodoSignal = (Add . .string) <~ sampleOn (keepIf id True K.enter) tfs.events
input = addTodoSignal `merge` doneBoxes.events `merge` removeDoneSignal

doneBoxes = Input.checkboxes RemoveDone

fieldState : Signal Input.FieldState
fieldState = sampleOn addTodoSignal (constant emptyField)

state : Signal State
state = foldp dispatchCommand defaultState input
-- view

todoInput : Signal Element
todoInput = tfs.field id "Input your todo" <~ fieldState

main = flow down <~ combine [constant removeDoneButton, todoInput, (showTasks <~ state)]

showTask : Todo -> Element
showTask task = 
  let
    chk = doneBoxes.checkbox (\_ -> Swap task.id) task.done
    decorate = if task.done then Text.strikeThrough else id
  in
    flow right [ width 300 (task.text |> toText |> decorate |> text)        
               , chk ]
showTasks : State -> Element                          
showTasks state =
    map showTask state.todos |> flow down