1 files changed, 83 insertions, 0 deletions
diff --git a/Haskell-book/24/ParserExercises/src/LogParser.hs b/Haskell-book/24/ParserExercises/src/LogParser.hs
new file mode 100644
index 0000000..480498d
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/src/LogParser.hs
@@ -0,0 +1,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