diff --git a/sensei.cabal b/sensei.cabal --- a/sensei.cabal +++ b/sensei.cabal @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.11.0. +-- This file has been generated from package.yaml by hpack version 0.15.0. -- -- see: https://github.com/sol/hpack name: sensei -version: 0.1.0 +version: 0.2.0 synopsis: Automatically run Hspec tests on file modifications category: Development homepage: https://github.com/hspec/sensei#readme @@ -22,8 +22,8 @@ main-is: seito.hs hs-source-dirs: src - , doctest/ghci-wrapper/src/ - , driver + doctest/ghci-wrapper/src/ + driver ghc-options: -Wall build-depends: base >= 4.7 && < 5 @@ -39,7 +39,7 @@ , network , ansi-terminal , directory - , http-client + , http-client >= 0.5.0 , bytestring , filepath , unix @@ -59,8 +59,8 @@ main-is: sensei.hs hs-source-dirs: src - , doctest/ghci-wrapper/src/ - , driver + doctest/ghci-wrapper/src/ + driver ghc-options: -Wall build-depends: base >= 4.7 && < 5 @@ -76,7 +76,7 @@ , network , ansi-terminal , directory - , http-client + , http-client >= 0.5.0 , bytestring , filepath , unix @@ -96,8 +96,8 @@ main-is: sensei-web.hs hs-source-dirs: src - , doctest/ghci-wrapper/src/ - , driver + doctest/ghci-wrapper/src/ + driver ghc-options: -Wall build-depends: base >= 4.7 && < 5 @@ -113,7 +113,7 @@ , network , ansi-terminal , directory - , http-client + , http-client >= 0.5.0 , bytestring , filepath , unix @@ -134,9 +134,10 @@ main-is: Spec.hs hs-source-dirs: src - , doctest/ghci-wrapper/src/ - , test + doctest/ghci-wrapper/src/ + test ghc-options: -Wall + cpp-options: -DTEST build-depends: base >= 4.7 && < 5 , base-compat >= 0.8 @@ -151,11 +152,12 @@ , network , ansi-terminal , directory - , http-client + , http-client >= 0.5.0 , bytestring , filepath , unix , hspec >= 2.2.1 + , hspec-meta , hspec-wai , mockery , silently diff --git a/src/Client.hs b/src/Client.hs --- a/src/Client.hs +++ b/src/Client.hs @@ -4,14 +4,14 @@ import Prelude () import Prelude.Compat import Control.Monad.Compat +import Data.Monoid.Compat import Control.Exception import Data.String import System.IO.Error import Network.HTTP.Client -import Network.HTTP.Client.Internal +import Network.HTTP.Client.Internal (Response(..)) import Network.HTTP.Types -import Network.Socket hiding (recv) -import Network.Socket.ByteString (sendAll, recv) +import Network.Socket (connect) import qualified Data.ByteString.Lazy as L import HTTP (newSocket, socketAddr, socketName) @@ -24,7 +24,7 @@ p :: HttpException -> Maybe () p e = case e of - FailedConnectionException2 _ _ _ se -> guard (isDoesNotExistException se) >> Just () + HttpExceptionRequest _ (ConnectionFailure se) -> guard (isDoesNotExistException se) >> Just () _ -> Nothing isDoesNotExistException :: SomeException -> Bool @@ -32,14 +32,10 @@ go = do manager <- newManager defaultManagerSettings {managerRawConnection = return newConnection} - request <- parseUrl "http://localhost/" - Response{..} <- httpLbs request {checkStatus = \_ _ _ -> Nothing} manager + Response{..} <- httpLbs "http://localhost/" manager return (statusIsSuccessful responseStatus, responseBody) newConnection _ _ _ = do sock <- newSocket connect sock socketAddr socketConnection sock 8192 - -socketConnection :: Socket -> Int -> IO Connection -socketConnection sock chunksize = makeConnection (recv sock chunksize) (sendAll sock) (sClose sock) diff --git a/src/HTTP.hs b/src/HTTP.hs --- a/src/HTTP.hs +++ b/src/HTTP.hs @@ -20,7 +20,7 @@ import System.Directory import Network.Wai import Network.HTTP.Types -import Network.Wai.Handler.Warp +import Network.Wai.Handler.Warp (runSettingsSocket, defaultSettings) import Network.Socket socketName :: String diff --git a/src/Session.hs b/src/Session.hs --- a/src/Session.hs +++ b/src/Session.hs @@ -1,20 +1,26 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} module Session ( Session(..) -, hspecFailureEnvName , new , close , reload , Summary(..) +, resetSummary +, hspecPreviousSummary , isFailure , isSuccess +, getRunSpec + +#ifdef TEST +, runSpec , hasSpec +, hspecFailureEnvName , hasHspecCommandSignature -, runSpec -, hspecPreviousSummary -, resetSummary +, hspecCommand , parseSummary +#endif ) where import Data.IORef @@ -52,6 +58,7 @@ _ <- eval ghci (":set prompt " ++ show "") _ <- eval ghci ("import qualified System.Environment") _ <- eval ghci ("import qualified Test.Hspec.Runner") + _ <- eval ghci ("import qualified Test.Hspec.Meta") _ <- eval ghci ("System.Environment.unsetEnv " ++ show hspecFailureEnvName) ref <- newIORef (Just $ Summary 0 0) return (Session ghci hspecArgs ref) @@ -70,19 +77,36 @@ hspecCommand :: String hspecCommand = "Test.Hspec.Runner.hspecResult spec" -hasSpec :: Session -> IO Bool -hasSpec Session{..} = hasHspecCommandSignature <$> eval sessionInterpreter (":type " ++ hspecCommand) +hspecMetaCommand :: String +hspecMetaCommand = "Test.Hspec.Meta.hspecResult spec" -hasHspecCommandSignature :: String -> Bool -hasHspecCommandSignature = any match . lines . normalizeTypeSignatures +getRunSpec :: Session -> IO (Maybe (IO String)) +getRunSpec session = do + r <- getRunSpecWith hspecCommand session + case r of + Just _ -> return r + Nothing -> getRunSpecWith hspecMetaCommand session + +getRunSpecWith :: String -> Session -> IO (Maybe (IO String)) +getRunSpecWith command session = do + has <- hasSpec command session + if has + then return $ Just (runSpec command session) + else return Nothing + +hasSpec :: String -> Session -> IO Bool +hasSpec command Session{..} = hasHspecCommandSignature command <$> eval sessionInterpreter (":type " ++ command) + +hasHspecCommandSignature :: String -> String -> Bool +hasHspecCommandSignature command = any match . lines . normalizeTypeSignatures where - match line = (hspecCommand ++ " :: IO ") `isPrefixOf` line && "Summary" `isSuffixOf` line + match line = (command ++ " :: IO ") `isPrefixOf` line && "Summary" `isSuffixOf` line -runSpec :: Session -> IO String -runSpec session@Session{..} = do +runSpec :: String -> Session -> IO String +runSpec command session@Session{..} = do failedPreviously <- isFailure <$> hspecPreviousSummary session let args = "--color" : (if failedPreviously then addRerun else id) sessionHspecArgs - r <- evalEcho sessionInterpreter $ "System.Environment.withArgs " ++ show args ++ " $ " ++ hspecCommand + r <- evalEcho sessionInterpreter $ "System.Environment.withArgs " ++ show args ++ " $ " ++ command writeIORef sessionHspecPreviousSummary (parseSummary r) return r where diff --git a/src/Trigger.hs b/src/Trigger.hs --- a/src/Trigger.hs +++ b/src/Trigger.hs @@ -23,19 +23,19 @@ else return (False, "") where hspec = do - hasSpec <- Session.hasSpec session - if hasSpec - then runSpecs - else return (True, "") + mRun <- Session.getRunSpec session + case mRun of + Just run -> runSpecs run + Nothing -> return (True, "") - runSpecs = do + runSpecs run = do failedPreviously <- isFailure <$> hspecPreviousSummary session - (success, xs) <- runSpec + (success, xs) <- runSpec run fmap (xs ++) <$> if success && failedPreviously - then runSpec + then runSpec run else return (success, "") - runSpec = do - xs <- Session.runSpec session + runSpec run = do + xs <- run success <- isSuccess <$> hspecPreviousSummary session return (success, xs) diff --git a/test/Helper.hs b/test/Helper.hs --- a/test/Helper.hs +++ b/test/Helper.hs @@ -7,6 +7,7 @@ , withSession , withSomeSpec , passingSpec +, passingMetaSpec , failingSpec ) where @@ -32,6 +33,18 @@ module Spec (spec) where import Test.Hspec + +spec :: Spec +spec = do + it "foo" True + it "bar" True +|] + +passingMetaSpec :: String +passingMetaSpec = [i| +module Spec (spec) where + +import Test.Hspec.Meta spec :: Spec spec = do diff --git a/test/SessionSpec.hs b/test/SessionSpec.hs --- a/test/SessionSpec.hs +++ b/test/SessionSpec.hs @@ -7,7 +7,7 @@ import Helper import qualified Session -import Session (Session(..), Summary(..), hspecFailureEnvName, hspecPreviousSummary) +import Session (Session(..), Summary(..), hspecFailureEnvName, hspecPreviousSummary, hspecCommand) spec :: Spec spec = do @@ -28,24 +28,24 @@ it "returns True" $ do withSession ["Spec.hs"] $ \session -> do _ <- silence (Session.reload session) - Session.hasSpec session `shouldReturn` True + Session.hasSpec hspecCommand session `shouldReturn` True context "when module does not contain spec" $ do it "returns False" $ do withSession ["Spec.hs"] $ \session -> do writeFile "Spec.hs" "module Main where" _ <- silence (Session.reload session) - Session.hasSpec session `shouldReturn` False + Session.hasSpec hspecCommand session `shouldReturn` False describe "hasHspecCommandSignature" $ do let signature = "Test.Hspec.Runner.hspecResult spec :: IO Test.Hspec.Core.Runner.Summary" context "when input contains qualified Hspec command signature" $ do it "returns True" $ do - Session.hasHspecCommandSignature signature `shouldBe` True + Session.hasHspecCommandSignature hspecCommand signature `shouldBe` True it "ignores additional output after summary" $ do - (Session.hasHspecCommandSignature . unlines) [ + (Session.hasHspecCommandSignature hspecCommand . unlines) [ "bar" , signature , "foo" @@ -53,21 +53,22 @@ context "when input contains unqualified Hspec command signature" $ do it "returns True" $ do - Session.hasHspecCommandSignature "Test.Hspec.Runner.hspecResult spec :: IO Summary" `shouldBe` True + Session.hasHspecCommandSignature hspecCommand "Test.Hspec.Runner.hspecResult spec :: IO Summary" `shouldBe` True context "when input dose not contain Hspec command signature" $ do it "returns False" $ do - Session.hasHspecCommandSignature "foo" `shouldBe` False + Session.hasHspecCommandSignature hspecCommand "foo" `shouldBe` False describe "runSpec" $ around_ withSomeSpec $ do + let runSpec = Session.runSpec hspecCommand it "stores summary of spec run" $ do withSession ["Spec.hs"] $ \session -> do - _ <- silence (Session.runSpec session >> Session.runSpec session) + _ <- silence (runSpec session >> runSpec session) hspecPreviousSummary session `shouldReturn` Just (Summary 2 0) it "accepts Hspec args" $ do withSession ["Spec.hs", "--no-color", "-m", "foo"] $ \session -> do - _ <- silence (Session.runSpec session >> Session.runSpec session) + _ <- silence (runSpec session >> runSpec session) hspecPreviousSummary session `shouldReturn` Just (Summary 1 0) describe "parseSummary" $ do diff --git a/test/TriggerSpec.hs b/test/TriggerSpec.hs --- a/test/TriggerSpec.hs +++ b/test/TriggerSpec.hs @@ -135,3 +135,19 @@ withSession ["Spec.hs"] $ \session -> do writeFile "Spec.hs" "module Main where" silence (trigger session >> trigger session) `shouldReturn` (True, "Ok, modules loaded: Main.\n") + + context "with an hspec-meta spec" $ do + it "reloads and runs spec" $ do + withSession ["Spec.hs", "--no-color"] $ \session -> do + writeFile "Spec.hs" passingMetaSpec + result <- silence (trigger session >> trigger session) + fmap normalize result `shouldBe` (True, [ + "Ok, modules loaded: Spec." + , "" + , "foo" + , "bar" + , "" + , "Finished in ..." + , "2 examples, 0 failures" + , "Summary {summaryExamples = 2, summaryFailures = 0}" + ])