Stuce/todo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

added edit page

Browse source
This commit is contained in:
stuce-bot 2025-05-18 23:14:03 +02:00
parent 03fce6f309
commit b07950f797
7 changed files with 128 additions and 87 deletions
Download patch file Download diff file Expand all files Collapse all files

7
app/FileActions.hs
View file

@ -16,14 +16,15 @@ tempFile = "tempFile"
add folder file item = do
content <- TIO.readFile (folder <> file)
let result = content <> item
TIO.writeFile (folder <> tempFile) result
write folder file result
write folder file content = do
TIO.writeFile (folder <> tempFile) content
renameFile (folder <> tempFile) (folder <> file)
delete folder file item = do
content <- TIO.readFile (folder <> file)
let result = T.unlines $ filter (not . item) (T.lines content)
TIO.writeFile (folder <> tempFile) result
renameFile (folder <> tempFile) (folder <> file)
write folder file result
check folder file item = do
content <- TIO.readFile (folder <> file)

50
app/Server.hs
View file

@ -28,6 +28,31 @@ application req respond =
TLE.encodeUtf8 $
TL.fromStrict $
simpleSite content
("GET", ["edit"]) -> do
content <- TIO.readFile "./app/res/b" -- TODO: move that in fileActions
respond $
responseLBS status200 [("Content-Type", "text/html")] $
TLE.encodeUtf8 $
TL.fromStrict $
editPage content
("POST", ["edit"]) -> do
-- TODO: refactor this shit, add sanitisation, make sure text ends with \n
putStrLn "overwriting list"
body <- strictRequestBody req
print body
let args = L8.split '&' body
case args of
[newList] -> f newList
_ -> error "should have exactly one arg"
where
f newList = do
let pair = BL.splitAt 5 newList
case pair of
("list=", t) -> do
let text = TE.decodeUtf8 (urlDecode True (BL.toStrict t))
FA.write "./app/res/" "b" text
_ -> error "incorrect args"
respond $ responseLBS status303 [(hLocation, "/")] "Redirecting..."
("POST", ["check", name]) -> do
FA.check "./app/res/" "b" name
respond $ responseLBS status303 [(hLocation, "/")] "Redirecting..."
@ -56,23 +81,24 @@ splitKeyValue bs = case L8.break (== '=') bs of
openingTag tag = "<" <> tag <> ">"
closingTag tag = "</" <> 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 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>"
tailHtml = "</html>"
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 = wrapContent "a"
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)
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 content =
@ -92,7 +118,17 @@ item rawLine = "<form action=\"/check/" <> rawLine <> "\" method=\"POST\"><butto
newItemForm = "<form action=\"/add\" method=\"post\"><input type=\"text\" name=\"text\" placeholder=\"[ ] add a new item\"><button type=\"submit\">Add</button></form>"
rawEditButton = link "/edit"
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
run 3000 application

12
app/res/b
View file

@ -1,6 +1,6 @@
[ ] Wake up
[ ] Eat
[ ] Sleep
[ ] Repeat
[ ] a
[ ] école
[ ] Wake up
[ ] Eat
[ ] Sleep
[x] Repeat
[x]
[ ] dasd