Merge pull request #8763 from haskell/Show-TestEnv

cabal-testsuite: new `instance Show TestEnv`
haskell · Feb 22, 2023 · e48386c · e48386c
2 parents 90a2f33 + 6885fa7
commit e48386c
Show file tree

Hide file tree

Showing 4 changed files with 8 additions and 9 deletions.
diff --git a/cabal-testsuite/src/Test/Cabal/Monad.hs b/cabal-testsuite/src/Test/Cabal/Monad.hs
@@ -336,7 +336,6 @@ runTestM mode m = withSystemTempDirectory "cabal-testsuite" $ \tmp_dir -> do
                     testPlan = Nothing,
                     testRecordDefaultMode = DoNotRecord,
                     testRecordUserMode = Nothing,
-                    testRecordNormalizer = id,
                     testSourceCopyRelativeDir = "source"
                 }
     let go = do cleanup
@@ -527,12 +526,11 @@ data TestEnv = TestEnv
     , testRecordDefaultMode :: RecordMode
     -- | User explicitly set record mode.  Not implemented ATM.
     , testRecordUserMode :: Maybe RecordMode
-    -- | Function to normalize recorded output
-    , testRecordNormalizer :: String -> String
     -- | Name of the subdirectory we copied the test's sources to,
     -- relative to 'testSourceDir'
     , testSourceCopyRelativeDir :: FilePath
     }
+    deriving Show
 
 testRecordMode :: TestEnv -> RecordMode
 testRecordMode env = fromMaybe (testRecordDefaultMode env) (testRecordUserMode env)

diff --git a/cabal-testsuite/src/Test/Cabal/Plan.hs b/cabal-testsuite/src/Test/Cabal/Plan.hs
@@ -19,23 +19,27 @@ import Control.Monad
 
 -- TODO: index this
 data Plan = Plan { planInstallPlan :: [InstallItem] }
+  deriving Show
 
 data InstallItem
     = APreExisting
     | AConfiguredGlobal ConfiguredGlobal
     | AConfiguredInplace ConfiguredInplace
+  deriving Show
 
 -- local or inplace package
 data ConfiguredInplace = ConfiguredInplace
     { configuredInplaceDistDir       :: FilePath
     , configuredInplaceBuildInfo     :: Maybe FilePath
     , configuredInplacePackageName   :: PackageName
     , configuredInplaceComponentName :: Maybe ComponentName }
+  deriving Show
 
 data ConfiguredGlobal = ConfiguredGlobal
     { configuredGlobalBinFile       :: Maybe FilePath
     , configuredGlobalPackageName   :: PackageName
     , configuredGlobalComponentName :: Maybe ComponentName }
+  deriving Show
 
 instance FromJSON Plan where
     parseJSON (Object v) = fmap Plan (v .: "install-plan")

diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs
@@ -679,7 +679,7 @@ recordHeader args = do
     env <- getTestEnv
     let mode = testRecordMode env
         str_header = "# " ++ intercalate " " args ++ "\n"
-        header = C.pack (testRecordNormalizer env str_header)
+        header = C.pack str_header
     case mode of
         DoNotRecord -> return ()
         _ -> do
@@ -696,7 +696,7 @@ recordLog res = do
     liftIO $ C.appendFile (testWorkDir env </> "test.log")
                          (C.pack $ "+ " ++ resultCommand res ++ "\n"
                             ++ resultOutput res ++ "\n\n")
-    liftIO . C.appendFile (testActualFile env) . C.pack . testRecordNormalizer env $
+    liftIO . C.appendFile (testActualFile env) . C.pack $
         case mode of
             RecordAll    -> unlines (lines (resultOutput res))
             RecordMarked -> getMarkedOutput (resultOutput res)
@@ -787,10 +787,6 @@ recordMode mode = withReaderT (\env -> env {
     testRecordUserMode = Just mode
     })
 
-recordNormalizer :: (String -> String) -> TestM a -> TestM a
-recordNormalizer f =
-    withReaderT (\env -> env { testRecordNormalizer = testRecordNormalizer env . f })
-
 assertOutputContains :: MonadIO m => WithCallStack (String -> Result -> m ())
 assertOutputContains needle result =
     withFrozenCallStack $

diff --git a/cabal-testsuite/src/Test/Cabal/Script.hs b/cabal-testsuite/src/Test/Cabal/Script.hs
@@ -37,6 +37,7 @@ data ScriptEnv = ScriptEnv
         , runnerPackages        :: [(OpenUnitId, ModuleRenaming)]
         , runnerWithSharedLib   :: Bool
         }
+    deriving Show
 
 {-
-Original file line number
+Diff line change
@@ Expand Up / @@ -37,6 +37,7 @@ data ScriptEnv = ScriptEnv @@
             , runnerPackages        :: [(OpenUnitId, ModuleRenaming)]
             , runnerWithSharedLib   :: Bool
             }
+        deriving Show
     {-
@@ Expand Down @@