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 $ 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