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

    , Config(..)
    , defaultConfig
    , doctestWith

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

    , runDocTests
    #ifdef TEST
    , expandDirs
    #endif
    ) where

    import           Imports

    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           System.Process (rawSystem)

    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]
    args0 = case [String] -> Result Run
    parseOptions [String]
    args0 of
      Options.ProxyToGhc [String]
    args -> String -> [String] -> IO ExitCode
    rawSystem String
    Interpreter.ghc [String]
    args IO ExitCode -> (ExitCode -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ExitCode -> IO ()
    forall e a. Exception e => e -> IO a
    E.throwIO
      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

        Bool
    i <- IO Bool
    Interpreter.interpreterSupported
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    i (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
          Handle -> String -> IO ()
    hPutStrLn Handle
    stderr String
    "WARNING: GHC does not support --interactive, skipping tests"
          IO ()
    forall a. IO a
    exitSuccess

        [String]
    opts <- case Bool
    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
            [String]
    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)
            [String]
    packageDBArgs <- IO [String]
    getPackageDBArgs
            [String] -> [String]
    addDistArgs <- IO ([String] -> [String])
    getAddDistArgs
            [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String] -> [String]
    addDistArgs ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [String]
    packageDBArgs [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    expandedArgs)
        Config -> IO ()
    doctestWith Config
    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
        Bool
    isDir <- String -> IO Bool
    doesDirectoryExist String
    fp0
        if Bool
    isDir
            then String -> IO [String]
    findHaskellFiles String
    fp0
            else [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String
    fp0]
      where
        findHaskellFiles :: String -> IO [String]
    findHaskellFiles String
    dir = do
            [String]
    contents <- String -> IO [String]
    getDirectoryContents String
    dir
            [[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]
    go ((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    hidden) [String]
    contents)
          where
            go :: String -> IO [String]
    go String
    name = do
                Bool
    isDir <- String -> IO Bool
    doesDirectoryExist String
    fp
                if Bool
    isDir
                    then String -> IO [String]
    findHaskellFiles String
    fp
                    else if String -> Bool
    isHaskellFile String
    fp
                            then [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String
    fp]
                            else [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    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
        [(String, String)]
    env <- IO [(String, String)]
    getEnvironment
        let dist :: String
    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
    autogen = String
    dist String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/build/autogen/"
            cabalMacros :: String
    cabalMacros = String
    autogen String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "cabal_macros.h"

        Bool
    dirExists <- String -> IO Bool
    doesDirectoryExist String
    autogen
        if Bool
    dirExists
            then do
                Bool
    fileExists <- String -> IO Bool
    doesFileExist String
    cabalMacros
                ([String] -> [String]) -> IO ([String] -> [String])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([String] -> [String]) -> IO ([String] -> [String]))
    -> ([String] -> [String]) -> IO ([String] -> [String])
    forall a b. (a -> b) -> a -> b
    $ \[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 ([String] -> [String]) -> IO ([String] -> [String])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String] -> [String]
    forall a. a -> a
    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

    isSuccess :: Result -> Bool
    isSuccess :: Result -> Bool
    isSuccess Result
    s = Result -> Int
    sErrors Result
    s Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    && Result -> Int
    sFailures Result
    s Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0

    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. 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
    verbose :: Bool
    repl :: (String, [String])
    fastMode :: Config -> Bool
    preserveIt :: Config -> Bool
    verbose :: 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
        Bool
    -> Bool
    -> Bool
    -> Interpreter
    -> [Module [Located DocTest]]
    -> IO Result
    runModules Bool
    fastMode Bool
    preserveIt Bool
    verbose Interpreter
    interpreter [Module [Located DocTest]]
    modules