Skip to content

Instantly share code, notes, and snippets.

@Arkham

Arkham/Main.hs Secret

Created Jan 6, 2021
Embed
What would you like to do?
{-# LANGUAGE DeriveGeneric #-}
module Main where
import qualified Data.Char as Char
import qualified Data.HashMap.Strict as HM
import Data.Hashable
import qualified Data.List.Split as S
import Data.Maybe (mapMaybe)
import GHC.Generics (Generic)
main :: IO ()
main = do
contents <- readFile "input.txt"
let entries = map parseEntry (S.splitOn "\n\n" contents)
print $ length $ mapMaybe entryToPassport entries
type PassportEntry = HM.HashMap PassportField String
data PassportField
= BirthYear
| IssueYear
| ExpirationYear
| Height
| HairColor
| EyeColor
| PassportId
| CountryId
deriving (Eq, Show, Generic)
instance Hashable PassportField
parseEntry :: String -> PassportEntry
parseEntry line =
HM.fromList $
mapMaybe parseTag $
S.splitWhen Char.isSpace line
parseTag :: String -> Maybe (PassportField, String)
parseTag value =
case S.splitOn ":" value of
["byr", byr] ->
Just (BirthYear, byr)
["iyr", iyr] ->
Just (IssueYear, iyr)
["eyr", eyr] ->
Just (ExpirationYear, eyr)
["hgt", height] ->
Just (Height, height)
["hcl", color] ->
Just (HairColor, color)
["ecl", color] ->
Just (EyeColor, color)
["pid", pid] ->
Just (PassportId, pid)
["cid", cid] ->
Just (CountryId, cid)
_ ->
Nothing
requiredFields :: [PassportField]
requiredFields =
[ BirthYear,
IssueYear,
ExpirationYear,
Height,
HairColor,
EyeColor,
PassportId
]
isEntryValid :: PassportEntry -> Bool
isEntryValid entry =
requiredFieldsPresent && allFieldsValid
where
requiredFieldsPresent =
all (`HM.member` entry) requiredFields
allFieldsValid =
all isFieldValid (HM.toList entry)
isFieldValid :: (PassportField, String) -> Bool
isFieldValid (field, value) =
case field of
BirthYear ->
let v = toInt value
in length value == 4 && v >= 1920 && v <= 2002
IssueYear ->
let v = toInt value
in length value == 4 && v >= 2010 && v <= 2020
ExpirationYear ->
let v = toInt value
in length value == 4 && v >= 2020 && v <= 2030
Height ->
case span Char.isDigit value of
(num, "cm") ->
let n = toInt num
in n >= 150 && n <= 193
(num, "in") ->
let n = toInt num
in n >= 59 && n <= 76
_ ->
False
HairColor ->
case (length value, value) of
(7, '#' : rest) ->
all (`elem` allowedHexChars) rest
_ ->
False
EyeColor ->
value `elem` validEyeColors
PassportId ->
length value == 9 && all Char.isDigit value
CountryId ->
all Char.isDigit value
toInt :: String -> Int
toInt = read
validEyeColors :: [String]
validEyeColors =
["amb", "blu", "brn", "gry", "grn", "hzl", "oth"]
allowedHexChars :: [Char]
allowedHexChars =
['0' .. '9'] <> ['a' .. 'f']
data Passport = Passport
{ birthYear :: Int,
issueYear :: Int,
expirationYear :: Int,
height :: String,
hairColor :: String,
eyeColor :: String,
passportId :: String,
countryId :: Maybe Int
}
parseField ::
(PassportField, String) -> Maybe (PassportField, String)
parseField tuple =
if isFieldValid tuple
then Just tuple
else Nothing
getAllRequiredFields :: PassportEntry -> Maybe [String]
getAllRequiredFields e =
traverse
( \field -> do
v <- HM.lookup field e
(_field, text) <- parseField (field, v)
return text
)
requiredFields
entryToPassport :: PassportEntry -> Maybe Passport
entryToPassport entry = do
case getAllRequiredFields entry of
Just [byr, iyr, eyr, hgt, hcl, ecl, pid] ->
Just $
Passport
{ birthYear = toInt byr,
issueYear = toInt iyr,
expirationYear = toInt eyr,
height = hgt,
hairColor = hcl,
eyeColor = ecl,
passportId = pid,
countryId = toInt <$> HM.lookup CountryId entry
}
_ ->
Nothing
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment