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
|
module Main where
import Text.ParserCombinators.Parsec
import Text.Parsec.Char
import Data.Either
import Data.Maybe
import Control.Monad
import Data.List (sortOn)
right (Right a) = a
fields = [ "byr" , "iyr" , "eyr" , "hgt" , "hcl" , "ecl" , "pid" ]
block = cell `sepBy` oneOf " \n"
cell = do
tag <- many lower
char ':'
rest <- many (alphaNum <|> char '#')
return (tag, rest)
parseInput :: String -> Either ParseError [(String, String)]
parseInput = parse block "input"
assocGet s (l:ls) = if fst l == s
then snd l
else assocGet s ls
doCheck :: [(String, String)] -> Bool
doCheck ls = all (isJust . flip lookup ls) fields
checkNum lower up s = p >= lower && p <= up
where p = read s :: Int
byr = checkNum 1920 2002
iyr = checkNum 2010 2020
eyr = checkNum 2020 2030
parseHeight :: Parser (Int, String)
parseHeight = do
v <- many1 digit
unit <- choice $ map string ["cm", "in"]
return (read v, unit)
hgt s = case parse parseHeight "hgt" s of
Right (v, "cm") -> v >= 150 && v <= 193
Right (v, "in") -> v >= 59 && v <= 76
_ -> False
parseColor = char '#' >> many hexDigit
hcl :: String -> Bool
hcl s = case parse parseColor "hcl" s of
Right c -> length c == 6
Left _ -> False
ecl :: String -> Bool
ecl = flip elem ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"]
parsePid = replicateM 9 digit
pid :: String -> Bool
pid s = isRight $ parse parsePid "pid" s
doValidity :: [(String, String)] -> Bool
doValidity ls = all ((== True) . ($ ls)) [ byr . assocGet "byr"
, iyr . assocGet "iyr"
, eyr . assocGet "eyr"
, hgt . assocGet "hgt"
, hcl . assocGet "hcl"
, ecl . assocGet "ecl"
, pid . assocGet "pid"
]
parseLines :: [String] -> [String]
parseLines allLines = unwords first : next
where (first, rest) = break null allLines
next = if null rest then [] else parseLines (tail rest)
main :: IO ()
main = do
n <- parseLines . lines <$> readFile "input/04"
let blocks = map (right . parseInput) n
print $ length $ filter (\p -> doCheck p && doValidity p) blocks
-- mapM_ print $ filter (\p -> doCheck p && doValidity p) $ map (sortOn fst) blocks
-- print $ length $ filter doCheck blocks
-- print $ length $ filter (\p -> doCheck p && doValidity p) $ map (sortOn fst) blocks
|
