packages feed

sensei-0.8.0: test/TriggerSpec.hs

{-# LANGUAGE CPP #-}
module TriggerSpec (spec) where

import           Helper

import qualified Session
import           Session (Session)
import           Language.Haskell.GhciWrapper (Config(..))

import           Trigger hiding (trigger, triggerAll)
import qualified Trigger

normalize :: String -> [String]
normalize = normalizeTiming . lines
  where
    normalizeTiming :: [String] -> [String]
    normalizeTiming = normalizeLine "Finished in "

    normalizeLine :: String -> [String] -> [String]
    normalizeLine message = map f
      where
        f line
          | message `isPrefixOf` line = message ++ "..."
          | otherwise = line

withSession :: FilePath -> [String] -> (Session -> IO a) -> IO a
withSession specPath args = do
  Session.withSession ghciConfig {configWorkingDirectory = Just dir} $
      "-fhide-source-paths"
    : "-fno-diagnostics-show-caret"
    : "-fdiagnostics-color=never"
    : file
    : args
    ++ ["--no-color", "--seed=0"]
  where
    (dir, file) = splitFileName specPath

trigger :: Session -> IO (Result, [String])
trigger session = triggerWithHooks session defaultHooks

triggerWithHooks :: Session -> Hooks -> IO (Result, [String])
triggerWithHooks session hooks = fmap normalize <$> Trigger.trigger session hooks

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)

withHooks :: (Hooks -> IO ()) -> IO [HookExecuted]
withHooks action = withSpy $ \ spy -> action defaultHooks {
  beforeReload = spy BeforeReloadSucceeded >> return HookSuccess
, afterReload = spy AfterReloadSucceeded >> return HookSuccess
}

failingHook :: Hook
failingHook = return $ HookFailure "hook failed"

spec :: Spec
spec = do
  describe "reloadedSuccessfully" $ do
    context "with GHC < 8.2.1" $ do
      it "detects success" $ do
        reloadedSuccessfully "Ok, modules loaded: Spec." `shouldBe` True

    context "with GHC >= 8.2.1" $ do
      context "with a single module" $ do
        it "detects success" $ do
          reloadedSuccessfully "Ok, 1 module loaded." `shouldBe` True

      context "with multiple modules" $ do
        it "detects success" $ do
          reloadedSuccessfully "Ok, 5 modules loaded." `shouldBe` True

    context "with GHC >= 8.2.2" $ do
      context "with a single module" $ do
        it "detects success" $ do
          reloadedSuccessfully "Ok, one module loaded." `shouldBe` True

      context "with multiple modules" $ do
        it "detects success" $ do
          reloadedSuccessfully "Ok, four modules loaded." `shouldBe` True

  describe "removeProgress" $ do
    it "removes transient output" $ do
      (removeProgress . unlines) [
          "foo"
        , "some progress output...\r                       \rbar"
        , "baz"
        ] `shouldBe` unlines [
          "foo"
        , "bar"
        , "baz"
        ]

  describe "triggerAll" $ do
    it "runs all specs" $ do
      withSomeSpec $ \ name -> do
        withSession name [] $ \ session -> do
          writeFile name failingSpec
          (trigger session >> triggerAll session) `shouldReturn` (Failure, [
              modulesLoaded Ok ["Spec"]
            , withColor Green "RELOADING SUCCEEDED"
            , ""
            , "foo [✔]"
            , "bar [✘]"
            , ""
            , "Failures:"
            , ""
            , "  Spec.hs:8:3: "
            , "  1) bar"
            , ""
            , "  To rerun use: --match \"/bar/\" --seed 0"
            , ""
            , "Randomized with seed 0"
            , ""
            , "Finished in ..."
            , "2 examples, 1 failure"
            , "Summary {summaryExamples = 2, summaryFailures = 1}"
            ])

  describe "trigger" $ around withSomeSpec $ do
    it "reloads and runs specs" $ \ name -> do
      withSession name [] $ \ session -> do
        trigger session `shouldReturn` (Success, [
            modulesLoaded Ok ["Spec"]
          , withColor Green "RELOADING SUCCEEDED"
          , ""
          , "foo [✔]"
          , "bar [✔]"
          , ""
          , "Finished in ..."
          , "2 examples, 0 failures"
          , "Summary {summaryExamples = 2, summaryFailures = 0}"
          ])

    context "with hooks" $ do
      it "executes hooks" $ \ name -> do
        withHooks $ \ hooks -> do
          withSession name [] $ \ session -> do
            triggerWithHooks session hooks `shouldReturn` (Success, [
                modulesLoaded Ok ["Spec"]
              , withColor Green "RELOADING SUCCEEDED"
              , ""
              , "foo [✔]"
              , "bar [✔]"
              , ""
              , "Finished in ..."
              , "2 examples, 0 failures"
              , "Summary {summaryExamples = 2, summaryFailures = 0}"
              ])
        `shouldReturn` [BeforeReloadSucceeded, AfterReloadSucceeded]

      context "when the before-reload hook fails" $ do
        it "cancels the reload cycle" $ \ name -> do
          withHooks $ \ hooks -> do
            withSession name [] $ \ session -> do
              triggerWithHooks session hooks { beforeReload = failingHook } `shouldReturn` (HookFailed, [
                  "hook failed"
                ])
          `shouldReturn` []

      context "when the after-reload hook fails" $ do
        it "cancels the reload cycle" $ \ name -> do
          withHooks $ \ hooks -> do
            withSession name [] $ \ session -> do
              triggerWithHooks session hooks { afterReload = failingHook } `shouldReturn` (HookFailed, [
                  modulesLoaded Ok ["Spec"]
                , withColor Green "RELOADING SUCCEEDED"
                , "hook failed"
                ])
          `shouldReturn` [BeforeReloadSucceeded]

    context "with a module that does not compile" $ do
      it "stops after reloading" $ \ name -> do
        withSession name [] $ \ session -> do
          writeFile name (passingSpec ++ "foo = bar")
          (trigger session >> trigger session) `shouldReturn` (Failure, [
              "[1 of 1] Compiling Spec"
            , ""
#if __GLASGOW_HASKELL__ >= 906
            , "Spec.hs:9:7: error: [GHC-88464] Variable not in scope: bar"
#else
            , "Spec.hs:9:7: error: Variable not in scope: bar"
#endif
            , modulesLoaded Failed []
            , withColor Red "RELOADING FAILED"
            ])

    context "with a failing spec" $ do
      it "indicates failure" $ \ name -> do
        withSession name [] $ \ session -> do
          writeFile name failingSpec
          (Failure, xs) <- trigger session
          xs `shouldContain` [modulesLoaded Ok ["Spec"]]
          xs `shouldContain` ["2 examples, 1 failure"]

      it "only reruns failing specs" $ \ name -> do
        withSession name [] $ \ session -> do
          writeFile name failingSpec
          (trigger session >> trigger session) `shouldReturn` (Failure, [
              modulesLoaded Ok ["Spec"]
            , withColor Green "RELOADING SUCCEEDED"
            , ""
            , "bar [✘]"
            , ""
            , "Failures:"
            , ""
            , "  Spec.hs:8:3: "
            , "  1) bar"
            , ""
            , "  To rerun use: --match \"/bar/\" --seed 0"
            , ""
            , "Randomized with seed 0"
            , ""
            , "Finished in ..."
            , "1 example, 1 failure"
            , "Summary {summaryExamples = 1, summaryFailures = 1}"
            ])

    context "after a failing spec passes" $ do
      it "runs all specs" $ \ name -> do
        withSession name [] $ \ session -> do
          writeFile name failingSpec
          _ <- trigger session
          writeFile name passingSpec
          trigger session `shouldReturn` (Success, [
#if __GLASGOW_HASKELL__ < 904
              "[1 of 1] Compiling Spec"
#else
              "[1 of 1] Compiling Spec [Source file changed]"
#endif
            , modulesLoaded Ok ["Spec"]
            , withColor Green "RELOADING SUCCEEDED"
            , ""
            , "bar [✔]"
            , ""
            , "Finished in ..."
            , "1 example, 0 failures"
            , "Summary {summaryExamples = 1, summaryFailures = 0}"
            , ""
            , "foo [✔]"
            , "bar [✔]"
            , ""
            , "Finished in ..."
            , "2 examples, 0 failures"
            , "Summary {summaryExamples = 2, summaryFailures = 0}"
            ])

    context "with a module that does not expose a spec" $ do
      it "only reloads" $ \ name -> do
        withSession name [] $ \ session -> do
          writeFile name "module Foo where"
          (trigger session >> trigger session) `shouldReturn` (Success, [
              modulesLoaded Ok ["Foo"]
            , withColor Green "RELOADING SUCCEEDED"
            ])

    context "with an hspec-meta spec" $ do
      it "reloads and runs spec" $ \ name -> do
        requiresHspecMeta $ withSession name ["-package hspec-meta"] $ \ session -> do
          writeFile name passingMetaSpec
          (trigger session >> trigger session) `shouldReturn` (Success, [
              modulesLoaded Ok ["Spec"]
            , withColor Green "RELOADING SUCCEEDED"
            , ""
            , "foo [✔]"
            , "bar [✔]"
            , ""
            , "Finished in ..."
            , "2 examples, 0 failures"
            , "Summary {summaryExamples = 2, summaryFailures = 0}"
            ])