Day 14 - Part 1

day14/main.hs

@@ -1,6 +1,6 @@
 #! /usr/bin/env -S"ANSWER=42" nix-shell
 #! nix-shell -p ghcid
-#! nix-shell -p "haskellPackages.ghcWithPackages (p: with p; [pretty-simple])"
+#! nix-shell -p "haskellPackages.ghcWithPackages (p: with p; [pretty-simple attoparsec])"
 #! nix-shell -i "ghcid -c 'ghci' -T main"
 
 {-# OPTIONS_GHC -Wall -Wincomplete-uni-patterns #-}
@@ -11,6 +11,133 @@
 import Debug.Trace (trace)
 import Text.Pretty.Simple
 
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as I
+
+import Data.Bits ((.&.),(.|.),FiniteBits,bit,complementBit)
+import Data.Maybe (catMaybes)
+
+import Numeric (showIntAtBase)
+import Data.Char (intToDigit)
+
+import Data.Attoparsec.Text (Parser)
+import qualified Data.Attoparsec.Text as P
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Data.String (IsString)
+
+import Data.Monoid (Sum(..))
+
+exampleData :: String
+exampleData = unlines $
+  [ "mask = XXXXXXXXXXXXXXXXXXXXXXXXXXXXX1XXXX0X"
+  , "mem[8] = 11"
+  , "mem[7] = 101"
+  , "mem[8] = 0"
+  ]
+
+-- The *special* mask is essentially a successive application of:
+-- - (.&.) with 0 (all others are 1), in order to force 0 on some bits, or
+-- - (.|.) with 1 (all others are 0), in order to force 1 on some bits.
+--
+data BW a = BWAnd a
+          | BWOr a
+
+instance (Show a, Integral a) => Show (BW a)
+  where
+    show (BWAnd a) = "And " <> showIntAtBase 2 intToDigit a ""
+    show (BWOr a) = "Or " <> showIntAtBase 2 intToDigit a ""
+
+mkBW :: String -> Mask
+mkBW xs | length xs == 36 = catMaybes $ map go (zip [35,34..] xs)
+  where
+    go (p,'1') = Just $ BWOr  (bit p)
+    go (p,'0') = Just $ BWAnd (complementBit (2 ^ (36 :: Int) - 1) p)
+    go (p,'X') = Nothing
+    go (_,c)   = trace ("Illegal char: " <> show c) $ undefined
+mkBW xs | otherwise = trace "Mask is not 36 bit long" $ undefined
+
+applyMask :: (FiniteBits a) => [BW a] -> a -> a
+applyMask xs a = foldl applyBitwise a xs
+  where
+    applyBitwise v (BWAnd n) = n .&. v
+    applyBitwise v (BWOr n) = n .|. v
+--
+
+-- We need a datatype to hold our datastructure
+--
+type Mask = [BW Int]
+type Mem = IntMap Int
+type Addr = Int
+
+data InitBlock = InitBlock { unMask :: Mask, unInitLines :: [(Addr,Int)] }
+  deriving Show
+
+data Program = Program { unMem :: Mem, unInits :: [InitBlock] }
+  deriving Show
+--
+
+-- Now, let's parse our input uwu
+--
+-- mask = XXXXXXXXXXXXXXXXXXXXXXXXXXXXX1XXXX0X
+parseMask :: Parser Mask
+parseMask = do
+  maskStr <- "mask = " *> P.take 36
+  P.endOfLine
+  pure $ mkBW $ T.unpack maskStr
+
+-- mem[x] = y
+parseInitLines :: Parser (Addr,Int)
+parseInitLines = do
+  x <- "mem[" *> P.decimal
+  y <- "] = " *> P.decimal
+  P.endOfLine
+  pure $ (x,y)
+
+parseBlock :: Parser InitBlock
+parseBlock = do
+  mask <- parseMask
+  ix <- P.many1 parseInitLines
+  pure $ InitBlock mask ix
+
+parseInput :: Parser [InitBlock]
+parseInput = do
+  bx <- P.many1 parseBlock
+  P.endOfInput
+  pure bx
+--
+
+-- Now we've got everyting for part1, let's solve the thing
+--
+runInitBlock :: Mem -> InitBlock -> Mem
+runInitBlock mem (InitBlock mask inits) =
+  I.union res mem
+  where
+    res = foldMap (\(addr,v) -> I.insert addr (applyMask mask v) I.empty) $ reverse inits
+
+solvePart1 :: Text -> Either String Int
+solvePart1 input = do
+  bx <- P.parseOnly parseInput input
+  pure . getSum . (foldMap Sum) . I.elems $ fullMem bx
+  where
+    fullMem :: [InitBlock] -> Mem
+    fullMem = foldMap (runInitBlock I.empty) . reverse
+--
+
+
 main :: IO ()
 main = do
+  input <- T.pack <$> readFile "day14/input"
+  putStrLn ":: Tests - Part 1"
+  pPrint . lines $ exampleData
+  print $ mkBW "XXXXXXXXXXXXXXXXXXXXXXXXXXXXX1XXXX0X"
+  print $ applyMask (mkBW "XXXXXXXXXXXXXXXXXXXXXXXXXXXXX1XXXX0X") 11
+  print $ applyMask (mkBW "XXXXXXXXXXXXXXXXXXXXXXXXXXXXX1XXXX0X") 101
+  print $ applyMask (mkBW "XXXXXXXXXXXXXXXXXXXXXXXXXXXXX1XXXX0X") 0
+  pPrint . P.parseOnly parseBlock . T.pack $ exampleData
+  -- pPrint . P.parseOnly parseInput $ input
   putStrLn ":: Day 14 - Part 1"
+  print . solvePart1 . T.pack $ exampleData
+  print . solvePart1 $ input