Implementation of the CIS194 homework 2 assignment (see LogAnalysis.hs)

Log.hs

-- CIS 194 Homework 2

module Log where

import Control.Applicative

data MessageType = Info
                 | Warning
                 | Error Int
  deriving (Show, Eq)

type TimeStamp = Int

data LogMessage = LogMessage MessageType TimeStamp String
                | Unknown String
  deriving (Show, Eq)

data MessageTree = Leaf
                 | Node MessageTree LogMessage MessageTree
  deriving (Show, Eq)

-- | @testParse p n f@ tests the log file parser @p@ by running it
--   on the first @n@ lines of file @f@.
testParse :: (String -> [LogMessage])
          -> Int
          -> FilePath
          -> IO [LogMessage]
testParse parse n file = take n . parse <$> readFile file

-- | @testWhatWentWrong p w f@ tests the log file parser @p@ and
--   warning message extractor @w@ by running them on the log file
--   @f@.
testWhatWentWrong :: (String -> [LogMessage])
                  -> ([LogMessage] -> [String])
                  -> FilePath
                  -> IO [String]
testWhatWentWrong parse whatWentWrong file
  = whatWentWrong . parse <$> readFile file

LogAnalysis.hs

{-# OPTIONS_GHC -Wall #-}

module LogAnalysis where

import Log

parseMessage :: String -> LogMessage
parseMessage l = 
  case words l of
  ("E":s:t:xs) -> LogMessage (Error (read s)) (read t) $ unwords xs
  ("I":t:xs)   -> LogMessage Info (read t :: Int) $ unwords xs
  ("W":t:xs)   -> LogMessage Warning (read t :: Int) $ unwords xs
  _            -> Unknown l

parse :: String -> [LogMessage]
parse = (map parseMessage) . lines

insert :: LogMessage -> MessageTree -> MessageTree
insert lm1@(LogMessage _ ts1 _) (Node left lm2@(LogMessage _ ts2 _) right)
  = case compare ts1 ts2 of
    LT -> Node (insert lm1 left) lm2 right
    _  -> Node left lm2 (insert lm1 right)

insert Unknown{} tree = tree
insert m@LogMessage{} Leaf = Node Leaf m Leaf

insert LogMessage{} (Node _ Unknown{} _) 
  = error "Unknown message in message tree"

showTree :: MessageTree -> String
-- showTree Leaf = ""
-- showTree (Node _ (Unknown _) _) = ""
-- showTree (Node left msg@LogMessage{} right) = showTree left ++ showMessage msg ++ showTree right
showTree = unlines . map showMessage . inOrder

showMessage :: LogMessage -> String
showMessage (Unknown _) = ""
showMessage (LogMessage ty ts m) = (showType ty) ++ (show ts) ++ " " ++ m
  where
  showType ty1 =
    case ty1 of
    (Error s) -> "Error (" ++ show s ++ "): "
    Info      -> "Info: "
    Warning   -> "Warning: "

build :: [LogMessage] -> MessageTree
build = foldl (flip insert) Leaf

-- build [] = Leaf
-- build (m:ms) = insert m (build ms)

inOrder :: MessageTree -> [LogMessage]
inOrder Leaf = []
inOrder (Node left message right) = (inOrder left) ++ (message : inOrder right)

whatWentWrong :: [LogMessage] -> [String]
whatWentWrong = map showMessage . inOrder . build . (filterErrorsAbove 50)

filterErrorsAbove :: Int -> [LogMessage] -> [LogMessage]
filterErrorsAbove level messages = [n | n@(LogMessage (Error l) _ _) <- messages, l >= level]

main :: IO ()
main = do
  messages <- testParse parse 5523 "error.log"
  putStr $ showTree $ build messages