[hs] Solve 2020_14 part 1

hs/src/Aoc/Y2020.hs

@@ -16,6 +16,7 @@ import qualified Aoc.Y2020.D10 as D10
 import qualified Aoc.Y2020.D11 as D11
 import qualified Aoc.Y2020.D12 as D12
 import qualified Aoc.Y2020.D13 as D13
+import qualified Aoc.Y2020.D14 as D14
 
 year :: Year
 year = Year 2020
@@ -32,4 +33,5 @@ year = Year 2020
   , (11, D11.day)
   , (12, D12.day)
   , (13, D13.day)
+  , (14, D14.day)
   ]

hs/src/Aoc/Y2020/D14.hs

@@ -0,0 +1,71 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Aoc.Y2020.D14
+  ( day
+  ) where
+
+import           Control.Monad
+import           Data.List
+
+import qualified Data.Map      as Map
+
+import           Aoc.Day
+import           Aoc.Parse
+
+data Instr
+  = Mask [Maybe Bool]
+  | Set Int Int
+
+parser :: Parser [Instr]
+parser = manyLines (pMask <|> pSet)
+  where
+    pMask = do
+      void $ string "mask = "
+      bits <- sequenceA $ replicate 36 $ (Nothing <$ char 'X') <|> (Just False <$ char '0') <|> (Just True <$ char '1')
+      pure $ Mask $ reverse bits -- Most significant first
+    pSet = do
+      void $ string "mem["
+      addr <- decimal
+      void $ string "] = "
+      Set addr <$> decimal
+
+digits :: Int -> [Bool]
+digits = map odd . iterate (`div` 2)
+
+mask :: [Maybe Bool] -> Int -> [Bool]
+mask m n = zipWith maskBit m $ digits n
+  where
+    maskBit Nothing  = id
+    maskBit (Just a) = const a
+
+data Mem = Mem
+  { mMask :: [Maybe Bool]
+  , mMem  :: Map.Map Int [Bool]
+  } deriving (Show)
+
+newMem :: Mem
+newMem = Mem{mMask = replicate 36 Nothing, mMem = Map.empty}
+
+setMask :: [Maybe Bool] -> Mem -> Mem
+setMask m mem = mem{mMask = m}
+
+setMem :: Int -> Int -> Mem -> Mem
+setMem addr val mem = mem{mMem = Map.insert addr masked $ mMem mem}
+  where
+    masked = mask (mMask mem) val
+
+doInstr :: Instr -> Mem -> Mem
+doInstr (Mask m)       = setMask m
+doInstr (Set addr val) = setMem addr val
+
+value :: [Bool] -> Int
+value = sum . map fst . filter snd . zip (iterate (*2) 1)
+
+solver :: [Instr] -> IO ()
+solver instrs = do
+  putStrLn ">> Part 1"
+  let mem = foldl' (flip doInstr) newMem instrs
+  print $ sum $ map value $ Map.elems $ mMem mem
+
+day :: Day
+day = dayParse parser solver