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

Compare commits

base: Stuce:0337de721dbb8d1b48c6df410b31b2e1fcb1a3d7
Branches Tags
Stuce:main
..
compare: Stuce:b6f757c35e48f07207e4dc34fb757c09578101fe
Branches Tags
Stuce:main

No commits in common. "0337de721dbb8d1b48c6df410b31b2e1fcb1a3d7" and "b6f757c35e48f07207e4dc34fb757c09578101fe" have entirely different histories.
0337de721d ... b6f757c35e

4 changed files with 92 additions and 67 deletions
Download patch file Download diff file Expand all files Collapse all files

2
app/FileActions.hs
View file

@ -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

68
app/HtmlPrimitives.hs
View file

@ -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"
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 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
item rawLine = "<form action=\"/check/" <> rawLine <> "\" method=\"POST\"><button type=\"submit\">" <> rawLine <> "</button></form>" label for = wrapContentWithArgs "label " ("for=" <> for)
html lang title content = headHtml lang title <> content <> tailHtml checkbox id name checked = checkboxPrimitive id name checked <> label id name
where
headHtml lang title = -- | Takes a raw line as in untouched from the file
"<!doctype html><html lang=\"" item rawLine = "<form action=\"/post/" <> rawLine <> "\" method=\"POST\"><button type=\"submit\">" <> rawLine <> "</button></form>"
<> lang
<> "\"><head><meta charset=\"UTF-8\" /><meta name=\"viewport\" content=\"width=device-width\" /><title>" path = "./app/res/b"
<> title
<> "</title></head><body>" simpleSite fileContent =
tailHtml = "</body></html>" docType
<> h1 "Bienvenue sur la todo liste"
<> p "this website is a simple example of how haskell can quickly become a great tool to write websites fast"
ul content = wrapContent "ul" $ concatMap (wrapContent "li") content

62
app/Server.hs
View file

@ -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

19
app/TodoListItem.hs
View file

@ -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
in
case parts of
(status : nameParts) ->
let
name = unwords nameParts -- Join the remaining parts as the name
done = case status of
"x" -> True "x" -> True
"o" -> False "o" -> False
_ -> error "Invalid status" _ -> error "Invalid status"
name = case n of in
"" -> error "empty name" [(TodoListItem name done, "")]
something -> filter (/= '\r') something _ -> []
[(TodoListItem name done, rest)]