Do not print known callstacks

- For known exceptions (i.e. TextException), do not print callstack.
  This also fixes a test bug where GHC 9.8 and 10 had different
  outputs (latter had callstacks).

- Improve functional tests so that chart tests use the CLI, like
  everything else.

backend/app/Main.hs

@@ -3,15 +3,11 @@
 -- @since 0.1
 module Main (main) where
 
-import GHC.Conc.Sync (setUncaughtExceptionHandler)
 import Pacer.Driver (runApp)
-import Pacer.Prelude hiding (IO)
 import System.IO (IO)
 
 -- | Executable entry-point.
 --
 -- @since 0.1
 main :: IO ()
-main = do
-  setUncaughtExceptionHandler (putStrLn . displayException)
-  runApp
+main = runApp

backend/pacer.cabal

@@ -142,6 +142,8 @@ test-suite functional
 
   build-depends:
     , base
+    , directory
+    , env-guard       ^>=0.2
     , fs-utils
     , hedgehog
     , pacer

backend/src/Pacer/Chart.hs

@@ -25,6 +25,7 @@ import Data.Aeson.Encode.Pretty
     Indent (Spaces),
   )
 import Data.Aeson.Encode.Pretty qualified as AsnPretty
+import FileSystem.OsPath (decodeLenient)
 import Pacer.Chart.Data.Chart (Chart)
 import Pacer.Chart.Data.Chart qualified as Chart
 import Pacer.Chart.Data.ChartRequest (ChartRequests)
@@ -132,7 +133,18 @@ createChartSeq runsPath chartRequestsPath = do
           ]
   where
     readDecodeToml :: forall a. (DecodeTOML a) => OsPath -> IO a
-    readDecodeToml = failMapLeft displayException . decode <=< readFileUtf8
+    readDecodeToml path = do
+      contents <- readFileUtf8 path
+      case decode contents of
+        Right t -> pure t
+        Left err ->
+          throwText
+            $ mconcat
+              [ "Error decoding toml file '",
+                packText $ decodeLenient path,
+                "': ",
+                displayExceptiont err
+              ]
 
 -- | Advances the ChartParams phase, filling in missing values with defaults.
 advancePhase :: ChartParamsArgs -> ChartParamsFinal

backend/src/Pacer/Driver.hs

@@ -5,6 +5,9 @@ module Pacer.Driver
   )
 where
 
+import Control.Exception.Annotation.Utils
+  ( setUncaughtExceptionDisplayInnerMatch,
+  )
 import FileSystem.OsPath qualified as OsPath
 import Options.Applicative qualified as OA
 import Pacer.Chart (ChartParamsArgs)
@@ -33,6 +36,11 @@ runApp = runAppWith (putStrLn . unpackText)
 
 runAppWith :: (Text -> IO a) -> IO a
 runAppWith handler = do
+  -- TODO: We should make this more precise at some point.
+  setUncaughtExceptionDisplayInnerMatch
+    knownExceptions
+    putStrLn
+
   args <- OA.execParser parserInfo
   case args.command of
     Chart chartArgs -> handleChart handler chartArgs

backend/src/Pacer/Prelude.hs

@@ -43,8 +43,10 @@ module Pacer.Prelude
 
 #endif
 
-    -- * Exception
+    -- * Exceptions
     displayExceptiont,
+    displayInnerMatchKnown,
+    knownExceptions,
 
     -- * Numeric
 
@@ -89,6 +91,8 @@ import Control.Exception as X
     throwIO,
     try,
   )
+import Control.Exception.Annotation.Utils (ExceptionProxy (MkExceptionProxy))
+import Control.Exception.Annotation.Utils qualified as Ex.Ann.Utils
 import Control.Exception.Utils as X (TextException, throwText, trySync)
 import Control.Monad as X
   ( Monad ((>>=)),
@@ -379,3 +383,13 @@ pattern SetToSeqNE x <- (NESeq.fromList . NESet.toList -> x)
     SetToSeqNE x = NESet.fromList (toNonEmpty x)
 
 {-# COMPLETE SetToSeqNE #-}
+
+-- | This and knownExceptions will probably need to be moved to e.g.
+-- Pacer.Exception, when we actually make our own.
+displayInnerMatchKnown :: (Exception e) => e -> String
+displayInnerMatchKnown = Ex.Ann.Utils.displayInnerMatch knownExceptions
+
+knownExceptions :: List ExceptionProxy
+knownExceptions =
+  [ MkExceptionProxy @TextException Proxy
+  ]

backend/test/functional/Functional/Chart.hs

@@ -2,48 +2,54 @@
 
 module Functional.Chart (tests) where
 
+import FileSystem.OsPath (unsafeDecode)
 import Functional.Prelude
-import Pacer.Chart qualified as Chart
 
-tests :: TestTree
-tests =
+tests :: IO OsPath -> TestTree
+tests getTestDir =
   testGroup
     "Pacer.Chart"
-    [ testExampleChart,
-      testSimple,
-      testFilter,
-      testFilterEmptyError,
-      testDuplicateDateError
+    [ testExampleChart getTestDir,
+      testSimple getTestDir,
+      testFilter getTestDir,
+      testFilterEmptyError getTestDir,
+      testDuplicateDateError getTestDir
     ]
 
-testExampleChart :: TestTree
-testExampleChart = testGoldenParams params
+testExampleChart :: IO OsPath -> TestTree
+testExampleChart getTestDir = testGoldenParams getTestDir params
   where
     params =
       MkGoldenParams
-        { testDesc = "Generates example",
+        { mkArgs = \testDir ->
+            [ "chart",
+              "--runs",
+              runsPath,
+              "--chart-requests",
+              chartRequestsPath,
+              "--json",
+              unsafeDecode (mkJsonPath testDir)
+            ],
+          testDesc = "Generates example",
           testName = [osp|testExampleChart|],
-          runner =
-            toStrictByteString
-              <$> Chart.createChartsJsonBS
-                (Just runsPath)
-                (Just chartRequestsPath)
+          resultToBytes = \path _ -> readBinaryFileIO . mkJsonPath $ path
         }
-    runsPath = [osp|data/input/example/runs.toml|]
-    chartRequestsPath = [osp|data/input/example/chart-requests.toml|]
+    runsPath = unsafeDecode [osp|data/input/example/runs.toml|]
+    chartRequestsPath = unsafeDecode [osp|data/input/example/chart-requests.toml|]
+    mkJsonPath testDir = testDir </> [ospPathSep|testExampleChart_charts.json|]
 
-testSimple :: TestTree
+testSimple :: IO OsPath -> TestTree
 testSimple = testChart "Simple example" [osp|testSimple|]
 
-testFilter :: TestTree
+testFilter :: IO OsPath -> TestTree
 testFilter = testChart "Filter example" [osp|testFilter|]
 
-testFilterEmptyError :: TestTree
+testFilterEmptyError :: IO OsPath -> TestTree
 testFilterEmptyError = testChart desc [osp|testFilterEmptyError|]
   where
     desc = "Filter empty error"
 
-testDuplicateDateError :: TestTree
+testDuplicateDateError :: IO OsPath -> TestTree
 testDuplicateDateError = testChart desc [osp|testDuplicateDateError|]
   where
     desc = "Duplicate date error"

backend/test/functional/Functional/Prelude.hs

@@ -20,6 +20,7 @@ module Functional.Prelude
 where
 
 import Data.Word (Word8)
+import FileSystem.OsPath (unsafeDecode)
 import FileSystem.OsPath qualified as FS.OsPath
 import Hedgehog as X
   ( Gen,
@@ -37,7 +38,6 @@ import Hedgehog as X
     (/==),
     (===),
   )
-import Pacer.Chart qualified as Chart
 import Pacer.Driver (runAppWith)
 import Pacer.Prelude as X hiding (IO)
 import System.Environment (withArgs)
@@ -96,10 +96,18 @@ runException desc expected args = testCase desc $ do
     Right r -> assertFailure $ unpackText $ "Expected exception, received: " <> r
     Left ex -> expected @=? displayExceptiont ex
 
+-- | Parameters for golden tests.
 data GoldenParams = MkGoldenParams
-  { testDesc :: TestName,
+  { -- | Functions to make the CLI arguments. The parameter is the tmp test
+    -- directory.
+    mkArgs :: OsPath -> List String,
+    -- | Test string description.
+    testDesc :: TestName,
+    -- | Test function name, for creating unique file paths.
     testName :: OsPath,
-    runner :: IO ByteString
+    -- | Function that creates the bytes to be written to the golden file.
+    -- The inputs are the tmp test directory, and the CLI's stdout.
+    resultToBytes :: OsPath -> Text -> IO ByteString
   }
 
 -- | Given a text description and testName OsPath, creates a golden test.
@@ -120,36 +128,53 @@ data GoldenParams = MkGoldenParams
 -- @
 --
 -- testFoo is the 'test name'.
-testChart :: TestName -> OsPath -> TestTree
-testChart desc testName = testGoldenParams params
+testChart :: TestName -> OsPath -> IO OsPath -> TestTree
+testChart testDesc testName getTestDir = testGoldenParams getTestDir params
   where
     params =
       MkGoldenParams
-        { testDesc = desc,
+        { mkArgs = \testDir ->
+            [ "chart",
+              "--runs",
+              runsPath,
+              "--chart-requests",
+              chartRequestsPath,
+              "--json",
+              unsafeDecode (mkJsonPath testDir)
+            ],
+          testDesc,
           testName,
-          runner =
-            toStrictByteString
-              <$> Chart.createChartsJsonBS
-                (Just runsPath)
-                (Just chartRequestsPath)
+          -- NOTE: It would be nice to test the txt output here i.e. the
+          -- second arg. Alas, it includes the path of the output json file,
+          -- which is non-deterministic, as it includes the tmp dir.
+          --
+          -- Thus for now we ignore it, since the json output is the main
+          -- part we care about.
+          resultToBytes = \path _ -> readBinaryFileIO . mkJsonPath $ path
         }
+
     basePath = [ospPathSep|test/functional/data|]
-    chartRequestsPath = basePath </> testName <> [osp|_chart-requests.toml|]
-    runsPath = basePath </> testName <> [osp|_runs.toml|]
+    chartRequestsPath = unsafeDecode $ basePath </> testName <> [osp|_chart-requests.toml|]
+    runsPath = unsafeDecode $ basePath </> testName <> [osp|_runs.toml|]
+    mkJsonPath testDir = testDir </> testName <> [ospPathSep|_charts.json|]
 
-testGoldenParams :: GoldenParams -> TestTree
-testGoldenParams goldenParams =
+testGoldenParams :: IO OsPath -> GoldenParams -> TestTree
+testGoldenParams getTestDir goldenParams = do
   goldenVsFile goldenParams.testDesc goldenPath actualPath $ do
-    trySync goldenParams.runner >>= \case
+    testDir <- getTestDir
+    let args = goldenParams.mkArgs testDir
+    trySync (withArgs args $ runAppWith pure) >>= \case
       Left err -> writeActualFile $ exToBs err
-      Right bs -> writeActualFile bs
+      Right txt -> do
+        bs <- goldenParams.resultToBytes testDir txt
+        writeActualFile bs
   where
     outputPathStart =
       FS.OsPath.unsafeDecode
         $ [ospPathSep|test/functional/goldens|]
         </> goldenParams.testName
 
-    exToBs = encodeUtf8 . displayExceptiont
+    exToBs = encodeUtf8 . packText . displayInnerMatchKnown
 
     writeActualFile :: ByteString -> IO ()
     writeActualFile =

backend/test/functional/Main.hs

@@ -1,21 +1,55 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE QuasiQuotes #-}
 
 module Main (main) where
 
+import FileSystem.OsPath (decodeLenient)
 import Functional.Chart qualified
 import Functional.Derive qualified
 import Functional.Prelude
 import Functional.Scale qualified
-import Test.Tasty (defaultMain, localOption)
+import System.Directory.OsPath qualified as Dir
+import System.Environment.Guard
+import Test.Tasty (defaultMain, localOption, withResource)
 import Test.Tasty.Golden (DeleteOutputFile (OnPass))
 
 main :: IO ()
 main =
   defaultMain
     $ localOption OnPass
-    $ testGroup
-      "Functional"
-      [ Functional.Chart.tests,
-        Functional.Derive.tests,
-        Functional.Scale.tests
-      ]
+    $ withResource setup teardown
+    $ \getTestDir ->
+      testGroup
+        "Functional"
+        [ Functional.Chart.tests getTestDir,
+          Functional.Derive.tests,
+          Functional.Scale.tests
+        ]
+
+setup :: IO OsPath
+setup = do
+  rootTmpDir <- (</> [osp|pacer|]) <$> Dir.getTemporaryDirectory
+  let tmpDir = rootTmpDir </> tmpName
+
+  -- Make sure we delete any leftover files from a previous run, so tests
+  -- have a clean environment.
+  dirExists <- Dir.doesDirectoryExist tmpDir
+  when dirExists (Dir.removeDirectoryRecursive tmpDir)
+
+  Dir.createDirectoryIfMissing True tmpDir
+  pure tmpDir
+  where
+    tmpName = [osp|test|] </> [osp|functional|]
+
+teardown :: OsPath -> IO ()
+teardown tmpDir = guardOrElse' "NO_CLEANUP" ExpectEnvSet doNothing cleanup
+  where
+    cleanup = do
+      dirExists <- Dir.doesDirectoryExist tmpDir
+      when dirExists (Dir.removeDirectoryRecursive tmpDir)
+
+    doNothing =
+      putStrLn
+        $ "*** Not cleaning up tmp dir: '"
+        <> decodeLenient tmpDir
+        <> "'"

backend/test/functional/goldens/testDuplicateDateError.golden

@@ -1,3 +1,3 @@
-user error (Decode error at '': Found overlapping timestamps
+Error decoding toml file 'test/functional/data/testDuplicateDateError_runs.toml': Decode error at '': Found overlapping timestamps
  - <no title>: 2024-10-20T14:30:00
- - A 5k: 2024-10-20)
+ - A 5k: 2024-10-20