From d0488726a05b83d8e01fd7d1aeb04395823e3a35 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Mon, 8 Dec 2025 22:42:29 +0000 Subject: [PATCH] Add argument to parser for disambiguating real data versus examples This breaks less code than adding it to the solution functions, and is more elegant in a way. --- haskell/Main.hs | 2 +- haskell/Pre.hs | 2 +- haskell/Puzzles/Day1.hs | 2 +- haskell/Puzzles/Day2.hs | 2 +- haskell/Puzzles/Day3.hs | 2 +- haskell/Puzzles/Day4.hs | 2 +- haskell/Puzzles/Day5.hs | 2 +- haskell/Puzzles/Day6.hs | 2 +- haskell/Puzzles/Day7.hs | 2 +- haskell/Puzzles/Day8.hs | 12 +++++------- 10 files changed, 14 insertions(+), 16 deletions(-) diff --git a/haskell/Main.hs b/haskell/Main.hs index 0b9c8f3..ad45d93 100644 --- a/haskell/Main.hs +++ b/haskell/Main.hs @@ -35,7 +35,7 @@ main = pt = show number parseFile fp = either (fail . ("parse failure: " <>) . errorBundlePretty) pure - . runParser (parser <* eof) fp + . runParser (parser isRealData <* eof) fp =<< T.readFile fp in withResource (parseFile $ "../inputs/" <> t <> "/" <> pt) mempty \input -> diff --git a/haskell/Pre.hs b/haskell/Pre.hs index 5f7f4db..57c5d0a 100644 --- a/haskell/Pre.hs +++ b/haskell/Pre.hs @@ -82,7 +82,7 @@ import Text.Megaparsec.Char.Lexer (decimal) data Puzzle = forall input. Puzzle { number :: Word - , parser :: Parsec Void Text input + , parser :: Bool -> Parsec Void Text input , parts :: [input -> TL.Text] , extraTests :: Bool -> FilePath -> IO input -> [TestTree] } diff --git a/haskell/Puzzles/Day1.hs b/haskell/Puzzles/Day1.hs index b14e3bb..3e71ecc 100644 --- a/haskell/Puzzles/Day1.hs +++ b/haskell/Puzzles/Day1.hs @@ -8,7 +8,7 @@ puzzle :: Puzzle puzzle = Puzzle { number = 1 - , parser = flip sepEndBy newline $ (,) <$> ((char 'L' $> L) <|> (char 'R' $> R)) <*> (Inc <$> decimal) + , parser = const $ flip sepEndBy newline $ (,) <$> ((char 'L' $> L) <|> (char 'R' $> R)) <*> (Inc <$> decimal) , parts = [ TL.show . sum diff --git a/haskell/Puzzles/Day2.hs b/haskell/Puzzles/Day2.hs index f3820d2..d3b7283 100644 --- a/haskell/Puzzles/Day2.hs +++ b/haskell/Puzzles/Day2.hs @@ -9,7 +9,7 @@ puzzle :: Puzzle puzzle = Puzzle { number = 2 - , parser = (<* newline) $ flip sepBy (char ',') $ (,) <$> (decimal <* char '-') <*> decimal + , parser = const $ (<* newline) $ flip sepBy (char ',') $ (,) <$> (decimal <* char '-') <*> decimal , parts = [ TL.show . sum diff --git a/haskell/Puzzles/Day3.hs b/haskell/Puzzles/Day3.hs index e2661f0..93da1c5 100644 --- a/haskell/Puzzles/Day3.hs +++ b/haskell/Puzzles/Day3.hs @@ -9,7 +9,7 @@ puzzle :: Puzzle puzzle = Puzzle { number = 3 - , parser = flip sepEndBy newline $ Bank . fmap (fromIntegral . digitToInt) <$> some1 digitChar + , parser = const $ flip sepEndBy newline $ Bank . fmap (fromIntegral . digitToInt) <$> some1 digitChar , parts = [ TL.show . sum diff --git a/haskell/Puzzles/Day4.hs b/haskell/Puzzles/Day4.hs index c4aa270..a87d3d0 100644 --- a/haskell/Puzzles/Day4.hs +++ b/haskell/Puzzles/Day4.hs @@ -12,7 +12,7 @@ puzzle :: Puzzle puzzle = Puzzle { number = 4 - , parser = flip sepEndBy newline $ some $ asum $ enumerate <&> \t -> char (inToChar t) $> t + , parser = const $ flip sepEndBy newline $ some $ asum $ enumerate <&> \t -> char (inToChar t) $> t , parts = [ TL.show . (\g -> countRolls g - countRolls (removeAccessibleRolls $ findAccessible g)) diff --git a/haskell/Puzzles/Day5.hs b/haskell/Puzzles/Day5.hs index c0df55d..9c9299e 100644 --- a/haskell/Puzzles/Day5.hs +++ b/haskell/Puzzles/Day5.hs @@ -8,7 +8,7 @@ puzzle :: Puzzle puzzle = Puzzle { number = 5 - , parser = do + , parser = const do ranges <- flip sepEndBy newline $ Range <$> decimal <* single '-' <*> decimal void newline vals <- sepEndBy decimal newline diff --git a/haskell/Puzzles/Day6.hs b/haskell/Puzzles/Day6.hs index 31ab853..6538549 100644 --- a/haskell/Puzzles/Day6.hs +++ b/haskell/Puzzles/Day6.hs @@ -8,7 +8,7 @@ puzzle :: Puzzle puzzle = Puzzle { number = 6 - , parser = do + , parser = const do ints <- (hspace *> (decimal `sepBy1` hspace1)) `sepEndBy1` newline ops <- ((single '*' $> Multiply) <|> (single '+' $> Add)) `sepEndBy` hspace1 void newline diff --git a/haskell/Puzzles/Day7.hs b/haskell/Puzzles/Day7.hs index 278dd28..938aa5b 100644 --- a/haskell/Puzzles/Day7.hs +++ b/haskell/Puzzles/Day7.hs @@ -10,7 +10,7 @@ puzzle :: Puzzle puzzle = Puzzle { number = 7 - , parser = do + , parser = const do line1 <- some $ (single '.' $> False) <|> (single 'S' $> True) start <- maybe (fail "start not found") (pure . fst) $ find snd $ zip [0 ..] line1 void newline diff --git a/haskell/Puzzles/Day8.hs b/haskell/Puzzles/Day8.hs index 55796bd..5197a50 100644 --- a/haskell/Puzzles/Day8.hs +++ b/haskell/Puzzles/Day8.hs @@ -11,20 +11,18 @@ puzzle :: Puzzle puzzle = Puzzle { number = 8 - , parser = (V3 <$> decimal <* single ',' <*> decimal <* single ',' <*> decimal) `sepEndBy` newline + , parser = \isRealData -> (if isRealData then 1000 else 10,) <$> (V3 <$> decimal <* single ',' <*> decimal <* single ',' <*> decimal) `sepEndBy` newline , parts = - [ TL.show + [ uncurry \n -> TL.show . product . take 3 . sortOn Down . map length . DS.toLists . snd - . \boxes -> - -- TODO more principled way of distinguishing example and real - (!! ((if length boxes == 20 then 10 else if length boxes == 1000 then 1000 else undefined))) $ - connectBoxes boxes - , TL.show + . (!! n) + . connectBoxes + , uncurry . const $ TL.show . maybe (error "sets never unified") (\((V3 x1 _ _, V3 x2 _ _), _) -> x1 * x2) . lastMay . takeWhile ((> 1) . DS.sets . snd)