diff --git a/doctest/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs b/doctest/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs --- a/doctest/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs +++ b/doctest/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs @@ -6,6 +6,7 @@ , new , close , eval +, evalIt , evalEcho ) where @@ -38,6 +39,9 @@ marker :: String marker = show "dcbd2a1e20ae519a1c7714df2859f1890581d57fac96ba3f499412b2f5c928a1" +itMarker :: String +itMarker = "d42472243a0e6fc481e7514cbc9eb08812ed48daa29ca815844d86010b1d113a" + data Interpreter = Interpreter { hIn :: Handle , hOut :: Handle @@ -94,10 +98,12 @@ when (e /= ExitSuccess) $ do throwIO (userError $ "Language.Haskell.GhciWrapper.close: Interpreter exited with an error (" ++ show e ++ ")") -putExpression :: Interpreter -> String -> IO () -putExpression Interpreter{hIn = stdin} e = do +putExpression :: Interpreter -> Bool -> String -> IO () +putExpression Interpreter{hIn = stdin} preserveIt e = do hPutStrLn stdin e - hPutStrLn stdin marker + when preserveIt $ hPutStrLn stdin $ "let " ++ itMarker ++ " = it" + hPutStrLn stdin (marker ++ " :: String") + when preserveIt $ hPutStrLn stdin $ "let it = " ++ itMarker hFlush stdin getResult :: Bool -> Interpreter -> IO String @@ -124,11 +130,17 @@ -- | Evaluate an expression eval :: Interpreter -> String -> IO String eval repl expr = do - putExpression repl expr + putExpression repl False expr getResult False repl +-- | Like 'eval', but try to preserve the @it@ variable +evalIt :: Interpreter -> String -> IO String +evalIt repl expr = do + putExpression repl True expr + getResult False repl + -- | Evaluate an expression evalEcho :: Interpreter -> String -> IO String evalEcho repl expr = do - putExpression repl expr + putExpression repl False expr getResult True repl diff --git a/sensei.cabal b/sensei.cabal --- a/sensei.cabal +++ b/sensei.cabal @@ -1,11 +1,11 @@ --- This file has been generated from package.yaml by hpack version 0.26.0. +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.3. -- -- see: https://github.com/sol/hpack --- --- hash: 1c99e15f659870947cd1d509837f537a52ef65ed0b14cf82f2ea563482748657 name: sensei -version: 0.4.0 +version: 0.5.0 synopsis: Automatically run Hspec tests on file modifications category: Development homepage: https://github.com/hspec/sensei#readme @@ -14,7 +14,6 @@ license: MIT license-file: LICENSE build-type: Simple -cabal-version: >= 1.10 source-repository head type: git @@ -29,8 +28,7 @@ ghc-options: -Wall build-depends: ansi-terminal - , base >=4.7 && <5 - , base-compat >=0.8 + , base >=4.11 && <5 , bytestring , directory , filepath @@ -49,6 +47,7 @@ Client EventQueue HTTP + Imports Options Run Session @@ -67,8 +66,7 @@ ghc-options: -Wall build-depends: ansi-terminal - , base >=4.7 && <5 - , base-compat >=0.8 + , base >=4.11 && <5 , bytestring , directory , filepath @@ -87,6 +85,7 @@ Client EventQueue HTTP + Imports Options Run Session @@ -105,8 +104,7 @@ ghc-options: -Wall build-depends: ansi-terminal - , base >=4.7 && <5 - , base-compat >=0.8 + , base >=4.11 && <5 , bytestring , directory , filepath @@ -125,6 +123,7 @@ Client EventQueue HTTP + Imports Options Run Session @@ -143,10 +142,11 @@ test ghc-options: -Wall cpp-options: -DTEST + build-tool-depends: + hspec-discover:hspec-discover build-depends: ansi-terminal - , base >=4.7 && <5 - , base-compat >=0.8 + , base >=4.11 && <5 , bytestring , directory , filepath @@ -171,6 +171,7 @@ Client EventQueue HTTP + Imports Options Run Session @@ -178,6 +179,7 @@ Util Language.Haskell.GhciWrapper ClientSpec + EventQueueSpec Helper HTTPSpec OptionsSpec diff --git a/src/Client.hs b/src/Client.hs --- a/src/Client.hs +++ b/src/Client.hs @@ -1,13 +1,8 @@ {-# LANGUAGE RecordWildCards, OverloadedStrings #-} module Client (client) where -import Prelude () -import Prelude.Compat -import Control.Monad.Compat -import Data.Monoid.Compat -import Control.Exception -import Data.String -import System.IO.Error +import Imports + import Network.HTTP.Client import Network.HTTP.Client.Internal (Response(..)) import Network.HTTP.Types diff --git a/src/EventQueue.hs b/src/EventQueue.hs --- a/src/EventQueue.hs +++ b/src/EventQueue.hs @@ -1,40 +1,45 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} module EventQueue ( EventQueue , newQueue -, emitTriggerAll -, emitModified -, emitDone + +, Event(..) +, FileEventType(..) +, emitEvent + +, Status(..) , processQueue + +#ifdef TEST +, Action(..) +, processEvents +, combineFileEvents +, groupFileEvents +#endif ) where -import Prelude () -import Prelude.Compat +import Imports -import Control.Monad.Compat -import Control.Concurrent (threadDelay) -import Control.Concurrent.STM.TChan import Control.Monad.STM -import Data.List.Compat +import Control.Concurrent.STM.TChan import Util type EventQueue = TChan Event -data Event = TriggerAll | Modified FilePath | Done - deriving Eq +data Event = TriggerAll | FileEvent FileEventType FilePath | Done + deriving (Eq, Show) +data FileEventType = FileAdded | FileRemoved | FileModified + deriving (Eq, Show) + newQueue :: IO EventQueue newQueue = atomically $ newTChan -emitTriggerAll :: EventQueue -> IO () -emitTriggerAll chan = atomically $ writeTChan chan TriggerAll - -emitModified :: FilePath -> EventQueue -> IO () -emitModified path chan = atomically $ writeTChan chan (Modified path) - -emitDone :: EventQueue -> IO () -emitDone chan = atomically $ writeTChan chan Done +emitEvent :: EventQueue -> Event -> IO () +emitEvent chan = atomically . writeTChan chan readEvents :: EventQueue -> IO [Event] readEvents chan = do @@ -54,18 +59,92 @@ Nothing -> return [] Just e -> (e :) <$> emptyQueue -processQueue :: EventQueue -> IO () -> IO () -> IO () +data Status = Terminate | Reload + +processQueue :: EventQueue -> IO () -> IO () -> IO Status processQueue chan triggerAll trigger = go where - go = do - readEvents chan >>= \case - events | Done `elem` events -> return () - events | TriggerAll `elem` events -> do - triggerAll - go - events -> do - let files = (nub . sort) [p | Modified p <- events] - withInfoColor $ do - mapM_ putStrLn (map ("--> " ++) files) - trigger - go + go = readEvents chan >>= processEvents >>= \ case + NoneAction -> do + go + TriggerAction files -> do + output files + trigger + go + TriggerAllAction -> do + triggerAll + go + ReloadAction file t -> do + output [file <> " (" <> show t <> ", reloading)"] + return Reload + DoneAction -> do + return Terminate + + output :: [String] -> IO () + output = withInfoColor . mapM_ (putStrLn . mappend "--> ") + +data Action = NoneAction | TriggerAction [FilePath] | TriggerAllAction | ReloadAction FilePath FileEventType | DoneAction + deriving (Eq, Show) + +processEvents :: [Event] -> IO Action +processEvents events = do + files <- fileEvents events + return $ if + | Done `elem` events -> DoneAction + | (file, t) : _ <- filter shouldReload files -> ReloadAction file t + | TriggerAll `elem` events -> TriggerAllAction + | not (null files) -> TriggerAction $ nub . sort $ map fst files + | otherwise -> NoneAction + +shouldReload :: (FilePath, FileEventType) -> Bool +shouldReload (name, event) = "Spec.hs" `isSuffixOf` name && case event of + FileAdded -> True + FileRemoved -> True + FileModified -> False + +fileEvents :: [Event] -> IO [(FilePath, FileEventType)] +fileEvents events = filterGitIgnored $ combineFileEvents [(p, e) | FileEvent e p <- events] + +filterGitIgnored :: [(FilePath, FileEventType)] -> IO [(FilePath, FileEventType)] +filterGitIgnored events = map f <$> filterGitIgnoredFiles (map fst events) + where + f :: FilePath -> (FilePath, FileEventType) + f p = (p, fromJust $ lookup p events) + +combineFileEvents :: [(FilePath, FileEventType)] -> [(FilePath, FileEventType)] +combineFileEvents events = [(file, e) | (file, Just e) <- map (second combineFileEventTypes) $ groupFileEvents events] + +groupFileEvents :: [(FilePath, FileEventType)] -> [(FilePath, [FileEventType])] +groupFileEvents = map (second $ map snd) . groupOn fst + +groupOn :: Eq b => (a -> b) -> [a] -> [(b, [a])] +groupOn f = go + where + go = \ case + [] -> [] + x : xs -> case partition (\ a -> f a == f x) xs of + (ys, zs) -> (f x, (x : ys)) : go zs + +combineFileEventTypes :: [FileEventType] -> Maybe FileEventType +combineFileEventTypes = go + where + go events = case events of + [] -> Nothing + [e] -> Just e + e1 : e2 : es -> go $ (combine e1 e2) es + + combine e1 e2 = case (e1, e2) of + (FileAdded, FileAdded) -> ignoreDuplicate FileAdded + (FileAdded, FileRemoved) -> id + (FileAdded, FileModified) -> (FileAdded :) + + (FileRemoved, FileAdded) -> (FileModified :) + (FileRemoved, FileRemoved) -> ignoreDuplicate FileRemoved + (FileRemoved, FileModified) -> shouldNeverHappen + + (FileModified, FileAdded) -> shouldNeverHappen + (FileModified, FileRemoved) -> (FileRemoved :) + (FileModified, FileModified) -> ignoreDuplicate FileModified + + ignoreDuplicate = (:) + shouldNeverHappen = (FileModified :) diff --git a/src/HTTP.hs b/src/HTTP.hs --- a/src/HTTP.hs +++ b/src/HTTP.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module HTTP ( withServer @@ -5,18 +6,13 @@ , newSocket , socketAddr --- exported for testing +#ifdef TEST , app +#endif ) where -import Prelude () -import Prelude.Compat -import Data.String -import Data.Text.Lazy.Encoding (encodeUtf8) -import Control.Exception -import Control.Monad -import Control.Concurrent -import System.IO.Error +import Imports + import System.Directory import Network.Wai import Network.HTTP.Types diff --git a/src/Imports.hs b/src/Imports.hs new file mode 100644 --- /dev/null +++ b/src/Imports.hs @@ -0,0 +1,14 @@ +module Imports (module Imports) where + +import Control.Concurrent as Imports +import Control.Exception as Imports +import Control.Monad as Imports +import Data.Bifunctor as Imports +import Data.Char as Imports +import Data.List as Imports +import Data.Maybe as Imports +import Data.String as Imports +import Data.Text.Lazy.Encoding as Imports (encodeUtf8) +import Data.Tuple as Imports +import System.IO.Error as Imports (isDoesNotExistError) +import Text.Read as Imports (readMaybe) diff --git a/src/Options.hs b/src/Options.hs --- a/src/Options.hs +++ b/src/Options.hs @@ -1,6 +1,7 @@ module Options (splitArgs) where -import Data.List +import Imports + import System.Console.GetOpt splitArgs :: [String] -> ([String], [String]) @@ -32,6 +33,7 @@ , Option [] ["qc-max-discard"] (ReqArg (const ()) "N") , Option [] ["seed"] (ReqArg (const ()) "N") , Option [] ["print-cpu-time"] (NoArg ()) + , Option [] ["focused-only"] (NoArg ()) , Option [] ["dry-run"] (NoArg ()) , Option [] ["fail-fast"] (NoArg ()) , Option "r" ["rerun"] (NoArg ()) diff --git a/src/Run.hs b/src/Run.hs --- a/src/Run.hs +++ b/src/Run.hs @@ -1,12 +1,11 @@ -{-# LANGUAGE OverloadedStrings #-} -module Run where -import Prelude () -import Prelude.Compat +{-# LANGUAGE LambdaCase #-} +module Run ( + run +, runWeb +) where -import Control.Concurrent -import Control.Exception -import Control.Monad (void, forever, when) -import Data.Foldable +import Imports + import System.Exit import System.FSNotify @@ -22,33 +21,51 @@ waitForever = forever $ threadDelay 10000000 watchFiles :: EventQueue -> IO () -watchFiles queue = void . forkIO $ do - withManager $ \manager -> do - _ <- watchTree manager "." (not . isBoring . eventPath) (\event -> emitModified (eventPath event) queue) - waitForever +watchFiles queue = do + watch $ emitEvent queue . \ case + Added file _ _ -> FileEvent FileAdded file + Removed file _ _ -> FileEvent FileRemoved file + Modified file _ _ -> FileEvent FileModified file + Unknown file _ _ -> FileEvent FileModified file + where + isInteresting = (&&) <$> not . eventIsDirectory <*> not . isBoring . eventPath + watch action = void . forkIO $ do + withManager $ \ manager -> do + _stopListening <- watchTree manager "." isInteresting action + waitForever + + watchInput :: EventQueue -> IO () watchInput queue = void . forkIO $ do input <- getContents forM_ (lines input) $ \_ -> do - emitTriggerAll queue - emitDone queue + emitEvent queue TriggerAll + emitEvent queue Done run :: [String] -> IO () run args = do - withSession args $ \session -> do - queue <- newQueue - watchFiles queue - watchInput queue - lastOutput <- newMVar (True, "") - HTTP.withServer (readMVar lastOutput) $ do - let saveOutput :: IO (Bool, String) -> IO () - saveOutput action = modifyMVar_ lastOutput $ \_ -> action - triggerAction = saveOutput (trigger session) - triggerAllAction = saveOutput (triggerAll session) - triggerAction - processQueue queue triggerAllAction triggerAction + queue <- newQueue + watchFiles queue + watchInput queue + lastOutput <- newMVar (True, "") + HTTP.withServer (readMVar lastOutput) $ do + let + saveOutput :: IO (Bool, String) -> IO () + saveOutput action = modifyMVar_ lastOutput $ \_ -> action + go = do + status <- withSession args $ \ session -> do + let + triggerAction = saveOutput (trigger session) + triggerAllAction = saveOutput (triggerAll session) + triggerAction + processQueue queue triggerAllAction triggerAction + case status of + Reload -> go + Terminate -> return () + go + runWeb :: [String] -> IO () runWeb args = do withSession args $ \session -> do @@ -57,7 +74,7 @@ HTTP.withServer (withMVar lock $ \() -> trigger session) $ do waitForever -withSession :: [String] -> (Session -> IO ()) -> IO () +withSession :: [String] -> (Session -> IO a) -> IO a withSession args action = do check <- dotGhciWritableByOthers when check $ do diff --git a/src/Session.hs b/src/Session.hs --- a/src/Session.hs +++ b/src/Session.hs @@ -23,12 +23,9 @@ #endif ) where +import Imports + import Data.IORef -import Data.List.Compat -import Data.Maybe (listToMaybe, catMaybes) -import Prelude () -import Prelude.Compat -import Text.Read.Compat import qualified Language.Haskell.GhciWrapper as GhciWrapper import Language.Haskell.GhciWrapper hiding (new, close) diff --git a/src/Trigger.hs b/src/Trigger.hs --- a/src/Trigger.hs +++ b/src/Trigger.hs @@ -7,10 +7,10 @@ #endif ) where -import Prelude () -import Prelude.Compat -import Data.List.Compat +import Imports + +import Util import Session (Session, isFailure, isSuccess, hspecPreviousSummary, resetSummary) import qualified Session @@ -34,8 +34,12 @@ trigger session = do xs <- Session.reload session fmap (xs ++) <$> if reloadedSuccessfully xs - then hspec - else return (False, "") + then do + withColor Green $ putStrLn "RELOADING SUCCEEDED" + hspec + else do + withColor Red $ putStrLn "RELOADING FAILED" + return (False, "") where hspec = do mRun <- Session.getRunSpec session diff --git a/src/Util.hs b/src/Util.hs --- a/src/Util.hs +++ b/src/Util.hs @@ -1,20 +1,35 @@ -{-# LANGUAGE OverloadedStrings, LambdaCase #-} -module Util where +{-# LANGUAGE CPP, OverloadedStrings, LambdaCase, RecordWildCards, ViewPatterns #-} +module Util ( + Color(..) +, withColor +, withInfoColor +, isBoring +, filterGitIgnoredFiles +, normalizeTypeSignatures +, dotGhciWritableByOthers -import Prelude () -import Prelude.Compat +#ifdef TEST +, filterGitIgnoredFiles_ +, writableByOthers +#endif +) where -import Control.Exception -import Data.List.Compat +import Imports + import System.Console.ANSI import System.FilePath +import System.Process import System.Posix.Files import System.Posix.Types +import qualified Data.Text as T withInfoColor :: IO a -> IO a -withInfoColor = bracket_ set reset +withInfoColor = withColor Magenta + +withColor :: Color -> IO a -> IO a +withColor c = bracket_ set reset where - set = setSGR [SetColor Foreground Dull Magenta] + set = setSGR [SetColor Foreground Dull c] reset = setSGR [] isBoring :: FilePath -> Bool @@ -22,6 +37,32 @@ where dirs = splitDirectories p isEmacsAutoSave = isPrefixOf ".#" . takeFileName + +filterGitIgnoredFiles :: [FilePath] -> IO [FilePath] +filterGitIgnoredFiles files = do + (feedback, ignoredFiles) <- filterGitIgnoredFiles_ files + printFeedback feedback + return $ ignoredFiles + where + printFeedback :: Feedback -> IO () + printFeedback = mapM_ $ \ (color, err) -> withColor color $ putStrLn ('\n' : err) + +type Feedback = Maybe (Color, String) + +filterGitIgnoredFiles_ :: [FilePath] -> IO (Feedback, [FilePath]) +filterGitIgnoredFiles_ files = fmap (files \\) <$> gitCheckIgnore files + +gitCheckIgnore :: [FilePath] -> IO (Feedback, [FilePath]) +gitCheckIgnore files = do + (_, ignoredFiles, err) <- readProcessWithExitCode "git" ["check-ignore", "--stdin", "-z"] $ join_ files + return (feedback err, split ignoredFiles) + where + join_ = intercalate "\0" + split = map T.unpack . T.split (== '\0') . T.pack + feedback err + | err == "fatal: not a git repository (or any of the parent directories): .git\n" = Just (Cyan, "warning: not a git repository - .gitignore support not available\n") + | err == "" = Nothing + | otherwise = Just (Red, err) normalizeTypeSignatures :: String -> String normalizeTypeSignatures = normalize . concatMap replace diff --git a/test/EventQueueSpec.hs b/test/EventQueueSpec.hs new file mode 100644 --- /dev/null +++ b/test/EventQueueSpec.hs @@ -0,0 +1,71 @@ +module EventQueueSpec (spec) where + +import Helper + +import EventQueue + +withGitRepository :: IO a -> IO a +withGitRepository action = inTempDirectory (readProcess "git" ["init"] "" >> action) + +spec :: Spec +spec = do + describe "processEvents" $ do + around_ withGitRepository $ do + + context "with FileEvent" $ do + it "returns TriggerAction" $ do + processEvents [FileEvent FileModified "test/FooSpec.hs"] `shouldReturn` TriggerAction ["test/FooSpec.hs"] + + context "with git ignored files" $ do + it "returns NoneAction" $ do + writeFile ".gitignore" "test/FooSpec.hs" + processEvents [FileEvent FileModified "test/FooSpec.hs"] `shouldReturn` NoneAction + + context "when a Spec file is added" $ do + it "returns ReloadAction" $ do + processEvents [FileEvent FileAdded "test/FooSpec.hs"] `shouldReturn` ReloadAction "test/FooSpec.hs" FileAdded + + it "takes precedence over TriggerAll" $ do + processEvents [TriggerAll, FileEvent FileAdded "test/FooSpec.hs", TriggerAll] `shouldReturn` ReloadAction "test/FooSpec.hs" FileAdded + + it "is overruled by Done" $ do + processEvents [Done, FileEvent FileAdded "test/FooSpec.hs", Done] `shouldReturn` DoneAction + + context "when a Spec file is removed" $ do + it "returns ReloadAction" $ do + processEvents [FileEvent FileRemoved "test/FooSpec.hs"] `shouldReturn` ReloadAction "test/FooSpec.hs" FileRemoved + + context "when file is first removed and then added" $ do + it "returns TriggerAction" $ do + processEvents [FileEvent FileRemoved "test/FooSpec.hs", FileEvent FileAdded "test/FooSpec.hs"] `shouldReturn` TriggerAction ["test/FooSpec.hs"] + + context "when file is first added and then removed" $ do + it "returns NoneAction" $ do + processEvents [FileEvent FileAdded "test/FooSpec.hs", FileEvent FileRemoved "test/FooSpec.hs"] `shouldReturn` NoneAction + + context "with TriggerAll" $ do + it "returns TriggerAllAction" $ do + processEvents [TriggerAll] `shouldReturn` TriggerAllAction + + it "takes precedence over FileEvent" $ do + processEvents [FileEvent FileModified "foo", TriggerAll, FileEvent FileModified "foo"] `shouldReturn` TriggerAllAction + + context "with Done" $ do + it "returns DoneAction" $ do + processEvents [Done] `shouldReturn` DoneAction + + describe "combineFileEvents" $ do + it "combines removed/added to modified" $ do + combineFileEvents [fileRemoved "foo", fileModified "bar", fileAdded "foo"] `shouldBe` [fileModified "foo", fileModified "bar"] + + it "does not combine events with different file names" $ do + combineFileEvents [fileRemoved "foo", fileAdded "bar"] `shouldBe` [fileRemoved "foo", fileAdded "bar"] + + describe "groupFileEvents" $ do + it "groups file event types by file name" $ do + groupFileEvents [fileRemoved "foo", fileModified "bar", fileAdded "foo"] `shouldBe` [("foo", [FileRemoved, FileAdded]), ("bar", [FileModified])] + + where + fileRemoved file = (file, FileRemoved) + fileAdded file = (file, FileAdded) + fileModified file = (file, FileModified) diff --git a/test/HTTPSpec.hs b/test/HTTPSpec.hs --- a/test/HTTPSpec.hs +++ b/test/HTTPSpec.hs @@ -1,7 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module HTTPSpec (spec) where -import Test.Hspec +import Helper + import Test.Hspec.Wai import HTTP diff --git a/test/Helper.hs b/test/Helper.hs --- a/test/Helper.hs +++ b/test/Helper.hs @@ -1,10 +1,6 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes #-} module Helper ( - module Test.Hspec -, module Test.Mockery.Directory -, module Control.Applicative -, module System.IO.Silently + module Imports , withSession , withSomeSpec , passingSpec @@ -14,15 +10,13 @@ , modulesLoaded ) where -import Control.Applicative -import Control.Exception +import Imports + import Data.String.Interpolate -#if __GLASGOW_HASKELL__ < 802 -import Data.List.Compat -#endif -import System.IO.Silently -import Test.Hspec -import Test.Mockery.Directory +import System.IO.Silently as Imports +import System.Process as Imports (readProcess, callCommand) +import Test.Hspec as Imports +import Test.Mockery.Directory as Imports import Run () import qualified Session @@ -74,13 +68,6 @@ deriving (Eq, Show) modulesLoaded :: Status -> [String] -> String -#if __GLASGOW_HASKELL__ < 802 -modulesLoaded status xs = show status ++ ", modules loaded: " ++ mods ++ "." - where - mods = case xs of - [] -> "none" - _ -> intercalate ", " xs -#elif MIN_VERSION_base(4,10,1) modulesLoaded status xs = show status ++ ", " ++ mods ++ " loaded." where n = length xs @@ -93,11 +80,3 @@ | n == 5 = "five modules" | n == 6 = "six modules" | otherwise = show n ++ " modules" -#else -modulesLoaded status xs = show status ++ ", " ++ show n ++ " " ++ mods ++ " loaded." - where - n = length xs - mods - | n == 1 = "module" - | otherwise = "modules" -#endif diff --git a/test/OptionsSpec.hs b/test/OptionsSpec.hs --- a/test/OptionsSpec.hs +++ b/test/OptionsSpec.hs @@ -1,6 +1,6 @@ module OptionsSpec (main, spec) where -import Test.Hspec +import Helper import Options diff --git a/test/SessionSpec.hs b/test/SessionSpec.hs --- a/test/SessionSpec.hs +++ b/test/SessionSpec.hs @@ -1,11 +1,11 @@ {-# LANGUAGE RecordWildCards #-} module SessionSpec (spec) where -import Language.Haskell.GhciWrapper (eval) -import System.Environment.Compat - import Helper +import System.Environment.Blank (setEnv) + +import Language.Haskell.GhciWrapper (eval) import qualified Session import Session (Session(..), Summary(..), hspecFailureEnvName, hspecPreviousSummary, hspecCommand) @@ -13,7 +13,7 @@ spec = do describe "new" $ do it "unsets HSPEC_FAILURES" $ do - setEnv hspecFailureEnvName "foo" + setEnv hspecFailureEnvName "foo" True withSession [] $ \Session{..} -> do _ <- eval sessionInterpreter "import System.Environment" eval sessionInterpreter ("lookupEnv " ++ show hspecFailureEnvName) `shouldReturn` "Nothing\n" diff --git a/test/TriggerSpec.hs b/test/TriggerSpec.hs --- a/test/TriggerSpec.hs +++ b/test/TriggerSpec.hs @@ -1,8 +1,6 @@ module TriggerSpec (spec) where import Helper -import Data.List.Compat -import Data.Char import Trigger @@ -77,9 +75,11 @@ , "" , "Failures:" , "" - , " Spec.hs:9: " + , " Spec.hs:9:3: " , " 1) bar" , "" + , " To rerun use: --match \"/bar/\"" + , "" , "Randomized with seed ..." , "" , "Finished in ..." @@ -133,8 +133,10 @@ , "" , "Failures:" , "" - , " Spec.hs:9: " + , " Spec.hs:9:3: " , " 1) bar" + , "" + , " To rerun use: --match \"/bar/\"" , "" , "Randomized with seed ..." , "" diff --git a/test/UtilSpec.hs b/test/UtilSpec.hs --- a/test/UtilSpec.hs +++ b/test/UtilSpec.hs @@ -4,7 +4,6 @@ import Helper import System.Posix.Files -import System.Process import Util @@ -23,6 +22,18 @@ it "replaces unicode characters" $ do normalizeTypeSignatures "head ∷ [a] → a" `shouldBe` "head :: [a] -> a" + + describe "filterGitIgnoredFiles_" $ do + around_ inTempDirectory $ do + it "discards files that are ignored by git" $ do + _ <- readProcess "git" ["init"] "" + writeFile ".gitignore" "foo" + filterGitIgnoredFiles_ ["foo", "bar"] `shouldReturn` (Nothing, ["bar"]) + + context "when used outside of a git repository" $ do + it "returns all files" $ do + let feedback = Just (Cyan, "warning: not a git repository - .gitignore support not available\n") + filterGitIgnoredFiles_ ["foo", "bar"] `shouldReturn` (feedback, ["foo", "bar"]) describe "dotGhciWritableByOthers" $ do around_ inTempDirectory $ do