LogMessage.hs

Log.hs

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

type TimeStamp = Int

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

LogAnalysisV1.hs

parseMessage :: String -> LogMessage
parseMessage msg = case parseCode $ words msg of
        (Just messageType, Just timestamp, rest)  -> LogMessage messageType timestamp rest
        _ -> Unknown msg

parseCode :: [String] -> (Maybe MessageType, Maybe TimeStamp, String )
parseCode ("E":code:ts:rest) =  (parseError code, toInt ts, unwords rest)
parseCode ("W":ts:rest) = (Just Warning, toInt ts, unwords rest)
parseCode ("I":ts:rest) = (Just Info, toInt ts, unwords rest)
parseCode msg = (Nothing, Nothing, unwords msg)

parseError :: String -> Maybe MessageType
parseError code = Error `fmap` toInt code

toInt :: String -> Maybe Int
toInt = readMaybe

LogAnalysisV2.hs

parseMessage :: String -> LogMessage
parseMessage s =
    let (maybeMtype, s1) = parseType $ words s
        (maybeTs, s2) = parseTs s1
        lm = liftA3 LogMessage maybeMtype maybeTs (Just $ unwords s2)
    in fromMaybe (Unknown s) lm

parseType :: [String] -> (Maybe MessageType, [String])
parseType ("I":xs) = (Just Info, xs)
parseType ("W":xs) = (Just Warning, xs)
parseType s@("E":code:rest) = (Error <$> readMaybe code, rest)
parseType s = (Nothing, s)

parseTs :: [String] -> (Maybe TimeStamp, [String])
parseTs (x:xs) = (readMaybe x, xs)

LogAnalysisV3.hs

parseMessage :: String -> LogMessage
parseMessage s = fromMaybe (Unknown s) (pure fst <*> runParser logMessage s) where
    logMessage = parseError <|> parseInfo <|> parseWarn
    parseLogMessage code = liftA3 LogMessage parseECode parseTs parseMsg
    parseError = liftA3 LogMessage parseECode parseTs parseMsg
    parseInfo = liftA3 LogMessage parseICode parseTs parseMsg
    parseWarn = liftA3 LogMessage parseWCode parseTs parseMsg
    parseECode = ( Error . fromInteger) <$> (char 'E' *> char ' ' *> posInt)
    parseICode = char 'I' *> pure Info
    parseWCode = char 'W' *> pure Warning
    parseTs = fromInteger <$> (char ' ' *> posInt)
    parseMsg = many <$> satisfy $ const True

LogAnalysisV3Full.hs

newtype Parser a = Parser { runParser :: String -> Maybe (a, String) }

satisfy :: (Char -> Bool) -> Parser Char
satisfy p = Parser f
  where
    f [] = Nothing
    f (x:xs)
        | p x       = Just (x, xs)
        | otherwise = Nothing

char :: Char -> Parser Char
char c = satisfy (== c)

posInt :: Parser Integer
posInt = Parser f
  where
    f xs
      | null ns   = Nothing
      | otherwise = Just (read ns, rest)
      where (ns, rest) = span isDigit xs

inParser f = Parser . f . runParser

first :: (a -> b) -> (a,c) -> (b,c)
first f (x,y) = (f x, y)

instance Functor Parser where
  fmap = inParser . fmap . fmap . first

instance Applicative Parser where
  pure a = Parser (\s -> Just (a, s))
  (Parser fp) <*> xp = Parser $ \s ->
    case fp s of
      Nothing     -> Nothing
      Just (f,s') -> runParser (f <$> xp) s'

instance Alternative Parser where
  empty = Parser (const Nothing)
  Parser p1 <|> Parser p2 = Parser $ liftA2 (<|>) p1 p2

parseMessage :: String -> LogMessage
parseMessage str = fromJust  $ runLogMessageParser str where
    runLogMessageParser s = fst <$> runParser logMessage s
    logMessage = parseError <|> parseInfo <|> parseWarn <|> parseUnknown
    parseUnknown = fmap Unknown parseMsg
    parseLogMessage code = liftA3 LogMessage parseECode parseTs parseMsg
    parseError = LogMessage <$> parseECode <*> parseTs <*> parseMsg
    parseInfo = liftA3 LogMessage parseICode parseTs parseMsg
    parseWarn = liftA3 LogMessage parseWCode parseTs parseMsg
    parseECode = Error . fromInteger <$> (char 'E' *> char ' ' *> posInt)
    parseICode = char 'I' $> Info
    parseWCode = char 'W' $> Warning
    parseTs = fromInteger <$> (char ' ' *> posInt)
    parseMsg = many <$> satisfy $ const True

sample.log

I 11 Initiating self-destruct sequence
E 70 3 Way too many pickles
E 65 8 Bad pickle-flange interaction detected
W 5 Flange is due for a check-up
I 7 Out for lunch, back in two time steps
Bad message