doctest 0.11.2 → 0.11.3
raw patch · 5 files changed
+121/−72 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- doctest.cabal +2/−2
- src/Help.hs +0/−27
- src/Options.hs +90/−0
- src/Parse.hs +4/−2
- src/Run.hs +25/−41
doctest.cabal view
@@ -1,5 +1,5 @@ name: doctest-version: 0.11.2+version: 0.11.3 synopsis: Test interactive Haskell examples description: The doctest program checks examples in source code comments. It is modeled after doctest for Python@@ -37,7 +37,7 @@ , GhcUtil , Interpreter , Location- , Help+ , Options , PackageDBs , Parse , Paths_doctest
− src/Help.hs
@@ -1,27 +0,0 @@-module Help (- usage-, printVersion-) where--import Paths_doctest (version)-import Data.Version (showVersion)-import Config as GHC-import Interpreter (ghc)--usage :: String-usage = unlines [- "Usage:"- , " doctest [ GHC OPTION | MODULE ]..."- , " doctest --help"- , " doctest --version"- , ""- , "Options:"- , " --help display this help and exit"- , " --version output version information and exit"- ]--printVersion :: IO ()-printVersion = do- putStrLn ("doctest version " ++ showVersion version)- putStrLn ("using version " ++ GHC.cProjectVersion ++ " of the GHC API")- putStrLn ("using " ++ ghc)
+ src/Options.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE CPP #-}+module Options (+ Result(..)+, Run(..)+, parseOptions+#ifdef TEST+, usage+, info+, versionInfo+#endif+) where++import Prelude ()+import Prelude.Compat++import Data.List.Compat+import Data.Maybe++import qualified Paths_doctest+import Data.Version (showVersion)+import Config as GHC+import Interpreter (ghc)++usage :: String+usage = unlines [+ "Usage:"+ , " doctest [ --no-magic | GHC OPTION | MODULE ]..."+ , " doctest --help"+ , " doctest --version"+ , " doctest --info"+ , ""+ , "Options:"+ , " --help display this help and exit"+ , " --version output version information and exit"+ , " --info output machine-readable version information and exit"+ ]++version :: String+version = showVersion Paths_doctest.version++ghcVersion :: String+ghcVersion = GHC.cProjectVersion++versionInfo :: String+versionInfo = unlines [+ "doctest version " ++ version+ , "using version " ++ ghcVersion ++ " of the GHC API"+ , "using " ++ ghc+ ]++info :: String+info = "[ " ++ (intercalate "\n, " . map show $ [+ ("version", version)+ , ("ghc_version", ghcVersion)+ , ("ghc", ghc)+ ]) ++ "\n]\n"++data Result = Output String | Result Run+ deriving (Eq, Show)++type Warning = String++data Run = Run {+ runWarnings :: [Warning]+, runOptions :: [String]+, runMagicMode :: Bool+} deriving (Eq, Show)++parseOptions :: [String] -> Result+parseOptions args+ | "--help" `elem` args = Output usage+ | "--info" `elem` args = Output info+ | "--version" `elem` args = Output versionInfo+ | otherwise = case stripOptGhc <$> stripNoMagic args of+ (magicMode, (warning, xs)) -> Result (Run (maybeToList warning) xs magicMode)++stripNoMagic :: [String] -> (Bool, [String])+stripNoMagic args = (noMagic `notElem` args, filter (/= noMagic) args)+ where+ noMagic = "--no-magic"++stripOptGhc :: [String] -> (Maybe Warning, [String])+stripOptGhc = go+ where+ go args = case args of+ [] -> (Nothing, [])+ "--optghc" : opt : rest -> (Just warning, opt : snd (go rest))+ opt : rest -> maybe (fmap (opt :)) (\x (_, xs) -> (Just warning, x : xs)) (stripPrefix "--optghc=" opt) (go rest)++ warning = "WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."
src/Parse.hs view
@@ -53,8 +53,10 @@ -- Extract 'DocTest's from all given modules and all modules included by the -- given modules. getDocTests :: [String] -> IO [Module [Located DocTest]] -- ^ Extracted 'DocTest's-getDocTests args = do- filter (not . isEmpty) . map parseModule <$> extract args+getDocTests args = parseModules <$> extract args++parseModules :: [Module (Located String)] -> [Module [Located DocTest]]+parseModules = filter (not . isEmpty) . map parseModule where isEmpty (Module _ setup tests) = null tests && isNothing setup
src/Run.hs view
@@ -4,7 +4,6 @@ #ifdef TEST , doctest_ , Summary-, stripOptGhc , expandDirs #endif ) where@@ -12,7 +11,6 @@ import Prelude () import Prelude.Compat -import Data.List.Compat import Control.Monad (when, unless) import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents) import System.Environment (getEnvironment)@@ -26,7 +24,7 @@ import PackageDBs import Parse-import Help+import Options import Runner import qualified Interpreter @@ -43,33 +41,33 @@ -- If a directory is given, it is traversed to find all .hs and .lhs files -- inside of it, ignoring hidden entries. doctest :: [String] -> IO ()-doctest args0- | "--help" `elem` args0 = putStr usage- | "--version" `elem` args0 = printVersion- | otherwise = do- args <- concat <$> mapM expandDirs args0- i <- Interpreter.interpreterSupported- unless i $ do- hPutStrLn stderr "WARNING: GHC does not support --interactive, skipping tests"- exitSuccess+doctest args0 = case parseOptions args0 of+ Output s -> putStr s+ Result (Run warnings args_ magicMode) -> do+ mapM_ (hPutStrLn stderr) warnings+ hFlush stderr - let (f, args_) = stripOptGhc args- when f $ do- hPutStrLn stderr "WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."- hFlush stderr+ i <- Interpreter.interpreterSupported+ unless i $ do+ hPutStrLn stderr "WARNING: GHC does not support --interactive, skipping tests"+ exitSuccess - packageDBArgs <- getPackageDBArgs- let addPackageConf = (packageDBArgs ++)- addDistArgs <- getAddDistArgs+ args <- case magicMode of+ False -> return args_+ True -> do+ expandedArgs <- concat <$> mapM expandDirs args_+ packageDBArgs <- getPackageDBArgs+ addDistArgs <- getAddDistArgs+ return (addDistArgs $ packageDBArgs ++ expandedArgs) - r <- doctest_ (addDistArgs $ addPackageConf 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.throwIO e- when (not $ isSuccess r) exitFailure+ 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.throwIO e+ when (not $ isSuccess r) exitFailure -- | Expand a reference to a directory to all .hs and .lhs files within it. expandDirs :: String -> IO [String]@@ -124,20 +122,6 @@ isSuccess :: Summary -> Bool isSuccess s = sErrors s == 0 && sFailures s == 0---- |--- Strip --optghc from GHC options. This is for backward compatibility with--- previous versions of doctest.------ A boolean is returned with the stripped arguments. It is True if striping--- occurred.-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