diff --git a/app/FileActions.hs b/app/FileActions.hs index 36e0b6c..67c8666 100644 --- a/app/FileActions.hs +++ b/app/FileActions.hs @@ -16,7 +16,7 @@ readF folder file = do content <- readFile (folder <> file) let itemsAsStrings = lines content -- TODO: check if can simplify this step by making read work on list of items (i suppose it doesnt yet) - let itemsAsObjects = map TR.read itemsAsStrings :: [TodoListItem] + let itemsAsObjects = map read itemsAsStrings :: [TodoListItem] return itemsAsObjects writeF folder file content = do let result = show content diff --git a/app/HtmlPrimitives.hs b/app/HtmlPrimitives.hs index f4525ff..0ce2fde 100644 --- a/app/HtmlPrimitives.hs +++ b/app/HtmlPrimitives.hs @@ -1,38 +1,62 @@ {-# LANGUAGE OverloadedStrings #-} -module HtmlPrimitives where +module HtmlPrimitives (mainPage, editPage) where -import Control.Monad.RWS (lift) +-- 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\"> 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 content = "<" <> content <> "/>" -docType = "" +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 = wrapContent "a" -li = wrapContent "li" +link href = wrapContentWithArgs "a" ("href=\"" <> href <> "\"") 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) - +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 --- | Takes a raw line as in untouched from the file -item rawLine = "
rawLine <> "\" method=\"POST\">
" +item rawLine = "
rawLine <> "\" method=\"POST\">
" -path = "./app/res/b" - -simpleSite fileContent = - 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 +html lang title content = headHtml lang title <> content <> tailHtml + where + headHtml lang title = + " lang + <> "\">" + <> title + <> "" + tailHtml = "" diff --git a/app/Server.hs b/app/Server.hs index 5e7c031..1b5a46b 100644 --- a/app/Server.hs +++ b/app/Server.hs @@ -12,12 +12,17 @@ import Data.Text.IO qualified as TIO import Data.Text.Lazy qualified as TL import Data.Text.Lazy.Encoding qualified as TLE import FileActions qualified as FA +import HtmlPrimitives import Network.HTTP.Types import Network.HTTP.Types.URI (urlDecode) import Network.Wai import Network.Wai.Handler.Warp (run) 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 = case (requestMethod req, pathInfo req) of ("GET", []) -> do @@ -25,7 +30,7 @@ application req respond = respond $ responseLBS status200 [("Content-Type", "text/html")] $ convert $ - simpleSite (show content) -- TODO: check if necessary to use text + mainPage (show content) -- TODO: check if necessary to use text ("GET", ["edit"]) -> do content <- FA.readF "./app/res/" "b" respond $ @@ -33,7 +38,7 @@ application req respond = convert $ editPage (show content) ("POST", ["edit"]) -> do - -- TODO: refactor this shit, add sanitisation, make sure text ends with \n + -- TODO: refactor this shit body <- strictRequestBody req print body let args = L8.split '&' body @@ -46,6 +51,7 @@ application req respond = case pair of ("list=", t) -> do let text = TE.decodeUtf8 (urlDecode True (BL.toStrict t)) + print text let result = map read (lines $ T.unpack text) :: [TodoListItem] FA.writeF "./app/res/" "b" result _ -> error "incorrect args" @@ -76,58 +82,6 @@ application req respond = splitKeyValue bs = case L8.break (== '=') bs of (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 = " lang <> "\">" <> title <> "" -tailHtml = "" -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 = "
rawLine <> "\" method=\"POST\">
" - -newItemForm = "
" - -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 diff --git a/app/TodoListItem.hs b/app/TodoListItem.hs index c9562f2..5e1fab3 100644 --- a/app/TodoListItem.hs +++ b/app/TodoListItem.hs @@ -15,18 +15,15 @@ instance Show TodoListItem where showList = foldr ((.) . shows) id instance Read TodoListItem where - readsPrec _ input = + readsPrec _ input = do + let (item, rest) = break (== '\n') input + let (d, n) = splitAt 2 item let - 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 - "o" -> False - _ -> error "Invalid status" - in - [(TodoListItem name done, "")] - _ -> [] + done = case d of + "x " -> True + "o " -> False + _ -> error "Invalid status" + name = case n of + "" -> error "empty name" + something -> filter (/= '\r') something + [(TodoListItem name done, rest)]