diff --git a/haskell/Main.hs b/haskell/Main.hs
index 623e79c..092304d 100644
--- a/haskell/Main.hs
+++ b/haskell/Main.hs
@@ -45,7 +45,7 @@ main =
                          in
                             withResource (parseFile $ "../inputs/" <> t <> "/" <> pt) mempty \input ->
                                 testGroup pt $
-                                    ( zip (map show [1 :: Int ..]) parts <&> \(n, pp) ->
+                                    ( flip mapWithIndexOutputParameterisedFunctionList parts \(show . succ -> n) pp ->
                                         goldenVsStringDiff n diffCommand ("../outputs/" <> t <> "/" <> pt <> "/" <> n) $
                                             TL.encodeUtf8 . (<> "\n") . TL.show . pp <$> input
                                     )
diff --git a/haskell/Pre.hs b/haskell/Pre.hs
index 577eaac..badace2 100644
--- a/haskell/Pre.hs
+++ b/haskell/Pre.hs
@@ -42,6 +42,11 @@ module Pre (
     adjacentPairs,
     sortPair,
     diffCommand,
+    OutputParameterisedFunctionList,
+    mapOutputParameterisedFunctionList,
+    mapWithIndexOutputParameterisedFunctionList,
+    (/\),
+    nil,
 )
 where
 
@@ -69,7 +74,8 @@ import Data.Foldable hiding (foldl1, foldr1, maximum, maximumBy, minimum, minimu
 import Data.Foldable1
 import Data.Function
 import Data.Functor
-import Data.List (sortOn, transpose)
+import Data.Kind (Constraint, Type)
+import Data.List (List, sortOn, transpose)
 import Data.List.Extra (dropEnd, enumerate, firstJust, notNull, splitOn)
 import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, some1, tail, tails)
 import Data.Maybe
@@ -91,10 +97,10 @@ import Text.Megaparsec hiding (Pos, State, Stream, many, some)
 import Text.Megaparsec.Char
 import Text.Megaparsec.Char.Lexer (decimal)
 
-data Puzzle = forall input output. (Show output) => Puzzle
+data Puzzle = forall input outputs. Puzzle
     { number :: Word
     , parser :: Bool -> Parsec Void Text input
-    , parts :: [input -> output]
+    , parts :: OutputParameterisedFunctionList Show input outputs
     , extraTests :: Bool -> FilePath -> IO input -> [TestTree]
     }
 
@@ -125,3 +131,35 @@ sortPair (a, b) = if a <= b then (a, b) else (b, a)
 
 diffCommand :: FilePath -> FilePath -> [String]
 diffCommand a b = ["diff", "--color=always", a, b]
+
+infixr 9 /\
+(/\) :: (c output) => (input -> output) -> OutputParameterisedFunctionList c input outputs -> OutputParameterisedFunctionList c input (output : outputs)
+(/\) = OutputParameterisedFunctionListCons
+nil :: OutputParameterisedFunctionList c input '[]
+nil = OutputParameterisedFunctionListNil
+
+data OutputParameterisedFunctionList (c :: Type -> Constraint) (input :: Type) (outputs :: List Type) :: Type where
+    OutputParameterisedFunctionListNil :: OutputParameterisedFunctionList c input '[]
+    OutputParameterisedFunctionListCons ::
+        (c output) =>
+        (input -> output) ->
+        OutputParameterisedFunctionList c input outputs ->
+        OutputParameterisedFunctionList c input (output ': outputs)
+mapOutputParameterisedFunctionList ::
+    (forall output. (c output) => (input -> output) -> a) ->
+    OutputParameterisedFunctionList c input outputs ->
+    [a]
+mapOutputParameterisedFunctionList f = \case
+    OutputParameterisedFunctionListNil -> []
+    OutputParameterisedFunctionListCons x xs -> f x : mapOutputParameterisedFunctionList f xs
+mapWithIndexOutputParameterisedFunctionList ::
+    forall c input outputs a.
+    (forall output. (c output) => Int -> (input -> output) -> a) ->
+    OutputParameterisedFunctionList c input outputs ->
+    [a]
+mapWithIndexOutputParameterisedFunctionList f = go 0
+  where
+    go :: Int -> OutputParameterisedFunctionList c input outputs' -> [a]
+    go i = \case
+        OutputParameterisedFunctionListNil -> []
+        OutputParameterisedFunctionListCons x xs -> f i x : go (i + 1) xs
diff --git a/haskell/Puzzles/Day1.hs b/haskell/Puzzles/Day1.hs
index de8002a..2dc3120 100644
--- a/haskell/Puzzles/Day1.hs
+++ b/haskell/Puzzles/Day1.hs
@@ -8,26 +8,29 @@ puzzle =
         { number = 1
         , parser = const $ ((,) <$> ((char 'L' $> L) <|> (char 'R' $> R)) <*> (Inc <$> decimal)) `sepEndBy` newline
         , parts =
-            [ sum
-                . flip evalState 50
-                . traverse \(d, i) -> do
-                    modify $ snd . step i d
-                    p' <- get
-                    pure $ Count if p' == 0 then 1 else 0
-            , sum
-                . flip evalState 50
-                . traverse \(d, i) -> do
-                    p <- get
-                    c <- state $ step i d
-                    p' <- get
-                    pure case d of
-                        R -> abs c
-                        L ->
-                            if
-                                | p == 0 -> abs c - 1
-                                | p' == 0 -> abs c + 1
-                                | otherwise -> abs c
-            ]
+            ( sum
+                . ( flip evalState 50
+                        . traverse \(d, i) -> do
+                            modify $ snd . step i d
+                            p' <- get
+                            pure $ Count if p' == 0 then 1 else 0
+                  )
+            )
+                /\ ( sum
+                        . flip evalState 50
+                        . traverse \(d, i) -> do
+                            p <- get
+                            c <- state $ step i d
+                            p' <- get
+                            pure case d of
+                                R -> abs c
+                                L ->
+                                    if
+                                        | p == 0 -> abs c - 1
+                                        | p' == 0 -> abs c + 1
+                                        | otherwise -> abs c
+                   )
+                /\ nil
         , extraTests = mempty
         }
 
diff --git a/haskell/Puzzles/Day10.hs b/haskell/Puzzles/Day10.hs
index e57cf35..510dee8 100644
--- a/haskell/Puzzles/Day10.hs
+++ b/haskell/Puzzles/Day10.hs
@@ -23,12 +23,13 @@ puzzle =
             void $ single '}'
             pure (Lights $ IM.fromList $ zip [0 ..] lights, switches)
         , parts =
-            [ sum . map \(lights, switches) ->
+            ( sum . map \(lights, switches) ->
                 maybe (error "no solution") length
                     . firstJust (firstJust (\(s, ls) -> guard (allOff ls) $> s))
                     $ flip iterate [([], lights)] \ls ->
                         concatMap (\s -> map (\(ss, l) -> (s : ss, applySwitch s l)) ls) switches
-            ]
+            )
+                /\ nil
         , extraTests = mempty
         }
 
diff --git a/haskell/Puzzles/Day2.hs b/haskell/Puzzles/Day2.hs
index f8192f1..cb3e44b 100644
--- a/haskell/Puzzles/Day2.hs
+++ b/haskell/Puzzles/Day2.hs
@@ -10,13 +10,15 @@ puzzle =
         { number = 2
         , parser = const $ (<* newline) $ ((,) <$> (decimal <* char '-') <*> decimal) `sepBy` (char ',')
         , parts =
-            [ sum
+            ( sum
                 . concatMap
                     (mapMaybe (\n -> guard (isRepetition2 n) $> n) . uncurry enumFromTo)
-            , sum
-                . concatMap
-                    (mapMaybe (\n -> guard (isRepetitionN n) $> n) . uncurry enumFromTo)
-            ]
+            )
+                /\ ( sum
+                        . concatMap
+                            (mapMaybe (\n -> guard (isRepetitionN n) $> n) . uncurry enumFromTo)
+                   )
+                /\ nil
         , extraTests = mempty
         }
 
diff --git a/haskell/Puzzles/Day3.hs b/haskell/Puzzles/Day3.hs
index 2f991a7..6abafa1 100644
--- a/haskell/Puzzles/Day3.hs
+++ b/haskell/Puzzles/Day3.hs
@@ -10,11 +10,13 @@ puzzle =
         { number = 3
         , parser = const $ (Bank <$> some1 digit) `sepEndBy` newline
         , parts =
-            [ sum
+            ( sum
                 . map (digitsToInt . fromMaybe (error "battery list too short") . maxBatteries 2)
-            , sum
-                . map (digitsToInt . fromMaybe (error "battery list too short") . maxBatteries 12)
-            ]
+            )
+                /\ ( sum
+                        . map (digitsToInt . fromMaybe (error "battery list too short") . maxBatteries 12)
+                   )
+                /\ nil
         , extraTests = mempty
         }
 
diff --git a/haskell/Puzzles/Day4.hs b/haskell/Puzzles/Day4.hs
index 902bb2e..25f409b 100644
--- a/haskell/Puzzles/Day4.hs
+++ b/haskell/Puzzles/Day4.hs
@@ -14,11 +14,13 @@ puzzle =
         { number = 4
         , parser = const $ (some $ asum $ enumerate <&> \t -> char (inToChar t) $> t) `sepEndBy` newline
         , parts =
-            [ (\g -> countRolls g - countRolls (removeAccessibleRolls $ findAccessible g))
+            ( (\g -> countRolls g - countRolls (removeAccessibleRolls $ findAccessible g))
                 . mkGrid
-            , (\g -> countRolls g - countRolls (fst $ S.head $ S.filter (noneAccessible . snd) $ generateFrames g))
-                . mkGrid
-            ]
+            )
+                /\ ( (\g -> countRolls g - countRolls (fst $ S.head $ S.filter (noneAccessible . snd) $ generateFrames g))
+                        . mkGrid
+                   )
+                /\ nil
         , extraTests = \isRealData path input ->
             [ testCase "round trip" do
                 t <- TL.readFile if isRealData then "../inputs/real/4" else "../inputs/examples/4"
diff --git a/haskell/Puzzles/Day5.hs b/haskell/Puzzles/Day5.hs
index c5fd252..729b4ee 100644
--- a/haskell/Puzzles/Day5.hs
+++ b/haskell/Puzzles/Day5.hs
@@ -12,16 +12,18 @@ puzzle =
             vals <- decimal `sepEndBy` newline
             pure (ranges, vals)
         , parts =
-            [ \(ranges, vals) ->
+            ( \(ranges, vals) ->
                 length
                     . filter (flip any ranges . isInRange)
                     $ vals
-            , sum
-                . map rangeLength
-                . foldr addInterval []
-                . sortOn (Down . (.lower))
-                . fst
-            ]
+            )
+                /\ ( sum
+                        . map rangeLength
+                        . foldr addInterval []
+                        . sortOn (Down . (.lower))
+                        . fst
+                   )
+                /\ nil
         , extraTests = mempty
         }
 
diff --git a/haskell/Puzzles/Day6.hs b/haskell/Puzzles/Day6.hs
index caa69ea..7d75a52 100644
--- a/haskell/Puzzles/Day6.hs
+++ b/haskell/Puzzles/Day6.hs
@@ -12,18 +12,20 @@ puzzle =
             void newline
             pure (ops, ints)
         , parts =
-            [ sum
+            ( sum
                 . uncurry (zipWith applyToList)
                 . second (transpose . map (map (digitsToInt @Int . catMaybes) . filter notNull . splitOn [Nothing]))
-            , sum
-                . uncurry (zipWith applyToList)
-                . second
-                    ( map catMaybes
-                        . splitOn [Nothing]
-                        . map (\l -> if all isNothing l then Nothing else Just $ digitsToInt @Int $ catMaybes l)
-                        . transpose
-                    )
-            ]
+            )
+                /\ ( sum
+                        . uncurry (zipWith applyToList)
+                        . second
+                            ( map catMaybes
+                                . splitOn [Nothing]
+                                . map (\l -> if all isNothing l then Nothing else Just $ digitsToInt @Int $ catMaybes l)
+                                . transpose
+                            )
+                   )
+                /\ nil
         , extraTests = mempty
         }
 
diff --git a/haskell/Puzzles/Day7.hs b/haskell/Puzzles/Day7.hs
index b1e44cf..d2da4aa 100644
--- a/haskell/Puzzles/Day7.hs
+++ b/haskell/Puzzles/Day7.hs
@@ -17,7 +17,7 @@ puzzle =
             let splitters = map (IS.fromList . map fst . filter snd . zip [0 ..]) rows
             pure (start, splitters)
         , parts =
-            [ uncurry \start ->
+            ( uncurry \start ->
                 flip execState (0 :: Int)
                     . foldlM
                         ( \beams splitters ->
@@ -27,17 +27,19 @@ puzzle =
                                 pure if hit then [x - 1, x + 1] else [x]
                         )
                         (IS.singleton start)
-            , uncurry \start ->
-                sum
-                    . map snd
-                    . IM.toList
-                    . foldl
-                        ( \beams splitters ->
-                            IM.fromListWith (+) . concat $ flip map (IM.toList beams) \(x, n) -> do
-                                let hit = x `IS.member` splitters
-                                zip (if hit then [x - 1, x + 1] else [x]) (repeat n)
-                        )
-                        (IM.singleton start (1 :: Int))
-            ]
+            )
+                /\ ( uncurry \start ->
+                        sum
+                            . map snd
+                            . IM.toList
+                            . foldl
+                                ( \beams splitters ->
+                                    IM.fromListWith (+) . concat $ flip map (IM.toList beams) \(x, n) -> do
+                                        let hit = x `IS.member` splitters
+                                        zip (if hit then [x - 1, x + 1] else [x]) (repeat n)
+                                )
+                                (IM.singleton start (1 :: Int))
+                   )
+                /\ nil
         , extraTests = mempty
         }
diff --git a/haskell/Puzzles/Day8.hs b/haskell/Puzzles/Day8.hs
index 9a5a88c..3785944 100644
--- a/haskell/Puzzles/Day8.hs
+++ b/haskell/Puzzles/Day8.hs
@@ -15,7 +15,7 @@ puzzle =
             (if isRealData then 1000 else 10,)
                 <$> (V3 <$> decimal <* single ',' <*> decimal <* single ',' <*> decimal) `sepEndBy` newline
         , parts =
-            [ uncurry \n ->
+            ( uncurry \n ->
                 product
                     . take 3
                     . sortOn Down
@@ -24,13 +24,15 @@ puzzle =
                     . maybe (error "not enough boxes") snd
                     . listIndex n
                     . connectBoxes
-            , uncurry . const $
-                uncurry ((*) `on` view _x)
-                    . maybe (error "sets never unified") fst
-                    . lastMay
-                    . takeWhile ((> 1) . DS.sets . snd)
-                    . connectBoxes
-            ]
+            )
+                /\ ( uncurry . const $
+                        uncurry ((*) `on` view _x)
+                            . maybe (error "sets never unified") fst
+                            . lastMay
+                            . takeWhile ((> 1) . DS.sets . snd)
+                            . connectBoxes
+                   )
+                /\ nil
         , extraTests = mempty
         }
 
diff --git a/haskell/Puzzles/Day9.hs b/haskell/Puzzles/Day9.hs
index 5e952c9..ed21332 100644
--- a/haskell/Puzzles/Day9.hs
+++ b/haskell/Puzzles/Day9.hs
@@ -8,25 +8,27 @@ puzzle =
         { number = 9
         , parser = const $ (V2 <$> decimal <* single ',' <*> decimal) `sepEndBy1` newline
         , parts =
-            [ maximum
+            ( maximum
                 . fmap (squareSize . uncurry Rectangle)
                 . fromMaybe (error "input too small")
                 . nonEmpty
                 . allUnorderedPairs False
-            , \points ->
-                let path =
-                        fromMaybe (error "malformed line")
-                            . traverse mkLine
-                            $ (last points', head points') :| adjacentPairs points
-                      where
-                        points' = fromMaybe (error "empty input") $ nonEmpty points
-                 in snd
-                        . fromMaybe (error "no solutions")
-                        . find (not . flip any path . lineIntersectsSquare . fst)
-                        . sortOn (Down . snd)
-                        . fmap ((id &&& squareSize) . uncurry Rectangle)
-                        $ allUnorderedPairs False points
-            ]
+            )
+                /\ ( \points ->
+                        let path =
+                                fromMaybe (error "malformed line")
+                                    . traverse mkLine
+                                    $ (last points', head points') :| adjacentPairs points
+                              where
+                                points' = fromMaybe (error "empty input") $ nonEmpty points
+                         in snd
+                                . fromMaybe (error "no solutions")
+                                . find (not . flip any path . lineIntersectsSquare . fst)
+                                . sortOn (Down . snd)
+                                . fmap ((id &&& squareSize) . uncurry Rectangle)
+                                $ allUnorderedPairs False points
+                   )
+                /\ nil
         , extraTests = mempty
         }
 
diff --git a/haskell/aoc.cabal b/haskell/aoc.cabal
index 517115c..8975c94 100644
--- a/haskell/aoc.cabal
+++ b/haskell/aoc.cabal
@@ -24,6 +24,7 @@ executable aoc
     default-extensions:
         BlockArguments
         DuplicateRecordFields
+        ImpredicativeTypes
         LexicalNegation
         MultiWayIf
         NamedFieldPuns