module Test
(
Internal.Test,
Internal.test,
Internal.describe,
Internal.skip,
Internal.only,
Internal.todo,
Internal.fuzz,
Internal.fuzz2,
Internal.fuzz3,
Internal.serialize,
run,
runWithSettings,
TestSettings (..),
defaultTestSettings,
)
where
import qualified GHC.IO.Encoding
import qualified GHC.Stack as Stack
import NriPrelude
import qualified Platform
import qualified Platform.DevLog
import qualified System.Directory
import qualified System.Environment
import qualified System.Exit
import System.IO (hPutStrLn, stderr)
import qualified System.IO
import qualified Task
import qualified Test.CliParser as CliParser
import qualified Test.Internal as Internal
import qualified Test.Reporter.ExitCode
import qualified Test.Reporter.Junit
import qualified Test.Reporter.Logfile
import qualified Test.Reporter.Stdout
import qualified Prelude
data TestSettings = TestSettings
{ TestSettings -> Maybe Handle
output :: Maybe System.IO.Handle,
TestSettings -> Maybe FilePath
junitPath :: Maybe Prelude.String,
TestSettings -> Bool
writeDevLog :: Bool
}
defaultTestSettings :: TestSettings
defaultTestSettings :: TestSettings
defaultTestSettings =
TestSettings
{ output :: Maybe Handle
output = Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
System.IO.stdout,
junitPath :: Maybe FilePath
junitPath = Maybe FilePath
forall a. Maybe a
Nothing,
writeDevLog :: Bool
writeDevLog = Bool
True
}
run :: (Stack.HasCallStack) => Internal.Test -> Prelude.IO ()
run :: HasCallStack => Test -> IO ()
run Test
suite = do
args <- IO [FilePath]
System.Environment.getArgs
let settings = TestSettings
defaultTestSettings {junitPath = getJunitPath args}
runWithSettings settings suite
runWithSettings :: (Stack.HasCallStack) => TestSettings -> Internal.Test -> Prelude.IO ()
runWithSettings :: HasCallStack => TestSettings -> Test -> IO ()
runWithSettings TestSettings
settings Test
suite = do
TextEncoding -> IO ()
GHC.IO.Encoding.setLocaleEncoding TextEncoding
System.IO.utf8
log <- IO LogHandler
Platform.silentHandler
args <- System.Environment.getArgs
let requestOrError = [FilePath] -> Result FilePath Request
CliParser.parseArgs [FilePath]
args
request <- case requestOrError of
Err FilePath
errs -> do
let error :: FilePath
error = (FilePath
"Invalid arguments:\n" FilePath -> FilePath -> FilePath
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ FilePath
errs)
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
error
IO Request
forall a. IO a
System.Exit.exitFailure
Ok Request
request ->
Request -> IO Request
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Request
request
results <- Task.perform log (Internal.run request suite)
case output settings of
Just Handle
outputHandle -> Handle -> SuiteResult -> IO ()
reportConsole Handle
outputHandle SuiteResult
results
Maybe Handle
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ()
case junitPath settings of
Maybe FilePath
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ()
Just FilePath
path -> FilePath -> SuiteResult -> IO ()
reportJunit FilePath
path SuiteResult
results
if writeDevLog settings
then do
logExplorerAvailable <- isLogExplorerAvailable
if logExplorerAvailable
then putTextLn "\nRun log-explorer in your shell to inspect logs collected during this test run."
else putTextLn "\nInstall the log-explorer tool to inspect logs collected during test runs. Find it at github.com/NoRedInk/haskell-libraries."
Stack.withFrozenCallStack reportLogfile results
else Prelude.pure ()
Test.Reporter.ExitCode.report results
reportConsole :: System.IO.Handle -> Internal.SuiteResult -> Prelude.IO ()
reportConsole :: Handle -> SuiteResult -> IO ()
reportConsole Handle
outputHandle SuiteResult
results =
Handle -> SuiteResult -> IO ()
Test.Reporter.Stdout.report Handle
outputHandle SuiteResult
results
reportLogfile :: (Stack.HasCallStack) => Internal.SuiteResult -> Prelude.IO ()
reportLogfile :: HasCallStack => SuiteResult -> IO ()
reportLogfile SuiteResult
results =
(HasCallStack => (TracingSpan -> IO ()) -> SuiteResult -> IO ())
-> (TracingSpan -> IO ()) -> SuiteResult -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
HasCallStack => (TracingSpan -> IO ()) -> SuiteResult -> IO ()
(TracingSpan -> IO ()) -> SuiteResult -> IO ()
Test.Reporter.Logfile.report
TracingSpan -> IO ()
Platform.DevLog.writeSpanToDevLog
SuiteResult
results
reportJunit :: Prelude.String -> Internal.SuiteResult -> Prelude.IO ()
reportJunit :: FilePath -> SuiteResult -> IO ()
reportJunit FilePath
path SuiteResult
results =
FilePath -> SuiteResult -> IO ()
Test.Reporter.Junit.report FilePath
path SuiteResult
results
getJunitPath :: [Prelude.String] -> Maybe Prelude.String
getJunitPath :: [FilePath] -> Maybe FilePath
getJunitPath [FilePath]
args =
case [FilePath]
args of
[] -> Maybe FilePath
forall a. Maybe a
Nothing
FilePath
"--xml" : FilePath
path : [FilePath]
_ -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path
FilePath
_ : [FilePath]
rest -> [FilePath] -> Maybe FilePath
getJunitPath [FilePath]
rest
isLogExplorerAvailable :: Prelude.IO Bool
isLogExplorerAvailable :: IO Bool
isLogExplorerAvailable = do
FilePath -> IO (Maybe FilePath)
System.Directory.findExecutable FilePath
"log-explorer"
IO (Maybe FilePath) -> (IO (Maybe FilePath) -> IO Bool) -> IO Bool
forall a b. a -> (a -> b) -> b
|> (Maybe FilePath -> Bool) -> IO (Maybe FilePath) -> IO Bool
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe FilePath
forall a. Maybe a
Nothing)