import Data.Char import Data.Function import Data.List import qualified Data.Set as Set -- TODO: use Text instead of linked lists of chars type WeechatLog = [WeechatLine] data WeechatLine = WeechatLine { wlDate :: String , wlTime :: String , wlNick :: String , wlMsg :: String } -- TODO: specific handling of join/part/network messages header = unlines [ "", "", " ", " ", " IRC log", " ", " " ] main = (printHTML . parseWeechatLog) =<< getContents parseWeechatLog :: String -> [WeechatLine] parseWeechatLog = map parseWeechatLine . lines where parseWeechatLine l = let [date, time, nick] = take 3 . words $ l msg = drop (length (unwords [date, time, nick]) + 1) l in WeechatLine date time nick msg printHTML :: [WeechatLine] -> IO () printHTML log = do putStrLn header putStrLn "" mapM_ printDay days putStrLn "" putStrLn "" where allNicks = Set.fromList . map (dropWhile sigil . wlNick) $ log days = groupBy ((==) `on` wlDate) log printDay ls = do putStrLn $ "

" ++ wlDate (head ls) ++ "

" putStrLn $ "" mapM_ printRow $ zip (WeechatLine "" "" "" "" : ls) ls putStrLn $ "
" printRow (prevRow, curRow) = do putStr $ "" ++ wlTime curRow ++ "" putStr $ "" ++ nick ++ "" putStrLn $ "" ++ (colorhl allNicks . escape $ wlMsg curRow) ++ "" where prevNick = wlNick prevRow curNick = wlNick curRow nick | specialNick curNick = curNick | prevNick == curNick = "↳" | otherwise = curNick ac = nickClass curNick specialNick = (`elem` ["-->","<--","--","*"]) nickClass "-->" = "nc-join" nickClass "<--" = "nc-quit" nickClass "--" = "nc-network" nickClass "*" = "nc-slashme" nickClass str = ("nc-color-" ++) . hash . dropWhile sigil $ str sigil = (`elem` "@%+") -- Weechat default nick hash function = sum of unicode values hash = show . (`mod` (length colors)) . sum . map ord colors = ["cyan","magenta","green","brown","lightblue","default", "lightcyan","lightmagenta","lightgreen","blue"] colorhl allNicks msg | firstWord == "" = msg | last firstWord == ':' && nick `Set.member` allNicks = sigils ++ "" ++ nick ++ ":" ++ rest | otherwise = msg where (firstWord, rest) = span (not . isSpace) msg (sigils, nick') = span sigil firstWord nick = init nick' escape = concat . map entity where entity '<' = "<" entity '>' = ">" entity c = [c]