1 files changed, 39 insertions, 54 deletions

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