From feac804d19e355c4d3bbf89a2ecff8f4fe03f971 Mon Sep 17 00:00:00 2001
From: Simon Hengel <sol@typeful.net>
Date: Wed, 23 Oct 2024 05:45:55 +0700
Subject: [PATCH] Improve spec performance

---
 .github/workflows/build.yml         |  5 +----
 src/HTTP.hs                         |  2 +-
 src/Imports.hs                      |  3 +++
 src/Language/Haskell/GhciWrapper.hs |  6 +++++-
 test/SpecHook.hs                    | 24 ++++++++++++++++++++++--
 test/TriggerSpec.hs                 | 14 +-------------
 6 files changed, 33 insertions(+), 21 deletions(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 5c150dbc..963fbdfa 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -54,10 +54,7 @@ jobs:
         run: cabal build all
 
       - shell: bash
-        run: echo | cabal repl sensei --build-depends hspec-meta
-
-      - shell: bash
-        run: cabal exec -- $(cabal list-bin spec) --times --print-slow
+        run: $(cabal list-bin spec) --times --print-slow
         env:
           HSPEC_OPTIONS: --color
 
diff --git a/src/HTTP.hs b/src/HTTP.hs
index 333e0832..9d578816 100644
--- a/src/HTTP.hs
+++ b/src/HTTP.hs
@@ -11,7 +11,7 @@ module HTTP (
 #endif
 ) where
 
-import           Imports hiding (encodeUtf8)
+import           Imports hiding (strip, encodeUtf8)
 
 import           System.Directory
 import qualified Data.ByteString.Lazy as L
diff --git a/src/Imports.hs b/src/Imports.hs
index afbeb70d..a8ffb5ee 100644
--- a/src/Imports.hs
+++ b/src/Imports.hs
@@ -55,3 +55,6 @@ encodeUtf8 = T.encodeUtf8 . T.pack
 
 decodeUtf8 :: ByteString -> String
 decodeUtf8 = T.unpack . T.decodeUtf8
+
+strip :: String -> String
+strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace
diff --git a/src/Language/Haskell/GhciWrapper.hs b/src/Language/Haskell/GhciWrapper.hs
index 64e92f27..addeae66 100644
--- a/src/Language/Haskell/GhciWrapper.hs
+++ b/src/Language/Haskell/GhciWrapper.hs
@@ -14,6 +14,7 @@ module Language.Haskell.GhciWrapper (
 , reload
 
 #ifdef TEST
+, lookupGhc
 , extractReloadStatus
 , extractNothing
 #endif
@@ -32,6 +33,9 @@ import           Util (isWritableByOthers)
 import qualified ReadHandle
 import           ReadHandle (ReadHandle, toReadHandle, Extract(..), partialMessageStartsWithOneOf)
 
+lookupGhc :: [(String, String)] -> FilePath
+lookupGhc = fromMaybe "ghc" . lookup "SENSEI_GHC"
+
 data Config = Config {
   configIgnoreDotGhci :: Bool
 , configWorkingDirectory :: Maybe FilePath
@@ -90,7 +94,7 @@ new startupFile Config{..} envDefaults args_ = do
       ] ++ mandatoryArgs
 
     ghc :: String
-    ghc = fromMaybe "ghc" $ lookup "SENSEI_GHC" env
+    ghc = lookupGhc env
 
   (stdoutReadEnd, stdoutWriteEnd) <- createPipe
 
diff --git a/test/SpecHook.hs b/test/SpecHook.hs
index cfb1f0da..7874fce2 100644
--- a/test/SpecHook.hs
+++ b/test/SpecHook.hs
@@ -1,7 +1,27 @@
 module SpecHook where
 
-import           Test.Hspec
+import           Helper
+import           System.Environment
 import           GHC.Conc
 
+import           Language.Haskell.GhciWrapper (lookupGhc)
+
+installPackageEnvironment :: FilePath -> FilePath -> IO ()
+installPackageEnvironment ghc file = callProcess "cabal" ["install", "-v0", "-w", ghc, "-z", "--lib", "hspec", "hspec-meta", "--package-env", file]
+
+ensurePackageEnvironment :: FilePath -> FilePath -> IO ()
+ensurePackageEnvironment ghc file = doesFileExist file >>= \ case
+  False -> installPackageEnvironment ghc file
+  True -> pass
+
+setPackageEnvironment :: IO ()
+setPackageEnvironment = do
+  dir <- getCurrentDirectory
+  ghc <- lookupGhc <$> getEnvironment
+  ghcVersion <- strip <$> readProcess ghc ["--numeric-version"] ""
+  let file = dir </> "dist-newstyle" </> "test-env" </> ghcVersion
+  ensurePackageEnvironment ghc file
+  setEnv "GHC_ENVIRONMENT" file
+
 hook :: Spec -> Spec
-hook spec = runIO (getNumProcessors >>= setNumCapabilities) >> parallel spec
+hook spec = runIO (setPackageEnvironment >> getNumProcessors >>= setNumCapabilities) >> parallel spec
diff --git a/test/TriggerSpec.hs b/test/TriggerSpec.hs
index 9be4a195..d953c938 100644
--- a/test/TriggerSpec.hs
+++ b/test/TriggerSpec.hs
@@ -44,18 +44,6 @@ triggerWithHooks session hooks = fmap normalize <$> Trigger.trigger session hook
 triggerAll :: Session -> IO (Result, [String])
 triggerAll session = fmap normalize <$> Trigger.triggerAll session defaultHooks
 
-requiresHspecMeta :: IO () -> IO ()
-requiresHspecMeta action = try action >>= \ case
-  Left (ExitFailure 1) -> expectationFailure $ unlines [
-      "This tests requires `hspec-meta`, which is not available.  To address this run"
-    , ""
-    , "    echo | cabal repl sensei --build-depends hspec-meta"
-    , ""
-    , "once."
-    ]
-  Left err -> throwIO err
-  Right () -> pass
-
 data HookExecuted = BeforeReloadSucceeded | AfterReloadSucceeded
   deriving (Eq, Show)
 
@@ -245,7 +233,7 @@ spec = do
 
     context "with an hspec-meta spec" $ do
       it "reloads and runs spec" $ \ name -> do
-        requiresHspecMeta $ withSession name ["-package hspec-meta"] $ \ session -> do
+        withSession name [] $ \ session -> do
           writeFile name passingMetaSpec
           (trigger session >> trigger session) `shouldReturn` (Success, [
               withColor Green "RELOADING SUCCEEDED"