added new formatting to guestbook and cli optimization and pretty pri…

…nting

app/Api/Api.hs

@@ -58,7 +58,7 @@ api ["guestbook", "add"] request = do
 api ["guestbook", "get"] request = do
     body <- getRequestBodyChunk request
     entries <- getGuestbook
-    return (status200, unpackBS $ toStrict $ encode entries)
+    return (status200, unpackBS $ toStrict $ encode $ show entries)
 api ["snake", "add"] request = do
     body <- getRequestBodyChunk request
     let entry = getDefault EmptyLeaderboard (decode (fromStrict body) :: Maybe LeaderboardEntry)

app/Helpers/Cli.hs

@@ -1,12 +1,13 @@
 module Helpers.Cli where
 import System.Exit (exitSuccess)
 
-import Helpers.Logger (up, right, clearLine)
+import Helpers.Logger (up, right, clearLine, clearEnd)
 import Data.List (intercalate)
 import Database.SQLite.Simple (Only (Only), execute)
 import Helpers.Database (getConn, initDb)
 import Database.SQLite.Simple.Types (Query(Query))
 import Data.Text (pack)
+import System.IO (hFlush, stdout)
 
 resetCursor :: Int ->  IO ()
 resetCursor n = do
@@ -32,17 +33,19 @@ doCommand ["drop", table] = do
     resetCursor 2
     initDb
     cli
+doCommand ("exit":_) = do 
+    putStrLn "Exiting"
+    exitSuccess
 doCommand x = do
     putStrLn $ "Error, no such command: ["++ unwords x ++"]"
     resetCursor 2
     cli
 
 cli :: IO ()
 cli = do
-    putStr "> "
+    putStr $ "> " ++ clearLine
+    hFlush stdout
     line <- getLine
-    if line /= "exit" then
-        doCommand $ words line
-    else do
-        putStrLn "Exiting... press ^C now!"
-        exitSuccess
+    putStr clearEnd
+    hFlush stdout
+    doCommand $ words line

app/Helpers/Database.hs

@@ -9,6 +9,7 @@ import Helpers.Globals (getDbPath)
 import Data.List (intercalate, inits)
 import Data.Text (pack, Text)
 import Helpers.Logger (info)
+import Helpers.Tree (Tree (Tree))
 
 getConn :: IO Connection
 getConn = do
@@ -21,19 +22,24 @@ insert query args = do
     execute conn query args
     close conn
 
+type GuestbookEntry = (Int, Int, String, String, Int)
+
+guestbookToTree :: [GuestbookEntry] -> Int -> [Tree GuestbookEntry]
+guestbookToTree entries targetParent = [Tree (id, timestamp, name, content, parent) $ guestbookToTree entries id | (id, timestamp, name, content, parent) <- entries, parent == targetParent]
+
 getVisits :: IO [(Int, Int, String)]
 getVisits = do
     conn <- getConn
     visits <- query conn "SELECT * FROM visits" () :: IO [(Int, Int, String)]
     close conn
     return visits
 
-getGuestbook :: IO [(Int, Int, String, String, Int)]
+getGuestbook :: IO [Tree GuestbookEntry]
 getGuestbook = do
     conn <- getConn
     entries <- query conn "SELECT * FROM guestbook" () :: IO [(Int, Int, String, String, Int)]
     close conn
-    return entries
+    return $ guestbookToTree entries (-1)
 
 getLeaderboard :: IO [(Int, Int, String, Int, Int, Int)]
 getLeaderboard = do

app/Helpers/Logger.hs

@@ -6,7 +6,9 @@ import Data.Text (unpack)
 import Network.HTTP.Types (Status(statusCode))
 
 import Helpers.Utils (unpackBS)
-import Helpers.Globals (LogLevel (..), getLogLevel)
+import Helpers.Globals (LogLevel (..), getLogLevel, getCliState)
+import System.IO (hFlush, stdout)
+import Control.Monad (when)
 
 colorStatus :: Int -> String
 colorStatus code | code < 300 = "\ESC[38;2;0;255;0m"++show code++"\ESC[0m"
@@ -32,8 +34,11 @@ right :: Int -> String
 right 0 = ""
 right n = "\ESC[" ++ show n ++ "C"
 
+clearEnd :: String
+clearEnd = "\ESC[0J"
+
 clearLine :: String
-clearLine = "\ESC[0J"
+clearLine = "\ESC[0K"
 
 tableify :: [String] -> String
 tableify (x:xs) = "| " ++ x ++ left l ++ right 20 ++ tableify xs
@@ -43,7 +48,7 @@ tableify [] = "|"
 
 
 info :: String -> IO ()
-info input = do 
+info input = do
     loglevel <- getLogLevel
     case loglevel of
         Info -> putStrLn $ "\ESC[38;2;100;100;100m" ++ input ++ "\ESC[0m"
@@ -65,12 +70,27 @@ logger :: Request -> Response -> IO ()
 logger request (ResponseBuilder status _ _) = do
     let method = unpackBS (requestMethod request)
     let path = getPath request
+    putStr $ "\r" ++ clearEnd
     putStrLn $ tableify [method, show $ statusCode status, path]
+    cliState <- getCliState
+    when cliState $ do
+        putStr "> "
+        hFlush stdout
 logger request (ResponseFile status _ _ _) = do
     let method = unpackBS (requestMethod request)
     let path = getPath request
+    putStr $ "\r" ++ clearEnd
     putStrLn $ tableify [method, show $ statusCode status, path]
+    cliState <- getCliState
+    when cliState $ do
+        putStr "> "
+        hFlush stdout
 logger request x = do
     let method = unpackBS (requestMethod request)
     let path = getPath request
-    putStrLn $ tableify [method, path]
+    putStr $ "\r" ++ clearEnd
+    putStrLn $ tableify [method, path]
+    cliState <- getCliState
+    when cliState $ do
+        putStr "> "
+        hFlush stdout

app/Main.hs

@@ -32,7 +32,7 @@ import Helpers.Utils (unpackBS)
 import Helpers.Globals (getPort, getCliState)
 import Helpers.Logger (logger, tableify, info, warning)
 import Api.Api (api)
-import Control.Concurrent (forkIO)
+import Control.Concurrent (forkIO, ThreadId)
 import Helpers.Cli (cli)
 
 page404 :: [String] -> Response
@@ -85,7 +85,8 @@ main = do
     putStrLn $ tableify ["METHOD", "STATUS", "PATH"]
     putStrLn $ "+" ++ mconcat (replicate 65 "-") ++ "+"
     cliState <- getCliState
-    if cliState then
-        forkIO cli
-    else forkIO (do putStr "") -- ???
-    run port app
+    if cliState then do
+        forkIO $ run port app
+        cli
+    else run port app
+

app/Pages/Guestbook/Guestbook.hs

@@ -3,53 +3,55 @@ module Pages.Guestbook.Guestbook where
 import IHP.HSX.QQ (hsx)
 import Text.Blaze.Html (Html)
 
-import Helpers.Database (getGuestbook)
+import Helpers.Database (getGuestbook, GuestbookEntry)
 import Helpers.Section (section)
 
 import Data.List (filter)
 
-import Data.Time.Format.ISO8601
-import Data.Time.Format
-import Data.Time.Clock.POSIX
+import Data.Time.Format ( defaultTimeLocale, formatTime )
+import Data.Time.Clock.POSIX ( POSIXTime, posixSecondsToUTCTime )
+import Helpers.Tree (Tree(Tree))
 
 type Guestbook = [(Int, Int, String, String, Int)]
 
 toPosix :: Int -> POSIXTime
-toPosix n = read ((show n) ++ "s") :: POSIXTime
+toPosix n = read (show n ++ "s") :: POSIXTime
 
-prettify_guestbook :: Guestbook -> Html
-prettify_guestbook ((id, timestamp, name, content, parent):xs) = mconcat [section [hsx|
+prettifyGuestbook :: [Tree GuestbookEntry] -> Html
+prettifyGuestbook ((Tree (id, timestamp, name, content, parent) children):xs) = mconcat [section [hsx|
     <h3>{name} said: </h3>
-    <div style="background-color: #111111; border: 1px solid #111111; border-radius: 5px;">
-        id: <span style="color: #ff0000">{id}</span> 
-        parent: <span style="color: #ff0000">{parent}</span> 
-        timestamp: <span style="color: #ff0000">{formatTime defaultTimeLocale "%c" $ posixSecondsToUTCTime (toPosix timestamp)}</span>
-        <br><br>
-        {content}
+    Posted: <span style="color: #ff0000">{formatTime defaultTimeLocale "%c" $ posixSecondsToUTCTime (toPosix timestamp)}</span>
+    <br>
+    <div style="background-color: #111111; border: 1px solid #111111; border-radius: 5px; padding: 10px;">
+        <table>
+            <tr>
+                <th style="background-color: #303030; width: 2px;"></th>
+                <th>
+                    <div style="white-space: pre;">
+                    {content}
+                    </div>
+                </th>
+            </tr>
+        </table>
     </div>
-    {prettify_guestbook $ children} 
-    {guestbook_input id True}
+    {prettifyGuestbook $ children} 
+    {guestbookInput id True}
     <br><br>
-|], prettify_guestbook rest]
-    where
-        children :: Guestbook
-        children = filter (\(_, _, _, _, childParent) -> childParent == id) xs
-        rest :: Guestbook
-        rest = filter (\(_, _, _, _, childParent) -> childParent /= id) xs
-prettify_guestbook [] = [hsx||]
+|], prettifyGuestbook xs]
+prettifyGuestbook [] = [hsx||]
 
-guestbook_input :: Int -> Bool -> Html
-guestbook_input parent False = [hsx|
+guestbookInput :: Int -> Bool -> Html
+guestbookInput parent False = [hsx|
     <textarea class="guestbook-text" id={"guestbook-text::"++show parent} type="text"></textarea>
     <br>
     Name: <input id={"guestbook-name::"++show parent} class="guestbook-name" type="text">
     <button id={show parent} onclick="post(this.id)">Post</button>
 |]
-guestbook_input parent True = [hsx|
+guestbookInput parent True = [hsx|
     <button id={show parent} onclick="guestbookToggleInput(this.id)">New reply</button>
     <br>
     <div style="display:none;" id={"guestbook-reply::"++show parent}>
-        {guestbook_input parent False}
+        {guestbookInput parent False}
     </div>
 |]
 
@@ -87,9 +89,8 @@ guestbook = do
         </script>
         <h1>Guestbook</h1>
         Write a message for me :)<br>
-        {guestbook_input (-1) False}
+        {guestbookInput (-1) False}
         <hr>
         <h2>History</h2>
-        {prettify_guestbook guestbook}
+        {prettifyGuestbook guestbook}
     |]
-