module Run (
doctest
#ifdef TEST
, doctest_
, Summary
, stripOptGhc
#endif
) where
import Data.Monoid
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 = do
case args of
["--help"] -> do
putStr usage
["--version"] ->
printVersion
_ -> 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
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
let c = (mconcat . map count) modules
hPrint stderr c
Interpreter.withInterpreter args $ \repl -> do
runModules (exampleCount c) repl modules
where
exampleCount (Count n _) = n
isSuccess :: Summary -> Bool
isSuccess s = sErrors s == 0 && sFailures s == 0
data Count = Count Int Int
instance Monoid Count where
mempty = Count 0 0
(Count x1 y1) `mappend` (Count x2 y2) = Count (x1 + x2) (y1 + y2)
instance Show Count where
show (Count 1 1) = "There is one test, with one single interaction."
show (Count 1 iCount) = "There is one test, with " ++ show iCount ++ " interactions."
show (Count tCount iCount) = "There are " ++ show tCount ++ " tests, with " ++ show iCount ++ " total interactions."
count :: Module DocTest -> Count
count (Module _ examples) = (mconcat . map f) examples
where
f :: DocTest -> Count
f (Example x) = Count 1 (length x)
f (Property _) = Count 1 1