    {-# LANGUAGE CPP #-}
    {-# LANGUAGE LambdaCase #-}
    module Run (
      doctest
    , doctestWithRepl

    , Config(..)
    , defaultConfig
    , doctestWith

    , Result
    , Summary(..)
    , formatSummary
    , isSuccess
    , evaluateResult
    , doctestWithResult

    , runDocTests
    #ifdef TEST
    , expandDirs
    #endif
    ) where

    import           Imports

    import           GHC.ResponseFile (expandResponse)
    import           System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents)
    import           System.Environment (getEnvironment)
    import           System.Exit (exitFailure, exitSuccess)
    import           System.FilePath ((</>), takeExtension)
    import           System.IO
    import           System.IO.CodePage (withCP65001)

    import qualified Control.Exception as E

    #if __GLASGOW_HASKELL__ < 900
    import           Panic
    #else
    import           GHC.Utils.Panic
    #endif

    import           PackageDBs
    import           Parse
    import           Options hiding (Result(..))
    import qualified Options
    import           Runner
    import           Location
    import qualified Interpreter

    -- | Run doctest with given list of arguments.
    --
    -- Example:
    --
    -- >>> doctest ["-iexample/src", "example/src/Example.hs"]
    -- ...
    -- Examples: 2  Tried: 2  Errors: 0  Failures: 0
    --
    -- This can be used to create a Cabal test suite that runs doctest for your
    -- project.
    --
    -- 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 :: [String] -> IO ()
    doctest = (String, [String]) -> [String] -> IO ()
    doctestWithRepl (Config -> (String, [String])
    repl Config
    defaultConfig)

    doctestWithRepl :: (String, [String]) -> [String] -> IO ()
    doctestWithRepl :: (String, [String]) -> [String] -> IO ()
    doctestWithRepl (String, [String])
    repl = [String] -> IO [String]
    expandResponse ([String] -> IO [String])
    -> ([String] -> IO ()) -> [String] -> IO ()
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> \ [String]
    args0 -> case [String] -> Result Run
    parseOptions [String]
    args0 of
      Options.ProxyToGhc [String]
    args -> String -> [String] -> IO ()
    exec String
    Interpreter.ghc [String]
    args
      Options.Output String
    s -> String -> IO ()
    putStr String
    s
      Options.Result (Run [String]
    warnings Bool
    magicMode Config
    config) -> do
        (String -> IO ()) -> [String] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Handle -> String -> IO ()
    hPutStrLn Handle
    stderr) [String]
    warnings
        Handle -> IO ()
    hFlush Handle
    stderr

        i <- IO Bool
    Interpreter.interpreterSupported
        unless i $ do
          hPutStrLn stderr "WARNING: GHC does not support --interactive, skipping tests"
          exitSuccess

        opts <- case magicMode of
          Bool
    False -> [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Config -> [String]
    ghcOptions Config
    config)
          Bool
    True -> do
            expandedArgs <- [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (String -> IO [String]) -> [String] -> IO [[String]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM String -> IO [String]
    expandDirs (Config -> [String]
    ghcOptions Config
    config)
            packageDBArgs <- getPackageDBArgs
            addDistArgs <- getAddDistArgs
            return (addDistArgs $ packageDBArgs ++ expandedArgs)
        doctestWith config{repl, ghcOptions = opts}

    -- | Expand a reference to a directory to all .hs and .lhs files within it.
    expandDirs :: String -> IO [String]
    expandDirs :: String -> IO [String]
    expandDirs String
    fp0 = do
        isDir <- String -> IO Bool
    doesDirectoryExist String
    fp0
        if isDir
            then findHaskellFiles fp0
            else return [fp0]
      where
        findHaskellFiles :: String -> IO [String]
    findHaskellFiles String
    dir = do
            contents <- String -> IO [String]
    getDirectoryContents String
    dir
            concat <$> mapM go (filter (not . hidden) contents)
          where
            go :: String -> IO [String]
    go String
    name = do
                isDir <- String -> IO Bool
    doesDirectoryExist String
    fp
                if isDir
                    then findHaskellFiles fp
                    else if isHaskellFile fp
                            then return [fp]
                            else return []
              where
                fp :: String
    fp = String
    dir String -> String -> String
    </> String
    name

        hidden :: String -> Bool
    hidden (Char
    '.':String
    _) = Bool
    True
        hidden String
    _ = Bool
    False

        isHaskellFile :: String -> Bool
    isHaskellFile String
    fp = String -> String
    takeExtension String
    fp String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String
    ".hs", String
    ".lhs"]

    -- | Get the necessary arguments to add the @cabal_macros.h@ file and autogen
    -- directory, if present.
    getAddDistArgs :: IO ([String] -> [String])
    getAddDistArgs :: IO ([String] -> [String])
    getAddDistArgs = do
        env <- IO [(String, String)]
    getEnvironment
        let dist = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "dist" (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "HASKELL_DIST_DIR" [(String, String)]
    env
            autogen = String
    dist String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/build/autogen/"
            cabalMacros = String
    autogen String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "cabal_macros.h"

        dirExists <- doesDirectoryExist autogen
        if dirExists
            then do
                fileExists <- doesFileExist cabalMacros
                return $ \[String]
    rest ->
                      [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String
    "-i", String
    dist, String
    "/build/autogen/"]
                    String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String
    "-optP-include"
                    String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (if Bool
    fileExists
                        then ([String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String
    "-optP", String
    dist, String
    "/build/autogen/cabal_macros.h"]String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :)
                        else [String] -> [String]
    forall a. a -> a
    id) [String]
    rest
            else return id

    doctestWith :: Config -> IO ()
    doctestWith :: Config -> IO ()
    doctestWith = Config -> IO Result
    doctestWithResult (Config -> IO Result) -> (Result -> IO ()) -> Config -> IO ()
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Result -> IO ()
    evaluateResult

    type Result = Summary

    evaluateResult :: Result -> IO ()
    evaluateResult :: Result -> IO ()
    evaluateResult Result
    r = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Result -> Bool
    isSuccess Result
    r) IO ()
    forall a. IO a
    exitFailure

    doctestWithResult :: Config -> IO Result
    doctestWithResult :: Config -> IO Result
    doctestWithResult Config
    config = do
      ([String] -> IO [Module [Located DocTest]]
    extractDocTests (Config -> [String]
    ghcOptions Config
    config) IO [Module [Located DocTest]]
    -> ([Module [Located DocTest]] -> IO Result) -> IO Result
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Config -> [Module [Located DocTest]] -> IO Result
    runDocTests Config
    config) IO Result -> (SomeException -> IO Result) -> IO Result
    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 Result
    forall a. IO a
    exitFailure
          Maybe GhcException
    _ -> SomeException -> IO Result
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO SomeException
    e

    runDocTests :: Config -> [Module [Located DocTest]] -> IO Result
    runDocTests :: Config -> [Module [Located DocTest]] -> IO Result
    runDocTests Config{Bool
    [String]
    (String, [String])
    repl :: Config -> (String, [String])
    ghcOptions :: Config -> [String]
    ghcOptions :: [String]
    fastMode :: Bool
    preserveIt :: Bool
    failFast :: Bool
    verbose :: Bool
    repl :: (String, [String])
    verbose :: Config -> Bool
    failFast :: Config -> Bool
    preserveIt :: Config -> Bool
    fastMode :: Config -> Bool
    ..} [Module [Located DocTest]]
    modules = do
      (String, [String]) -> (Interpreter -> IO Result) -> IO Result
    forall a. (String, [String]) -> (Interpreter -> IO a) -> IO a
    Interpreter.withInterpreter (([String] -> [String] -> [String]
    forall a. Semigroup a => a -> a -> a
    <> [String]
    ghcOptions) ([String] -> [String]) -> (String, [String]) -> (String, [String])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (String, [String])
    repl) ((Interpreter -> IO Result) -> IO Result)
    -> (Interpreter -> IO Result) -> IO Result
    forall a b. (a -> b) -> a -> b
    $ \ Interpreter
    interpreter -> IO Result -> IO Result
    forall a. IO a -> IO a
    withCP65001 (IO Result -> IO Result) -> IO Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ do
        FastMode
    -> PreserveIt
    -> FailFast
    -> Verbose
    -> Interpreter
    -> [Module [Located DocTest]]
    -> IO Result
    runModules
          (if Bool
    fastMode then FastMode
    FastMode else FastMode
    NoFastMode)
          (if Bool
    preserveIt then PreserveIt
    PreserveIt else PreserveIt
    NoPreserveIt)
          (if Bool
    failFast then FailFast
    FailFast else FailFast
    NoFailFast)
          (if Bool
    verbose then Verbose
    Verbose else Verbose
    NonVerbose)
          Interpreter
    interpreter [Module [Located DocTest]]
    modules