module Freckle.App.Test.Hspec.Runner
( run
, runParConfig
, runWith
, makeParallelConfig
) where
import Freckle.App.Prelude
import Control.Concurrent (getNumCapabilities, setNumCapabilities)
import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
import Data.List (isInfixOf)
import System.Environment (getArgs, lookupEnv)
import Test.Hspec (Spec)
import Test.Hspec.JUnit
( configWithJUnit
, setJUnitConfigOutputFile
, setJUnitConfigSourcePathPrefix
)
import Test.Hspec.JUnit.Config.Env (envJUnitConfig, envJUnitEnabled)
import Test.Hspec.Runner
( Config
, Path
, Summary
, configConcurrentJobs
, configSkipPredicate
, defaultConfig
, evaluateSummary
, hspecWithResult
, readConfig
)
import qualified Prelude as Unsafe (read)
run :: String -> Spec -> IO ()
run :: [Char] -> Spec -> IO ()
run = Config -> [Char] -> Spec -> IO ()
runWith Config
defaultConfig
runParConfig :: String -> Spec -> IO ()
runParConfig :: [Char] -> Spec -> IO ()
runParConfig [Char]
name Spec
spec = do
Config
config <- Config -> IO Config
makeParallelConfig Config
defaultConfig
Config -> [Char] -> Spec -> IO ()
runWith Config
config [Char]
name Spec
spec
runWith :: Config -> String -> Spec -> IO ()
runWith :: Config -> [Char] -> Spec -> IO ()
runWith Config
config [Char]
name Spec
spec = do
[[Char]]
args <- IO [[Char]]
getArgs
[Char] -> IO ()
putStrLn [Char]
"Running UNRELIABLE tests; failures here should not fail the build"
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
[Char] -> (Config -> Config) -> Config -> IO Summary
runner ([Char]
"unreliable-" forall a. Semigroup a => a -> a -> a
<> [Char]
name) forall a. a -> a
id
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [[Char]] -> Config -> IO Config
load
[[Char]]
args
((Path -> Bool) -> Config -> Config
skip Path -> Bool
reliableTests Config
config)
[Char] -> IO ()
putStrLn [Char]
"Running RELIABLE"
Summary
reliableSummary <-
[Char] -> (Config -> Config) -> Config -> IO Summary
runner [Char]
name forall a. a -> a
id
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [[Char]] -> Config -> IO Config
load [[Char]]
args ((Path -> Bool) -> Config -> Config
skip (forall a. [a -> Bool] -> a -> Bool
anys [Path -> Bool
unreliableTests, Path -> Bool
isolatedTests]) Config
config)
[Char] -> IO ()
putStrLn [Char]
"Running ISOLATED"
Summary
isolatedSummary <-
[Char] -> (Config -> Config) -> Config -> IO Summary
runner ([Char]
"isolated-" forall a. Semigroup a => a -> a -> a
<> [Char]
name) Config -> Config
noConcurrency
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [[Char]] -> Config -> IO Config
load [[Char]]
args ((Path -> Bool) -> Config -> Config
skip (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Bool
isolatedTests) Config
config)
Summary -> IO ()
evaluateSummary forall a b. (a -> b) -> a -> b
$ Summary
reliableSummary forall a. Semigroup a => a -> a -> a
<> Summary
isolatedSummary
where
load :: [[Char]] -> Config -> IO Config
load = forall a b c. (a -> b -> c) -> b -> a -> c
flip Config -> [[Char]] -> IO Config
readConfig
runner :: [Char] -> (Config -> Config) -> Config -> IO Summary
runner [Char]
filename Config -> Config
changeConfig =
(Spec
spec Spec -> ([Char], [Char]) -> Config -> IO Summary
`runWithJUnit` ([Char]
"/tmp/junit", [Char]
filename)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Config
changeConfig
noConcurrency :: Config -> Config
noConcurrency Config
x = Config
x {configConcurrentJobs :: Maybe Int
configConcurrentJobs = forall a. a -> Maybe a
Just Int
1}
runWithJUnit :: Spec -> (FilePath, String) -> Config -> IO Summary
runWithJUnit :: Spec -> ([Char], [Char]) -> Config -> IO Summary
runWithJUnit Spec
spec ([Char]
path, [Char]
name) Config
config = do
Bool
junitEnabled <- IO Bool
envJUnitEnabled
JUnitConfig
baseJUnitConfig <- IO JUnitConfig
envJUnitConfig
let modify :: Config -> Config
modify = if Bool
junitEnabled then JUnitConfig -> Config -> Config
configWithJUnit forall a b. (a -> b) -> a -> b
$ JUnitConfig -> JUnitConfig
withOverride JUnitConfig
baseJUnitConfig else forall a. a -> a
id
Spec
spec Spec -> Config -> IO Summary
`runSpec` Config -> Config
modify Config
config
where
runSpec :: Spec -> Config -> IO Summary
runSpec = forall a b c. (a -> b -> c) -> b -> a -> c
flip Config -> Spec -> IO Summary
hspecWithResult
filePath :: [Char]
filePath = [Char]
path forall a. Semigroup a => a -> a -> a
<> [Char]
"/" forall a. Semigroup a => a -> a -> a
<> [Char]
name forall a. Semigroup a => a -> a -> a
<> [Char]
"/test_results.xml"
withOverride :: JUnitConfig -> JUnitConfig
withOverride =
[Char] -> JUnitConfig -> JUnitConfig
setJUnitConfigSourcePathPrefix [Char]
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> JUnitConfig -> JUnitConfig
setJUnitConfigOutputFile [Char]
filePath
makeParallelConfig :: Config -> IO Config
makeParallelConfig :: Config -> IO Config
makeParallelConfig Config
config = do
Int
jobCores <-
forall a. a -> Maybe a -> a
fromMaybe Int
1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
(forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT IO (Maybe Int)
lookupTestCapabilities forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT IO (Maybe Int)
lookupHostCapabilities)
[Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Running spec with " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
jobCores forall a. Semigroup a => a -> a -> a
<> [Char]
" cores"
Int -> IO ()
setNumCapabilities Int
jobCores
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config {configConcurrentJobs :: Maybe Int
configConcurrentJobs = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int
jobCores forall a. Num a => a -> a -> a
* Int
4}
lookupTestCapabilities :: IO (Maybe Int)
lookupTestCapabilities :: IO (Maybe Int)
lookupTestCapabilities = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Read a => [Char] -> a
Unsafe.read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"TEST_CAPABILITIES"
lookupHostCapabilities :: IO (Maybe Int)
lookupHostCapabilities :: IO (Maybe Int)
lookupHostCapabilities = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
reduceCapabilities forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int
getNumCapabilities
reduceCapabilities :: Int -> Int
reduceCapabilities :: Int -> Int
reduceCapabilities = forall a. Ord a => a -> a -> a
max Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`div` Int
2)
skip :: (Path -> Bool) -> Config -> Config
skip :: (Path -> Bool) -> Config -> Config
skip Path -> Bool
predicate Config
config = Config
config {configSkipPredicate :: Maybe (Path -> Bool)
configSkipPredicate = forall a. a -> Maybe a
Just Path -> Bool
predicate}
unreliableTests :: Path -> Bool
unreliableTests :: Path -> Bool
unreliableTests = ([Char]
"UNRELIABLE" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
reliableTests :: Path -> Bool
reliableTests :: Path -> Bool
reliableTests = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Bool
unreliableTests
isolatedTests :: Path -> Bool
isolatedTests :: Path -> Bool
isolatedTests = ([Char]
"ISOLATED" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
anys :: [a -> Bool] -> a -> Bool
anys :: forall a. [a -> Bool] -> a -> Bool
anys [a -> Bool]
xs a
a = forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a -> Bool
f -> a -> Bool
f a
a) [a -> Bool]
xs