{-# 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\">" $ 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 = " "
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 = ""
html lang title content = headHtml lang title <> content <> tailHtml
where
headHtml lang title =
" lang
<> "\">"
<> title
<> ""
tailHtml = ""