Pasted

import Data.Char (isDigit)
import Data.List (intercalate)
 
import Data.Set (Set)
import qualified Data.Set as S
import Data.Map (Map)
import qualified Data.Map as M
 
key :: String -> String
key = fst . kv
 
kv :: String -> (String, String)
kv s = (key, drop 1 value)
 where (key, value) = break (':' ==) s
 
paras :: [String] -> [String]
paras ls = if null pls then [] else intercalate " " pls : paras (drop 1 remain)
 where
  (pls, remain) = break (null . words) ls
 
reqKeys :: Set String
reqKeys = S.fromList [ "byr", "iyr", "eyr", "hgt", "hcl", "ecl", "pid" ]
 
validations :: Map String (String -> Bool)
validations = M.fromList
  [ ("byr", validByr)
  , ("iyr", validIyr)
  , ("eyr", validEyr)
  , ("hgt", validHgt)
  , ("hcl", validHcl)
  , ("ecl", validEcl)
  , ("pid", validPid)
  ]
 
keys :: String -> Set String
keys = S.fromList . map key . words
 
kvs :: String -> Map String String
kvs = M.fromList . map kv . words
 
hasReqKeys :: Set String -> Bool
hasReqKeys x = S.size reqKeys == S.size (S.intersection reqKeys x)
 
validates :: Map String String -> Bool
validates x = M.size results == M.size validations && and results
 where results = M.intersectionWith ($) validations x
 
count :: (a -> Bool) -> [a] -> Int
count pred = length . filter pred
 
validByr :: String -> Bool
validByr byr = 1920 <= v && v <= 2002
 where v = read byr
 
validIyr :: String -> Bool
validIyr iyr = 2010 <= v && v <= 2020
 where v = read iyr
 
validEyr :: String -> Bool
validEyr eyr = 2020 <= v && v <= 2030
 where v = read eyr
 
validHgt :: String -> Bool
validHgt hgt =
  case units of
   "cm" -> 150 <= v && v <= 193
   "in" -> 59 <= v && v <= 76
   _ -> False
 where
  (n, units) = span isDigit hgt
  v = read n
 
lcHexDigits :: Set Char
lcHexDigits = S.fromList "0123456789abcdef"
 
validHcl :: String -> Bool
validHcl ('#':hex@(_:_:_:_:_:_:[])) = all (flip S.member lcHexDigits) hex
validHcl _ = False
 
eyeColors :: Set String
eyeColors = S.fromList [ "amb", "blu", "brn", "gry", "grn", "hzl", "oth" ]
 
validEcl :: String -> Bool
validEcl = flip S.member eyeColors
 
validPid :: String -> Bool
validPid pid = length pid == 9 && all isDigit pid
 
main = interact ((++"\n") . show . count (validates . kvs). paras . lines)