fixed sanitisation a bit

app/FileActions.hs

@@ -7,34 +7,40 @@ module FileActions where
 import Data.Text qualified as T
 import Data.Text.IO qualified as TIO
 import System.Directory
+import Text.Read qualified as TR
 import TodoListItem
 
 tempFile = "tempFile"
 
--- TODO: add sanitisation using the todo item type ?
+readF folder file = do
--- TODO: sometimes the whitespace does not work as expected, find why and solve it
+        content <- readFile (folder <> file)
-add folder file item = do
+        let itemsAsStrings = lines content
-        content <- TIO.readFile (folder <> file)
+        -- TODO: check if can simplify this step by making read work on list of items (i suppose it doesnt yet)
-        let result = content <> item
+        let itemsAsObjects = map TR.read itemsAsStrings :: [TodoListItem]
-        write folder file result
+        return itemsAsObjects
-write folder file content = do
+writeF folder file content = do
-        TIO.writeFile (folder <> tempFile) content
+        let result = show content
+        writeFile (folder <> tempFile) result
         renameFile (folder <> tempFile) (folder <> file)
 
+appendF folder file item = do
+        content <- readF folder file
+        let result = content <> item -- TODO: check if more elegant solution exist (without needing a list for 1 item)
+        writeF folder file result
+
+delete :: FilePath -> FilePath -> TodoListItem -> IO ()
 delete folder file item = do
-        content <- TIO.readFile (folder <> file)
+        content <- readF folder file
-        let result = T.unlines $ filter (not . item) (T.lines content)
+        let result = filter (/= item) content
-        write folder file result
+        writeF folder file result
 
-check folder file item = do
+check :: FilePath -> FilePath -> TodoListItem -> IO ()
-        content <- TIO.readFile (folder <> file)
+check folder file name = do
-        let result = T.unlines $ map (swapIfMatch item) (T.lines content)
+        content <- readF folder file
-        TIO.writeFile (folder <> tempFile) result
+        let result = map (swapIfMatch name) content
-        renameFile (folder <> tempFile) (folder <> file)
+        writeF folder file result
-
+    where
-swapIfMatch name strEncodedItem = if name == strEncodedItem then swapCheck strEncodedItem else strEncodedItem
+        swapIfMatch name item = do
-
+                if item == name
-swapCheck text
+                        then TodoListItem{name = TodoListItem.name item, done = not (TodoListItem.done item)}
-        | T.index text 1 == 'x' = "[ ] " <> T.drop 4 text
+                        else item
-        | T.index text 1 == ' ' = "[x] " <> T.drop 4 text
-        | otherwise = error "incorrectly formated element"

app/Server.hs

@@ -2,8 +2,6 @@
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE OverloadedStrings #-}
 
--- For documentation purposes, I find it clearer to ignore eta reduce as it feels more natural for me in this context
-
 module Server where
 
 import Data.ByteString.Lazy qualified as BL
@@ -18,26 +16,24 @@ import Network.HTTP.Types
 import Network.HTTP.Types.URI (urlDecode)
 import Network.Wai
 import Network.Wai.Handler.Warp (run)
+import TodoListItem
 
 application req respond =
         case (requestMethod req, pathInfo req) of
                 ("GET", []) -> do
-                        content <- TIO.readFile "./app/res/b" -- TODO: move that in fileActions
+                        content <- FA.readF "./app/res/" "b"
                         respond $
                                 responseLBS status200 [("Content-Type", "text/html")] $
-                                        TLE.encodeUtf8 $
+                                        convert $
-                                                TL.fromStrict $
+                                                simpleSite (show content) -- TODO: check if necessary to use text
-                                                        simpleSite content
                 ("GET", ["edit"]) -> do
-                        content <- TIO.readFile "./app/res/b" -- TODO: move that in fileActions
+                        content <- FA.readF "./app/res/" "b"
                         respond $
                                 responseLBS status200 [("Content-Type", "text/html")] $
-                                        TLE.encodeUtf8 $
+                                        convert $
-                                                TL.fromStrict $
+                                                editPage (show content)
-                                                        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
@@ -50,11 +46,12 @@ application req respond =
                                 case pair of
                                         ("list=", t) -> do
                                                 let text = TE.decodeUtf8 (urlDecode True (BL.toStrict t))
-                                                FA.write "./app/res/" "b" text
+                                                let result = map read (lines $ T.unpack text) :: [TodoListItem]
+                                                FA.writeF "./app/res/" "b" result
                                         _ -> error "incorrect args"
                                 respond $ responseLBS status303 [(hLocation, "/")] "Redirecting..."
                 ("POST", ["check", name]) -> do
-                        FA.check "./app/res/" "b" name
+                        FA.check "./app/res/" "b" (read $ T.unpack name)
                         respond $ responseLBS status303 [(hLocation, "/")] "Redirecting..."
                 -- TODO: refactor this using where better and creating meaningfull local functions
                 ("POST", ["add"]) -> do
@@ -70,7 +67,8 @@ application req respond =
                                 case pair of
                                         ("text=", t) -> do
                                                 let text = TE.decodeUtf8 (urlDecode True (BL.toStrict t))
-                                                FA.add "./app/res/" "b" text
+                                                let item = read (T.unpack text) :: TodoListItem
+                                                FA.appendF "./app/res/" "b" [item]
                                         _ -> error "incorrect args"
                                 respond $ responseLBS status303 [(hLocation, "/")] "Redirecting..."
                 (method, array) -> do
@@ -101,6 +99,7 @@ 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"
@@ -111,9 +110,8 @@ simpleSite content =
                 <> rawEditButton
                 <> tailHtml
     where
-        f content = T.concat $ map item (T.lines content)
+        f content = concatMap item (lines content)
 
-item :: T.Text -> T.Text
 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>"
@@ -132,3 +130,5 @@ rawEditButton = link "/edit" "edit todo list"
 
 runServer = do
         run 3000 application
+
+convert = BL.fromStrict . TE.encodeUtf8 . T.pack

app/TodoListItem.hs

@@ -4,12 +4,29 @@ data TodoListItem = TodoListItem
         { name :: String
         , done :: Bool
         }
+        deriving (Eq)
 
 instance Show TodoListItem where
         show (TodoListItem name done) =
                 s done ++ " " ++ name ++ "\n"
             where
-                s True = "[x]"
+                s True = "x"
-                s False = "[ ]"
+                s False = "o"
+        showList = foldr ((.) . shows) id
 
--- TODO: create a class to render items to html to make it easier to create everything for the website using the web primitives
+instance Read TodoListItem where
+        readsPrec _ input =
+                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, "")]
+                                _ -> []

app/res/b

@@ -1,6 +1,4 @@
-[ ] Wake up
+o Wake up
-[ ] Eat
+o Eat
-[ ] Sleep
+o Sleep
-[x] Repeat
+o Repeat
-[x] 
-[ ] dasd