62 lines
2.8 KiB
Haskell
62 lines
2.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module HtmlPrimitives (mainPage, editPage) where
|
|
|
|
-- NOTE: this looks like shit, but that's what happens when u dont use library and u bad
|
|
-- TODO: check if compiler does in fact inline this mess as it has no buisness beeing computed more than once pro build
|
|
|
|
{-# INLINE mainPage #-}
|
|
mainPage content =
|
|
html "en" "todo" $
|
|
h1 "Todo Liste"
|
|
<> h2 "Stuce"
|
|
<> f content
|
|
<> newItemForm
|
|
<> rawEditButton
|
|
where
|
|
f content = concatMap item (lines content)
|
|
newItemForm = form "action=\"/add\" method=\"post\"><input type=\"text\" name=\"text\" placeholder=\"o add a new item>" $ button "type=\"submit\"" "add"
|
|
rawEditButton = link "/edit" "edit todo list"
|
|
|
|
{-# INLINE editPage #-}
|
|
editPage content =
|
|
html "en" "edit" $ wrapContentWithArgs "form" "action=\"/edit\" method=\"post\"" (editForm content)
|
|
where
|
|
editForm content = editLabel <> br <> editTextArea content <> br <> editButton
|
|
editLabel = label "list" "Edit the todo list"
|
|
editTextArea = textArea "list" "30" "33"
|
|
editButton = button "type=\"submit\"" "submit"
|
|
|
|
openingTag tag = "<" <> tag <> ">"
|
|
closingTag tag = "</" <> tag <> ">"
|
|
|
|
wrapContent tag content = openingTag tag <> content <> closingTag tag
|
|
wrapContentWithArgs tag arg content = openingTag (tag <> " " <> arg) <> content <> closingTag tag
|
|
singleWrap = closingTag
|
|
|
|
br = "<br>"
|
|
h1 = wrapContent "h1"
|
|
h2 = wrapContent "h2"
|
|
h3 = wrapContent "h3"
|
|
link href = wrapContentWithArgs "a" ("href=\"" <> href <> "\"")
|
|
p = wrapContent "p"
|
|
button = wrapContentWithArgs "button"
|
|
form = wrapContentWithArgs "form"
|
|
label for = wrapContentWithArgs "label" ("for=" <> for)
|
|
textArea id rows cols = wrapContentWithArgs "textarea" ("id=\"" <> id <> "\" name=\"" <> id <> "\" rows=\"" <> rows <> "\" cols=\"" <> cols <> "\"")
|
|
checkbox id name checked = checkboxPrimitive id name checked <> label id name
|
|
where
|
|
checkboxPrimitive id name True = singleWrap $ "input type='checkbox' id=" <> id <> " name=" <> name <> " checked"
|
|
checkboxPrimitive id name False = singleWrap $ "input type='checkbox' id=" <> id <> " name=" <> name
|
|
|
|
item rawLine = "<form action=\"/check/" <> rawLine <> "\" method=\"POST\"><button type=\"submit\">" <> rawLine <> "</button></form>"
|
|
|
|
html lang title content = headHtml lang title <> content <> tailHtml
|
|
where
|
|
headHtml lang title =
|
|
"<!doctype html><html lang=\""
|
|
<> lang
|
|
<> "\"><head><meta charset=\"UTF-8\" /><meta name=\"viewport\" content=\"width=device-width\" /><title>"
|
|
<> title
|
|
<> "</title></head><body>"
|
|
tailHtml = "</body></html>"
|