[hs] Solve 2020_08 part 1

hs/src/Aoc/Y2020.hs

@@ -10,6 +10,7 @@ import qualified Aoc.Y2020.D04 as D04
 import qualified Aoc.Y2020.D05 as D05
 import qualified Aoc.Y2020.D06 as D06
 import qualified Aoc.Y2020.D07 as D07
+import qualified Aoc.Y2020.D08 as D08
 
 year :: Year
 year = Year 2020
@@ -20,4 +21,5 @@ year = Year 2020
   , ( 5, D05.day)
   , ( 6, D06.day)
   , ( 7, D07.day)
+  , ( 8, D08.day)
   ]

hs/src/Aoc/Y2020/D08.hs

@@ -0,0 +1,72 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Aoc.Y2020.D08
+  ( day
+  ) where
+
+import qualified Data.Map  as Map
+import qualified Data.Set  as Set
+
+import           Aoc.Day
+import           Aoc.Parse
+
+data Opcode = Acc | Jmp | Nop
+  deriving (Show, Eq, Ord)
+
+data Instr = Instr Opcode Int
+  deriving (Show, Eq, Ord)
+
+parser :: Parser [Instr]
+parser = manyLines $ Instr <$> (pOpcode <* char ' ') <*> signed (pure ()) decimal
+  where
+    pOpcode =  (Acc <$ string "acc") <|> (Jmp <$ string "jmp") <|> (Nop <$ string "nop")
+
+data State = State
+  { sInstrs :: Map.Map Int Instr
+  , sIdx    :: Int
+  , sAcc    :: Int
+  } deriving (Show)
+
+newState :: [Instr] -> State
+newState instrs = State (Map.fromList $ zip [0..] instrs) 0 0
+
+incIdx :: Int -> State -> State
+incIdx delta s = s { sIdx = delta + sIdx s }
+
+incAcc :: Int -> State -> State
+incAcc delta s = s { sAcc = delta + sAcc s }
+
+step :: State -> Maybe State
+step s = do
+  (Instr op val) <- sInstrs s Map.!? sIdx s
+  pure $ case op of
+    Acc -> incIdx 1 $ incAcc val s
+    Jmp -> incIdx val s
+    Nop -> incIdx 1 s
+
+run :: State -> [State]
+run s = s : case step s of
+  Nothing -> []
+  Just s' -> run s'
+
+untilRepeatingIdx :: [State] -> [State]
+untilRepeatingIdx = helper Set.empty
+  where
+    helper _ [] = []
+    helper idxs (s:ss)
+      | i `Set.member` idxs = []
+      | otherwise           = s : helper (Set.insert i idxs) ss
+      where i = sIdx s
+
+solver :: [Instr] -> IO ()
+solver instrs = do
+  let s = newState instrs
+
+  putStrLn ">> Part 1"
+  print $ sAcc $ last $ untilRepeatingIdx $ run s
+
+  putStrLn ""
+  putStrLn ">> Part 2"
+
+day :: Day
+day = dayParse parser solver