Formating is now monadic

ane · Jan 4, 2010 · 5a0a30d · 5a0a30d
1 parent b0ce5a9
commit 5a0a30d
Show file tree

Hide file tree

Showing 3 changed files with 110 additions and 33 deletions.
diff --git a/src/Hisg/Core.hs b/src/Hisg/Core.hs
@@ -35,6 +35,8 @@ type HisgM = StateT Hisg IO
 
 data Hisg = Hisg { files :: [IRCLog] }
 
+data Command = Parse | Format
+
 data HisgChange = ParseFile IRCLog
                 | FormatFile IRCLog
 
@@ -51,20 +53,14 @@ getFile n = do
     return $ listToMaybe $ filter (\logf -> filename logf == n) (files hst)
 
 -- | Parses a log file according to the user commands.
-parseLog :: String -> HisgM (Maybe HisgChange)
-parseLog fn = do
+parseLog :: String -> Command -> HisgM (Maybe HisgChange)
+parseLog fn cmd = do
     logf <- getFile fn
-    return $ do
+    return $ do -- maybe monad
         l <- logf
-        Just $ ParseFile l
-
--- | Formats a log into a HTML file.
-formatLog :: String -> String -> HisgM (Maybe HisgChange)
-formatLog fn outf = do
-    logf <- getFile fn
-    return $ do
-        l <- logf
-        Just $ FormatFile l
+        case cmd of
+            Parse -> Just $ ParseFile l
+            Format -> Just $ FormatFile l
 
 -- | Loads a file and queues it for parsing.
 loadFile :: String -> HisgM ()
@@ -77,15 +73,24 @@ loadFile inp = do
 processFiles :: HisgM ()
 processFiles = do
     hst <- get
-    forM_ (files hst) (liftIO . writeLog)
+    forM_ (files hst) (liftIO . processLog)
+
+formatLog :: String -> IRCLog -> FormatterM String
+formatLog chan logf = do
+    insertHeaders chan
+    insertScoreboard (take 25 (reverse . sort $ calcMessageStats (contents logf)))
+    insertFooter "0.1.0"
+    getFinalOutput
 
-writeLog :: IRCLog -> IO ()
-writeLog logf = do
+-- Formats the log and writes the output to a file.
+-- Lifts to the Formatter monad. When that's ready, that is.
+processLog :: IRCLog -> IO ()
+processLog logf = do
     let fn = takeWhile ('.' /=) $ filename logf
         out = fn ++ ".html"
+    output <- evalStateT (formatLog fn logf) (Formatter "")
     putStr $ "Writing " ++ out ++ "..."
     outf <- openFile out WriteMode
-    writeHeaders outf fn
-    writeUsersTable outf (take 25 (reverse . sort $ calcMessageStats (contents logf)))
+    hPutStrLn outf output
     hClose outf
     putStrLn " done."
diff --git a/src/Hisg/Formatter.hs b/src/Hisg/Formatter.hs
@@ -20,26 +20,56 @@ module Hisg.Formatter where
 
 import System.IO
 import Data.List
+import Control.Monad.State.Lazy
+import Data.Maybe
+import Data.List
+import System.IO
 
 import Hisg.Types
 import Hisg.Stats
 import Hisg.Misc
 
-writeHeaders :: Handle -> String -> IO ()
-writeHeaders out chan = do
-    --let dates = getDates logf
-    hPutStrLn out $ "<html>\n<head><title>Statistics for #" ++ chan ++ "</title>"
-    hPutStrLn out $ "<link rel=\"stylesheet\" type=\"text/css\" href=\"style.css\" />"
-    hPutStrLn out "</style>\n<body>\n"
-    hPutStrLn out $ "<h1>Statistics for #" ++ takeWhile (/= '.') chan ++ "</h1>"
-    --hPutStrLn out $ "<p>Data from " ++ show (head dates) ++ " &mdash; " ++ show (last dates) ++ "<br/>"
-    --hPutStrLn out $ "A total of " ++ show (length logf) ++ " lines were spoken during this period.</p>"
-
-writeUsersTable :: Handle -> [User] -> IO ()
-writeUsersTable out users = do
-    hPutStrLn out "<h2>Top 25 users</h2>"
-    hPutStrLn out $ "<table>\n<tr><th>Nickname</th><th>Number of lines</th><th>Number of words</th></tr>" ++ concatMap (\(rank, u) -> "<tr><td><b>" ++ show rank ++ ".</b> " ++ userNick u ++ "</td><td>" ++ show (userLines u) ++ "</td><td>" ++ show (userWords u) ++ "</td></tr>") (zip [1..] users) ++ "</table>"
 
+-- | The FormatterM monad provides a data abstraction layer between the formatted content
+-- | and user input. @addOutput@ and @getOutput@ are the methods used to add and fetch data,
+-- | respectively.
+type FormatterM = StateT Formatter IO
+
+data Formatter = Formatter { output :: String }
+
+-- | Adds output to the content.
+addOutput :: String -> FormatterM()
+addOutput str = do
+    fmst <- get
+    put $ Formatter $ (output fmst) ++ str
+
+-- | Gets the final output.
+getFinalOutput :: FormatterM String
+getFinalOutput = do
+    fmst <- get
+    return (output fmst)
+
+-- | Adds HTML headers to the output.
+insertHeaders :: String -> FormatterM ()
+insertHeaders chan = do
+    addOutput str
+    where
+        str =   "<html>\n<head><title>Statistics for #" ++ chan ++ "</title>"
+             ++ "<link rel=\"stylesheet\" type=\"text/css\" href=\"style.css\" />"
+             ++ "</style>\n<body>\n"
+             ++ "<h1>Statistics for #" ++ takeWhile (/= '.') chan ++ "</h1>"
+
+-- | Adds a small HTML footer.
+insertFooter :: String -> FormatterM ()
+insertFooter ver = do
+    addOutput $ "<p>Generated with <a href=\"http://anhekalm.github.com/hisg\">hisg</a> v" ++ ver ++ "</p></body></html>"
+
+insertScoreboard :: [User] -> FormatterM ()
+insertScoreboard users = do
+    addOutput "<h2>Top 25 users</h2>"
+    addOutput $ "<table>\n<tr><th>Nickname</th><th>Number of lines</th><th>Number of words</th></tr>" ++ concatMap (\(rank, u) -> "<tr><td><b>" ++ show rank ++ ".</b> " ++ userNick u ++ "</td><td>" ++ show (userLines u) ++ "</td><td>" ++ show (userWords u) ++ "</td></tr>") (zip [1..] users) ++ "</table>"
+
+-- FOR THE LOVE OF GOD, MAKE THIS CODE BETTER.
 writeMiscStats :: Handle -> Log -> IO ()
 writeMiscStats out logf = do
     let kicks = getKicks logf
@@ -71,5 +101,3 @@ writeMiscStats out logf = do
 getKicked (KickEvent k) = kickTarget k
 getKicker (KickEvent k) = kickAuthor k
 
-footer :: String -> String
-footer ver = "<p>Generated with <a href=\"http://anhekalm.github.com/hisg\">hisg</a> v" ++ ver ++ "</p></body></html>"
diff --git a/src/style.css b/src/style.css
@@ -0,0 +1,44 @@
+body
+{
+    font-family: Arial, Helvetica, Verdana, sans-serif;
+    font-size: 13px;
+    color: #333;
+    margin: 0px auto;
+    text-align: center;
+    background-color: #fff;
+}
+
+table
+{
+    width: 600px;
+    border-collapse: collapse;
+    border-spacing: 0;
+    margin: 0px auto;
+    font-size: 14px;
+}
+
+td, th
+{
+    padding: 4px 5px;
+    border: 1px solid #ccc;
+    background-color: #eee;
+}
+
+th
+{
+    font-weight: bold;
+    background-color: #445588;
+    color: white;
+    border: 1px solid #999;
+}
+
+h1, h2, h3, h4, h5, h6
+{
+    font-family: "Myriad Pro", "Myriad Web", "Bitstream Vera Sans", "DejaVu Sans", "Trebuchet MS", Arial, Helvetica, sans-serif;
+    color: #222;
+}
+
+span.monospace
+{
+    font-family: "Consolas", "Lucida Console", "Monaco", "Andale Mono", "Courier New", monospace;
+}