Todo/TodoHtml.idr at master · leon-vv/Todo · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
module TodoHtml

import Todo
import Html
import Record
import File

import Effects

%access public export

notFound : Html
notFound = tagc "div" [text "404 not found"]

idToString : Todo -> String
idToString t = case (t .. "id") of
                    Nothing => ""
                    Just id => show id

-- Try generating form based on schema
todoForm : Todo -> Html
todoForm t =
  let checked = if t .. "done" then [("checked", "")] else []
  in tagac "form"
      [("id", "edit"), ("method", "get"), ("action", "./save")]
      [
        input Hidden [("name", "id"), ("value", idToString t)],
        tagc "div" [
          input TextType [("name", "name"), ("value", t .. "name"), ("placeholder", "description")]],
        tagc "label" [text "Already done:", input Checkbox (("name", "done")::checked)],
        tagc "div" [input Submit [("value", "Save")]]]

emptyForm : Html
emptyForm = todoForm ({ "id" ::= Nothing & "name" ::= "" & "done" ::= False })

divId : String -> List Html -> Html
divId id children = tagac "div" [("id", id)] children

spanId : String -> List Html -> Html
spanId id children = tagac "span" [("id", id)] children

link : String -> String -> Html
link href content = tagac "a" [("href", href)] [text content]

withinContent : List Html -> JS_IO String
withinContent b =
  (\style => "<!DOCTYPE html>" ++ show (
                tagc "html" [
                  tagc "head" [tagac "style" [("type", "text/CSS")] [text {escape=False} style]],
                  tagc "body" [divId "wrapper" [divId "content" b]]]))
    <$> readFileSync "style.css"

todoToHtml : Todo -> Html
todoToHtml t =
  let name = (t .. "name")
  in let checked = if t .. "done" then [("checked", "")] else []
  in tagac "div" [("class", "todo")]
    [ tagc "span" [text name],
      tagc "div" [taga {selfClose=True} "input" ([("disabled", ""), ("type", "checkbox")] ++ checked)],
      link ("/edit?id=" ++ idToString t) "Edit",
      tagac "form" [("action", ("/delete?id=" ++ idToString t)), ("method", "get")]
        [tagac "button" [("type", "submit")] [text "Delete"],
         taga {selfClose=True} "input"
          [("type", "hidden"), ("value", idToString t), ("name", "id")]]]

messageToHtml : String -> Html
messageToHtml msg = tagc "div" [text msg]

showTodos : List Todo -> JS_IO String
showTodos ts =
  let add = divId "add" [tagac "a" [("href", "/new")] [text "Add Todo"]]
  in let header = divId "header" [spanId "name" [text "Description"], spanId "done" [text "Done?"]]
  in let todos = divId "todos" (header::(map todoToHtml ts))
  in withinContent [add, todos]