Solve day 8 part 2

haskell/Pre.hs

@@ -34,6 +34,8 @@ module Pre (
     module Text.Megaparsec.Char,
     module Text.Megaparsec.Char.Lexer,
     Puzzle (..),
+    digit,
+    digitsToInt,
 )
 where
 
@@ -61,7 +63,7 @@ import Data.Foldable1
 import Data.Function
 import Data.Functor
 import Data.List (sortOn, tails, transpose)
-import Data.List.Extra (dropEnd, enumerate)
+import Data.List.Extra (dropEnd, enumerate, notNull, splitOn)
 import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, some1)
 import Data.Maybe
 import Data.Ord
@@ -88,3 +90,9 @@ data Puzzle = forall input. Puzzle
     , parts :: [input -> TL.Text]
     , extraTests :: Bool -> FilePath -> IO input -> [TestTree]
     }
+
+digit :: (Token s ~ Char, Num b, MonadParsec e s f) => f b
+digit = fromIntegral . digitToInt <$> digitChar
+
+digitsToInt :: (Integral a) => [a] -> Int
+digitsToInt = snd . foldr (\b (p, acc) -> (10 * p, acc + fromIntegral b * p)) (1, 0)

haskell/Puzzles/Day3.hs

@@ -9,7 +9,7 @@ puzzle :: Puzzle
 puzzle =
     Puzzle
         { number = 3
-        , parser = const $ flip sepEndBy newline $ Bank . fmap (fromIntegral . digitToInt) <$> some1 digitChar
+        , parser = const $ flip sepEndBy newline $ Bank <$> some1 digit
         , parts =
             [ TL.show
                 . sum
@@ -39,6 +39,3 @@ maxBatteries n0 (Bank bs0) = flip unfoldrM (n0, toList bs0) \case
 -- returns the leftmost element in case of a tie
 findMax :: (Ord a) => NonEmpty a -> (a, Int)
 findMax = foldl1' (\m x -> if fst x > fst m then x else m) . flip NE.zip (0 :| [1 ..])
-
-digitsToInt :: [Battery] -> Int
-digitsToInt = snd . foldr (\b (p, acc) -> (10 * p, acc + fromIntegral b * p)) (1, 0)

haskell/Puzzles/Day6.hs

@@ -9,14 +9,24 @@ puzzle =
     Puzzle
         { number = 6
         , parser = const do
-            ints <- (hspace *> (decimal `sepBy1` hspace1)) `sepEndBy1` newline
+            ints <- some ((Just <$> digit) <|> (single ' ' $> Nothing)) `sepEndBy1` newline
             ops <- ((single '*' $> Multiply) <|> (single '+' $> Add)) `sepEndBy` hspace1
             void newline
-            pure (ops, transpose ints)
+            pure (ops, ints)
         , parts =
             [ TL.show
                 . sum
-                . uncurry (zipWith \op -> foldl' (apply op) (unit op))
+                . uncurry (zipWith applyToList)
+                . second (transpose . map (map (digitsToInt @Int . catMaybes) . filter notNull . splitOn [Nothing]))
+            , TL.show
+                . sum
+                . uncurry (zipWith applyToList)
+                . second
+                    ( map catMaybes
+                        . splitOn [Nothing]
+                        . map (\l -> if all isNothing l then Nothing else Just $ digitsToInt @Int $ catMaybes l)
+                        . transpose
+                    )
             ]
         , extraTests = mempty
         }
@@ -31,3 +41,5 @@ unit :: Op -> Int
 unit = \case
     Add -> 0
     Multiply -> 1
+applyToList :: Op -> [Int] -> Int
+applyToList op = foldl' (apply op) (unit op)

outputs/real/6/2

@@ -0,0 +1 @@
+11708563470209