module Run (
doctest
#ifdef TEST
, doctest_
, Summary
, stripOptGhc
#endif
) where
import Data.List
import Control.Monad (when)
import System.Exit (exitFailure)
import System.IO
import qualified Control.Exception as E
import Panic
import Parse
import Help
import Report
import qualified Interpreter
doctest :: [String] -> IO ()
doctest args
| "--help" `elem` args = putStr usage
| "--version" `elem` args = printVersion
| otherwise = do
let (f, args_) = stripOptGhc args
when f $ do
hPutStrLn stderr "WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."
hFlush stderr
r <- doctest_ args_ `E.catch` \e -> do
case fromException e of
Just (UsageError err) -> do
hPutStrLn stderr ("doctest: " ++ err)
hPutStrLn stderr "Try `doctest --help' for more information."
exitFailure
_ -> E.throw e
when (not $ isSuccess r) exitFailure
isSuccess :: Summary -> Bool
isSuccess s = sErrors s == 0 && sFailures s == 0
stripOptGhc :: [String] -> (Bool, [String])
stripOptGhc = go
where
go args = case args of
[] -> (False, [])
"--optghc" : opt : rest -> (True, opt : snd (go rest))
opt : rest -> maybe (fmap (opt :)) (\x (_, xs) -> (True, x :xs)) (stripPrefix "--optghc=" opt) (go rest)
doctest_ :: [String] -> IO Summary
doctest_ args = do
modules <- getDocTests args
Interpreter.withInterpreter args $ \repl -> do
runModules repl modules