Main.hs

{-# 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 $ filter isEntryValid 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']