Use safe indices for test part lookup

haskell/Main.hs

@@ -2,8 +2,8 @@ module Main (main) where
 
 import Pre
 
+import Data.Finite
 import Data.Functor.Contravariant
-import Data.List ((!!))
 import Data.Text.IO qualified as T
 import Puzzles.Day1 qualified as Day1
 import Puzzles.Day10 qualified as Day10
@@ -43,14 +43,14 @@ main =
                                 . runParser (parser isRealData <* eof) fp
                                 =<< T.readFile fp
                         let (rs, os) =
-                                (foldHListF0 ((:) . fst) [] &&& foldHListF (HCons . snd) HNil) $
+                                (lookupHList fst &&& foldHListF (HCons . snd) HNil) $
                                     mapHListF (\(Fanout (f, Op o)) -> (o &&& id) $ f input) parts
                          in pure (input, rs, os)
                     )
-                    $ ( [0 :: Int .. foldHListF0 (const succ) 0 parts - 1] <&> \n@(show . succ -> nt) ->
+                    $ ( finites <&> \(n@(show . succ @Int . fromIntegral -> nt)) ->
                             TestTree
                                 (mkTestName nt)
-                                (\(_, rs, _) -> golden ("../outputs/" <> t <> "/" <> pt <> "/" <> nt) $ (rs !! n) <> "\n")
+                                (\(_, rs, _) -> golden ("../outputs/" <> t <> "/" <> pt <> "/" <> nt) $ rs n <> "\n")
                                 []
                       )
                         <> let ts = extraTests isRealData ("../outputs/" <> t <> "/" <> pt <> "/extra/")

haskell/Pre.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Pre (
     module BasePrelude,
@@ -44,10 +45,12 @@ module Pre (
     foldHListF,
     foldHListF0,
     mapHListF,
+    lookupHList,
     (/\),
     (/\\),
     nil,
     Fanout (..),
+    Length,
     TestTree (..),
     TestName,
     mkTestName,
@@ -81,6 +84,7 @@ import Control.Monad.State
 import Data.Bifunctor
 import Data.Bool
 import Data.Char
+import Data.Finite
 import Data.Foldable hiding (foldl1, foldr1, maximum, maximumBy, minimum, minimumBy)
 import Data.Foldable1
 import Data.Function
@@ -104,13 +108,14 @@ import Data.Tree
 import Data.Tuple.Extra ((&&&))
 import Data.Void
 import Data.Word
+import GHC.TypeNats (KnownNat, Nat, type (+))
 import Linear (V2 (..))
 import Safe
 import Text.Megaparsec hiding (Pos, State, Stream, many, some)
 import Text.Megaparsec.Char
 import Text.Megaparsec.Char.Lexer (decimal)
 
-data Puzzle = forall input outputs. Puzzle
+data Puzzle = forall input outputs. (KnownNat (Length outputs)) => Puzzle
     { number :: Word
     , parser :: Bool -> Parsec Void Text input
     , parts :: PuzzleParts input outputs
@@ -176,8 +181,17 @@ foldHListF0 f e = \case
 mapHListF :: (forall a. f a -> g a) -> HListF f as -> HListF g as
 mapHListF t = foldHListF (\x r -> HConsF (t x) $ r) HNilF
 
+lookupHList :: (forall a. f a -> r) -> HListF f as -> Finite (Length as) -> r
+lookupHList f = \case
+    HNilF -> absurd . separateZero
+    HConsF x xs -> maybe (f x) (lookupHList f xs) . unshift
+
 newtype Fanout f g a = Fanout (f a, g a)
 
+type family Length as :: Nat where
+    Length '[] = 0
+    Length (x ': xs) = Length xs + 1
+
 data TestTree m input where
     TestTree :: TestName -> (input -> m output) -> [TestTree m output] -> TestTree m input
 

haskell/aoc.cabal

@@ -55,6 +55,7 @@ executable aoc
         exceptions,
         extra,
         filepath,
+        finite-typelits,
         lens,
         linear,
         massiv,