updated some text and wrote nicer printing

Mast3rwaf1z · Aug 28, 2024 · 6d1154c · 6d1154c
1 parent 6c0290d
commit 6d1154c
Show file tree

Hide file tree

Showing 6 changed files with 134 additions and 62 deletions.
diff --git a/app/Helpers/Database.hs b/app/Helpers/Database.hs
@@ -8,6 +8,7 @@ import Helpers.Globals (getDbPath)
 
 import Data.List (intercalate, inits)
 import Data.Text (pack, Text)
+import Helpers.Logger (info)
 
 getConn :: IO Connection
 getConn = do
@@ -85,13 +86,13 @@ initSchema ((Table name columns):tables) = do
     conn <- getConn
     execute conn (Query (pack $ "CREATE TABLE IF NOT EXISTS "++name++"("++columnText columns++")")) ()
     close conn
-    putStrLn $ "Initialized table " ++ name
+    info $ "Initialized table " ++ name
     initSchema tables
-initSchema [] = putStrLn "Finished initializing DB"
+initSchema [] = info "Finished initializing DB"
 
 initDb :: IO ()
 initDb = do
-    putStrLn "Initializing DB"
+    info "Initializing DB"
     initSchema schema
 
 test_db :: IO ()

diff --git a/app/Helpers/Globals.hs b/app/Helpers/Globals.hs
@@ -15,4 +15,15 @@ getPort = do
     result <- lookupEnv "HOMEPAGE_PORT"
     return $ case result of
         (Just a) -> read a :: Int
-        Nothing -> 8000
+        Nothing -> 8000
+
+data LogLevel = Error | Warning | Info
+
+getLogLevel :: IO LogLevel
+getLogLevel = do
+    result <- lookupEnv "HOMEPAGE_LOGLEVEL"
+    return $ case result of
+        (Just "info") -> Info
+        (Just "warning") -> Warning
+        (Just "error") -> Error
+        Nothing -> Error
diff --git a/app/Helpers/Logger.hs b/app/Helpers/Logger.hs
@@ -0,0 +1,72 @@
+module Helpers.Logger where
+
+import Network.Wai.Internal (Response(ResponseBuilder, ResponseFile), Request, pathInfo, requestMethod)
+import Data.List (intercalate)
+import Data.Text (unpack)
+import Network.HTTP.Types (Status(statusCode))
+
+import Helpers.Utils (unpackBS)
+import Helpers.Globals (LogLevel (..), getLogLevel)
+
+colorStatus :: Int -> String
+colorStatus code | code < 300 = "\ESC[38;2;0;255;0m"++show code++"\ESC[0m"
+                 | code < 400 = "\ESC[38;2;255;255;0m"++show code++"\ESC[0m"
+                 | otherwise  = "\ESC[38;2;255;0;0m"++show code++"\ESC[0m"
+
+getPath :: Request -> String
+getPath request = intercalate "/" $ map unpack $ pathInfo request
+
+up :: Int -> String
+up 0 = ""
+up n = "\ESC[" ++ show n ++ "A"
+
+left :: Int -> String
+left 0 = ""
+left n = "\ESC[" ++ show n ++ "D"
+
+down :: Int -> String
+down 0 = ""
+down n = "\ESC[" ++ show n ++ "B"
+
+right :: Int -> String
+right 0 = ""
+right n = "\ESC[" ++ show n ++ "C"
+
+tableify :: [String] -> String
+tableify (x:xs) = "| " ++ x ++ left l ++ right 20 ++ tableify xs
+    where
+        l = length x
+tableify [] = "|"
+
+
+info :: String -> IO ()
+info input = do 
+    loglevel <- getLogLevel
+    case loglevel of
+        Info -> putStrLn $ "\ESC[38;2;100;100;100m" ++ input ++ "\ESC[0m"
+        _ -> return ()
+
+warning :: String -> IO ()
+warning input = do
+    loglevel <- getLogLevel
+    case loglevel of
+        Warning -> putStrLn $ "\ESC[38;2;255;255;0m" ++ input ++ "\ESC[0m"
+        Info -> putStrLn $ "\ESC[38;2;255;255;0m" ++ input ++ "\ESC[0m"
+        _ -> return ()
+
+error :: String -> IO ()
+error input = putStrLn $ "\ESC[38;2;255;0;0m" ++ input ++ "\ESC[0m"
+
+logger :: Request -> Response -> IO ()
+logger request (ResponseBuilder status _ _) = do
+    let method = unpackBS (requestMethod request)
+    let path = getPath request
+    putStrLn $ tableify [method, show $ statusCode status, path]
+logger request (ResponseFile status _ _ _) = do
+    let method = unpackBS (requestMethod request)
+    let path = getPath request
+    putStrLn $ tableify [method, show $ statusCode status, path]
+logger request x = do
+    let method = unpackBS (requestMethod request)
+    let path = getPath request
+    putStrLn $ tableify [method, path]
diff --git a/app/Main.hs b/app/Main.hs
@@ -30,6 +30,7 @@ import Pages.Guestbook.Guestbook (guestbook)
 import Helpers.Database (initDb)
 import Helpers.Utils (unpackBS)
 import Helpers.Globals (getPort)
+import Helpers.Logger (logger, tableify, info, warning)
 import Api.Api (api)
 
 page404 :: [String] -> Response
@@ -43,10 +44,13 @@ serve content = responseBuilder status200 [("Content-Type", "text/html")] $ copy
 
 serveFile :: String -> IO Response
 serveFile path = do
+    info "Serving file"
     exists <- doesFileExist path
-    if exists then
+    if exists then do
+        info "File exists"
         return $ responseFile status200 [] path Nothing
-    else
+    else do
+        warning "No file found!"
         return $ responseBuilder status404 [("Content-Type", "text/json")] $ copyByteString "{\"error\":\"Error: file not found!\"}"
 
 
@@ -64,26 +68,6 @@ handleRequest ["favicon.ico"] request = do serveFile "static/favicon.ico"
 handleRequest [] request = return $ serve (layout index)
 handleRequest x request = return $ page404 x
 
-colorStatus :: Int -> String
-colorStatus code | code < 300 = "\ESC[38;2;0;255;0m"++show code++"\ESC[0m"
-                 | code < 400 = "\ESC[38;2;255;255;0m"++show code++"\ESC[0m"
-                 | otherwise  = "\ESC[38;2;255;0;0m"++show code++"\ESC[0m"
-
-logger :: Request -> Response -> IO ()
-logger request (ResponseBuilder status _ _) = do
-    let method = unpackBS (requestMethod request)
-    let path = intercalate "/" (map unpack (pathInfo request))
-    putStrLn $ method ++ "\r\t| " ++ path ++ "\r\t\t\t\t\t\t| " ++ colorStatus (statusCode status)
-logger request (ResponseFile status _ _ _) = do
-    let method = unpackBS (requestMethod request)
-    let path = intercalate "/" (map unpack (pathInfo request))
-    putStrLn $ method ++ "\r\t| " ++ path ++ "\r\t\t\t\t\t\t| " ++ colorStatus (statusCode status)
-logger request x = do
-    let method = unpackBS (requestMethod request)
-    let path = intercalate "/" (map unpack (pathInfo request))
-    putStrLn $ method ++ "\r\t| " ++ path
-
-
 app :: Request -> (Response -> IO b)  -> IO b
 app request respond = do
     response <- handleRequest (map unpack (pathInfo request)) request
@@ -94,5 +78,8 @@ main :: IO ()
 main = do
     port <- getPort
     initDb
-    putStrLn $ "Listening on " ++ show port
+    info $ "Listening on " ++ show port
+    putStrLn $ "+" ++ mconcat (replicate 65 "-") ++ "+"
+    putStrLn $ tableify ["METHOD", "STATUS", "PATH"]
+    putStrLn $ "+" ++ mconcat (replicate 65 "-") ++ "+"
     run port app
diff --git a/app/Pages/Projects/Projects.hs b/app/Pages/Projects/Projects.hs
@@ -14,58 +14,58 @@ import Helpers.Database (schema, prettyPrintSchema)
 import Helpers.CodeBlock (codeBlock)
 
 defaultProject :: (String, Html)
-defaultProject = ("", (section [hsx|
+defaultProject = ("", section [hsx|
     Use the sidebar to find a project :)<br><br>
 
     This page is inspired by my friend Mohamad, his site is available below<br><br>
     <a href="https://mohamaddalal.github.io/">Mohamad's site</a>
-|]))
+|])
 
 projectsTree :: Tree (String, Html)
 projectsTree = Tree defaultProject [
-    Tree ("Semester Projects", (section [hsx|
-        Here's all the projects i've done at Aalborg University, they're defined as Pn where n is the semester they were done at. for example, P6 and P8 is my bachelor and master's projects respectively.
-    |])) [
-        Tree ("P1", (section [hsx|
+    Tree ("Semester Projects", section [hsx|
+        Here's all the projects i've done at Aalborg University, they're defined as Pn where n is the semester they were done at. for example, P6 and P10 is my bachelor and master's projects respectively.
+    |]) [
+        Tree ("P1", section [hsx|
             P1 was about Random Linear Network Coding
             <br>
             It was cool
-        |])) [],
-        Tree ("P2", (section [hsx|
+        |]) [],
+        Tree ("P2", section [hsx|
             A Project about adaptive cruise control in cars
-        |])) [],
-        Tree ("P3", (section [hsx|
+        |]) [],
+        Tree ("P3", section [hsx|
             We made a satellite ground station to be full duplex, as the previous implementation could only send data one way at a time, would be cool to use two channels.
-        |])) [],
-        Tree ("P4", (section [hsx|
+        |]) [],
+        Tree ("P4", section [hsx|
             Detecting fires on a map, it wasn't particularly interesting.
-        |])) [],
-        Tree ("P5", (section [hsx|
+        |]) [],
+        Tree ("P5", section [hsx|
             Testing TCP performance using NS3, we learned a bit of C++, it was nice.
-        |])) [],
-        Tree ("P6", (section [hsx|
+        |]) [],
+        Tree ("P6", section [hsx|
             Modeling a testbed for edge nodes for measurement in real world scenarios<br><br>
 
             It was a pretty interesting project, as we designed our own dataframe instead of using like HTTP, it made it very fast, but as could be read in our semester report, our system could be even faster if we optimized language and protocols. <br><br>
 
             It would probably be beyond our expectations if we went and implemented our own solution at the data-link layer of networking instead of at the routing layer (or whatever its called again in TCP/IP)
-        |])) [],
-        Tree ("P7", (section [hsx|
+        |]) [],
+        Tree ("P7", section [hsx|
             The semester we learned haskell! Honestly i think i spent more time in my free time in total on haskell than i did thinking about this project. The project was about measuring the amount of people in a room using IoT devices and bluetooth.<br><br>
 
             The coolest part of this project was definitely with fidding with low-level promisquous mode on an IoT device.
-        |])) [],
-        Tree ("P8", (section [hsx|
+        |]) [],
+        Tree ("P8", section [hsx|
             This was a project about conducting a user-study, measuring people's stress and questioning them through an app on a mobile phone.
             <br>
             (this project was very, very bad imo, but i learned more C++)
-        |])) []
+        |]) []
     ],
-    Tree ("Personal Projects", (section [hsx|
+    Tree ("Personal Projects", section [hsx|
         I find it fun coding in my free time, i do it a lot and as such this website was also born!
-    |])) [
+    |]) [
         Tree ("Snake", snake) [],
-        Tree ("Website", (mconcat [section [hsx|
+        Tree ("Website", mconcat [section [hsx|
             <div style="max-width: 100%">
                 Written in Haskell using IHP-HSX as the primary library, and sqlite-simple as the database implementation.<br>
 
@@ -91,32 +91,32 @@ projectsTree = Tree defaultProject [
         [hsx|<h3>Version 3</h3>|],
         snd (findItem ["", "Personal Projects", "Website", "Version 3"] projectsTree),
         [hsx|<h3>Version 4</h3>|],
-        snd (findItem ["", "Personal Projects", "Website", "Version 4"] projectsTree)])) [
-            Tree ("Version 1", (section [hsx|
+        snd (findItem ["", "Personal Projects", "Website", "Version 4"] projectsTree)]) [
+            Tree ("Version 1", section [hsx|
                 Was written on github pages using markdown<br>
                 barely had any content.
-            |])) [],
-            Tree ("Version 2", (section [hsx|
+            |]) [],
+            Tree ("Version 2", section [hsx|
                 Was written in html, css and javascript, had a lot of client side javascript and is still available at <a href="https://about.skademaskinen.win">https://about.skademaskinen.win</a><br>
                 The guestbook and the interests page was my main goal and i finished both of them.<br>
                 Source code is available at <a href="https://github.com/Skademaskinen/Frontend">https://github.com/Skademaskinen/Frontend</a><br>
-            |])) [],
-            Tree ("Version 3", (section [hsx|
+            |]) [],
+            Tree ("Version 3", section [hsx|
                 This was written in haskell using the full IHP framework, it was a lot of framework to code around compared to the older sites, ofc this made it possible to write more functionality with less code, but with such a feature also comes a lot of restrictions, such as the database being very hard to implement, and dependencies being less easily managed and coding an API using raw HTTP was very restrictive. hence version 4.<br>
                 Source code is available at <a href="https://github.com/Skademaskinen/F3">https://github.com/Skademaskinen/F3</a>
-            |])) [],
-            Tree ("Version 4", (section [hsx|
+            |]) [],
+            Tree ("Version 4", section [hsx|
                 This version is also written in haskell, but this time also using Warp directly to translate HSX to blaze and parse blaze to a bytestring. Its this current site and doesn't require a link :P<br>
                 Source code is available at <a href="https://github.com/Mast3rwaf1z/homepage">https://github.com/Mast3rwaf1z/homepage</a>
-            |])) []
+            |]) []
         ],
-        Tree ("Skademaskinen", (section [hsx|
+        Tree ("Skademaskinen", section [hsx|
             This is about my server, it hosts a lot of things, but the things accessible from HTTP is available at:
             <br>
             <div style="text-align:center;">
                 {services}
             </div>
-        |])) []]]
+        |]) []]]
 
 services :: Html
 services = mconcat $ map (\(name, d) -> [hsx|

diff --git a/homepage.cabal b/homepage.cabal
@@ -16,6 +16,7 @@ executable homepage
         Helpers.Database,
         Helpers.Globals,
         Helpers.Tables,
+        Helpers.Logger,
         Api.Api,
         Pages.Contact.Contact,
         Pages.Projects.Projects,