aboutsummaryrefslogtreecommitdiff
path: root/src/BirthdateParser.hs
blob: 9fa7c50dd09032592b491bc1d6521aa44b1d98ea (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
module BirthdateParser
  ( parseBirthdates
  ) where

import Control.Arrow (left)

import Data.Text (Text)
import qualified Data.Text as T

import Text.ParserCombinators.Parsec

import Birthdate
import Date

parseBirthdates :: Text -> Either Text [Birthdate]
parseBirthdates input =
  left
    (T.pack . show)
    (parse birthdatesParser "" (T.unpack input))

birthdatesParser :: Parser [Birthdate]
birthdatesParser = many (many newline >> birthdateParser <* many newline)

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)