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
84
85
86
87
88
89
90
91
92
|
{-# LANGUAGE OverloadedStrings #-}
module Model.EventParser
( parseEvents
) where
import Control.Arrow (left)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Maybe (catMaybes)
import Text.ParserCombinators.Parsec
import Text.Parsec.Char (endOfLine)
import Model.Event (Event, Event(Event))
import qualified Model.Event as Event
import Model.Date (Date(Date))
import qualified Model.Date as Date
parseEvents :: Text -> Either Text [Event]
parseEvents input =
left (T.pack . show) (parse eventsParser "" (T.unpack input)) >>= validateEvents
validateEvents :: [Event] -> Either Text [Event]
validateEvents events =
let invalid = filter (not . Date.isValid . Event.date) events
in if null invalid
then
Right events
else
Left $
T.concat
[ "Invalid events: "
, T.intercalate ", " (map Event.renderEvent invalid)
]
eventsParser :: Parser [Event]
eventsParser = concat <$> many monthSection
monthSection :: Parser [Event]
monthSection = do
month <- monthSectionTitle
spaces
events <- catMaybes <$> many lineParser
return $
map (\(day, year, name) ->
Event (Date day month year) name
) events
lineParser :: Parser (Maybe (Int, Int, Text))
lineParser =
(Just <$> eventParser <* endOfLine)
<|> (comment >> return Nothing)
<|> (emptyLine >> return Nothing)
monthSectionTitle :: Parser Int
monthSectionTitle = char '[' *> monthParser <* char ']'
monthParser :: Parser Int
monthParser =
(try $ string "January" >> return 1)
<|> (try $ string "February" >> return 2)
<|> (try $ string "March" >> return 3)
<|> (try $ string "April" >> return 4)
<|> (try $ string "May" >> return 5)
<|> (try $ string "June" >> return 6)
<|> (try $ string "July" >> return 7)
<|> (try $ string "August" >> return 8)
<|> (try $ string "September" >> return 9)
<|> (try $ string "October" >> return 10)
<|> (try $ string "November" >> return 11)
<|> (try $ string "December" >> return 12)
eventParser :: Parser (Int, Int, Text)
eventParser =
(,,) <$>
integerParser <* separator ',' <*>
integerParser <* separator ':' <*>
(T.strip . T.pack <$> many (noneOf "\n"))
separator :: Char -> Parser ()
separator c = many (char ' ') >> char c >> many (char ' ') >> return ()
integerParser :: Parser Int
integerParser = (read :: String -> Int) <$> many1 digit
emptyLine :: Parser ()
emptyLine = skipMany (char ' ') >> endOfLine >> return ()
comment :: Parser ()
comment = char '#' >> many (noneOf "\n") >> endOfLine >> return ()
|
