Move output showing to main entry point

This commit is contained in:
George Thomas 2025-12-09 16:57:05 +00:00
parent 6e851d63f0
commit 57c1613019
11 changed files with 22 additions and 52 deletions

View File

@ -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]

View File

@ -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]
}

View File

@ -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

View File

@ -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)
]

View File

@ -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

View File

@ -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 ->

View File

@ -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))

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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)