Solve day 7 part 1

haskell/Pre.hs

@@ -21,6 +21,7 @@ module Pre (
     module Data.Stream.Infinite,
     module Data.Text,
     module Data.Text.Encoding,
+    module Data.Traversable,
     module Data.Void,
     module Data.Word,
     module Linear,
@@ -66,6 +67,7 @@ import Data.Stream.Infinite (Stream ((:>)))
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Text.Lazy qualified as TL
+import Data.Traversable
 import Data.Void
 import Data.Word
 import Linear (V2 (..))

haskell/Puzzles/Day7.hs

@@ -2,14 +2,32 @@ module Puzzles.Day7 (puzzle) where
 
 import Pre
 
+import Data.IntSet qualified as IS
+import Data.Text.Lazy qualified as TL
+
 puzzle :: Puzzle
 puzzle =
     Puzzle
         { number = 7
-        , parser = pure ()
+        , parser = do
+            line1 <- some $ (single '.' $> False) <|> (single 'S' $> True)
+            start <- maybe (fail "start not found") (pure . fst) $ find snd $ zip [0 ..] line1
+            void newline
+            rows <- (some $ (single '.' $> False) <|> (single '^' $> True)) `sepEndBy1` newline
+            let splitters = map (IS.fromList . map fst . filter snd . zip [0 ..]) rows
+            pure (start, splitters)
         , parts =
-            [ \() ->
-                "TODO"
+            [ uncurry \start ->
+                TL.show
+                    . flip execState (0 :: Int)
+                    . foldlM
+                        ( \beams splitters ->
+                            IS.fromList . concat <$> for (IS.toList beams) \x -> do
+                                let hit = x `IS.member` splitters
+                                when hit $ modify succ
+                                pure if hit then [x - 1, x + 1] else [x]
+                        )
+                        (IS.singleton start)
             ]
         , extraTests = mempty
         }

outputs/real/7/1

@@ -0,0 +1 @@
+1537