Compare commits
No commits in common. "0337de721dbb8d1b48c6df410b31b2e1fcb1a3d7" and "b6f757c35e48f07207e4dc34fb757c09578101fe" have entirely different histories.
0337de721d
...
b6f757c35e
4 changed files with 92 additions and 67 deletions
|
|
@ -16,7 +16,7 @@ readF folder file = do
|
||||||
content <- readFile (folder <> file)
|
content <- readFile (folder <> file)
|
||||||
let itemsAsStrings = lines content
|
let itemsAsStrings = lines content
|
||||||
-- TODO: check if can simplify this step by making read work on list of items (i suppose it doesnt yet)
|
-- TODO: check if can simplify this step by making read work on list of items (i suppose it doesnt yet)
|
||||||
let itemsAsObjects = map read itemsAsStrings :: [TodoListItem]
|
let itemsAsObjects = map TR.read itemsAsStrings :: [TodoListItem]
|
||||||
return itemsAsObjects
|
return itemsAsObjects
|
||||||
writeF folder file content = do
|
writeF folder file content = do
|
||||||
let result = show content
|
let result = show content
|
||||||
|
|
|
||||||
|
|
@ -1,62 +1,38 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module HtmlPrimitives (mainPage, editPage) where
|
module HtmlPrimitives where
|
||||||
|
|
||||||
-- NOTE: this looks like shit, but that's what happens when u dont use library and u bad
|
import Control.Monad.RWS (lift)
|
||||||
-- 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 <> ">"
|
openingTag tag = "<" <> tag <> ">"
|
||||||
closingTag tag = "</" <> tag <> ">"
|
closingTag tag = "</" <> tag <> ">"
|
||||||
|
|
||||||
wrapContent tag content = openingTag tag <> content <> closingTag tag
|
wrapContent tag content = openingTag tag <> content <> closingTag tag
|
||||||
wrapContentWithArgs tag arg content = openingTag (tag <> " " <> arg) <> content <> closingTag tag
|
wrapContentWithArgs tag arg content = openingTag (tag <> arg) <> content <> closingTag tag
|
||||||
singleWrap = closingTag
|
singleWrap content = "<" <> content <> "/>"
|
||||||
|
|
||||||
br = "<br>"
|
docType = "<!DOCTYPE html>"
|
||||||
h1 = wrapContent "h1"
|
h1 = wrapContent "h1"
|
||||||
h2 = wrapContent "h2"
|
h2 = wrapContent "h2"
|
||||||
h3 = wrapContent "h3"
|
h3 = wrapContent "h3"
|
||||||
link href = wrapContentWithArgs "a" ("href=\"" <> href <> "\"")
|
link = wrapContent "a"
|
||||||
|
li = wrapContent "li"
|
||||||
p = wrapContent "p"
|
p = wrapContent "p"
|
||||||
button = wrapContentWithArgs "button"
|
|
||||||
form = wrapContentWithArgs "form"
|
checkboxPrimitive id name True = singleWrap $ "input type='checkbox' id=" <> id <> " name=" <> name <> " checked"
|
||||||
label for = wrapContentWithArgs "label" ("for=" <> for)
|
checkboxPrimitive id name False = singleWrap $ "input type='checkbox' id=" <> id <> " name=" <> name
|
||||||
textArea id rows cols = wrapContentWithArgs "textarea" ("id=\"" <> id <> "\" name=\"" <> id <> "\" rows=\"" <> rows <> "\" cols=\"" <> cols <> "\"")
|
|
||||||
|
label for = wrapContentWithArgs "label " ("for=" <> for)
|
||||||
|
|
||||||
checkbox id name checked = checkboxPrimitive id name checked <> label id name
|
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>"
|
-- | Takes a raw line as in untouched from the file
|
||||||
|
item rawLine = "<form action=\"/post/" <> rawLine <> "\" method=\"POST\"><button type=\"submit\">" <> rawLine <> "</button></form>"
|
||||||
|
|
||||||
html lang title content = headHtml lang title <> content <> tailHtml
|
path = "./app/res/b"
|
||||||
where
|
|
||||||
headHtml lang title =
|
simpleSite fileContent =
|
||||||
"<!doctype html><html lang=\""
|
docType
|
||||||
<> lang
|
<> h1 "Bienvenue sur la todo liste"
|
||||||
<> "\"><head><meta charset=\"UTF-8\" /><meta name=\"viewport\" content=\"width=device-width\" /><title>"
|
<> p "this website is a simple example of how haskell can quickly become a great tool to write websites fast"
|
||||||
<> title
|
|
||||||
<> "</title></head><body>"
|
ul content = wrapContent "ul" $ concatMap (wrapContent "li") content
|
||||||
tailHtml = "</body></html>"
|
|
||||||
|
|
|
||||||
|
|
@ -12,17 +12,12 @@ import Data.Text.IO qualified as TIO
|
||||||
import Data.Text.Lazy qualified as TL
|
import Data.Text.Lazy qualified as TL
|
||||||
import Data.Text.Lazy.Encoding qualified as TLE
|
import Data.Text.Lazy.Encoding qualified as TLE
|
||||||
import FileActions qualified as FA
|
import FileActions qualified as FA
|
||||||
import HtmlPrimitives
|
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
import Network.HTTP.Types.URI (urlDecode)
|
import Network.HTTP.Types.URI (urlDecode)
|
||||||
import Network.Wai
|
import Network.Wai
|
||||||
import Network.Wai.Handler.Warp (run)
|
import Network.Wai.Handler.Warp (run)
|
||||||
import TodoListItem
|
import TodoListItem
|
||||||
|
|
||||||
-- TODO: make every http generator in another file and make it cleaner
|
|
||||||
-- TODO: make the case statement readable and use where more
|
|
||||||
-- TODO: make better use of reads or readMaybe or watever to not just make it crash but cancel bad inputs by default
|
|
||||||
|
|
||||||
application req respond =
|
application req respond =
|
||||||
case (requestMethod req, pathInfo req) of
|
case (requestMethod req, pathInfo req) of
|
||||||
("GET", []) -> do
|
("GET", []) -> do
|
||||||
|
|
@ -30,7 +25,7 @@ application req respond =
|
||||||
respond $
|
respond $
|
||||||
responseLBS status200 [("Content-Type", "text/html")] $
|
responseLBS status200 [("Content-Type", "text/html")] $
|
||||||
convert $
|
convert $
|
||||||
mainPage (show content) -- TODO: check if necessary to use text
|
simpleSite (show content) -- TODO: check if necessary to use text
|
||||||
("GET", ["edit"]) -> do
|
("GET", ["edit"]) -> do
|
||||||
content <- FA.readF "./app/res/" "b"
|
content <- FA.readF "./app/res/" "b"
|
||||||
respond $
|
respond $
|
||||||
|
|
@ -38,7 +33,7 @@ application req respond =
|
||||||
convert $
|
convert $
|
||||||
editPage (show content)
|
editPage (show content)
|
||||||
("POST", ["edit"]) -> do
|
("POST", ["edit"]) -> do
|
||||||
-- TODO: refactor this shit
|
-- TODO: refactor this shit, add sanitisation, make sure text ends with \n
|
||||||
body <- strictRequestBody req
|
body <- strictRequestBody req
|
||||||
print body
|
print body
|
||||||
let args = L8.split '&' body
|
let args = L8.split '&' body
|
||||||
|
|
@ -51,7 +46,6 @@ application req respond =
|
||||||
case pair of
|
case pair of
|
||||||
("list=", t) -> do
|
("list=", t) -> do
|
||||||
let text = TE.decodeUtf8 (urlDecode True (BL.toStrict t))
|
let text = TE.decodeUtf8 (urlDecode True (BL.toStrict t))
|
||||||
print text
|
|
||||||
let result = map read (lines $ T.unpack text) :: [TodoListItem]
|
let result = map read (lines $ T.unpack text) :: [TodoListItem]
|
||||||
FA.writeF "./app/res/" "b" result
|
FA.writeF "./app/res/" "b" result
|
||||||
_ -> error "incorrect args"
|
_ -> error "incorrect args"
|
||||||
|
|
@ -82,6 +76,58 @@ application req respond =
|
||||||
splitKeyValue bs = case L8.break (== '=') bs of
|
splitKeyValue bs = case L8.break (== '=') bs of
|
||||||
(key, rest) -> (key, L8.drop 1 rest)
|
(key, rest) -> (key, L8.drop 1 rest)
|
||||||
|
|
||||||
|
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 content = "<" <> content <> "/>"
|
||||||
|
|
||||||
|
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>"
|
||||||
|
br = "<br>"
|
||||||
|
h1 = wrapContent "h1"
|
||||||
|
h2 = wrapContent "h2"
|
||||||
|
h3 = wrapContent "h3"
|
||||||
|
link href = wrapContentWithArgs "a" ("href=\"" <> href <> "\"")
|
||||||
|
li = wrapContent "li"
|
||||||
|
p = wrapContent "p"
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
simpleSite :: String -> String
|
||||||
|
simpleSite content =
|
||||||
|
headHtml "en" "todo"
|
||||||
|
<> h1 "Bienvenue"
|
||||||
|
<> h2 "Site exemple"
|
||||||
|
<> p "this website is a simple example of how haskell can quickly become a great tool to write websites fast"
|
||||||
|
<> f content
|
||||||
|
<> newItemForm
|
||||||
|
<> rawEditButton
|
||||||
|
<> tailHtml
|
||||||
|
where
|
||||||
|
f content = concatMap item (lines content)
|
||||||
|
|
||||||
|
item rawLine = "<form action=\"/check/" <> rawLine <> "\" method=\"POST\"><button type=\"submit\">" <> rawLine <> "</button></form>"
|
||||||
|
|
||||||
|
newItemForm = "<form action=\"/add\" method=\"post\"><input type=\"text\" name=\"text\" placeholder=\"[ ] add a new item\"><button type=\"submit\">Add</button></form>"
|
||||||
|
|
||||||
|
editForm content = editLabel <> br <> editTextArea content <> br <> editButton
|
||||||
|
where
|
||||||
|
editLabel = label "list" "Edit the todo list"
|
||||||
|
editTextArea = textArea "list" "30" "33"
|
||||||
|
editButton = wrapContentWithArgs "button" "type=\"submit\"" "submit"
|
||||||
|
|
||||||
|
editPage content =
|
||||||
|
headHtml "en" "edit"
|
||||||
|
<> wrapContentWithArgs "form" "action=\"/edit\" method=\"post\"" (editForm content)
|
||||||
|
<> tailHtml
|
||||||
|
rawEditButton = link "/edit" "edit todo list"
|
||||||
|
|
||||||
runServer = do
|
runServer = do
|
||||||
run 3000 application
|
run 3000 application
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -15,15 +15,18 @@ instance Show TodoListItem where
|
||||||
showList = foldr ((.) . shows) id
|
showList = foldr ((.) . shows) id
|
||||||
|
|
||||||
instance Read TodoListItem where
|
instance Read TodoListItem where
|
||||||
readsPrec _ input = do
|
readsPrec _ input =
|
||||||
let (item, rest) = break (== '\n') input
|
|
||||||
let (d, n) = splitAt 2 item
|
|
||||||
let
|
let
|
||||||
done = case d of
|
parts = words input
|
||||||
"x " -> True
|
in
|
||||||
"o " -> False
|
case parts of
|
||||||
_ -> error "Invalid status"
|
(status : nameParts) ->
|
||||||
name = case n of
|
let
|
||||||
"" -> error "empty name"
|
name = unwords nameParts -- Join the remaining parts as the name
|
||||||
something -> filter (/= '\r') something
|
done = case status of
|
||||||
[(TodoListItem name done, rest)]
|
"x" -> True
|
||||||
|
"o" -> False
|
||||||
|
_ -> error "Invalid status"
|
||||||
|
in
|
||||||
|
[(TodoListItem name done, "")]
|
||||||
|
_ -> []
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue