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

Justify test time to right of terminal

Browse Source
This commit is contained in:
George Thomas 2026-01-06 22:52:43 +00:00
parent 2eecc653b8
commit 98acc016a6
2 changed files with 18 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
haskell/Main.hs
View File

@ -16,11 +16,14 @@ import Puzzles.Day6 qualified as Day6
import Puzzles.Day7 qualified as Day7
import Puzzles.Day8 qualified as Day8
import Puzzles.Day9 qualified as Day9
import System.Console.ANSI (getTerminalSize)
main :: IO ()
main = do
-- terminalWidth <- fmap snd <$> getTerminalSize -- TODO this doesn't work in GHCID or GHCIWatch...
terminalWidth <- pure $ Just 60
putStrLn $ drawTree $ show <$> getTestTree tests
TL.putStrLn . displayTestResultsConsole =<< runTests () tests
TL.putStrLn . displayTestResultsConsole terminalWidth =<< runTests () tests
tests :: TestTree IO ()
tests =

21
haskell/Pre.hs
View File

@ -279,23 +279,23 @@ instance Show SomeExceptionLegalShow where
getTestTree :: TestTree m r -> Tree TestName
getTestTree (TestTree name _ ts) = Node name $ map getTestTree ts
displayTestResultsConsole :: TestResult -> TL.Text
displayTestResultsConsole testResult =
displayTestResultsConsole :: Maybe Int -> TestResult -> TL.Text
displayTestResultsConsole terminalWidth testResult =
displayResult 0 testResult <> TL.pack (setSGRCode [Reset])
where
displayResult indent =
(TL.replicate indent " " <>) . \case
(TL.replicate (fromIntegral indent) " " <>) . \case
Pass (TestName name) dt children ->
TL.fromStrict (header Green '✓' name (Just dt))
TL.fromStrict (header Green '✓' name indent (Just dt))
<> TL.concat (map (displayResult (indent + 1)) children)
Fail (TestName name) (SomeExceptionLegalShow e) ->
TL.fromStrict
( header Red '✗' name Nothing
( header Red '✗' name indent Nothing
<> setColour Vivid Red
)
<> TL.show e
<> "\n"
header colour icon name time =
header colour icon name indent time =
setColour Vivid colour
<> T.singleton icon
<> " "
@ -304,7 +304,14 @@ displayTestResultsConsole testResult =
<> maybe
mempty
( \_t@(showTime -> tt) ->
" "
T.replicate
( fromIntegral $
maybe
3
(\n -> n - (2 * indent + length name + T.length tt + 2))
terminalWidth
)
" "
<> setColour Dull Black
<> tt
)