| 1 | -- | The TodoMVC page, rendered on the server. It follows TodoMVC's own |
| 2 | -- template, plus the plain forms that make every action work without |
| 3 | -- JavaScript. @static/app.css@ lays those forms out and @static/app.js@ |
| 4 | -- takes over from them when it runs. |
| 5 | module Todo.Html |
| 6 | ( View (..) |
| 7 | , page |
| 8 | , fragment |
| 9 | ) where |
| 10 | |
| 11 | import Control.Monad (forM_, unless) |
| 12 | import Data.Text (Text) |
| 13 | import Data.Text qualified as T |
| 14 | import Lucid |
| 15 | import Lucid.Base (makeAttributes) |
| 16 | import Todo.Model |
| 17 | |
| 18 | -- | Everything one render needs. |
| 19 | data View = View |
| 20 | { viewFilter :: Filter |
| 21 | , viewTodos :: [Todo] |
| 22 | -- ^ The whole list, whatever the filter. |
| 23 | , viewEditing :: Maybe TodoId |
| 24 | , viewAssetVersion :: Text |
| 25 | -- ^ Appended to this app's own asset URLs, so a new build is fetched. |
| 26 | } |
| 27 | |
| 28 | page :: View -> Html () |
| 29 | page v = doctype_ >> html_ [lang_ "en"] (do |
| 30 | head_ $ do |
| 31 | meta_ [charset_ "utf-8"] |
| 32 | meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1"] |
| 33 | title_ "TodoMVC" |
| 34 | link_ [rel_ "stylesheet", href_ "/static/base.css"] |
| 35 | link_ [rel_ "stylesheet", href_ "/static/index.css"] |
| 36 | link_ [rel_ "stylesheet", href_ ("/static/app.css?v=" <> viewAssetVersion v)] |
| 37 | script_ [type_ "module", src_ ("/static/app.js?v=" <> viewAssetVersion v)] ("" :: Text) |
| 38 | body_ $ do |
| 39 | section_ [class_ "todoapp"] $ do |
| 40 | header_ [class_ "header"] $ do |
| 41 | h1_ "todos" |
| 42 | postForm v "/todos" $ |
| 43 | input_ $ |
| 44 | [class_ "new-todo", name_ "title", placeholder_ "What needs to be done?", autocomplete_ "off"] |
| 45 | <> [autofocus_ | null (viewEditing v)] |
| 46 | fragment v |
| 47 | footer_ [class_ "info"] $ do |
| 48 | p_ "Double-click to edit a todo" |
| 49 | p_ $ do |
| 50 | "Created by " |
| 51 | a_ [href_ "https://bakeoff.bfj.oncarlos.com"] "the CARLOS bakeoff" |
| 52 | " · Haskell" |
| 53 | p_ $ do |
| 54 | "Part of " |
| 55 | a_ [href_ "http://todomvc.com"] "TodoMVC") |
| 56 | |
| 57 | -- | @section.main@ and @footer.footer@: the part of the page every |
| 58 | -- action changes. With JavaScript on, actions answer with just this. |
| 59 | fragment :: View -> Html () |
| 60 | fragment v = do |
| 61 | section_ ([class_ "main"] <> hiddenIf (null todos)) $ do |
| 62 | input_ ([id_ "toggle-all", class_ "toggle-all", type_ "checkbox"] <> [checked_ | allDone]) |
| 63 | label_ [for_ "toggle-all"] "Mark all as complete" |
| 64 | postForm v "/todos/toggle-all" $ |
| 65 | button_ [class_ "toggle-all-submit", data_ "action" "toggle-all"] "Mark all as complete" |
| 66 | ul_ [class_ "todo-list"] $ |
| 67 | forM_ (filter (visible (viewFilter v)) todos) (item v) |
| 68 | footer_ ([class_ "footer"] <> hiddenIf (null todos)) $ do |
| 69 | span_ [class_ "todo-count"] $ do |
| 70 | strong_ (toHtml (show left)) |
| 71 | if left == 1 then " item left" else " items left" |
| 72 | ul_ [class_ "filters"] $ |
| 73 | forM_ [minBound .. maxBound] $ \f -> do |
| 74 | unless (f == minBound) " " |
| 75 | li_ $ a_ ([href_ (filterPath f)] <> [class_ "selected" | f == viewFilter v]) (filterLabel f) |
| 76 | postForm v "/todos/clear-completed" $ |
| 77 | button_ ([class_ "clear-completed"] <> hiddenIf (left == length todos)) "Clear completed" |
| 78 | where |
| 79 | todos = viewTodos v |
| 80 | left = length (filter (not . todoCompleted) todos) |
| 81 | allDone = not (null todos) && left == 0 |
| 82 | |
| 83 | item :: View -> Todo -> Html () |
| 84 | item v t = |
| 85 | li_ ([data_ "id" tid] <> [class_ (T.unwords classes) | not (null classes)]) $ do |
| 86 | div_ [class_ "view"] $ do |
| 87 | input_ ([class_ "toggle", type_ "checkbox"] <> [checked_ | todoCompleted t]) |
| 88 | label_ $ a_ [data_ "action" "edit", href_ editHref] (toHtml (todoTitle t)) |
| 89 | postForm v (base <> "/toggle") $ |
| 90 | button_ |
| 91 | [ class_ "toggle-submit" |
| 92 | , data_ "action" "toggle" |
| 93 | , makeAttributes "aria-label" (if todoCompleted t then "Mark as active" else "Mark as complete") |
| 94 | ] |
| 95 | "" |
| 96 | postForm v (base <> "/destroy") $ |
| 97 | button_ [class_ "destroy", makeAttributes "aria-label" "Delete"] "" |
| 98 | postForm v (base <> "/edit") $ |
| 99 | input_ ([class_ "edit", name_ "title", value_ (todoTitle t)] <> [autofocus_ | editing]) |
| 100 | where |
| 101 | tid = todoIdText (todoId t) |
| 102 | base = "/todos/" <> tid |
| 103 | editing = viewEditing v == Just (todoId t) |
| 104 | classes = ["completed" | todoCompleted t] <> ["editing" | editing] |
| 105 | editHref = filterPath (viewFilter v) <> "?edit=" <> tid |
| 106 | |
| 107 | -- | A form that posts to one action, carrying the current filter so the |
| 108 | -- redirect comes back to it. Laid out with @display: contents@, so it |
| 109 | -- doesn't disturb TodoMVC's CSS. |
| 110 | postForm :: View -> Text -> Html () -> Html () |
| 111 | postForm v action body = |
| 112 | form_ [method_ "post", action_ action, class_ "action"] $ do |
| 113 | input_ [type_ "hidden", name_ "filter", value_ (filterName (viewFilter v))] |
| 114 | body |
| 115 | |
| 116 | hiddenIf :: Bool -> [Attributes] |
| 117 | hiddenIf b = [hidden_ "" | b] |
| 118 | |
| 119 | filterLabel :: Filter -> Html () |
| 120 | filterLabel = \case |
| 121 | All -> "All" |
| 122 | Active -> "Active" |
| 123 | Completed -> "Completed" |
| 124 | |
amadan