3 files changed, 66 insertions, 55 deletions

diff --git a/aoc.cabal b/aoc.cabal
index dda4a43..4b92bb7 100644
--- a/aoc.cabal
+++ b/aoc.cabal
@@ -36,6 +36,6 @@ executable Day03
 
 executable Day04
   main-is:             Day04.hs
-  build-depends:       base, parsec
+  build-depends:       base, parsec, containers
   default-language:    Haskell2010
   hs-source-dirs:      execs
diff --git a/execs/Day04.hs b/execs/Day04.hs
index 04aacbb..565415f 100644
--- a/execs/Day04.hs
+++ b/execs/Day04.hs
@@ -1,14 +1,13 @@
 module Main where
 
-import Text.ParserCombinators.Parsec
-import Text.Parsec.Char
-import Data.Either
-import Data.Maybe
-import Control.Monad
-import Data.List (sortOn)
+import           Text.ParserCombinators.Parsec
+import           Data.Map.Strict (Map, (!))
+import qualified Data.Map.Strict as Map
+import           Data.Char (isDigit, isHexDigit)
 
 right (Right a) = a
-fields = [ "byr" , "iyr" , "eyr" , "hgt" , "hcl" , "ecl" , "pid" ] 
+requiredFields = [ "byr" , "iyr" , "eyr" , "hgt" , "hcl" , "ecl" , "pid" ] 
+eyeColors = ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"]
 
 block = cell `sepBy` oneOf " \n"
 cell = do
@@ -17,55 +16,41 @@ cell = do
     rest <- many (alphaNum <|> char '#')
     return (tag, rest)
 
-parseInput :: String -> Either ParseError [(String, String)]
-parseInput = parse block "input"
+parseInput :: String -> Either ParseError (Map String String)
+parseInput s = Map.fromList <$> parse block "input" s
 
-assocGet s (l:ls) = if fst l == s
-                       then snd l
-                       else assocGet s ls
+doCheck :: Map String String -> Bool
+doCheck ls = all ((== True) . flip Map.member ls) requiredFields
 
-doCheck :: [(String, String)] -> Bool
-doCheck ls = all (isJust . flip lookup ls) fields
+bet :: Int -> (Int, Int) -> Bool
+bet k (l, u) = k >= l && k <= u
 
-checkNum lower up s = p >= lower && p <= up
-    where p = read s :: Int
-byr = checkNum 1920 2002
-iyr = checkNum 2010 2020
-eyr = checkNum 2020 2030
-
-parseHeight :: Parser (Int, String)
-parseHeight = do
-    v <- many1 digit
-    unit <- choice $ map string ["cm", "in"]
-    return (read v, unit)
-hgt s = case parse parseHeight "hgt" s of
-          Right (v, "cm") -> v >= 150 && v <= 193
-          Right (v, "in") -> v >= 59 && v <= 76
+validByr s = bet (read s :: Int) (1920, 2002)
+validIyr s = bet (read s :: Int) (2010, 2020)
+validEyr s = bet (read s :: Int) (2020, 2030)
+validEcl = flip elem eyeColors
+validPid s = length s == 9 && all isDigit s
+validHcl ('#':rest) = length rest == 6 && all isHexDigit rest
+validHcl _ = False
+validHgt s = 
+    let value = takeWhile isDigit s
+        unit = dropWhile isDigit s
+        height = (read value :: Int, unit)
+     in case height of
+          (v, "cm") -> bet v (150, 193)
+          (v, "in") -> bet v (59, 76)
           _ -> False
 
-parseColor = char '#' >> many hexDigit
-hcl :: String -> Bool
-hcl s = case parse parseColor "hcl" s of
-          Right c -> length c == 6
-          Left _ -> False
-
-
-ecl :: String -> Bool
-ecl = flip elem ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"]
-
-parsePid = replicateM 9 digit
-pid :: String -> Bool
-pid s = isRight $ parse parsePid "pid" s
-
-doValidity :: [(String, String)] -> Bool
-doValidity ls = all ((== True) . ($ ls)) [ byr . assocGet "byr"
-                                         , iyr . assocGet "iyr"
-                                         , eyr . assocGet "eyr"
-                                         , hgt . assocGet "hgt"
-                                         , hcl . assocGet "hcl"
-                                         , ecl . assocGet "ecl"
-                                         , pid . assocGet "pid"
-                                         ]
+doValidity :: Map String String -> Bool
+doValidity map = all ((== True) . (\(s, v) -> v $ map ! s))  ls
+    where ls = [ ("byr", validByr)
+               , ("iyr", validIyr)
+               , ("eyr", validEyr)
+               , ("hgt", validHgt)
+               , ("hcl", validHcl)
+               , ("ecl", validEcl)
+               , ("pid", validPid)
+               ]
 
 parseLines :: [String] -> [String]
 parseLines allLines = unwords first : next
@@ -76,7 +61,7 @@ main :: IO ()
 main = do
     n <- parseLines . lines <$> readFile "input/04"
     let blocks = map (right . parseInput) n
+    {- part 1 -}
+    print $ length $ filter doCheck blocks
+    {- part 2 -}
     print $ length $ filter (\p -> doCheck p && doValidity p) blocks
-    -- mapM_ print $ filter (\p -> doCheck p && doValidity p) $ map (sortOn fst) blocks
-    -- print $ length $ filter doCheck blocks
-    -- print $ length $ filter (\p -> doCheck p && doValidity p) $ map (sortOn fst) blocks
diff --git a/input/04sample b/input/04sample
new file mode 100644
index 0000000..81712b3
--- /dev/null
+++ b/input/04sample
@@ -0,0 +1,26 @@
+eyr:1972 cid:100
+hcl:#18171d ecl:amb hgt:170 pid:186cm iyr:2018 byr:1926
+
+iyr:2019
+hcl:#602927 eyr:1967 hgt:170cm
+ecl:grn pid:012533040 byr:1946
+
+hcl:dab227 iyr:2012
+ecl:brn hgt:182cm pid:021572410 eyr:2020 byr:1992 cid:277
+
+hgt:59cm ecl:zzz
+eyr:2038 hcl:74454a iyr:2023
+pid:3556412378 byr:2007
+
+pid:087499704 hgt:74in ecl:grn iyr:2012 eyr:2030 byr:1980
+hcl:#623a2f
+
+eyr:2029 ecl:blu cid:129 byr:1989
+iyr:2014 pid:896056539 hcl:#a97842 hgt:165cm
+
+hcl:#888785
+hgt:164cm byr:2001 iyr:2015 cid:88
+pid:545766238 ecl:hzl
+eyr:2022
+
+iyr:2010 hgt:158cm hcl:#b6652a ecl:blu byr:1944 eyr:2021 pid:093154719