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

Simplify test name handling

Browse Source 
We keep the internal type safety, while making things easier for users.
This commit is contained in:
George Thomas 2026-01-07 00:55:07 +00:00
parent f634b9b42d
commit fb2d412f95
3 changed files with 8 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
haskell/Main.hs
View File

@ -30,7 +30,7 @@ tests :: TestTree IO ()
tests = tests =
test "tests" pure $ test "tests" pure $
enumerate <&> \isRealData@(bool "examples" "real" -> t) -> enumerate <&> \isRealData@(bool "examples" "real" -> t) ->
test (mkTestName $ T.pack t) pure $ test (T.pack t) pure $
[ Day1.puzzle [ Day1.puzzle
, Day2.puzzle , Day2.puzzle
, Day3.puzzle , Day3.puzzle
@ -44,7 +44,7 @@ tests =
] ]
<&> \Puzzle{number = show -> pt, parser, parts, extraTests} -> <&> \Puzzle{number = show -> pt, parser, parts, extraTests} ->
testLazy testLazy
(mkTestName $ T.pack pt) (T.pack pt)
( \() -> do ( \() -> do
let fp = "../inputs/" <> t <> "/" <> pt let fp = "../inputs/" <> t <> "/" <> pt
input <- input <-
@ -58,7 +58,7 @@ tests =
) )
$ ( finites <&> \(n@(show . succ @Int . fromIntegral -> nt)) -> $ ( finites <&> \(n@(show . succ @Int . fromIntegral -> nt)) ->
test test
(mkTestName $ T.pack nt) (T.pack nt)
(\(_, rs, _) -> golden ("../outputs/" <> t <> "/" <> pt <> "/" <> nt) $ rs n <> "\n") (\(_, rs, _) -> golden ("../outputs/" <> t <> "/" <> pt <> "/" <> nt) $ rs n <> "\n")
[] []
) )

12
haskell/Pre.hs
View File

@ -68,7 +68,6 @@ module Pre (
test, test,
testLazy, testLazy,
TestName, TestName,
mkTestName,
getTestTree, getTestTree,
displayTestResultsConsole, displayTestResultsConsole,
runTests, runTests,
@ -266,14 +265,14 @@ newtype Test m a = Test (ExceptT TestFailure m a)
) )
-- | See `testLazy` for avoiding the `NFData` constraint. -- | See `testLazy` for avoiding the `NFData` constraint.
test :: (NFData output) => TestName -> (input -> Test m output) -> [TestTree m output] -> TestTree m input test :: (NFData output) => Text -> (input -> Test m output) -> [TestTree m output] -> TestTree m input
test n f = TestTree n $ TestCase f test n f = TestTree (TestName n) $ TestCase f
{- | This is `test` without the `NFData` constraint. {- | This is `test` without the `NFData` constraint.
It doesn't force the output before completion, which means that reported timings may be less accurate. It doesn't force the output before completion, which means that reported timings may be less accurate.
-} -}
testLazy :: TestName -> (input -> Test m output) -> [TestTree m output] -> TestTree m input testLazy :: Text -> (input -> Test m output) -> [TestTree m output] -> TestTree m input
testLazy n f = TestTree n $ TestCaseLazy f testLazy n f = TestTree (TestName n) $ TestCaseLazy f
data TestResult data TestResult
= Pass TestName NominalDiffTime [TestResult] = Pass TestName NominalDiffTime [TestResult]
@ -289,9 +288,6 @@ data TestFailure
newtype TestName = TestName Text newtype TestName = TestName Text
deriving newtype (IsString, Show) deriving newtype (IsString, Show)
mkTestName :: Text -> TestName
mkTestName = TestName
getTestTree :: TestTree m r -> Tree TestName getTestTree :: TestTree m r -> Tree TestName
getTestTree (TestTree name _ ts) = Node name $ map getTestTree ts getTestTree (TestTree name _ ts) = Node name $ map getTestTree ts

2
haskell/Puzzles/Day4.hs
View File

@ -41,7 +41,7 @@ puzzle =
in map in map
( \n -> ( \n ->
test test
(mkTestName $ T.show n) (T.show n)
( \frames -> do ( \frames -> do
g <- lookupFrame n frames g <- lookupFrame n frames
golden (path <> "frames/" <> show n) $ drawGrid g golden (path <> "frames/" <> show n) $ drawGrid g