diff --git a/haskell/Main.hs b/haskell/Main.hs index 4aaf91c..8bdd10b 100644 --- a/haskell/Main.hs +++ b/haskell/Main.hs @@ -3,6 +3,7 @@ module Main (main) where import Pre import Data.Text.IO qualified as T +import Data.Text.Lazy qualified as TL import Data.Text.Lazy.Encoding qualified as TL import Puzzles.Day1 qualified as Day1 import Puzzles.Day2 qualified as Day2 @@ -44,6 +45,6 @@ main = testGroup pt $ ( zip (map show [1 :: Int ..]) parts <&> \(n, pp) -> goldenVsStringDiff n diffCommand ("../outputs/" <> t <> "/" <> pt <> "/" <> n) $ - TL.encodeUtf8 . pp <$> input + TL.encodeUtf8 . TL.show . pp <$> input ) <> [testGroup "extra" $ extraTests isRealData ("../outputs/" <> t <> "/" <> pt <> "/extra/") input] diff --git a/haskell/Pre.hs b/haskell/Pre.hs index d472881..0350f6f 100644 --- a/haskell/Pre.hs +++ b/haskell/Pre.hs @@ -78,7 +78,6 @@ import Data.Sequence (Seq) 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.Tuple.Extra ((&&&)) import Data.Void @@ -92,10 +91,10 @@ import Text.Megaparsec hiding (Pos, State, Stream, many, some) import Text.Megaparsec.Char import Text.Megaparsec.Char.Lexer (decimal) -data Puzzle = forall input. Puzzle +data Puzzle = forall input output. (Show output) => Puzzle { number :: Word , parser :: Bool -> Parsec Void Text input - , parts :: [input -> TL.Text] + , parts :: [input -> output] , extraTests :: Bool -> FilePath -> IO input -> [TestTree] } diff --git a/haskell/Puzzles/Day1.hs b/haskell/Puzzles/Day1.hs index c2b109e..de8002a 100644 --- a/haskell/Puzzles/Day1.hs +++ b/haskell/Puzzles/Day1.hs @@ -2,23 +2,19 @@ module Puzzles.Day1 (puzzle) where import Pre -import Data.Text.Lazy qualified as TL - puzzle :: Puzzle puzzle = Puzzle { number = 1 , parser = const $ ((,) <$> ((char 'L' $> L) <|> (char 'R' $> R)) <*> (Inc <$> decimal)) `sepEndBy` newline , parts = - [ TL.show - . sum + [ sum . flip evalState 50 . traverse \(d, i) -> do modify $ snd . step i d p' <- get pure $ Count if p' == 0 then 1 else 0 - , TL.show - . sum + , sum . flip evalState 50 . traverse \(d, i) -> do p <- get diff --git a/haskell/Puzzles/Day2.hs b/haskell/Puzzles/Day2.hs index da2bac7..f8192f1 100644 --- a/haskell/Puzzles/Day2.hs +++ b/haskell/Puzzles/Day2.hs @@ -3,7 +3,6 @@ module Puzzles.Day2 (puzzle) where import Pre import Data.Text qualified as T -import Data.Text.Lazy qualified as TL puzzle :: Puzzle puzzle = @@ -11,12 +10,10 @@ puzzle = { number = 2 , parser = const $ (<* newline) $ ((,) <$> (decimal <* char '-') <*> decimal) `sepBy` (char ',') , parts = - [ TL.show - . sum + [ sum . concatMap (mapMaybe (\n -> guard (isRepetition2 n) $> n) . uncurry enumFromTo) - , TL.show - . sum + , sum . concatMap (mapMaybe (\n -> guard (isRepetitionN n) $> n) . uncurry enumFromTo) ] diff --git a/haskell/Puzzles/Day3.hs b/haskell/Puzzles/Day3.hs index 9b62285..2f991a7 100644 --- a/haskell/Puzzles/Day3.hs +++ b/haskell/Puzzles/Day3.hs @@ -3,7 +3,6 @@ module Puzzles.Day3 (puzzle) where import Pre import Data.List.NonEmpty qualified as NE -import Data.Text.Lazy qualified as TL puzzle :: Puzzle puzzle = @@ -11,11 +10,9 @@ puzzle = { number = 3 , parser = const $ (Bank <$> some1 digit) `sepEndBy` newline , parts = - [ TL.show - . sum + [ sum . map (digitsToInt . fromMaybe (error "battery list too short") . maxBatteries 2) - , TL.show - . sum + , sum . map (digitsToInt . fromMaybe (error "battery list too short") . maxBatteries 12) ] , extraTests = mempty diff --git a/haskell/Puzzles/Day4.hs b/haskell/Puzzles/Day4.hs index 1be6346..902bb2e 100644 --- a/haskell/Puzzles/Day4.hs +++ b/haskell/Puzzles/Day4.hs @@ -14,11 +14,9 @@ puzzle = { number = 4 , parser = const $ (some $ asum $ enumerate <&> \t -> char (inToChar t) $> t) `sepEndBy` newline , parts = - [ TL.show - . (\g -> countRolls g - countRolls (removeAccessibleRolls $ findAccessible g)) + [ (\g -> countRolls g - countRolls (removeAccessibleRolls $ findAccessible g)) . mkGrid - , TL.show - . (\g -> countRolls g - countRolls (fst $ S.head $ S.filter (noneAccessible . snd) $ generateFrames g)) + , (\g -> countRolls g - countRolls (fst $ S.head $ S.filter (noneAccessible . snd) $ generateFrames g)) . mkGrid ] , extraTests = \isRealData path input -> diff --git a/haskell/Puzzles/Day5.hs b/haskell/Puzzles/Day5.hs index f2bdffb..c5fd252 100644 --- a/haskell/Puzzles/Day5.hs +++ b/haskell/Puzzles/Day5.hs @@ -2,8 +2,6 @@ module Puzzles.Day5 (puzzle) where import Pre -import Data.Text.Lazy qualified as TL - puzzle :: Puzzle puzzle = Puzzle @@ -15,12 +13,10 @@ puzzle = pure (ranges, vals) , parts = [ \(ranges, vals) -> - TL.show - . length + length . filter (flip any ranges . isInRange) $ vals - , TL.show - . sum + , sum . map rangeLength . foldr addInterval [] . sortOn (Down . (.lower)) diff --git a/haskell/Puzzles/Day6.hs b/haskell/Puzzles/Day6.hs index 35e71df..caa69ea 100644 --- a/haskell/Puzzles/Day6.hs +++ b/haskell/Puzzles/Day6.hs @@ -2,8 +2,6 @@ module Puzzles.Day6 (puzzle) where import Pre -import Data.Text.Lazy qualified as TL - puzzle :: Puzzle puzzle = Puzzle @@ -14,12 +12,10 @@ puzzle = void newline pure (ops, ints) , parts = - [ TL.show - . sum + [ sum . uncurry (zipWith applyToList) . second (transpose . map (map (digitsToInt @Int . catMaybes) . filter notNull . splitOn [Nothing])) - , TL.show - . sum + , sum . uncurry (zipWith applyToList) . second ( map catMaybes diff --git a/haskell/Puzzles/Day7.hs b/haskell/Puzzles/Day7.hs index 938aa5b..b1e44cf 100644 --- a/haskell/Puzzles/Day7.hs +++ b/haskell/Puzzles/Day7.hs @@ -4,7 +4,6 @@ import Pre import Data.IntMap qualified as IM import Data.IntSet qualified as IS -import Data.Text.Lazy qualified as TL puzzle :: Puzzle puzzle = @@ -19,8 +18,7 @@ puzzle = pure (start, splitters) , parts = [ uncurry \start -> - TL.show - . flip execState (0 :: Int) + flip execState (0 :: Int) . foldlM ( \beams splitters -> IS.fromList . concat <$> for (IS.toList beams) \x -> do @@ -30,8 +28,7 @@ puzzle = ) (IS.singleton start) , uncurry \start -> - TL.show - . sum + sum . map snd . IM.toList . foldl diff --git a/haskell/Puzzles/Day8.hs b/haskell/Puzzles/Day8.hs index 47d7ecf..9a5a88c 100644 --- a/haskell/Puzzles/Day8.hs +++ b/haskell/Puzzles/Day8.hs @@ -4,7 +4,6 @@ import Pre import Control.Lens import Data.DisjointSet qualified as DS -import Data.Text.Lazy qualified as TL import Linear.Metric import Linear.V3 @@ -17,8 +16,7 @@ puzzle = <$> (V3 <$> decimal <* single ',' <*> decimal <* single ',' <*> decimal) `sepEndBy` newline , parts = [ uncurry \n -> - TL.show - . product + product . take 3 . sortOn Down . map length @@ -27,8 +25,7 @@ puzzle = . listIndex n . connectBoxes , uncurry . const $ - TL.show - . uncurry ((*) `on` view _x) + uncurry ((*) `on` view _x) . maybe (error "sets never unified") fst . lastMay . takeWhile ((> 1) . DS.sets . snd) diff --git a/haskell/Puzzles/Day9.hs b/haskell/Puzzles/Day9.hs index c224fa8..fc1c685 100644 --- a/haskell/Puzzles/Day9.hs +++ b/haskell/Puzzles/Day9.hs @@ -2,16 +2,13 @@ module Puzzles.Day9 (puzzle) where import Pre -import Data.Text.Lazy qualified as TL - puzzle :: Puzzle puzzle = Puzzle { number = 9 , parser = const $ (V2 <$> decimal <* single ',' <*> decimal) `sepEndBy1` newline , parts = - [ TL.show - . maximum + [ maximum . fmap (squareSize . uncurry Square) . fromMaybe (error "input too small") . nonEmpty @@ -23,8 +20,7 @@ puzzle = $ (last points', head points') :| adjacentPairs points where points' = fromMaybe (error "empty input") $ nonEmpty points - in TL.show - . snd + in snd . fromMaybe (error "no solutions") . find (not . flip any path . lineIntersectsSquare . fst) . sortOn (Down . snd)