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 add folder file item = do
content <- TIO.readFile (folder <> file) content <- TIO.readFile (folder <> file)
let result = content <> item 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) renameFile (folder <> tempFile) (folder <> file)
delete folder file item = do delete folder file item = do
content <- TIO.readFile (folder <> file) content <- TIO.readFile (folder <> file)
let result = T.unlines $ filter (not . item) (T.lines content) let result = T.unlines $ filter (not . item) (T.lines content)
TIO.writeFile (folder <> tempFile) result write folder file result
renameFile (folder <> tempFile) (folder <> file)
check folder file item = do check folder file item = do
content <- TIO.readFile (folder <> file) content <- TIO.readFile (folder <> file)

50
app/Server.hs
View file

@ -28,6 +28,31 @@ application req respond =
TLE.encodeUtf8 $ TLE.encodeUtf8 $
TL.fromStrict $ TL.fromStrict $
simpleSite content 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 ("POST", ["check", name]) -> do
FA.check "./app/res/" "b" name FA.check "./app/res/" "b" name
respond $ responseLBS status303 [(hLocation, "/")] "Redirecting..." respond $ responseLBS status303 [(hLocation, "/")] "Redirecting..."
@ -56,23 +81,24 @@ splitKeyValue bs = case L8.break (== '=') bs of
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 content = "<" <> content <> "/>" 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>" 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 = "</html>" tailHtml = "</body></html>"
br = "<br>"
h1 = wrapContent "h1" h1 = wrapContent "h1"
h2 = wrapContent "h2" h2 = wrapContent "h2"
h3 = wrapContent "h3" h3 = wrapContent "h3"
link = wrapContent "a" link href = wrapContentWithArgs "a" ("href=\"" <> href <> "\"")
li = wrapContent "li" li = wrapContent "li"
p = wrapContent "p" p = wrapContent "p"
checkboxPrimitive id name True = singleWrap $ "input type='checkbox' id=" <> id <> " name=" <> name <> " checked" 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 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 checkbox id name checked = checkboxPrimitive id name checked <> label id name
simpleSite content = 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>" 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 runServer = do
run 3000 application run 3000 application

6
app/res/b
View file

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

13
shell.nix
View file

@ -1,2 +1,11 @@
let pkgs = import <nixpkgs> { }; let
in pkgs.haskellPackages.developPackage { root = ./.; } pkgs = import <nixpkgs> {};
pinnedPkgs = import (builtins.fetchTarball "https://github.com/NixOS/nixpkgs/archive/9b5ac7ad45298d58640540d0323ca217f32a6762.tar.gz") {};
in
pinnedPkgs.haskellPackages.developPackage {
root = ./.;
modifier = drv:
pinnedPkgs.haskell.lib.addBuildTools drv (with pinnedPkgs.haskellPackages; [
haskell-language-server
]);
}

131
tags
View file

@ -1,69 +1,64 @@
!_TAG_FILE_SORTED 1 // !_TAG_FILE_SORTED 1 //
ArgParser /home/stuce/haskell/todo/app/ArgParser.hs 1;" m ArgParser /home/stuce/dev/haskell/todo/app/ArgParser.hs 1;" m
Args /home/stuce/haskell/todo/app/ArgParser.hs 5;" t Args /home/stuce/dev/haskell/todo/app/ArgParser.hs 5;" t
DBActions /home/stuce/haskell/todo/app/DBActions.hs 4;" m FileActions /home/stuce/dev/haskell/todo/app/FileActions.hs 5;" m
FileActions /home/stuce/haskell/todo/app/FileActions.hs 5;" m HtmlPrimitives /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 3;" m
HtmlPrimitives /home/stuce/haskell/todo/app/HtmlPrimitives.hs 3;" m Main /home/stuce/dev/haskell/todo/app/Main.hs 3;" m
Main /home/stuce/haskell/todo/app/Main.hs 3;" m Server /home/stuce/dev/haskell/todo/app/Server.hs 7;" m
Server /home/stuce/haskell/todo/app/Server.hs 7;" m TodoListItem /home/stuce/dev/haskell/todo/app/TodoListItem.hs 1;" m
TodoListItem /home/stuce/haskell/todo/app/TodoListItem.hs 1;" m add /home/stuce/dev/haskell/todo/app/FileActions.hs 16;" f
add /home/stuce/haskell/todo/app/FileActions.hs 16;" f application /home/stuce/dev/haskell/todo/app/Server.hs 22;" f
application /home/stuce/haskell/todo/app/Server.hs 22;" f argAdd /home/stuce/dev/haskell/todo/app/ArgParser.hs 6;" f
argAdd /home/stuce/haskell/todo/app/ArgParser.hs 6;" f argCheck /home/stuce/dev/haskell/todo/app/ArgParser.hs 8;" f
argCheck /home/stuce/haskell/todo/app/ArgParser.hs 8;" f argDelete /home/stuce/dev/haskell/todo/app/ArgParser.hs 7;" f
argDelete /home/stuce/haskell/todo/app/ArgParser.hs 7;" f argTui /home/stuce/dev/haskell/todo/app/ArgParser.hs 9;" f
argTui /home/stuce/haskell/todo/app/ArgParser.hs 9;" f args /home/stuce/dev/haskell/todo/app/ArgParser.hs 12;" f
args /home/stuce/haskell/todo/app/ArgParser.hs 12;" f check /home/stuce/dev/haskell/todo/app/FileActions.hs 28;" f
check /home/stuce/haskell/todo/app/FileActions.hs 28;" f checkbox /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 26;" f
checkbox /home/stuce/haskell/todo/app/HtmlPrimitives.hs 26;" f checkbox /home/stuce/dev/haskell/todo/app/Server.hs 76;" f
checkbox /home/stuce/haskell/todo/app/Server.hs 76;" f checkboxPrimitive /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 21;" f
checkboxPrimitive /home/stuce/haskell/todo/app/HtmlPrimitives.hs 21;" f checkboxPrimitive /home/stuce/dev/haskell/todo/app/Server.hs 71;" f
checkboxPrimitive /home/stuce/haskell/todo/app/Server.hs 71;" f closingTag /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 8;" f
closingTag /home/stuce/haskell/todo/app/HtmlPrimitives.hs 8;" f closingTag /home/stuce/dev/haskell/todo/app/Server.hs 57;" f
closingTag /home/stuce/haskell/todo/app/Server.hs 57;" f delete /home/stuce/dev/haskell/todo/app/FileActions.hs 22;" f
delete /home/stuce/haskell/todo/app/FileActions.hs 22;" f docType /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 13;" f
docType /home/stuce/haskell/todo/app/HtmlPrimitives.hs 13;" f done /home/stuce/dev/haskell/todo/app/TodoListItem.hs 5;" f
done /home/stuce/haskell/todo/app/TodoListItem.hs 5;" f h1 /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 14;" f
h1 /home/stuce/haskell/todo/app/HtmlPrimitives.hs 14;" f h1 /home/stuce/dev/haskell/todo/app/Server.hs 64;" f
h1 /home/stuce/haskell/todo/app/Server.hs 64;" f h2 /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 15;" f
h2 /home/stuce/haskell/todo/app/HtmlPrimitives.hs 15;" f h2 /home/stuce/dev/haskell/todo/app/Server.hs 65;" f
h2 /home/stuce/haskell/todo/app/Server.hs 65;" f h3 /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 16;" f
h3 /home/stuce/haskell/todo/app/HtmlPrimitives.hs 16;" f h3 /home/stuce/dev/haskell/todo/app/Server.hs 66;" f
h3 /home/stuce/haskell/todo/app/Server.hs 66;" f headHtml /home/stuce/dev/haskell/todo/app/Server.hs 62;" f
headHtml /home/stuce/haskell/todo/app/Server.hs 62;" f item /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 29;" f
item /home/stuce/haskell/todo/app/HtmlPrimitives.hs 29;" f item /home/stuce/dev/haskell/todo/app/Server.hs 90;" f
item /home/stuce/haskell/todo/app/Server.hs 90;" f label /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 24;" f
label /home/stuce/haskell/todo/app/HtmlPrimitives.hs 24;" f label /home/stuce/dev/haskell/todo/app/Server.hs 74;" f
label /home/stuce/haskell/todo/app/Server.hs 74;" f li /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 18;" f
li /home/stuce/haskell/todo/app/HtmlPrimitives.hs 18;" f li /home/stuce/dev/haskell/todo/app/Server.hs 68;" f
li /home/stuce/haskell/todo/app/Server.hs 68;" f link /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 17;" f
link /home/stuce/haskell/todo/app/HtmlPrimitives.hs 17;" f link /home/stuce/dev/haskell/todo/app/Server.hs 67;" f
link /home/stuce/haskell/todo/app/Server.hs 67;" f main /home/stuce/dev/haskell/todo/app/Main.hs 7;" f
main /home/stuce/haskell/todo/app/Main.hs 7;" f name /home/stuce/dev/haskell/todo/app/TodoListItem.hs 4;" f
name /home/stuce/haskell/todo/app/TodoListItem.hs 4;" f newItemForm /home/stuce/dev/haskell/todo/app/Server.hs 93;" f
newItemForm /home/stuce/haskell/todo/app/Server.hs 93;" f openingTag /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 7;" f
openingTag /home/stuce/haskell/todo/app/HtmlPrimitives.hs 7;" f openingTag /home/stuce/dev/haskell/todo/app/Server.hs 56;" f
openingTag /home/stuce/haskell/todo/app/Server.hs 56;" f p /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 19;" f
p /home/stuce/haskell/todo/app/HtmlPrimitives.hs 19;" f p /home/stuce/dev/haskell/todo/app/Server.hs 69;" f
p /home/stuce/haskell/todo/app/Server.hs 69;" f path /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 31;" f
path /home/stuce/haskell/todo/app/HtmlPrimitives.hs 31;" f rawEditButton /home/stuce/dev/haskell/todo/app/Server.hs 95;" f
rawEditButton /home/stuce/haskell/todo/app/Server.hs 95;" f runServer /home/stuce/dev/haskell/todo/app/Server.hs 97;" f
runAdd /home/stuce/haskell/todo/app/DBActions.hs 9;" f simpleSite /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 33;" f
runCheck /home/stuce/haskell/todo/app/DBActions.hs 20;" f simpleSite /home/stuce/dev/haskell/todo/app/Server.hs 78;" f
runDelete /home/stuce/haskell/todo/app/DBActions.hs 15;" f singleWrap /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 11;" f
runServer /home/stuce/haskell/todo/app/Server.hs 97;" f singleWrap /home/stuce/dev/haskell/todo/app/Server.hs 60;" f
runShow /home/stuce/haskell/todo/app/DBActions.hs 24;" f splitKeyValue /home/stuce/dev/haskell/todo/app/Server.hs 53;" f
simpleSite /home/stuce/haskell/todo/app/HtmlPrimitives.hs 33;" f swapCheck /home/stuce/dev/haskell/todo/app/FileActions.hs 36;" f
simpleSite /home/stuce/haskell/todo/app/Server.hs 78;" f swapIfMatch /home/stuce/dev/haskell/todo/app/FileActions.hs 34;" f
singleWrap /home/stuce/haskell/todo/app/HtmlPrimitives.hs 11;" f tailHtml /home/stuce/dev/haskell/todo/app/Server.hs 63;" f
singleWrap /home/stuce/haskell/todo/app/Server.hs 60;" f tempFile /home/stuce/dev/haskell/todo/app/FileActions.hs 12;" f
splitKeyValue /home/stuce/haskell/todo/app/Server.hs 53;" f ul /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 38;" f
swapCheck /home/stuce/haskell/todo/app/FileActions.hs 36;" f wrapContent /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 9;" f
swapIfMatch /home/stuce/haskell/todo/app/FileActions.hs 34;" f wrapContent /home/stuce/dev/haskell/todo/app/Server.hs 58;" f
tailHtml /home/stuce/haskell/todo/app/Server.hs 63;" f wrapContentWithArgs /home/stuce/dev/haskell/todo/app/HtmlPrimitives.hs 10;" f
tempFile /home/stuce/haskell/todo/app/FileActions.hs 12;" f wrapContentWithArgs /home/stuce/dev/haskell/todo/app/Server.hs 59;" f
ul /home/stuce/haskell/todo/app/HtmlPrimitives.hs 38;" f
wrapContent /home/stuce/haskell/todo/app/HtmlPrimitives.hs 9;" f
wrapContent /home/stuce/haskell/todo/app/Server.hs 58;" f
wrapContentWithArgs /home/stuce/haskell/todo/app/HtmlPrimitives.hs 10;" f
wrapContentWithArgs /home/stuce/haskell/todo/app/Server.hs 59;" f

2
todo.cabal
View file

@ -63,7 +63,7 @@ executable todo
main-is: Main.hs main-is: Main.hs
-- Modules included in this executable, other than Main. -- Modules included in this executable, other than Main.
-- other-modules: other-modules: TodoListItem
-- LANGUAGE extensions used by modules in this package. -- LANGUAGE extensions used by modules in this package.
-- other-extensions: -- other-extensions:

BIN
todo.db
View file

Binary file not shown.