patrickaldis/garnet
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Move output showing to main entry point

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
haskell/Main.hs
View File

@ -3,6 +3,7 @@ module Main (main) where
import Pre import Pre
import Data.Text.IO qualified as T import Data.Text.IO qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding qualified as TL import Data.Text.Lazy.Encoding qualified as TL
import Puzzles.Day1 qualified as Day1 import Puzzles.Day1 qualified as Day1
import Puzzles.Day2 qualified as Day2 import Puzzles.Day2 qualified as Day2
@ -44,6 +45,6 @@ main =
testGroup pt $ testGroup pt $
( zip (map show [1 :: Int ..]) parts <&> \(n, pp) -> ( zip (map show [1 :: Int ..]) parts <&> \(n, pp) ->
goldenVsStringDiff n diffCommand ("../outputs/" <> t <> "/" <> pt <> "/" <> n) $ 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] <> [testGroup "extra" $ extraTests isRealData ("../outputs/" <> t <> "/" <> pt <> "/extra/") input]

5
haskell/Pre.hs
View File

@ -78,7 +78,6 @@ import Data.Sequence (Seq)
import Data.Stream.Infinite (Stream ((:>))) import Data.Stream.Infinite (Stream ((:>)))
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (encodeUtf8)
import Data.Text.Lazy qualified as TL
import Data.Traversable import Data.Traversable
import Data.Tuple.Extra ((&&&)) import Data.Tuple.Extra ((&&&))
import Data.Void import Data.Void
@ -92,10 +91,10 @@ import Text.Megaparsec hiding (Pos, State, Stream, many, some)
import Text.Megaparsec.Char import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer (decimal) import Text.Megaparsec.Char.Lexer (decimal)
data Puzzle = forall input. Puzzle data Puzzle = forall input output. (Show output) => Puzzle
{ number :: Word { number :: Word
, parser :: Bool -> Parsec Void Text input , parser :: Bool -> Parsec Void Text input
, parts :: [input -> TL.Text] , parts :: [input -> output]
, extraTests :: Bool -> FilePath -> IO input -> [TestTree] , extraTests :: Bool -> FilePath -> IO input -> [TestTree]
} }

8
haskell/Puzzles/Day1.hs
View File

@ -2,23 +2,19 @@ module Puzzles.Day1 (puzzle) where
import Pre import Pre
import Data.Text.Lazy qualified as TL
puzzle :: Puzzle puzzle :: Puzzle
puzzle = puzzle =
Puzzle Puzzle
{ number = 1 { number = 1
, parser = const $ ((,) <$> ((char 'L' $> L) <|> (char 'R' $> R)) <*> (Inc <$> decimal)) `sepEndBy` newline , parser = const $ ((,) <$> ((char 'L' $> L) <|> (char 'R' $> R)) <*> (Inc <$> decimal)) `sepEndBy` newline
, parts = , parts =
[ TL.show [ sum
. sum
. flip evalState 50 . flip evalState 50
. traverse \(d, i) -> do . traverse \(d, i) -> do
modify $ snd . step i d modify $ snd . step i d
p' <- get p' <- get
pure $ Count if p' == 0 then 1 else 0 pure $ Count if p' == 0 then 1 else 0
, TL.show , sum
. sum
. flip evalState 50 . flip evalState 50
. traverse \(d, i) -> do . traverse \(d, i) -> do
p <- get p <- get

7
haskell/Puzzles/Day2.hs
View File

@ -3,7 +3,6 @@ module Puzzles.Day2 (puzzle) where
import Pre import Pre
import Data.Text qualified as T import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
puzzle :: Puzzle puzzle :: Puzzle
puzzle = puzzle =
@ -11,12 +10,10 @@ puzzle =
{ number = 2 { number = 2
, parser = const $ (<* newline) $ ((,) <$> (decimal <* char '-') <*> decimal) `sepBy` (char ',') , parser = const $ (<* newline) $ ((,) <$> (decimal <* char '-') <*> decimal) `sepBy` (char ',')
, parts = , parts =
[ TL.show [ sum
. sum
. concatMap . concatMap
(mapMaybe (\n -> guard (isRepetition2 n) $> n) . uncurry enumFromTo) (mapMaybe (\n -> guard (isRepetition2 n) $> n) . uncurry enumFromTo)
, TL.show , sum
. sum
. concatMap . concatMap
(mapMaybe (\n -> guard (isRepetitionN n) $> n) . uncurry enumFromTo) (mapMaybe (\n -> guard (isRepetitionN n) $> n) . uncurry enumFromTo)
] ]

7
haskell/Puzzles/Day3.hs
View File

@ -3,7 +3,6 @@ module Puzzles.Day3 (puzzle) where
import Pre import Pre
import Data.List.NonEmpty qualified as NE import Data.List.NonEmpty qualified as NE
import Data.Text.Lazy qualified as TL
puzzle :: Puzzle puzzle :: Puzzle
puzzle = puzzle =
@ -11,11 +10,9 @@ puzzle =
{ number = 3 { number = 3
, parser = const $ (Bank <$> some1 digit) `sepEndBy` newline , parser = const $ (Bank <$> some1 digit) `sepEndBy` newline
, parts = , parts =
[ TL.show [ sum
. sum
. map (digitsToInt . fromMaybe (error "battery list too short") . maxBatteries 2) . map (digitsToInt . fromMaybe (error "battery list too short") . maxBatteries 2)
, TL.show , sum
. sum
. map (digitsToInt . fromMaybe (error "battery list too short") . maxBatteries 12) . map (digitsToInt . fromMaybe (error "battery list too short") . maxBatteries 12)
] ]
, extraTests = mempty , extraTests = mempty

6
haskell/Puzzles/Day4.hs
View File

@ -14,11 +14,9 @@ puzzle =
{ number = 4 { number = 4
, parser = const $ (some $ asum $ enumerate <&> \t -> char (inToChar t) $> t) `sepEndBy` newline , parser = const $ (some $ asum $ enumerate <&> \t -> char (inToChar t) $> t) `sepEndBy` newline
, parts = , parts =
[ TL.show [ (\g -> countRolls g - countRolls (removeAccessibleRolls $ findAccessible g))
. (\g -> countRolls g - countRolls (removeAccessibleRolls $ findAccessible g))
. mkGrid . 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 . mkGrid
] ]
, extraTests = \isRealData path input -> , extraTests = \isRealData path input ->

8
haskell/Puzzles/Day5.hs
View File

@ -2,8 +2,6 @@ module Puzzles.Day5 (puzzle) where
import Pre import Pre
import Data.Text.Lazy qualified as TL
puzzle :: Puzzle puzzle :: Puzzle
puzzle = puzzle =
Puzzle Puzzle
@ -15,12 +13,10 @@ puzzle =
pure (ranges, vals) pure (ranges, vals)
, parts = , parts =
[ \(ranges, vals) -> [ \(ranges, vals) ->
TL.show length
. length
. filter (flip any ranges . isInRange) . filter (flip any ranges . isInRange)
$ vals $ vals
, TL.show , sum
. sum
. map rangeLength . map rangeLength
. foldr addInterval [] . foldr addInterval []
. sortOn (Down . (.lower)) . sortOn (Down . (.lower))

8
haskell/Puzzles/Day6.hs
View File

@ -2,8 +2,6 @@ module Puzzles.Day6 (puzzle) where
import Pre import Pre
import Data.Text.Lazy qualified as TL
puzzle :: Puzzle puzzle :: Puzzle
puzzle = puzzle =
Puzzle Puzzle
@ -14,12 +12,10 @@ puzzle =
void newline void newline
pure (ops, ints) pure (ops, ints)
, parts = , parts =
[ TL.show [ sum
. sum
. uncurry (zipWith applyToList) . uncurry (zipWith applyToList)
. second (transpose . map (map (digitsToInt @Int . catMaybes) . filter notNull . splitOn [Nothing])) . second (transpose . map (map (digitsToInt @Int . catMaybes) . filter notNull . splitOn [Nothing]))
, TL.show , sum
. sum
. uncurry (zipWith applyToList) . uncurry (zipWith applyToList)
. second . second
( map catMaybes ( map catMaybes

7
haskell/Puzzles/Day7.hs
View File

@ -4,7 +4,6 @@ import Pre
import Data.IntMap qualified as IM import Data.IntMap qualified as IM
import Data.IntSet qualified as IS import Data.IntSet qualified as IS
import Data.Text.Lazy qualified as TL
puzzle :: Puzzle puzzle :: Puzzle
puzzle = puzzle =
@ -19,8 +18,7 @@ puzzle =
pure (start, splitters) pure (start, splitters)
, parts = , parts =
[ uncurry \start -> [ uncurry \start ->
TL.show flip execState (0 :: Int)
. flip execState (0 :: Int)
. foldlM . foldlM
( \beams splitters -> ( \beams splitters ->
IS.fromList . concat <$> for (IS.toList beams) \x -> do IS.fromList . concat <$> for (IS.toList beams) \x -> do
@ -30,8 +28,7 @@ puzzle =
) )
(IS.singleton start) (IS.singleton start)
, uncurry \start -> , uncurry \start ->
TL.show sum
. sum
. map snd . map snd
. IM.toList . IM.toList
. foldl . foldl

7
haskell/Puzzles/Day8.hs
View File

@ -4,7 +4,6 @@ import Pre
import Control.Lens import Control.Lens
import Data.DisjointSet qualified as DS import Data.DisjointSet qualified as DS
import Data.Text.Lazy qualified as TL
import Linear.Metric import Linear.Metric
import Linear.V3 import Linear.V3
@ -17,8 +16,7 @@ puzzle =
<$> (V3 <$> decimal <* single ',' <*> decimal <* single ',' <*> decimal) `sepEndBy` newline <$> (V3 <$> decimal <* single ',' <*> decimal <* single ',' <*> decimal) `sepEndBy` newline
, parts = , parts =
[ uncurry \n -> [ uncurry \n ->
TL.show product
. product
. take 3 . take 3
. sortOn Down . sortOn Down
. map length . map length
@ -27,8 +25,7 @@ puzzle =
. listIndex n . listIndex n
. connectBoxes . connectBoxes
, uncurry . const $ , uncurry . const $
TL.show uncurry ((*) `on` view _x)
. uncurry ((*) `on` view _x)
. maybe (error "sets never unified") fst . maybe (error "sets never unified") fst
. lastMay . lastMay
. takeWhile ((> 1) . DS.sets . snd) . takeWhile ((> 1) . DS.sets . snd)

8
haskell/Puzzles/Day9.hs
View File

@ -2,16 +2,13 @@ module Puzzles.Day9 (puzzle) where
import Pre import Pre
import Data.Text.Lazy qualified as TL
puzzle :: Puzzle puzzle :: Puzzle
puzzle = puzzle =
Puzzle Puzzle
{ number = 9 { number = 9
, parser = const $ (V2 <$> decimal <* single ',' <*> decimal) `sepEndBy1` newline , parser = const $ (V2 <$> decimal <* single ',' <*> decimal) `sepEndBy1` newline
, parts = , parts =
[ TL.show [ maximum
. maximum
. fmap (squareSize . uncurry Square) . fmap (squareSize . uncurry Square)
. fromMaybe (error "input too small") . fromMaybe (error "input too small")
. nonEmpty . nonEmpty
@ -23,8 +20,7 @@ puzzle =
$ (last points', head points') :| adjacentPairs points $ (last points', head points') :| adjacentPairs points
where where
points' = fromMaybe (error "empty input") $ nonEmpty points points' = fromMaybe (error "empty input") $ nonEmpty points
in TL.show in snd
. snd
. fromMaybe (error "no solutions") . fromMaybe (error "no solutions")
. find (not . flip any path . lineIntersectsSquare . fst) . find (not . flip any path . lineIntersectsSquare . fst)
. sortOn (Down . snd) . sortOn (Down . snd)