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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
-- requires cabal install --lib megaparsec parser-combinators
module Main (main) where
import Control.Applicative.Permutations
import Control.Monad (void, when)
import Data.Maybe (catMaybes)
import Data.Void (Void)
import Text.Megaparsec
import Text.Megaparsec.Char
-- import Text.Megaparsec.Debug
import System.Exit (die)
exampleExpectedOutput = 2
data Passport = Passport { byr :: Int
, iyr :: Int
, eyr :: Int
, hgt :: Int
, hcl :: String
, ecl :: String
, pid :: Int
} deriving (Show)
type Parser = Parsec Void String
parseKey :: String -> Parser ()
parseKey key = do
void (string key)
void (char ':')
parseColor :: String -> Parser (Maybe String)
parseColor key = do
value <- try (do
parseKey key
void $ char '#'
v <- some hexDigitChar
spaceBetween
return $ Just v
) <|> skipString key
case value of
Just v -> if length v == 6 then return value else return Nothing
_ -> return Nothing
parseEyeColor :: String -> Parser (Maybe String)
parseEyeColor key = do
parseKey key
value <- (Just <$> ( string "amb"
<|> string "blu"
<|> string "brn"
<|> string "gry"
<|> string "grn"
<|> string "hzl"
<|> string "oth"
)) <|> ((some $ alphaNumChar <|> char '#') *> return Nothing)
spaceBetween
return value
parseHeight :: String -> Parser (Maybe Int)
parseHeight key = do
vu <- try (do
parseKey key
v <- some digitChar
u <- string "cm" <|> string "in"
spaceBetween
return $ Just (v, u)
) <|> skipString key *> return Nothing
case vu of
Just (value, unit) -> let v = read value
in case unit of
"cm" -> if v >= 150 && v <= 193 then return (Just v) else return Nothing
"in" -> if v >= 59 && v <= 76 then return (Just v) else return Nothing
_ -> return Nothing
_ -> return Nothing
parseInt :: String -> Int -> Int -> Parser (Maybe Int)
parseInt key low high = do
parseKey key
value <- some digitChar
spaceBetween
let vv = read value
if vv >= low && vv <= high then return $ Just vv else return Nothing
parsePid :: String -> Parser (Maybe Int)
parsePid key = do
value <- try (do
parseKey key
v <- some digitChar
spaceBetween
return $ Just v
) <|> skipString key *> return Nothing
case value of
Just v -> if length v == 9 then return (Just $ read v) else return Nothing
_ -> return Nothing
skipInt :: String -> Parser (Maybe Int)
skipInt key = do
parseKey key
void (some $ alphaNumChar <|> char '#')
spaceBetween
return Nothing
skipString :: String -> Parser (Maybe String)
skipString key = do
parseKey key
void (some $ alphaNumChar <|> char '#')
spaceBetween
return Nothing
spaceBetween :: Parser ()
spaceBetween = void $ char ' ' <|> char '\n'
parsePassport :: Parser (Maybe Passport)
parsePassport = do
-- (byr, iyr, eyr, hgt, hcl, ecl, pid, _) <- dbg "passport" . runPermutation $
(byr, iyr, eyr, hgt, hcl, ecl, pid, _) <- runPermutation $
(,,,,,,,) <$> toPermutationWithDefault Nothing (parseInt "byr" 1920 2002)
<*> toPermutationWithDefault Nothing (parseInt "iyr" 2010 2020)
<*> toPermutationWithDefault Nothing (parseInt "eyr" 2020 2030)
<*> toPermutationWithDefault Nothing (parseHeight "hgt")
<*> toPermutationWithDefault Nothing (parseColor "hcl")
<*> toPermutationWithDefault Nothing (parseEyeColor "ecl")
<*> toPermutationWithDefault Nothing (parsePid "pid")
<*> toPermutationWithDefault Nothing (skipString "cid")
void (char '\n')
return $ makePassport byr iyr eyr hgt hcl ecl pid
makePassport :: Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe String -> Maybe String -> Maybe Int -> Maybe Passport
makePassport (Just byr) ( Just iyr) (Just eyr) (Just hgt) (Just hcl) (Just ecl) (Just pid) = Just $ Passport { byr=byr, iyr=iyr, eyr=eyr, hgt=hgt, hcl=hcl, ecl=ecl, pid=pid }
makePassport _ _ _ _ _ _ _ = Nothing
parsePassports :: Parser [Passport]
parsePassports = do
passports <- some parsePassport
eof
return $ catMaybes passports
parseInput :: String -> IO [Passport]
parseInput filename = do
input <- readFile filename
case runParser parsePassports filename input of
Left bundle -> die $ errorBundlePretty bundle
Right passports -> return passports
compute :: [Passport]-> Int
compute passports = length passports
main :: IO ()
main = do
example <- parseInput "example"
let exampleOutput = compute example
when (exampleOutput /= exampleExpectedOutput) (die $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput)
input <- parseInput "input"
print $ compute input
|