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 qualified Prelude as Unsafe (read)
import System.Environment (getArgs, lookupEnv)
import Test.Hspec (Spec)
import Test.Hspec.JUnit
(configWithJUnit, defaultJUnitConfig, setJUnitConfigOutputFile)
import Test.Hspec.Runner
( Config
, Path
, Summary
, configConcurrentJobs
, configSkipPredicate
, defaultConfig
, evaluateSummary
, readConfig
, runSpec
)
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
Bool
isCircle <- forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"CIRCLECI"
let runner :: [Char] -> (Config -> Config) -> Config -> IO Summary
runner = if Bool
isCircle then [Char] -> (Config -> Config) -> Config -> IO Summary
junit else [Char] -> (Config -> Config) -> Config -> IO Summary
hspec
[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
junit :: [Char] -> (Config -> Config) -> Config -> IO Summary
junit [Char]
filename Config -> Config
changeConfig =
(Spec
spec Spec -> ([Char], [Char]) -> Config -> IO Summary
`runJUnitSpec` ([Char]
"/tmp/junit", [Char]
filename)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Config
changeConfig
hspec :: [Char] -> (Config -> Config) -> Config -> IO Summary
hspec [Char]
_ Config -> Config
changeConfig = Spec -> Config -> IO Summary
runSpec Spec
spec 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 }
runJUnitSpec :: Spec -> (FilePath, String) -> Config -> IO Summary
runJUnitSpec :: Spec -> ([Char], [Char]) -> Config -> IO Summary
runJUnitSpec Spec
spec ([Char]
path, [Char]
name) Config
config =
Spec
spec Spec -> Config -> IO Summary
`runSpec` JUnitConfig -> Config -> Config
configWithJUnit JUnitConfig
junitConfig Config
config
where
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"
junitConfig :: JUnitConfig
junitConfig =
[Char] -> JUnitConfig -> JUnitConfig
setJUnitConfigOutputFile [Char]
filePath forall a b. (a -> b) -> a -> b
$ Text -> JUnitConfig
defaultJUnitConfig forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack [Char]
name
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