{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
module Test.DocTest where
import Prelude ()
import Prelude.Compat
import qualified Data.Set as Set
import Control.Monad (unless)
import System.Exit (exitFailure)
import System.IO
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
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
Summary
r <- Library -> Config -> IO Summary
main 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 :: forall a. [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
main :: Library -> Config -> IO Summary
main :: Library -> Config -> IO Summary
main Library
lib Config{Bool
[String]
Maybe Int
cfgThreads :: Config -> Maybe Int
cfgModules :: Config -> [String]
cfgVerbose :: Config -> Bool
cfgPreserveIt :: Config -> 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"]
[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)
let modules :: [Module [Located DocTest]]
modules = [String]
-> [Module [Located DocTest]] -> [Module [Located DocTest]]
forall a. [String] -> [Module a] -> [Module a]
filterModules [String]
cfgModules [Module [Located DocTest]]
allModules
Maybe Int
-> Bool
-> Bool
-> Bool
-> [String]
-> [Module [Located DocTest]]
-> IO Summary
runModules Maybe Int
cfgThreads Bool
cfgPreserveIt Bool
cfgVerbose Bool
implicitPrelude [String]
evalGhciArgs [Module [Located DocTest]]
modules