Shpadoinkle-examples-0.0.0.1: TODOMVC.hs

{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}


module Main where


import           Data.Text                     hiding (count, filter, length)
import           Prelude                       hiding (div, unwords)
import           Shpadoinkle
import           Shpadoinkle.Backend.ParDiff
import           Shpadoinkle.Html              hiding (main)
import           Shpadoinkle.Html.LocalStorage
import           Shpadoinkle.Html.Memo
import           Shpadoinkle.Html.Utils

import           TODOMVC.Types
import           TODOMVC.Update


default (Text)


filterHtml :: Applicative m => Visibility -> Visibility -> Html m Visibility
filterHtml = memo2 $ \cur item -> li_
  [ a (href "#" : onClick item : [className ("selected", cur == item)]) [ text . pack $ show item ]
  ]


htmlIfTasks :: Model -> [Html m a] -> [Html m a]
htmlIfTasks m h' = if Prelude.null (tasks m) then [] else h'


taskView :: MonadJSM m => Model -> Task -> Html m Model
taskView m = memo $ \(Task (Description d) c tid) ->
  li [ id' . pack . show $ unTaskId tid
     , className [ ("completed", c == Complete)
                 , ("editing", Just tid == editing m) ]
     ]
  [ div "view"
    [ input' [ type' "checkbox"
             , className "toggle"
             , onChange $ toggleCompleted m tid
             , checked $ c == Complete
             ]
    , label [ onDblclick (toggleEditing m (Just tid)) ] [ text d ]
    , button' [ className "destroy", onClick (removeTask m tid) ]
    ]
  , form [ onSubmit $ toggleEditing m Nothing ]
    [ input' [ className "edit"
             , value d
             , onInput $ updateTaskDescription m tid . Description
             , autofocus True
             , onBlur $ toggleEditing m Nothing
             ]
    ]
  ]


listFooter :: Applicative m => Model -> Html m Model
listFooter model = footer "footer" $
  [ Shpadoinkle.Html.span "todo-count" $ let co = count Incomplete $ tasks model in
    [ strong_ [ text . pack $ show co ]
    , text $ " item" <> (if co == 1 then "" else "s") <> " left"
    ]
  , ul "filters" $ fmap (\v -> model { visibility = v })
                <$> (filterHtml (visibility model) <$> [minBound..maxBound])
  ] ++ (if count Complete (tasks model) == 0 then [] else
  [ button [ className "clear-completed", onClick $ clearComplete model ] [ "Clear completed" ]
  ])



info :: Html m a
info = footer "info"
  [ p_ [ "Double-click to edit a todo" ]
  , p_ [ "Credits ", a [ href "https://twitter.com/fresheyeball" ] [ "Isaac Shapira" ] ]
  , p_ [ "Part of ", a [ href "http://todomvc.com" ] [ "TodoMVC" ] ]
  ]


newTaskForm :: MonadJSM m => Model -> Html m Model
newTaskForm model = form [ className "todo-form", onSubmit (appendItem model) ]
  [ input' [ className "new-todo"
           , value . unDescription $ current model
           , onInput $ updateDescription model . Description
           , placeholder "What needs to be done?" ]
  ]


todoList :: MonadJSM m => Model -> Html m Model
todoList model = ul "todo-list" $ taskView model <$> toVisible (visibility model) (tasks model)


toggleAllBtn :: Applicative m => Model -> [Html m Model]
toggleAllBtn model =
  [ input' [ id' "toggle-all", className "toggle-all", type' "checkbox", onChange (toggleAll model) ]
  , label [ for' "toggle-all" ] [ "Mark all as complete" ]
  ]


view :: MonadJSM m => Model -> Html m Model
view model = div_
  [ section "todoapp" $
    header "header"
      [ h1_ [ "todos" ], newTaskForm model ]
    : htmlIfTasks model
    [ section "main" $ toggleAllBtn model ++ [ todoList model ]
    , listFooter model
    ]
  , info
  ]


app :: JSM ()
app = do
  model <- manageLocalStorage "todo" emptyModel
  initial <- readTVarIO model
  addStyle "https://cdn.jsdelivr.net/npm/todomvc-common@1.0.5/base.css"
  addStyle "https://cdn.jsdelivr.net/npm/todomvc-app-css@2.2.0/index.css"
  shpadoinkle id runParDiff initial model view getBody


main :: IO ()
main = do
  putStrLn "running app"
  runJSorWarp 8080 app