{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
module Test.DocTest
( mainFromCabal
, mainFromLibrary
, mainFromCabalWithConfig
, mainFromLibraryWithConfig
, filterModules
, isSuccess
, getSeed
, run
) where
import Prelude ()
import Prelude.Compat
import qualified Data.Set as Set
import Control.Monad (unless)
import System.Exit (exitFailure)
import System.IO
import System.Random (randomIO)
import qualified Control.Exception as E
#if __GLASGOW_HASKELL__ < 900
import Panic
#else
import GHC.Utils.Panic
#endif
import Test.DocTest.Internal.Parse
import Test.DocTest.Internal.Options
import Test.DocTest.Internal.Runner
import Distribution.Simple
( KnownExtension(ImplicitPrelude), Extension (DisableExtension) )
import Test.DocTest.Helpers
( Library (libDefaultExtensions), extractCabalLibrary, findCabalPackage
, libraryToGhciArgs )
mainFromCabal :: String -> [String] -> IO ()
mainFromCabal :: String -> [String] -> IO ()
mainFromCabal String
libName [String]
cmdArgs = do
Library
lib <- String -> IO Library
extractCabalLibrary (String -> IO Library) -> IO String -> IO Library
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HasCallStack => String -> IO String
String -> IO String
findCabalPackage String
libName
Library -> [String] -> IO ()
mainFromLibrary Library
lib [String]
cmdArgs
mainFromCabalWithConfig :: String -> Config -> IO ()
mainFromCabalWithConfig :: String -> Config -> IO ()
mainFromCabalWithConfig String
libName Config
config = do
Library
lib <- String -> IO Library
extractCabalLibrary (String -> IO Library) -> IO String -> IO Library
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HasCallStack => String -> IO String
String -> IO String
findCabalPackage String
libName
Library -> Config -> IO ()
mainFromLibraryWithConfig Library
lib Config
config
mainFromLibrary :: Library -> [String] -> IO ()
mainFromLibrary :: Library -> [String] -> IO ()
mainFromLibrary Library
lib ([String] -> Result Config
parseOptions -> Result Config
opts) =
case Result Config
opts of
ResultStdout String
s -> String -> IO ()
putStr String
s
ResultStderr String
s -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"doctest: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Try `doctest --help' for more information."
IO ()
forall a. IO a
exitFailure
Result Config
config -> do
Library -> Config -> IO ()
mainFromLibraryWithConfig Library
lib Config
config
mainFromLibraryWithConfig :: Library -> Config -> IO ()
mainFromLibraryWithConfig :: Library -> Config -> IO ()
mainFromLibraryWithConfig Library
lib Config
config = do
Summary
r <- Library -> Config -> IO Summary
run Library
lib Config
config IO Summary -> (SomeException -> IO Summary) -> IO Summary
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \SomeException
e -> do
case SomeException -> Maybe GhcException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just (UsageError String
err) -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"doctest: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Try `doctest --help' for more information."
IO Summary
forall a. IO a
exitFailure
Maybe GhcException
_ -> SomeException -> IO Summary
forall e a. Exception e => e -> IO a
E.throwIO SomeException
e
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Summary -> Bool
isSuccess Summary
r) IO ()
forall a. IO a
exitFailure
isSuccess :: Summary -> Bool
isSuccess :: Summary -> Bool
isSuccess Summary
s = Summary -> Int
sErrors Summary
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Summary -> Int
sFailures Summary
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
filterModules :: [ModuleName] -> [Module a] -> [Module a]
filterModules :: [String] -> [Module a] -> [Module a]
filterModules [] [Module a]
mods = [Module a]
mods
filterModules [String]
wantedMods0 [Module a]
allMods0
| (String
_:[String]
_) <- [String]
nonExistingMods = String -> [Module a]
forall a. HasCallStack => String -> a
error (String
"Unknown modules specified: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall a. Show a => a -> String
show [String]
nonExistingMods)
| Bool
otherwise = (Module a -> Bool) -> [Module a] -> [Module a]
forall a. (a -> Bool) -> [a] -> [a]
filter Module a -> Bool
forall a. Module a -> Bool
isSpecifiedMod [Module a]
allMods0
where
wantedMods1 :: Set String
wantedMods1 = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
wantedMods0
allMods1 :: Set String
allMods1 = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ((Module a -> String) -> [Module a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Module a -> String
forall a. Module a -> String
moduleName [Module a]
allMods0)
nonExistingMods :: [String]
nonExistingMods = Set String -> [String]
forall a. Set a -> [a]
Set.toList (Set String
wantedMods1 Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set String
allMods1)
isSpecifiedMod :: Module a -> Bool
isSpecifiedMod Module{String
moduleName :: String
moduleName :: forall a. Module a -> String
moduleName} = String
moduleName String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
wantedMods1
getSeed
:: Bool
-> Bool
-> Maybe Int
-> IO (Maybe Int)
getSeed :: Bool -> Bool -> Maybe Int -> IO (Maybe Int)
getSeed Bool
_quiet Bool
False Maybe Int
_ = Maybe Int -> IO (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing
getSeed Bool
_quiet Bool
True (Just Int
seed) = Maybe Int -> IO (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
seed)
getSeed Bool
quiet Bool
True Maybe Int
Nothing = do
Int
seed <- Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> IO Int -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quiet (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String
"Using freshly generated seed to randomize test order: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
seed)
Maybe Int -> IO (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
seed)
run :: Library -> Config -> IO Summary
run :: Library -> Config -> IO Summary
run Library
lib Config{Bool
[String]
Maybe Int
cfgQuiet :: Config -> Bool
cfgSeed :: Config -> Maybe Int
cfgRandomizeOrder :: Config -> Bool
cfgThreads :: Config -> Maybe Int
cfgModules :: Config -> [String]
cfgVerbose :: Config -> Bool
cfgPreserveIt :: Config -> Bool
cfgQuiet :: Bool
cfgSeed :: Maybe Int
cfgRandomizeOrder :: Bool
cfgThreads :: Maybe Int
cfgModules :: [String]
cfgVerbose :: Bool
cfgPreserveIt :: Bool
..} = do
let
implicitPrelude :: Bool
implicitPrelude = KnownExtension -> Extension
DisableExtension KnownExtension
ImplicitPrelude Extension -> [Extension] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Library -> [Extension]
libDefaultExtensions Library
lib
([String]
includeArgs, [String]
moduleArgs, [String]
otherGhciArgs) = Library -> ([String], [String], [String])
libraryToGhciArgs Library
lib
evalGhciArgs :: [String]
evalGhciArgs = [String]
otherGhciArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-XNoImplicitPrelude"]
Maybe Int
seed <- Bool -> Bool -> Maybe Int -> IO (Maybe Int)
getSeed Bool
cfgQuiet Bool
cfgRandomizeOrder Maybe Int
cfgSeed
[Module [Located DocTest]]
allModules <- [String] -> IO [Module [Located DocTest]]
getDocTests ([String]
includeArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
moduleArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
otherGhciArgs)
Maybe Int
-> Bool
-> Bool
-> Maybe Int
-> Bool
-> [String]
-> Bool
-> [Module [Located DocTest]]
-> IO Summary
runModules
Maybe Int
cfgThreads Bool
cfgPreserveIt Bool
cfgVerbose Maybe Int
seed Bool
implicitPrelude [String]
evalGhciArgs
Bool
cfgQuiet ([String]
-> [Module [Located DocTest]] -> [Module [Located DocTest]]
forall a. [String] -> [Module a] -> [Module a]
filterModules [String]
cfgModules [Module [Located DocTest]]
allModules)