diff --git a/src/Hisg/Core.hs b/src/Hisg/Core.hs
index 95b0cd9..cf15ad1 100644
--- 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
index 7073f21..be3e942 100644
--- 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 $ "\nStatistics for #" ++ chan ++ ""
- hPutStrLn out $ ""
- hPutStrLn out "\n\n"
- hPutStrLn out $ "
Statistics for #" ++ takeWhile (/= '.') chan ++ "
"
- --hPutStrLn out $ "
Data from " ++ show (head dates) ++ " — " ++ show (last dates) ++ " "
- --hPutStrLn out $ "A total of " ++ show (length logf) ++ " lines were spoken during this period.
"
-
-writeUsersTable :: Handle -> [User] -> IO ()
-writeUsersTable out users = do
- hPutStrLn out "
Top 25 users
"
- hPutStrLn out $ "
\n
Nickname
Number of lines
Number of words
" ++ concatMap (\(rank, u) -> "
" ++ show rank ++ ". " ++ userNick u ++ "
" ++ show (userLines u) ++ "
" ++ show (userWords u) ++ "
") (zip [1..] users) ++ "
"
+-- | 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 = "\nStatistics for #" ++ chan ++ ""
+ ++ ""
+ ++ "\n\n"
+ ++ "
Statistics for #" ++ takeWhile (/= '.') chan ++ "
"
+
+-- | Adds a small HTML footer.
+insertFooter :: String -> FormatterM ()
+insertFooter ver = do
+ addOutput $ "
"
+
+-- 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 = "