newt/todomvc/src/Todo.newt

module Todo

import Prelude
import Web.Spruce

data FilterState = All | Active | Completed
derive Eq FilterState
data Msg
  = Toggle Nat
  | Remove Nat
  -- TODO behavior varies by implementation, but probably should do return / esc / blur
  | StartEdit Nat
  | EndEdit Nat String
  | Change String
  | Filter FilterState
  | Clear
  | ToggleAll

record Item where
  checked : Bool
  text : String

data EditState = NoEdit | Edit Nat

record Model where
  items : List Item
  newText : String
  filter : FilterState
  edit : EditState

ElCon : U
ElCon = List (Attr Msg) → List (VNode Msg) → VNode Msg

-- Attributes

onChange : (String → Msg) → Attr Msg
onChange = VAttr "onChange"

onClick : Msg → Attr Msg
onClick action = MAttr "OnClick" action

className : String → Attr Msg
className v = SAttr "class" v

checkbox : Bool → Nat → VNode Msg
checkbox checked ix =
  tag "input" [ className "toggle"
              , SAttr "checked" (ite checked "true" "")
              , onChange (\ _ => Toggle ix)
              , SAttr "type" "checkbox" ] []

-- Elements

section : ElCon
section = tag "section"

header : ElCon
header = tag "header"

footer : ElCon
footer = tag "footer"

div : ElCon
div = tag "div"

ul : ElCon
ul = tag "ul"

li : ElCon
li = tag "li"

span : ElCon
span = tag "span"

id_ : String → Attr Msg
id_ id = SAttr "id" id

itemView : FilterState → EditState → Nat × Item → Maybe (VNode Msg)
itemView filter estate (ix , item) =
  if exclude filter item then Nothing else
  Just $ li [ className (getCName estate) ]
    [ div [ className "view", MAttr "onDblClick" (StartEdit ix) ]
      [ checkbox item.checked ix
      , tag "label" [] [text item.text]
      , tag "button" [ className "destroy", MAttr "onClick" (Remove ix)] []
      ]
    , tag "input" [ className "edit"
                  , onChange (EndEdit ix)
                  , SAttr "value" item.text ] [ ]
    ]
  where
    getCName : EditState → String
    getCName NoEdit = ite item.checked "completed" ""
    getCName (Edit n) = if n == ix then "editing" else if item.checked then "completed" else ""

    exclude : FilterState → Item → Bool
    exclude All _ = False
    exclude Active (MkItem checked text) = checked
    exclude Completed (MkItem checked text) = not checked

footerView : Model → VNode Msg
-- we don't have undefined/empty at the moment..
footerView (MkModel Nil _ _ _) = div [] []
footerView (MkModel items _ select _) =
  let count = length' $ filter (\ item => not item.checked) items
      ccount = length' $ filter (\ item => item.checked) items
      label = text $ if count == 1 then " item left" else " items left"
  in footer [className "footer"]
    [ span [ className "todo-count" ] [ tag "strong" [] [ text $ show count ], label ]
    , ul [ className "filters" ]
         [ li [] [ tag "a" [ getClass All, onClick (Filter All)] [ text "All" ]]
         , li [] [ tag "a" [ getClass Active, onClick (Filter Active)] [ text "Active" ]]
         , li [] [ tag "a" [ getClass Completed, onClick (Filter Completed)] [ text "Completed" ]]
         ]
    , (if ccount == 0 then div [] [] else tag "button" [ className "clear-completed", onClick Clear ] [ text "Clear completed" ])
    ]
  where
    getClass : FilterState → Attr Msg
    getClass x = if x == select then className "selected" else className ""

listView : Model → VNode Msg
listView (MkModel Nil _ _ _) = div [] []
listView (MkModel items newText select estate) =
    let count = length' items
        acount = length' $ (filter (\ item => not item.checked) items)
    in tag "section" [ className "main" ]
      [ tag "input" [ id_ "toggle-all"
                    , className "toggle-all"
                    , onClick ToggleAll
                    , SAttr "type" "checkbox"] []
      -- accessibility
      , tag "label" [ SAttr "for" "toggle-all"] [ text "Mark all as complete" ]
      , ul [ className "todo-list" ] (mapMaybe (itemView select estate) (enumerate items))
      ]
view : Model → VNode Msg
view model =
  section [ className "todoapp" ]
    [ header [ className "header" ]
        [ tag "h1" [] [ text "todos" ]
        , tag "input" [ className "new-todo"
                      , SAttr "placeholder" "What needs to be done?"
                      , SAttr "value" model.newText
                      , VAttr "onChange" Change
                      , SAttr "autofocus" "true"] []]
    , listView model
    , footerView model
    ]

isEmpty : ∀ a. List a → Bool
isEmpty Nil = True
isEmpty _ = False

update : Msg → Model → Model
update Clear model = { items $= filter (\ item => not item.checked) } model
update (StartEdit ix) model = { edit := Edit ix } model
update (EndEdit ix text) model = { edit := NoEdit; items $= edit ix } model
  where
    edit : Nat → List Item → List Item
    edit Z (item :: items) = the Item { text := text } item :: items
    edit (S k) (item :: items) = item :: edit k items
    edit _ Nil = Nil

update ToggleAll model =
  let checked = not $ isEmpty $ filter (\item => not item.checked) model.items
  in { items $= map (the (Item → Item) { checked := checked }) } model

update (Toggle ix) model = { items $= toggle ix } model
  where
    toggleItem : Item → Item
    toggleItem item = { checked := not item.checked } item

    toggle : Nat → List Item → List Item
    toggle _ Nil = Nil
    toggle Z (item :: rest) = toggleItem item :: rest
    toggle (S k) (item :: rest) = item :: toggle k rest

update (Filter filter) model = { filter := filter } model
update (Remove ix) model = {items $= delete ix } model
  where
    delete : Nat → List Item → List Item
    delete _ Nil = Nil
    delete Z (item :: rest) = rest
    delete (S k) (item :: rest) = item :: delete k rest

update (Change text) model = { items := (snoc model.items $ MkItem False text) } model

main : IO Unit
main = pure $ runApp (getElementById "main") (MkModel [] "" All NoEdit) update view