Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Improve spec performance #145

Merged
merged 1 commit into from
Oct 22, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 1 addition & 4 deletions .github/workflows/build.yml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion src/HTTP.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 3 additions & 0 deletions src/Imports.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
6 changes: 5 additions & 1 deletion src/Language/Haskell/GhciWrapper.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ module Language.Haskell.GhciWrapper (
, reload

#ifdef TEST
, lookupGhc
, extractReloadStatus
, extractNothing
#endif
Expand All @@ -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
Expand Down Expand Up @@ -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

Expand Down
3 changes: 2 additions & 1 deletion test/Language/Haskell/GhciWrapperSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
module Language.Haskell.GhciWrapperSpec (main, spec) where

import Helper
import Util
import qualified Data.ByteString.Char8 as ByteString

import Language.Haskell.GhciWrapper (Config(..), Interpreter(..), ReloadStatus(..), extractNothing)
Expand Down Expand Up @@ -121,7 +122,7 @@ spec = do

context "with -XNoImplicitPrelude" $ do
it "works" $ withInterpreter ["-XNoImplicitPrelude"] $ \ ghci -> do
Interpreter.eval ghci "putStrLn \"foo\"" >>= (`shouldContain` "Variable not in scope: putStrLn")
normalizeTypeSignatures <$> Interpreter.eval ghci "putStrLn \"foo\"" >>= (`shouldContain` "Variable not in scope: putStrLn")
Interpreter.eval ghci "23" `shouldReturn` "23\n"

describe "reload" do
Expand Down
24 changes: 22 additions & 2 deletions test/SpecHook.hs
Original file line number Diff line number Diff line change
@@ -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
14 changes: 1 addition & 13 deletions test/TriggerSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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"
Expand Down
Loading