153 lines
5.1 KiB
Haskell
153 lines
5.1 KiB
Haskell
-- 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
|