Day 10

src/Days/D10.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Days.D10 where
+
+import Common
+import Parse
+
+import Data.List.Extra (chunksOf)
+import Text.Megaparsec ((<|>))
+import Text.Megaparsec.Char (space, string)
+
+data Instruction = Noop | Addx Int
+
+type Trace = [Int]
+
+parser :: Parser [Instruction]
+parser = someLines instruction
+ where
+  instruction :: Parser Instruction
+  instruction = (Noop <$ string "noop") <|> (Addx <$ string "addx" <* space <*> int)
+
+trace :: [Instruction] -> Trace
+trace =
+  scanl (+) 1
+    . foldMap
+      ( \case
+          Noop -> [0]
+          Addx x -> [0, x]
+      )
+
+snapshot :: [Int] -> [a] -> [a]
+snapshot idxs l = [l !! (ix - 1) | ix <- idxs]
+
+cycles :: [Int]
+cycles = [20, 60, 100, 140, 180, 220]
+
+part1 :: Trace -> Int
+part1 = sum . zipWith (*) cycles . snapshot cycles
+
+part2 :: Trace -> String
+part2 = parseCRT . screenCrop . zipWith ((render .) . inRange) (cycle [0 .. 39])
+ where
+  inRange :: Int -> Int -> Bool
+  inRange a b = let d = b - a in d == 0 || d == 1 || d == -1
+
+  render :: Bool -> Char
+  render True = '#'
+  render False = '.'
+
+  screenCrop :: String -> [String]
+  screenCrop = take 6 . chunksOf 40
+
+day :: Day
+day = parsecDay (trace <$> parser) (definitive . part1, definitive . part2)