Do some experimental stuff

src/Hisg/Core.hs

@@ -25,6 +25,7 @@ import Control.Monad.State.Lazy
 import Data.Maybe
 import Data.List
 import System.IO
+import qualified Data.Map as M
 
 import Hisg.IRCLog
 import Hisg.Formatter
@@ -67,7 +68,7 @@ loadFile :: String -> HisgM ()
 loadFile inp = do
     logf <- liftIO $ do
         putStrLn $ "Reading " ++ inp ++ "..."
-        loadLog inp
+        loadLog' inp
     addFile logf
 
 processFiles :: HisgM ()
@@ -79,7 +80,7 @@ formatLog :: String -> IRCLog -> FormatterM String
 formatLog chan logf = do
     let popular (_, (a, _)) (_, (b, _)) = compare b a
     insertHeaders chan
-    insertScoreboard (take 15 . sortBy popular $ calcMessageStats (contents logf))
+    insertScoreboard (take 15 . sortBy popular . M.toList . calcMessageStats)
     insertFooter "0.1.0"
     getFinalOutput
 

src/Hisg/IRCLog.hs

@@ -27,11 +27,14 @@ import Control.Parallel.Strategies (NFData(..), rwhnf)
 import Hisg.Parser
 import Hisg.Types
 import Hisg.LineChunks
+import Hisg.Stats
 
+import qualified Data.Map as M
 import qualified Data.ByteString.Char8 as S
 import qualified Data.ByteString.Lazy.Char8 as L
 
-data IRCLog = IRCLog { filename :: String, contents :: [[LogEvent]] }
+--data IRCLog = IRCLog { filename :: String, contents :: [[LogEvent]] }
+data IRCLog = IRCLog { filename :: String, contents :: M.Map S.ByteString (Int, Int)  }
 
 instance NFData S.ByteString where
     rnf _ = ()    -- not built into Control.Parallel.Strategies
@@ -44,7 +47,11 @@ parseInput chunks = map conv chunks
     where
         conv inp = map (fromMaybe (Simple (L.pack "")) . (decode)) (L.lines inp)
 
-loadLog :: String -> IO IRCLog
-loadLog fn = do
-    inp <- chunkedReadWith parseInput fn
+loadLog' fn = do
+    inp <- chunkedReadWith calcMessageStats'' fn
     return $ IRCLog fn inp
+
+--loadLog :: String -> IO IRCLog
+--loadLog fn = do
+--    inp <- chunkedReadWith parseInput fn
+--    return $ IRCLog fn inp

src/Hisg/Stats.hs

@@ -21,6 +21,7 @@ module Hisg.Stats (
 --    getDates,
 --    getKicks,
     calcMessageStats,
+    calcMessageStats'',
     processMessages,
     updateMap
 --   getNicks,
@@ -33,9 +34,12 @@ import Control.Monad.State
 import qualified Data.Map as M
 import qualified Data.Set as Set
 import qualified Data.ByteString.Char8 as S
+import qualified Data.ByteString.Lazy.Char8 as L
 
+import Text.Regex.PCRE.Light (compile, match)
 import Hisg.Types
 import Hisg.MapReduce
+import Hisg.Formats.Irssi
 
 --instance Ord User where
 --  (User n1 w1 l1) <= (User n2 w2 l2) = l1 <= l2
@@ -72,6 +76,17 @@ workMessageStats = do
 calcMessageStats :: Log -> [(S.ByteString, (Int, Int))]
 calcMessageStats log = processMessages log
 
+calcMessageStats'' :: [L.ByteString] -> M.Map S.ByteString (Int, Int)
+calcMessageStats'' = mapReduce rwhnf (foldl' updateWLC M.empty . L.lines)
+                           rwhnf (M.unionsWith (sumTuples))
+    where
+        updateWLC map line =
+            case match (compile normalMessage []) (conv line) [] of
+              Just (_:ts:nick:contents)
+                    -> M.insertWith' (sumTuples) nick (1, length . S.words . S.concat $ contents) map
+              _ -> map
+        conv = S.concat . L.toChunks
+
 --calcKickStats :: Log -> [(S.ByteString, Int)]
 --calcKickStats = evalState (workKickStats)