initial commit

2025-05-13 20:21:30 +02:00 · 2025-05-13 20:21:30 +02:00 · 70d3db13c7
commit 70d3db13c7
17 changed files with 1109 additions and 0 deletions
--- a/app/Server.hs
+++ b/app/Server.hs
@ -0,0 +1,98 @@
+{-# LANGUAGE BlockArguments #-}
+{-# 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
+import Data.ByteString.Lazy.Char8 qualified as L8
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as TE
+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 Network.HTTP.Types
+import Network.HTTP.Types.URI (urlDecode)
+import Network.Wai
+import Network.Wai.Handler.Warp (run)
+
+application req respond =
+        case (requestMethod req, pathInfo req) of
+                ("GET", []) -> do
+                        content <- TIO.readFile "./app/res/b" -- TODO: move that in fileActions
+                        respond $
+                                responseLBS status200 [("Content-Type", "text/html")] $
+                                        TLE.encodeUtf8 $
+                                                TL.fromStrict $
+                                                        simpleSite content
+                ("POST", ["check", name]) -> do
+                        FA.check "./app/res/" "b" name
+                        respond $ responseLBS status303 [(hLocation, "/")] "Redirecting..."
+                -- TODO: refactor this using where better and creating meaningfull local functions
+                ("POST", ["add"]) -> do
+                        putStrLn "adding item"
+                        body <- strictRequestBody req
+                        let args = L8.split '&' body
+                        case args of
+                                [item] -> f item
+                                _ -> error "should have exactly one arg"
+                    where
+                        f item = do
+                                let pair = BL.splitAt 5 item
+                                case pair of
+                                        ("text=", t) -> do
+                                                let text = TE.decodeUtf8 (urlDecode True (BL.toStrict t))
+                                                FA.add "./app/res/" "b" text
+                                        _ -> error "incorrect args"
+                                respond $ responseLBS status303 [(hLocation, "/")] "Redirecting..."
+                (method, array) -> do
+                        respond $ responseLBS status303 [(hLocation, "/")] "Redirecting..."
+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 = "<!doctype html><html lang=\"" <> lang <> "\"><head><meta charset=\"UTF-8\" /><meta name=\"viewport\" content=\"width=device-width\" /><title>" <> title <> "</title></head>"
+tailHtml = "</html>"
+h1 = wrapContent "h1"
+h2 = wrapContent "h2"
+h3 = wrapContent "h3"
+link = wrapContent "a"
+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)
+
+checkbox id name checked = checkboxPrimitive id name checked <> label id name
+
+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 = T.concat $ map item (T.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>"
+
+rawEditButton = link "/edit"
+
+runServer = do
+        run 3000 application