blob: 9bed07a438ca32099010ba3e9b2ec7955173d537 (
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
84
|
{-# LANGUAGE OverloadedStrings #-}
module Model.BirthdateParser
( parseBirthdates
) 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.Birthdate
import Model.Date
parseBirthdates :: Text -> Either Text [Birthdate]
parseBirthdates input =
left (T.pack . show) (parse birthdatesParser "" (T.unpack input)) >>= validateBirthdates
validateBirthdates :: [Birthdate] -> Either Text [Birthdate]
validateBirthdates birthdates =
let invalid = filter (not . isValid . date) birthdates
in if null invalid
then
Right birthdates
else
Left $
T.concat
[ "Invalid birthdates: "
, T.intercalate ", " (map renderBirthdate invalid)
]
birthdatesParser :: Parser [Birthdate]
birthdatesParser = catMaybes <$> many lineParser
lineParser :: Parser (Maybe Birthdate)
lineParser =
(Just <$> birthdateParser <* endOfLine)
<|> (emptyLine >> return Nothing)
<|> (commentLine >> return Nothing)
emptyLine :: Parser ()
emptyLine = skipMany (char ' ') >> endOfLine >> return ()
commentLine :: Parser Text
commentLine = T.strip . T.pack <$> (spaces *> char '#' *> many (noneOf "\n") <* endOfLine)
birthdateParser :: Parser Birthdate
birthdateParser =
Birthdate <$>
dateParser <* spaces <* char ',' <*>
valueParser <* char ',' <*>
valueParser
valueParser :: Parser Text
valueParser = T.strip . T.pack <$> many (noneOf ",\n")
dateParser :: Parser Date
dateParser =
Date <$>
integerParser <* spaces <*>
monthParser <* spaces <*>
integerParser
integerParser :: Parser Int
integerParser = (read :: String -> Int) <$> many1 digit
monthParser :: Parser Int
monthParser =
(try $ string "Jan" >> return 1)
<|> (try $ string "Feb" >> return 2)
<|> (try $ string "Mar" >> return 3)
<|> (try $ string "Apr" >> return 4)
<|> (try $ string "May" >> return 5)
<|> (try $ string "Jun" >> return 6)
<|> (try $ string "Jul" >> return 7)
<|> (try $ string "Aug" >> return 8)
<|> (try $ string "Sep" >> return 9)
<|> (try $ string "Oct" >> return 10)
<|> (try $ string "Nov" >> return 11)
<|> (try $ string "Dec" >> return 12)
|
