Add 2020 day 14 part 1

haskellAoC/src/Y2020/Day14.hs

@@ -0,0 +1,52 @@
+module Y2020.Day14 (y20day14) where
+
+import Data.Bits
+import qualified Data.Map as M
+
+type Bitmask = M.Map Int Bool
+
+data Instruction = UpdateBitMask [(Int, Bool)] | SetMemory Int Int deriving (Show)
+
+data State = State {
+  bitmask :: Bitmask
+  , memory :: M.Map Int Int -- [(Int, Int)]
+  } deriving (Show)
+
+parseInput :: [String] -> Instruction
+parseInput ["mask", "=", mask] = UpdateBitMask $ parseBitMask 0 $ reverse mask
+  where
+    parseBitMask :: Int -> String -> [(Int, Bool)]
+    parseBitMask _ [] = []
+    parseBitMask offset (x:xs) =
+      let next = (parseBitMask (offset + 1) xs) in
+        case x of
+          '1' -> (offset, True):next
+          '0' -> (offset, False):next
+          _ -> next
+parseInput ["mem", offset, "=", value] = SetMemory (read offset) (read value)
+parseInput s = error $ "Invalid line: " ++ (unwords s)
+
+applyInstructionP1 :: State -> Instruction -> State
+applyInstructionP1 (State _ mem) (UpdateBitMask updates) = State newMask mem
+  where newMask = M.fromList updates
+applyInstructionP1 (State bm mem) (SetMemory offset value) = State bm newMemory
+  where newMemory = M.insert offset (maskValue value) mem
+        maskValue val = checkBit val $ finiteBitSize val
+          where checkBit v (-1) = v
+                checkBit v offset' = checkBit newVal (offset' - 1)
+                  where newVal = case offset `M.lookup` bm of
+                                   Just True  -> v `setBit` offset'
+                                   Just False -> v `clearBit` offset'
+                                   Nothing    -> v
+
+y20day14 :: [String] -> (String, String)
+y20day14 input = (part1, part2)
+  where part1 = show $ M.foldr (+) 0 $ memory endState
+        part2 = show $ "WIP"
+        initialState = State M.empty M.empty
+        endState = foldl applyInstructionP1 initialState instructions
+        instructions = map (parseInput . words . replaceBrackets) input
+          where replaceBrackets ('[':xs) = ' ':(replaceBrackets xs)
+                replaceBrackets (']':xs) = ' ':(replaceBrackets xs)
+                replaceBrackets (x:xs) = x:(replaceBrackets xs)
+                replaceBrackets [] = []

haskellAoC/src/Y2020/Days.hs

@@ -13,6 +13,7 @@ import Y2020.Day10
 import Y2020.Day11
 import Y2020.Day12
 import Y2020.Day13
+import Y2020.Day14
 
 year2020 :: String -> [String] -> (String, String)
 year2020 "01" = y20day01
@@ -28,3 +29,4 @@ year2020 "10" = y20day10
 year2020 "11" = y20day11
 year2020 "12" = y20day12
 year2020 "13" = y20day13
+year2020 "14" = y20day14