diff --git a/cabal.project b/cabal.project index 282723f..a4eadbd 100644 --- a/cabal.project +++ b/cabal.project @@ -1,7 +1,7 @@ packages: sensei.cabal -package sensei +program-options ghc-options: -Werror tests: True diff --git a/src/Language/Haskell/GhciWrapper.hs b/src/Language/Haskell/GhciWrapper.hs index 8947df2..5663799 100644 --- a/src/Language/Haskell/GhciWrapper.hs +++ b/src/Language/Haskell/GhciWrapper.hs @@ -1,26 +1,35 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE BlockArguments #-} module Language.Haskell.GhciWrapper ( Config(..) , Interpreter(echo) , withInterpreter , eval + +, Extract(..) , evalVerbose + +, ReloadStatus(..) +, reload + +#ifdef TEST +, extractReloadStatus +, extractNothing +#endif ) where import Imports import qualified Data.ByteString as ByteString -import Data.Text.Encoding (decodeUtf8) -import qualified Data.Text as T import System.IO hiding (stdin, stdout, stderr) import System.IO.Temp (withSystemTempFile) import System.Environment (getEnvironment) import System.Process hiding (createPipe) import System.Exit (exitFailure) -import Util (isWritableByOthers) +import Util (isWritableByOthers, decodeUtf8) import qualified ReadHandle -import ReadHandle (ReadHandle, toReadHandle) +import ReadHandle (ReadHandle, toReadHandle, Extract(..)) data Config = Config { configIgnoreDotGhci :: Bool @@ -123,13 +132,13 @@ new startupFile Config{..} envDefaults args_ = do hSetBuffering h LineBuffering hSetEncoding h utf8 - printStartupMessages :: Interpreter -> IO String - printStartupMessages interpreter = evalVerbose interpreter "" + printStartupMessages :: Interpreter -> IO (String, [ReloadStatus]) + printStartupMessages interpreter = evalVerbose extractReloadStatus interpreter "" close :: Interpreter -> IO () close Interpreter{..} = do hClose hIn - ReadHandle.drain readHandle echo + ReadHandle.drain extractNothing readHandle echo hClose hOut e <- waitForProcess process when (e /= ExitSuccess) $ do @@ -141,14 +150,45 @@ putExpression Interpreter{hIn = stdin} e = do ByteString.hPut stdin ReadHandle.marker hFlush stdin -getResult :: Interpreter -> IO String -getResult Interpreter{..} = T.unpack . decodeUtf8 <$> ReadHandle.getResult readHandle echo +data ReloadStatus = Ok | Failed + deriving (Eq, Show) + +extractReloadStatus :: Extract ReloadStatus +extractReloadStatus = Extract { + isPartialMessage = \ chunk -> or [ + ByteString.isPrefixOf chunk ok + , ByteString.isPrefixOf ok chunk + , ByteString.isPrefixOf chunk failed + , ByteString.isPrefixOf failed chunk + ] + , parseMessage = \ case + line | ByteString.isPrefixOf ok line -> Just (Ok, "") + line | ByteString.isPrefixOf failed line -> Just (Failed, "") + _ -> Nothing + } + where + ok = "Ok, modules loaded: " + failed = "Failed, modules loaded: " + +extractNothing :: Extract () +extractNothing = Extract { + isPartialMessage = const False +, parseMessage = undefined +} + +getResult :: Extract a -> Interpreter -> IO (String, [a]) +getResult extract Interpreter{..} = first decodeUtf8 <$> ReadHandle.getResult extract readHandle echo silent :: ByteString -> IO () silent _ = pass eval :: Interpreter -> String -> IO String -eval ghci = evalVerbose ghci {echo = silent} +eval ghci = fmap fst . evalVerbose extractNothing ghci {echo = silent} + +evalVerbose :: Extract a -> Interpreter -> String -> IO (String, [a]) +evalVerbose extract ghci expr = putExpression ghci expr >> getResult extract ghci -evalVerbose :: Interpreter -> String -> IO String -evalVerbose ghci expr = putExpression ghci expr >> getResult ghci +reload :: Interpreter -> IO (String, ReloadStatus) +reload ghci = evalVerbose extractReloadStatus ghci ":reload" <&> second \ case + [Ok] -> Ok + _ -> Failed diff --git a/src/ReadHandle.hs b/src/ReadHandle.hs index 058a509..a156d31 100644 --- a/src/ReadHandle.hs +++ b/src/ReadHandle.hs @@ -3,9 +3,11 @@ module ReadHandle ( ReadHandle(..) , toReadHandle , marker +, Extract(..) , getResult , drain #ifdef TEST +, breakAfterNewLine , newEmptyBuffer #endif ) where @@ -34,9 +36,9 @@ data ReadHandle = ReadHandle { , buffer :: IORef Buffer } -drain :: ReadHandle -> (ByteString -> IO ()) -> IO () -drain h echo = while (not <$> isEOF h) $ do - _ <- getResult h echo +drain :: Extract a -> ReadHandle -> (ByteString -> IO ()) -> IO () +drain extract h echo = while (not <$> isEOF h) $ do + _ <- getResult extract h echo pass isEOF :: ReadHandle -> IO Bool @@ -73,15 +75,58 @@ toReadHandle h n = do newEmptyBuffer :: IO (IORef Buffer) newEmptyBuffer = newIORef BufferEmpty -getResult :: ReadHandle -> (ByteString -> IO ()) -> IO ByteString -getResult h echo = mconcat <$> go - where - go :: IO [ByteString] - go = nextChunk h >>= \ case - Chunk chunk -> echo chunk >> (chunk :) <$> go +data Extract a = Extract { + isPartialMessage :: ByteString -> Bool +, parseMessage :: ByteString -> Maybe (a, ByteString) +} + +getResult :: Extract a -> ReadHandle -> (ByteString -> IO ()) -> IO (ByteString, [a]) +getResult extract h echo = do + ref <- newIORef [] + + let + startOfLine :: ByteString -> IO [ByteString] + startOfLine chunk + | extract.isPartialMessage chunk = extractMessage chunk + | otherwise = notStartOfLine chunk + + notStartOfLine :: ByteString -> IO [ByteString] + notStartOfLine chunk = case breakAfterNewLine chunk of + Nothing -> echo chunk >> (chunk :) <$> withMoreInput_ notStartOfLine + Just (c, "") -> echo c >> (c :) <$> withMoreInput_ startOfLine + Just (c, xs) -> echo c >> (c :) <$> startOfLine xs + + extractMessage :: ByteString -> IO [ByteString] + extractMessage chunk = case breakAfterNewLine chunk of + Nothing -> withMoreInput chunk startOfLine + Just (pre, suf) -> do + d <- case extract.parseMessage pre of + Nothing -> do + return pre + Just (diagnostic, formatted) -> do + modifyIORef' ref (diagnostic :) + return formatted + echo d >> (d :) <$> startOfLine suf + + withMoreInput_ :: (ByteString -> IO [ByteString]) -> IO [ByteString] + withMoreInput_ action = nextChunk h >>= \ case + Chunk chunk -> action chunk Marker -> return [] EOF -> return [] + withMoreInput :: ByteString -> (ByteString -> IO [ByteString]) -> IO [ByteString] + withMoreInput acc action = nextChunk h >>= \ case + Chunk chunk -> action (acc <> chunk) + Marker -> echo acc >> return [acc] + EOF -> echo acc >> return [acc] + + (,) <$> (mconcat <$> withMoreInput_ startOfLine) <*> readIORef ref + +breakAfterNewLine :: ByteString -> Maybe (ByteString, ByteString) +breakAfterNewLine input = case ByteString.elemIndex '\n' input of + Just n -> Just (ByteString.splitAt (n + 1) input) + Nothing -> Nothing + data Chunk = Chunk ByteString | Marker | EOF nextChunk :: ReadHandle -> IO Chunk diff --git a/src/Session.hs b/src/Session.hs index ce07cb1..25b7632 100644 --- a/src/Session.hs +++ b/src/Session.hs @@ -4,6 +4,8 @@ module Session ( , Session(..) , echo , withSession + +, ReloadStatus(..) , reload , Summary(..) @@ -18,7 +20,7 @@ module Session ( , hasSpec , hasHspecCommandSignature , hspecCommand -, parseSummary +, extractSummary #endif ) where @@ -26,11 +28,14 @@ import Imports import Data.IORef -import Language.Haskell.GhciWrapper +import Language.Haskell.GhciWrapper hiding (reload) +import qualified Language.Haskell.GhciWrapper as Interpreter import Util import Options +import qualified Data.ByteString as ByteString + data Session = Session { interpreter :: Interpreter , hspecArgs :: [String] @@ -57,14 +62,28 @@ withSession config args action = do where (ghciArgs, hspecArgs) = splitArgs args -reload :: MonadIO m => Session -> m String -reload session = liftIO $ evalVerbose session.interpreter ":reload" +reload :: MonadIO m => Session -> m (String, ReloadStatus) +reload session = liftIO $ Interpreter.reload session.interpreter data Summary = Summary { summaryExamples :: Int , summaryFailures :: Int } deriving (Eq, Show, Read) +extractSummary :: Extract Summary +extractSummary = Extract { + isPartialMessage = \ chunk -> or [ + ByteString.isPrefixOf chunk ok + , ByteString.isPrefixOf ok chunk + , ByteString.isPrefixOf chunk ok_ + , ByteString.isPrefixOf ok_ chunk + ] + , parseMessage = fmap (flip (,) "") . parseSummary + } + where + ok = "Summary {" + ok_ = ansiShowCursor <> ok + hspecCommand :: String hspecCommand = "Test.Hspec.Runner.hspecResult spec" @@ -103,8 +122,8 @@ runSpec :: String -> Session -> IO String runSpec command session = do failedPreviously <- isFailure <$> hspecPreviousSummary session let args = "--color" : (if failedPreviously then addRerun else id) session.hspecArgs - r <- evalVerbose session.interpreter $ "System.Environment.withArgs " ++ show args ++ " $ " ++ command - writeIORef session.hspecPreviousSummaryRef (parseSummary r) + (r, summary) <- evalVerbose extractSummary session.interpreter $ "System.Environment.withArgs " ++ show args ++ " $ " ++ command + writeIORef session.hspecPreviousSummaryRef $ listToMaybe summary return r where addRerun :: [String] -> [String] @@ -116,13 +135,8 @@ isFailure = maybe True ((/= 0) . (.summaryFailures)) isSuccess :: Maybe Summary -> Bool isSuccess = not . isFailure -parseSummary :: String -> Maybe Summary -parseSummary = findJust . map (readMaybe . dropAnsiEscapeSequences) . reverse . lines - where - findJust = listToMaybe . catMaybes +parseSummary :: ByteString -> Maybe Summary +parseSummary input = readMaybe . decodeUtf8 . fromMaybe input $ ByteString.stripPrefix ansiShowCursor input - dropAnsiEscapeSequences xs - | "Summary" `isPrefixOf` xs = xs - | otherwise = case xs of - _ : ys -> dropAnsiEscapeSequences ys - [] -> [] +ansiShowCursor :: ByteString +ansiShowCursor = "\ESC[?25h" diff --git a/src/Trigger.hs b/src/Trigger.hs index 4053115..132d602 100644 --- a/src/Trigger.hs +++ b/src/Trigger.hs @@ -25,7 +25,7 @@ import Control.Monad.Except import Util import Config (Hook, HookResult(..)) -import Session (Session, isFailure, isSuccess, hspecPreviousSummary, resetSummary) +import Session (Session, ReloadStatus(..), isFailure, isSuccess, hspecPreviousSummary, resetSummary) import qualified Session data Hooks = Hooks { @@ -47,12 +47,6 @@ triggerAll session hooks = do resetSummary session trigger session hooks -reloadedSuccessfully :: String -> Bool -reloadedSuccessfully = any success . lines - where - success :: String -> Bool - success = isPrefixOf "Ok, modules loaded: " - removeProgress :: String -> String removeProgress xs = case break (== '\r') xs of (_, "") -> xs @@ -71,13 +65,13 @@ trigger session hooks = runWriterT (runExceptT go) >>= \ case go :: Trigger () go = do runHook hooks.beforeReload - output <- Session.reload session + (output, r) <- Session.reload session tell output - case reloadedSuccessfully output of - False -> do + case r of + Failed -> do echo $ withColor Red "RELOADING FAILED" <> "\n" abort - True -> do + Ok -> do echo $ withColor Green "RELOADING SUCCEEDED" <> "\n" runHook hooks.afterReload diff --git a/src/Util.hs b/src/Util.hs index 1c6c3ea..efba6dd 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -4,6 +4,7 @@ module Util ( , withColor , withInfoColor , encodeUtf8 +, decodeUtf8 , isBoring , filterGitIgnoredFiles , normalizeTypeSignatures @@ -37,6 +38,9 @@ withColor c string = set <> string <> reset encodeUtf8 :: String -> ByteString encodeUtf8 = T.encodeUtf8 . T.pack +decodeUtf8 :: ByteString -> String +decodeUtf8 = T.unpack . T.decodeUtf8 + isBoring :: FilePath -> Bool isBoring p = ".git" `elem` dirs || "dist" `elem` dirs || isEmacsAutoSave p where diff --git a/test/Helper.hs b/test/Helper.hs index c287bb4..72d1ca3 100644 --- a/test/Helper.hs +++ b/test/Helper.hs @@ -8,8 +8,6 @@ module Helper ( , passingSpec , passingMetaSpec , failingSpec -, Status(..) -, modulesLoaded , Color(..) , withColor @@ -92,17 +90,3 @@ failingSpec = unlines [ , " it \"foo\" True" , " it \"bar\" False" ] - -data Status = Ok | Failed - deriving (Eq, Show) - -modulesLoaded :: Status -> [String] -> String -modulesLoaded status xs = show status ++ ", modules loaded: " <> mods <> "." - where - mods = case xs of - [] -> "none" - [name] -> formatModule name - _ -> undefined - - formatModule :: String -> String - formatModule name = name <> " (" <> name <> ".o)" diff --git a/test/Language/Haskell/GhciWrapperSpec.hs b/test/Language/Haskell/GhciWrapperSpec.hs index 5947045..0f66928 100644 --- a/test/Language/Haskell/GhciWrapperSpec.hs +++ b/test/Language/Haskell/GhciWrapperSpec.hs @@ -4,7 +4,7 @@ module Language.Haskell.GhciWrapperSpec (main, spec) where import Helper import qualified Data.ByteString.Char8 as ByteString -import Language.Haskell.GhciWrapper (Config(..), Interpreter(..)) +import Language.Haskell.GhciWrapper (Config(..), Interpreter(..), ReloadStatus(..), extractNothing) import qualified Language.Haskell.GhciWrapper as Interpreter main :: IO () @@ -55,7 +55,7 @@ spec = do it "echos result" $ do fmap mconcat . withSpy $ \ spy -> do withInterpreter [] $ \ ghci -> do - Interpreter.evalVerbose ghci {echo = spy} "23" `shouldReturn` "23\n" + Interpreter.evalVerbose extractNothing ghci {echo = spy} "23" `shouldReturn` ("23\n", []) `shouldReturn` "23\n" describe "eval" $ do @@ -116,9 +116,37 @@ spec = do ghci "exitWith $ ExitFailure 10" `shouldReturn` "*** Exception: ExitFailure 10\n" it "gives an error message for identifiers that are not in scope" $ withGhci $ \ ghci -> do - ghci "foo" >>= (`shouldSatisfy` isInfixOf "Variable not in scope: foo") + ghci "foo" >>= (`shouldContain` "Variable not in scope: foo") context "with -XNoImplicitPrelude" $ do it "works" $ withInterpreter ["-XNoImplicitPrelude"] $ \ ghci -> do Interpreter.eval ghci "putStrLn \"foo\"" >>= (`shouldContain` "Variable not in scope: putStrLn") Interpreter.eval ghci "23" `shouldReturn` "23\n" + + describe "reload" $ do + it "reloads" $ do + withTempDirectory $ \ dir -> do + let + name :: FilePath + name = dir "Foo.hs" + + writeFile name $ unlines [ + "module Foo where" + ] + + withInterpreter [name] $ \ ghci -> do + Interpreter.reload ghci `shouldReturn` ("", Ok) + + it "reloads" $ do + withTempDirectory $ \ dir -> do + let + name :: FilePath + name = dir "Foo.hs" + + writeFile name $ unlines [ + "module Foo where" + , "foo = bar" + ] + + withInterpreter [name] $ \ ghci -> do + snd <$> Interpreter.reload ghci `shouldReturn` Failed diff --git a/test/ReadHandleSpec.hs b/test/ReadHandleSpec.hs index ccd5e56..528d984 100644 --- a/test/ReadHandleSpec.hs +++ b/test/ReadHandleSpec.hs @@ -1,11 +1,17 @@ module ReadHandleSpec (spec) where -import Helper +import Prelude hiding (span) +import Helper hiding (span) import Test.QuickCheck import qualified Data.ByteString as ByteString import ReadHandle +import Language.Haskell.GhciWrapper (extractReloadStatus) + +import Session (Summary(..), extractSummary) +import Util (encodeUtf8) + chunkByteString :: (Int, Int) -> ByteString -> Gen [ByteString] chunkByteString size = go where @@ -24,22 +30,29 @@ withRandomChunkSizes :: [ByteString] -> (ReadHandle -> Expectation) -> Property withRandomChunkSizes (mconcat -> input) action = property $ do chunkSizes <- elements [SmallChunks, BigChunks] let + maxChunkSize :: Int maxChunkSize = case chunkSizes of SmallChunks -> 4 BigChunks -> ByteString.length input chunks <- chunkByteString (1, maxChunkSize) input - return $ fakeHandle chunks >>= action + return $ do + counterexample (unlines $ map show chunks) $ do + fakeHandle chunks >>= action partialMarker :: ByteString partialMarker = ByteString.take 5 marker spec :: Spec spec = do + describe "breakAfterNewLine" $ do + it "" $ do + breakAfterNewLine "foo\nbar\nbaz" `shouldBe` Just ("foo\n", "bar\nbaz") + describe "drain" $ do it "drains all remaining input" $ do h <- fakeHandle ["foo", marker, "bar", marker, "baz", marker, ""] - withSpy (drain h) `shouldReturn` ["foo", "bar", "baz"] + withSpy (drain extractReloadStatus h) `shouldReturn` ["foo", "bar", "baz"] describe "getResult" $ do context "with a single result" $ do @@ -48,62 +61,104 @@ spec = do it "returns result" $ do withSpy $ \ echo -> do h <- fakeHandle input - getResult h echo `shouldReturn` "foobarbaz" + getResult extractReloadStatus h echo `shouldReturn` ("foobarbaz", []) `shouldReturn` ["foo", "bar", "baz"] context "with chunks of arbitrary size" $ do it "returns result" $ do withRandomChunkSizes input $ \ h -> do fmap mconcat . withSpy $ \ echo -> do - getResult h echo `shouldReturn` "foobarbaz" + getResult extractReloadStatus h echo `shouldReturn` ("foobarbaz", []) `shouldReturn` "foobarbaz" + context "" $ do + let + summary :: Summary + summary = Summary 5 3 + + + it "" $ do + let + xs :: [ByteString] + xs = [ + "foo\n" + , "bar\n" + , encodeUtf8 $ show summary <> "\n" + , "baz\n" + , marker + ] + + withRandomChunkSizes xs $ \ h -> do + fmap mconcat . withSpy $ \ echo -> do + getResult extractSummary h echo `shouldReturn` ("foo\nbar\nbaz\n", [summary]) + `shouldReturn` "foo\nbar\nbaz\n" + + context "when predicate does not match" $ do + it "does not attempt parsing" $ do + let + extract :: Extract Summary + extract = extractSummary {parseMessage = undefined} + + xs :: [ByteString] + xs = [ + "foo\n" + , "bar\n" + , encodeUtf8 . take 8 $ show summary <> "\n" + , "baz\n" + , marker + ] + + withRandomChunkSizes xs $ \ h -> do + fmap mconcat . withSpy $ \ echo -> do + getResult extract h echo `shouldReturn` ("foo\nbar\nSummary baz\n", []) + `shouldReturn` "foo\nbar\nSummary baz\n" + context "with multiple results" $ do let input = ["foo", marker, "bar", marker, "baz", marker] it "returns one result at a time" $ do withSpy $ \ echo -> do h <- fakeHandle input - getResult h echo `shouldReturn` "foo" - getResult h echo `shouldReturn` "bar" - getResult h echo `shouldReturn` "baz" + getResult extractReloadStatus h echo `shouldReturn` ("foo", []) + getResult extractReloadStatus h echo `shouldReturn` ("bar", []) + getResult extractReloadStatus h echo `shouldReturn` ("baz", []) `shouldReturn` ["foo", "bar", "baz"] context "with chunks of arbitrary size" $ do it "returns one result at a time" $ do withRandomChunkSizes input $ \ h -> do fmap mconcat . withSpy $ \ echo -> do - getResult h echo `shouldReturn` "foo" - getResult h echo `shouldReturn` "bar" - getResult h echo `shouldReturn` "baz" + getResult extractReloadStatus h echo `shouldReturn` ("foo", []) + getResult extractReloadStatus h echo `shouldReturn` ("bar", []) + getResult extractReloadStatus h echo `shouldReturn` ("baz", []) `shouldReturn` "foobarbaz" context "when a chunk that contains a marker ends with a partial marker" $ do it "correctly gives the marker precedence over the partial marker" $ do withSpy $ \ echo -> do h <- fakeHandle ["foo" <> marker <> "bar" <> partialMarker, ""] - getResult h echo `shouldReturn` "foo" - getResult h echo `shouldReturn` ("bar" <> partialMarker) + getResult extractReloadStatus h echo `shouldReturn` ("foo", []) + getResult extractReloadStatus h echo `shouldReturn` ("bar" <> partialMarker, []) `shouldReturn` ["foo", "bar", partialMarker] context "on EOF" $ do it "returns all remaining input" $ do withSpy $ \ echo -> do h <- fakeHandle ["foo", "bar", "baz", ""] - getResult h echo `shouldReturn` "foobarbaz" + getResult extractReloadStatus h echo `shouldReturn` ("foobarbaz", []) `shouldReturn` ["foo", "bar", "baz"] context "with a partialMarker at the end" $ do it "includes the partial marker in the output" $ do withSpy $ \ echo -> do h <- fakeHandle ["foo", "bar", "baz", partialMarker, ""] - getResult h echo `shouldReturn` ("foobarbaz" <> partialMarker) + getResult extractReloadStatus h echo `shouldReturn` ("foobarbaz" <> partialMarker, []) `shouldReturn` ["foo", "bar", "baz", partialMarker] context "after a marker" $ do it "returns all remaining input" $ do withSpy $ \ echo -> do h <- fakeHandle ["foo", "bar", "baz", marker, "qux", ""] - getResult h echo `shouldReturn` "foobarbaz" - getResult h echo `shouldReturn` "qux" + getResult extractReloadStatus h echo `shouldReturn` ("foobarbaz", []) + getResult extractReloadStatus h echo `shouldReturn` ("qux", []) `shouldReturn` ["foo", "bar", "baz", "qux"] diff --git a/test/SessionSpec.hs b/test/SessionSpec.hs index 60ca90f..2f0e5d9 100644 --- a/test/SessionSpec.hs +++ b/test/SessionSpec.hs @@ -38,8 +38,8 @@ spec = do describe "reload" $ do it "reloads" $ do - withSession [] $ \session -> do - Session.reload session `shouldReturn` (modulesLoaded Ok [] ++ "\n") + withSession [] $ \ session -> do + Session.reload session `shouldReturn` ("", Ok) describe "hasSpec" $ around withSomeSpec $ do context "when module contains spec" $ do @@ -88,25 +88,3 @@ spec = do withSession [name, "--no-color", "-m", "foo"] $ \session -> do _ <- runSpec session >> runSpec session hspecPreviousSummary session `shouldReturn` Just (Summary 1 0) - - describe "parseSummary" $ do - let summary = Summary 2 0 - - it "parses summary" $ do - Session.parseSummary (show summary) `shouldBe` Just summary - - it "ignores additional output before / after summary" $ do - (Session.parseSummary . unlines) [ - "foo" - , show summary - , "bar" - ] `shouldBe` Just summary - - it "gives last occurrence precedence" $ do - (Session.parseSummary . unlines) [ - show (Summary 3 0) - , show summary - ] `shouldBe` Just summary - - it "ignores additional output at the beginning of a line (to cope with ansi escape sequences)" $ do - Session.parseSummary ("foo " ++ show summary) `shouldBe` Just (Summary 2 0) diff --git a/test/TriggerSpec.hs b/test/TriggerSpec.hs index 1903410..9be4a19 100644 --- a/test/TriggerSpec.hs +++ b/test/TriggerSpec.hs @@ -3,8 +3,6 @@ module TriggerSpec (spec) where import Helper -import qualified Data.Text as Text - import qualified Session import Session (Session) import Language.Haskell.GhciWrapper (Config(..)) @@ -13,7 +11,7 @@ import Trigger hiding (trigger, triggerAll) import qualified Trigger normalize :: String -> [String] -normalize = normalizeTiming . lines . forGhc9dot4 +normalize = normalizeTiming . lines where normalizeTiming :: [String] -> [String] normalizeTiming = normalizeLine "Finished in " @@ -25,9 +23,6 @@ normalize = normalizeTiming . lines . forGhc9dot4 | message `isPrefixOf` line = message ++ "..." | otherwise = line - forGhc9dot4 :: String -> String - forGhc9dot4 = Text.unpack . Text.replace "Ok, modules loaded: Spec." "Ok, modules loaded: Spec (Spec.o)." . Text.pack - withSession :: FilePath -> [String] -> (Session -> IO a) -> IO a withSession specPath args = do Session.withSession ghciConfig {configWorkingDirectory = Just dir} $ @@ -93,8 +88,7 @@ spec = do withSession name [] $ \ session -> do writeFile name failingSpec (trigger session >> triggerAll session) `shouldReturn` (Failure, [ - modulesLoaded Ok ["Spec"] - , withColor Green "RELOADING SUCCEEDED" + withColor Green "RELOADING SUCCEEDED" , "" , "foo [✔]" , "bar [✘]" @@ -108,22 +102,19 @@ spec = do , "" , "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" + withColor Green "RELOADING SUCCEEDED" , "" , "foo [✔]" , "bar [✔]" , "" , "Finished in ..." , "2 examples, 0 failures" - , "Summary {summaryExamples = 2, summaryFailures = 0}" ]) context "with hooks" $ do @@ -131,15 +122,13 @@ spec = do withHooks $ \ hooks -> do withSession name [] $ \ session -> do triggerWithHooks session hooks `shouldReturn` (Success, [ - modulesLoaded Ok ["Spec"] - , withColor Green "RELOADING SUCCEEDED" + withColor Green "RELOADING SUCCEEDED" , "" , "foo [✔]" , "bar [✔]" , "" , "Finished in ..." , "2 examples, 0 failures" - , "Summary {summaryExamples = 2, summaryFailures = 0}" ]) `shouldReturn` [BeforeReloadSucceeded, AfterReloadSucceeded] @@ -157,8 +146,7 @@ spec = do withHooks $ \ hooks -> do withSession name [] $ \ session -> do triggerWithHooks session hooks { afterReload = failingHook } `shouldReturn` (HookFailed, [ - modulesLoaded Ok ["Spec"] - , withColor Green "RELOADING SUCCEEDED" + withColor Green "RELOADING SUCCEEDED" , "hook failed" ]) `shouldReturn` [BeforeReloadSucceeded] @@ -180,7 +168,6 @@ spec = do #if __GLASGOW_HASKELL__ >= 910 , "" #endif - , modulesLoaded Failed [] , withColor Red "RELOADING FAILED" ]) @@ -189,15 +176,29 @@ spec = do withSession name [] $ \ session -> do writeFile name failingSpec (Failure, xs) <- trigger session - xs `shouldContain` [modulesLoaded Ok ["Spec"]] - xs `shouldContain` ["2 examples, 1 failure"] + xs `shouldBe` [ + "[1 of 1] Compiling Spec [Source file changed]" + , withColor Green "RELOADING SUCCEEDED" + , "" + , "foo [✔]" + , "bar [✘]" + , "" + , "Failures:" + , "" + , " Spec.hs:8:3: " + , " 1) bar" + , "" + , "Randomized with seed 0" + , "" + , "Finished in ..." + , "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" + withColor Green "RELOADING SUCCEEDED" , "" , "bar [✘]" , "" @@ -210,7 +211,6 @@ spec = do , "" , "Finished in ..." , "1 example, 1 failure" - , "Summary {summaryExamples = 1, summaryFailures = 1}" ]) context "after a failing spec passes" $ do @@ -221,21 +221,18 @@ spec = do writeFile name passingSpec trigger session `shouldReturn` (Success, [ "[1 of 1] Compiling Spec [Source file changed]" - , 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 @@ -243,8 +240,7 @@ spec = do withSession name [] $ \ session -> do writeFile name "module Spec where" (trigger session >> trigger session) `shouldReturn` (Success, [ - modulesLoaded Ok ["Spec"] - , withColor Green "RELOADING SUCCEEDED" + withColor Green "RELOADING SUCCEEDED" ]) context "with an hspec-meta spec" $ do @@ -252,13 +248,11 @@ spec = 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" + withColor Green "RELOADING SUCCEEDED" , "" , "foo [✔]" , "bar [✔]" , "" , "Finished in ..." , "2 examples, 0 failures" - , "Summary {summaryExamples = 2, summaryFailures = 0}" ])