summaryrefslogtreecommitdiff
path: root/Haskell-book/24/ParserExercises/src/LogParser.hs
blob: 480498d1861882fbfeee419ae618a12ac47b3285 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
module LogParser where

import Control.Applicative
import Data.Time
import Test.QuickCheck
import Text.Trifecta

-- 5. Write a parser for a log file format and sum the time spent in
-- each activity. Additionally, provide an alternative aggregation
-- of the data that provides average time spent per activity per day.
-- The format supports the use of comments which your parser
-- will have to ignore. The # characters followed by a date mark
-- the beginning of a particular day.
--
-- You are to derive a reasonable datatype for representing this
-- data yourself. For bonus points, make this bi-directional by
-- making a Show representation for the datatype which matches
-- the format you are parsing. Then write a generator for this data
-- using QuickCheck’s Gen and see if you can break your parser
-- with QuickCheck.

data Statement = Statement TimeOfDay String deriving Eq
data LogEntry = LogEntry Day [Statement] deriving Eq
newtype Log = Log { getLog :: [LogEntry] }

instance Show Statement where
    show (Statement x y) = (formatTime defaultTimeLocale "%R" x) ++ " " ++ y

instance Show LogEntry where
    show (LogEntry x y) = "# " ++ (show x) ++ "\n"
                      ++ (foldl (\acc v -> acc ++ (show v) ++ "\n") "" y)

instance Show Log where
    show (Log y) = (foldl (\acc v -> acc ++ (show v) ++ "\n") "" y)

instance Arbitrary Statement where
    arbitrary = do
        h <- choose (0, 23)
        m <- choose (0, 59)
        text <- listOf1 $ elements ['.'..'~']
        return $ Statement (TimeOfDay h m 0) text

instance Arbitrary LogEntry where
    arbitrary = do
        day <- arbitrary
        statements <- arbitrary
        return $ LogEntry (ModifiedJulianDay day) statements

skipEOL :: Parser ()
skipEOL = skipMany (oneOf "\n")

skipComments :: Parser ()
skipComments =
    skipMany (do _ <- char '-'
                 _ <- char '-'
                 skipMany (noneOf "\n")
                 skipEOL)

parseStatement :: Parser Statement
parseStatement = do
    h <- integer
    _ <- char ':'
    m <- integer
    text <- manyTill anyChar (try (string "--") <|> (string "\n") <|> (eof >> return ""))
    skipComments
    skipEOL
    return $ Statement (TimeOfDay (fromIntegral h) (fromIntegral m) 0) text

parseLogEntry :: Parser LogEntry
parseLogEntry = do
    _ <- string "# "
    y <- integer
    _ <- char '-'
    m <- integer
    _ <- char '-'
    d <- integer
    skipComments
    skipEOL
    statements <- many parseStatement
    return $ LogEntry (fromGregorian (fromIntegral y) (fromIntegral m) (fromIntegral d)) statements

parseLog :: Parser Log
parseLog = Log <$> many parseLogEntry