1 files changed, 74 insertions, 0 deletions
diff --git a/2020/4.hs b/2020/4.hs
new file mode 100644
index 0000000..fd4d475
--- /dev/null
+++ b/2020/4.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
+module Main (main) where
+
+import Data.Char (isDigit, isSpace)
+import Data.List (isInfixOf)
+import qualified Data.Map.Strict as Map
+import Data.Map.Strict (Map)
+import Text.Parsec hiding (getInput, between)
+import Text.Read (readMaybe)
+
+import Input
+
+
+data Pass = Pass (Map String String)
+  deriving (Show)
+
+data Field = Field { fField :: (String, String), fSep :: Bool }
+  deriving (Show)
+
+parseFields :: String -> [Field]
+parseFields = either (error . show) id . parse pFields ""
+  where
+    pFields :: Parsec String () [Field]
+    pFields =
+        choice [try (spaces >> eof >> return [])
+               ,(:) <$> (Field <$> pField <*> pSep) <*> pFields]
+
+    pField :: Parsec String () (String, String)
+    pField = (,) <$> sequence (replicate 3 lower) <*> (char ':' >> many1 (satisfy (not . isSpace)))
+
+    pSep :: Parsec String () Bool
+    pSep = ("\n\n" `isInfixOf`) <$> many1 space
+
+parsePasses :: [Field] -> [Pass]
+parsePasses [] = []
+parsePasses fs = case break fSep fs of
+                   (pre, p : post) ->
+                       Pass (Map.fromList (map fField (pre ++ [p])))
+                         : parsePasses post
+                   (pre, []) ->
+                       [Pass (Map.fromList (map fField pre))]
+
+validate :: [(String, String -> Bool)] -> Pass -> Bool
+validate vs (Pass fields) =
+    all (\(key, check) -> maybe False check (Map.lookup key fields)) vs
+
+numVor :: Int -> (Int -> Bool) -> String -> Bool
+numVor len f s
+  | length s == len, all isDigit s = f (read s)
+  | otherwise = False
+
+main :: IO ()
+main = do
+    let between l h x = l <= x && x <= h
+        isHexDigit = flip elem "0123456789abcdef"
+        validators =
+            [("byr", numVor 4 (between 1920 2002))
+            ,("iyr", numVor 4 (between 2010 2020))
+            ,("eyr", numVor 4 (between 2020 2030))
+            ,("hgt", \s -> case readMaybe @Int . reverse <$> splitAt 2 (reverse s) of
+                             ("mc", Just n) -> between 150 193 n
+                             ("ni", Just n) -> between 59 76 n
+                             _ -> False)
+            ,("hcl", \case '#' : c | length c == 6, all isHexDigit c -> True
+                           _ -> False)
+            ,("ecl", flip elem ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"])
+            ,("pid", numVor 9 (const True))]
+        validators' = fmap (const (const True)) <$> validators
+    input <- unlines <$> getInput 4
+    let passes = parsePasses (parseFields input)
+    print (sum [fromEnum (validate validators' p) | p <- passes])
+    print (sum [fromEnum (validate validators p) | p <- passes])