    {-# LANGUAGE ImplicitParams #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ViewPatterns #-}

    module Test.DocTest
      ( mainFromCabal
      , mainFromLibrary
      , mainFromCabalWithConfig
      , mainFromLibraryWithConfig

      -- * Internal
      , filterModules
      , isSuccess
      , setSeed
      , run
      ) where

    import           Prelude ()
    import           Prelude.Compat

    import qualified Data.Set as Set
    import           Data.List (intercalate)

    import           Control.Monad (unless)
    import           Control.Monad.Extra (ifM)
    import           System.Exit (exitFailure)
    import           System.IO
    import           System.Random (randomIO)

    import qualified Control.Exception as E

    import GHC.Utils.Panic

    import Test.DocTest.Internal.Options
    import Test.DocTest.Internal.Runner
    import Test.DocTest.Internal.Nix (getNixGhciArgs)

    -- Cabal
    import Distribution.Simple
      ( KnownExtension(ImplicitPrelude), Extension (DisableExtension) )

    -- me
    import Test.DocTest.Helpers
      ( Library (libDefaultExtensions), extractCabalLibrary, findCabalPackage
      , libraryToGhciArgs )
    import Test.DocTest.Internal.Logging (LogLevel(..))

    import qualified Test.DocTest.Internal.Logging as Logging

    -- | Run doctest with given list of arguments.
    --
    -- Example:
    --
    -- @
    -- mainFromCabal "my-project" =<< getArgs
    -- @
    --
    mainFromCabal :: String -> [String] -> IO ()
    mainFromCabal :: [Char] -> [[Char]] -> IO ()
    mainFromCabal [Char]
    libName [[Char]]
    cmdArgs = do
      lib <- [Char] -> IO Library
    extractCabalLibrary ([Char] -> IO Library) -> IO [Char] -> IO Library
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< HasCallStack => [Char] -> IO [Char]
    [Char] -> IO [Char]
    findCabalPackage [Char]
    libName
      mainFromLibrary lib cmdArgs

    -- | Run doctest given config.
    --
    -- Example:
    --
    -- @
    -- mainFromCabal "my-project" defaultConfig
    -- @
    --
    mainFromCabalWithConfig :: String -> Config -> IO ()
    mainFromCabalWithConfig :: [Char] -> Config -> IO ()
    mainFromCabalWithConfig [Char]
    libName Config
    config = do
      lib <- [Char] -> IO Library
    extractCabalLibrary ([Char] -> IO Library) -> IO [Char] -> IO Library
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< HasCallStack => [Char] -> IO [Char]
    [Char] -> IO [Char]
    findCabalPackage [Char]
    libName
      mainFromLibraryWithConfig lib config

    -- | Like 'mainFromCabal', but with a given library.
    mainFromLibrary :: Library -> [String] -> IO ()
    mainFromLibrary :: Library -> [[Char]] -> IO ()
    mainFromLibrary Library
    lib ([[Char]] -> Result Config
    parseOptions -> Result Config
    opts) =
      case Result Config
    opts of
        ResultStdout [Char]
    s -> [Char] -> IO ()
    putStr [Char]
    s
        ResultStderr [Char]
    s -> do
           Handle -> [Char] -> IO ()
    hPutStrLn Handle
    stderr ([Char]
    "doctest: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    s)
           Handle -> [Char] -> IO ()
    hPutStrLn Handle
    stderr [Char]
    "Try `doctest --help' for more information."
           IO ()
    forall a. IO a
    exitFailure
        Result Config
    config -> do
          Library -> Config -> IO ()
    mainFromLibraryWithConfig Library
    lib Config
    config

    -- | Run doctests with given library and config.
    mainFromLibraryWithConfig :: Library -> Config -> IO ()
    mainFromLibraryWithConfig :: Library -> Config -> IO ()
    mainFromLibraryWithConfig Library
    lib Config
    config = do
      r <- Library -> Config -> IO Summary
    run Library
    lib Config
    config IO Summary -> (SomeException -> IO Summary) -> IO Summary
    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 [Char]
    err) -> do
            Handle -> [Char] -> IO ()
    hPutStrLn Handle
    stderr ([Char]
    "doctest: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    err)
            Handle -> [Char] -> IO ()
    hPutStrLn Handle
    stderr [Char]
    "Try `doctest --help' for more information."
            IO Summary
    forall a. IO a
    exitFailure
          Maybe GhcException
    _ -> SomeException -> IO Summary
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO SomeException
    e
      unless (isSuccess r) exitFailure

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

    -- | Filter modules to be tested against a list of modules to be tested (specified
    -- by the user on the command line). If list is empty, test all modules. Throws
    -- and error if a non-existing module was specified.
    filterModules :: [ModuleName] -> [ModuleName] -> [ModuleName]
    filterModules :: [[Char]] -> [[Char]] -> [[Char]]
    filterModules [] [[Char]]
    mods = [[Char]]
    mods
    filterModules [[Char]]
    wantedMods0 [[Char]]
    allMods0
      | ([Char]
    _:[[Char]]
    _) <- [[Char]]
    nonExistingMods = [Char] -> [[Char]]
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "Unknown modules specified: " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [[Char]] -> [Char]
    forall a. Show a => a -> [Char]
    show [[Char]]
    nonExistingMods)
      | Bool
    otherwise = ([Char] -> Bool) -> [[Char]] -> [[Char]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter [Char] -> Bool
    isSpecifiedMod [[Char]]
    allMods0
     where
      wantedMods1 :: Set [Char]
    wantedMods1 = [[Char]] -> Set [Char]
    forall a. Ord a => [a] -> Set a
    Set.fromList [[Char]]
    wantedMods0
      allMods1 :: Set [Char]
    allMods1 = [[Char]] -> Set [Char]
    forall a. Ord a => [a] -> Set a
    Set.fromList [[Char]]
    allMods0

      nonExistingMods :: [[Char]]
    nonExistingMods = Set [Char] -> [[Char]]
    forall a. Set a -> [a]
    Set.toList (Set [Char]
    wantedMods1 Set [Char] -> Set [Char] -> Set [Char]
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` Set [Char]
    allMods1)
      isSpecifiedMod :: [Char] -> Bool
    isSpecifiedMod [Char]
    nm = [Char]
    nm [Char] -> Set [Char] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set [Char]
    wantedMods1

    setSeed :: (?verbosity :: LogLevel) => ModuleConfig -> IO ModuleConfig
    setSeed :: (?verbosity::LogLevel) => ModuleConfig -> IO ModuleConfig
    setSeed cfg :: ModuleConfig
    cfg@ModuleConfig{cfgRandomizeOrder :: ModuleConfig -> Bool
    cfgRandomizeOrder=Bool
    True, cfgSeed :: ModuleConfig -> Maybe Int
    cfgSeed=Maybe Int
    Nothing} = do
      -- Using an absolute number to prevent copy+paste errors
      seed <- Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> IO Int -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Int
    forall a (m :: * -> *). (Random a, MonadIO m) => m a
    randomIO
      Logging.log Info ("Using freshly generated seed to randomize test order: " <> show seed)
      pure cfg{cfgSeed=Just seed}
    setSeed ModuleConfig
    cfg = ModuleConfig -> IO ModuleConfig
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ModuleConfig
    cfg

    -- | Run doctest for given library and config. Produce a summary of all tests.
    run :: Library -> Config -> IO Summary
    run :: Library -> Config -> IO Summary
    run Library
    lib Config{Bool
    [[Char]]
    Maybe Int
    LogLevel
    ModuleConfig
    cfgLogLevel :: LogLevel
    cfgModules :: [[Char]]
    cfgThreads :: Maybe Int
    cfgModuleConfig :: ModuleConfig
    cfgNix :: Bool
    cfgGhcArgs :: [[Char]]
    cfgGhcArgs :: Config -> [[Char]]
    cfgNix :: Config -> Bool
    cfgModuleConfig :: Config -> ModuleConfig
    cfgThreads :: Config -> Maybe Int
    cfgModules :: Config -> [[Char]]
    cfgLogLevel :: Config -> LogLevel
    ..} = do
      nixGhciArgs <- IO Bool -> IO [[Char]] -> IO [[Char]] -> IO [[Char]]
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    cfgNix) IO [[Char]]
    getNixGhciArgs ([[Char]] -> IO [[Char]]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [])

      let
        implicitPrelude = KnownExtension -> Extension
    DisableExtension KnownExtension
    ImplicitPrelude Extension -> [Extension] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` Library -> [Extension]
    libDefaultExtensions Library
    lib
        (includeArgs, allModules, otherGhciArgs) = libraryToGhciArgs lib
        evalGhciArgs = [[Char]]
    otherGhciArgs [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]
    "-XNoImplicitPrelude"] [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]]
    nixGhciArgs
        parseGhcArgs = [[Char]]
    includeArgs [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]]
    otherGhciArgs [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]]
    nixGhciArgs [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]]
    cfgGhcArgs

      let
        ?verbosity = cfgLogLevel

      modConfig <- setSeed cfgModuleConfig

      -- Run tests
      Logging.log Verbose "Running examples.."
      let
        filteredModules = [[Char]] -> [[Char]] -> [[Char]]
    filterModules [[Char]]
    cfgModules [[Char]]
    allModules
        filteredModulesMsg = [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    ", " [[Char]]
    filteredModules
      Logging.log Debug ("Running examples in modules: " <> filteredModulesMsg)
      runModules modConfig cfgThreads implicitPrelude parseGhcArgs evalGhciArgs filteredModules