packages feed

sensei 0.4.0 → 0.5.0

raw patch · 18 files changed

+374/−151 lines, 18 filesdep −base-compatdep ~base

Dependencies removed: base-compat

Dependency ranges changed: base

Files

doctest/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs view
@@ -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
sensei.cabal view
@@ -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
src/Client.hs view
@@ -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
src/EventQueue.hs view
@@ -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 :)
src/HTTP.hs view
@@ -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
+ src/Imports.hs view
@@ -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)
src/Options.hs view
@@ -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 ())
src/Run.hs view
@@ -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
src/Session.hs view
@@ -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)
src/Trigger.hs view
@@ -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
src/Util.hs view
@@ -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
+ test/EventQueueSpec.hs view
@@ -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)
test/HTTPSpec.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module HTTPSpec (spec) where -import           Test.Hspec+import           Helper+ import           Test.Hspec.Wai  import           HTTP
test/Helper.hs view
@@ -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
test/OptionsSpec.hs view
@@ -1,6 +1,6 @@ module OptionsSpec (main, spec) where -import           Test.Hspec+import           Helper  import           Options
test/SessionSpec.hs view
@@ -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"
test/TriggerSpec.hs view
@@ -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 ..."             , ""
test/UtilSpec.hs view
@@ -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