    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ImplicitParams #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE TypeApplications #-}

    module Test.DocTest.Internal.Runner where

    import           Prelude hiding (putStr, putStrLn, error)

    import           Control.Concurrent (Chan, writeChan, readChan, newChan, forkIO, ThreadId, myThreadId, MVar, newMVar)
    import           Control.Exception (SomeException, AsyncException, throw)
    import           Control.Monad hiding (forM_)
    import           Control.Monad.Catch (catches, Handler (Handler))
    import           Data.Foldable (forM_)
    import           Data.Function (on)
    import           Data.List (sortBy)
    import           Data.Maybe (fromMaybe, maybeToList)
    import           GHC.Conc (getNumProcessors)
    import           System.IO (hPutStrLn, hPutStr, stderr, hIsTerminalDevice)
    import           System.Random (randoms, mkStdGen)
    import           Text.Printf (printf)

    import           Control.Monad.Trans.State
    import           Control.Monad.IO.Class

    import           Test.DocTest.Internal.Interpreter (Interpreter)
    import qualified Test.DocTest.Internal.Interpreter as Interpreter
    import           Test.DocTest.Internal.Parse
    import           Test.DocTest.Internal.Options
      ( ModuleName, ModuleConfig (cfgPreserveIt), cfgSeed, cfgPreserveIt
      , cfgRandomizeOrder, cfgImplicitModuleImport, parseLocatedModuleOptions)
    import           Test.DocTest.Internal.Location
    import qualified Test.DocTest.Internal.Property as Property
    import           Test.DocTest.Internal.Extract (isEmptyModule)
    import           Test.DocTest.Internal.GhcUtil (withGhc)
    import           Test.DocTest.Internal.Logging (LogLevel (..), formatLog, shouldLog, getThreadName)
    import           Test.DocTest.Internal.Runner.Example

    import           System.IO.CodePage (withCP65001)
    import           Control.Monad.Extra (whenM)
    import GHC (Ghc)

    #ifdef mingw32_HOST_OS
    import           Control.Concurrent.MVar (putMVar, takeMVar)
    import           Control.Monad.Catch (finally)
    #endif

    -- | Whether an "example" is part of setup block
    data FromSetup = FromSetup | NotFromSetup

    -- | Summary of a test run.
    data Summary = Summary {
        Summary -> Int
    sExamples :: Int  -- ^ Total number of lines of examples (excluding setup)
      , Summary -> Int
    sTried    :: Int  -- ^ Executed /sTried/ lines so  far
      , Summary -> Int
    sErrors   :: Int  -- ^ Couldn't execute /sErrors/ examples
      , Summary -> Int
    sFailures :: Int  -- ^ Got unexpected output for /sFailures/ examples
    } deriving Summary -> Summary -> Bool
    (Summary -> Summary -> Bool)
    -> (Summary -> Summary -> Bool) -> Eq Summary
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Summary -> Summary -> Bool
    == :: Summary -> Summary -> Bool
    $c/= :: Summary -> Summary -> Bool
    /= :: Summary -> Summary -> Bool
    Eq

    emptySummary :: Summary
    emptySummary :: Summary
    emptySummary = Int -> Int -> Int -> Int -> Summary
    Summary Int
    0 Int
    0 Int
    0 Int
    0

    -- | Format a summary.
    instance Show Summary where
      show :: Summary -> String
    show (Summary Int
    examples Int
    tried Int
    errors Int
    failures) =
        String -> Int -> Int -> Int -> Int -> String
    forall r. PrintfType r => String -> r
    printf String
    "Examples: %d  Tried: %d  Errors: %d  Unexpected output: %d" Int
    examples Int
    tried Int
    errors Int
    failures

    -- | Sum up summaries.
    instance Monoid Summary where
      mempty :: Summary
    mempty = Int -> Int -> Int -> Int -> Summary
    Summary Int
    0 Int
    0 Int
    0 Int
    0

    instance Semigroup Summary where
      <> :: Summary -> Summary -> Summary
    (<>) (Summary Int
    x1 Int
    x2 Int
    x3 Int
    x4) (Summary Int
    y1 Int
    y2 Int
    y3 Int
    y4) =
        Int -> Int -> Int -> Int -> Summary
    Summary (Int
    x1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y1) (Int
    x2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y2) (Int
    x3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y3) (Int
    x4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y4)

    -- | Run all examples from a list of modules.
    runModules
      :: (?verbosity::LogLevel)
      => ModuleConfig
      -- ^ Configuration options specific to module
      -> Maybe Int
      -- ^ Number of threads to use. Defaults to 'getNumProcessors'.
      -> Bool
      -- ^ Implicit Prelude
      -> [String]
      -- ^ Arguments passed to the GHC for parsing
      -> [String]
      -- ^ Arguments passed to the GHCi process.
      -> [ModuleName]
      -- ^ Modules under test
      -> IO Summary
    runModules :: (?verbosity::LogLevel) =>
    ModuleConfig
    -> Maybe Int
    -> Bool
    -> [String]
    -> [String]
    -> [String]
    -> IO Summary
    runModules ModuleConfig
    modConfig Maybe Int
    nThreads Bool
    implicitPrelude [String]
    parseArgs [String]
    evalArgs [String]
    modules = do
      isInteractive <- Handle -> IO Bool
    hIsTerminalDevice Handle
    stderr
      ghcLock <- newMVar ()

      -- Start a thread pool. It sends status updates to this thread through 'output'.
      nCores <- getNumProcessors
      (input, output) <-
        makeThreadPool
          (fromMaybe nCores nThreads)
          parseArgs
          (runModule modConfig implicitPrelude ghcLock evalArgs)

      -- Send instructions to threads
      liftIO (mapM_ (writeChan input) modules)

      let
        initState = ReportState
          { reportStateCount :: Int
    reportStateCount = Int
    0
          , reportStateInteractive :: Bool
    reportStateInteractive = Bool
    isInteractive
          , reportStateSummary :: Summary
    reportStateSummary = Summary
    forall a. Monoid a => a
    mempty
          }

      threadId <- myThreadId
      let ?threadId = threadId

      ReportState{reportStateSummary} <- (`execStateT` initState) $ do
        consumeUpdates output (length modules)
        gets (show . reportStateSummary) >>= report Info

      return reportStateSummary
     where
      consumeUpdates ::
        (?threadId :: ThreadId) =>
        Chan (ThreadId, ReportUpdate) ->
        Int ->
        StateT ReportState IO ()
      consumeUpdates :: (?threadId::ThreadId) =>
    Chan (ThreadId, ReportUpdate) -> Int -> StateT ReportState IO ()
    consumeUpdates Chan (ThreadId, ReportUpdate)
    _output Int
    0 = () -> StateT ReportState IO ()
    forall a. a -> StateT ReportState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      consumeUpdates Chan (ThreadId, ReportUpdate)
    output Int
    modsLeft = do
        (threadId, update) <- IO (ThreadId, ReportUpdate)
    -> StateT ReportState IO (ThreadId, ReportUpdate)
    forall a. IO a -> StateT ReportState IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Chan (ThreadId, ReportUpdate) -> IO (ThreadId, ReportUpdate)
    forall a. Chan a -> IO a
    readChan Chan (ThreadId, ReportUpdate)
    output)
        let ?threadId = threadId
        consumeUpdates output =<<
          case update of
            UpdateInternalError String
    modName SomeException
    e -> (?verbosity::LogLevel, ?threadId::ThreadId) =>
    String -> SomeException -> StateT ReportState IO ()
    String -> SomeException -> StateT ReportState IO ()
    reportInternalError String
    modName SomeException
    e StateT ReportState IO ()
    -> StateT ReportState IO Int -> StateT ReportState IO Int
    forall a b.
    StateT ReportState IO a
    -> StateT ReportState IO b -> StateT ReportState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> StateT ReportState IO Int
    forall a. a -> StateT ReportState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    modsLeft Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
            UpdateImportError String
    modName Either String String
    result -> (?verbosity::LogLevel, ?threadId::ThreadId) =>
    String -> Either String String -> StateT ReportState IO ()
    String -> Either String String -> StateT ReportState IO ()
    reportImportError String
    modName Either String String
    result StateT ReportState IO ()
    -> StateT ReportState IO Int -> StateT ReportState IO Int
    forall a b.
    StateT ReportState IO a
    -> StateT ReportState IO b -> StateT ReportState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> StateT ReportState IO Int
    forall a. a -> StateT ReportState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    modsLeft Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
            UpdateSuccess FromSetup
    fs -> (?verbosity::LogLevel, ?threadId::ThreadId) =>
    FromSetup -> StateT ReportState IO ()
    FromSetup -> StateT ReportState IO ()
    reportSuccess FromSetup
    fs StateT ReportState IO ()
    -> StateT ReportState IO () -> StateT ReportState IO ()
    forall a b.
    StateT ReportState IO a
    -> StateT ReportState IO b -> StateT ReportState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> StateT ReportState IO ()
    (?verbosity::LogLevel) => StateT ReportState IO ()
    reportProgress StateT ReportState IO ()
    -> StateT ReportState IO Int -> StateT ReportState IO Int
    forall a b.
    StateT ReportState IO a
    -> StateT ReportState IO b -> StateT ReportState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> StateT ReportState IO Int
    forall a. a -> StateT ReportState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    modsLeft
            UpdateFailure FromSetup
    fs Location
    loc String
    expr [String]
    errs -> (?verbosity::LogLevel, ?threadId::ThreadId) =>
    FromSetup
    -> Location -> String -> [String] -> StateT ReportState IO ()
    FromSetup
    -> Location -> String -> [String] -> StateT ReportState IO ()
    reportFailure FromSetup
    fs Location
    loc String
    expr [String]
    errs StateT ReportState IO ()
    -> StateT ReportState IO Int -> StateT ReportState IO Int
    forall a b.
    StateT ReportState IO a
    -> StateT ReportState IO b -> StateT ReportState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> StateT ReportState IO Int
    forall a. a -> StateT ReportState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    modsLeft
            UpdateError FromSetup
    fs Location
    loc String
    expr String
    err -> (?verbosity::LogLevel, ?threadId::ThreadId) =>
    FromSetup
    -> Location -> String -> String -> StateT ReportState IO ()
    FromSetup
    -> Location -> String -> String -> StateT ReportState IO ()
    reportError FromSetup
    fs Location
    loc String
    expr String
    err StateT ReportState IO ()
    -> StateT ReportState IO Int -> StateT ReportState IO Int
    forall a b.
    StateT ReportState IO a
    -> StateT ReportState IO b -> StateT ReportState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> StateT ReportState IO Int
    forall a. a -> StateT ReportState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    modsLeft
            UpdateOptionError Location
    loc String
    err -> (?verbosity::LogLevel, ?threadId::ThreadId) =>
    Location -> String -> StateT ReportState IO ()
    Location -> String -> StateT ReportState IO ()
    reportOptionError Location
    loc String
    err StateT ReportState IO ()
    -> StateT ReportState IO Int -> StateT ReportState IO Int
    forall a b.
    StateT ReportState IO a
    -> StateT ReportState IO b -> StateT ReportState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> StateT ReportState IO Int
    forall a. a -> StateT ReportState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    modsLeft
            ReportUpdate
    UpdateModuleDone -> Int -> StateT ReportState IO Int
    forall a. a -> StateT ReportState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    modsLeft Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
            UpdateLog LogLevel
    lvl String
    msg -> (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    lvl String
    msg StateT ReportState IO ()
    -> StateT ReportState IO Int -> StateT ReportState IO Int
    forall a b.
    StateT ReportState IO a
    -> StateT ReportState IO b -> StateT ReportState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> StateT ReportState IO Int
    forall a. a -> StateT ReportState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    modsLeft
            UpdateModuleParsed String
    modName Int
    nExamples -> (?verbosity::LogLevel, ?threadId::ThreadId) =>
    String -> Int -> StateT ReportState IO ()
    String -> Int -> StateT ReportState IO ()
    reportModuleParsed String
    modName Int
    nExamples StateT ReportState IO ()
    -> StateT ReportState IO Int -> StateT ReportState IO Int
    forall a b.
    StateT ReportState IO a
    -> StateT ReportState IO b -> StateT ReportState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> StateT ReportState IO Int
    forall a. a -> StateT ReportState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    modsLeft

    -- | Count number of expressions in given module.
    count :: Module [Located DocTest] -> Int
    count :: Module [Located DocTest] -> Int
    count (Module String
    _ Maybe [Located DocTest]
    _ [[Located DocTest]]
    tests [Located String]
    _) = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum (([Located DocTest] -> Int) -> [[Located DocTest]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [Located DocTest] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Located DocTest]]
    tests)

    -- | A monad for generating test reports.
    type Report = StateT ReportState IO

    data ReportState = ReportState {
      ReportState -> Int
    reportStateCount        :: Int     -- ^ characters on the current line
    , ReportState -> Bool
    reportStateInteractive  :: Bool    -- ^ should intermediate results be printed?
    , ReportState -> Summary
    reportStateSummary      :: Summary -- ^ test summary
    }

    -- | Add output to the report.
    report ::
      ( ?verbosity :: LogLevel
      , ?threadId :: ThreadId
      ) =>
      LogLevel ->
      String ->
      Report ()
    report :: (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    lvl String
    msg0 =
      Bool -> StateT ReportState IO () -> StateT ReportState IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((?verbosity::LogLevel) => LogLevel -> Bool
    LogLevel -> Bool
    shouldLog LogLevel
    lvl) (StateT ReportState IO () -> StateT ReportState IO ())
    -> StateT ReportState IO () -> StateT ReportState IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        threadName <- IO String -> StateT ReportState IO String
    forall a. IO a -> StateT ReportState IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> StateT ReportState IO String)
    -> IO String -> StateT ReportState IO String
    forall a b. (a -> b) -> a -> b
    $ ThreadId -> IO String
    getThreadName ?threadId::ThreadId
    ThreadId
    ?threadId
        let msg1 = String -> LogLevel -> ShowS
    formatLog String
    threadName LogLevel
    lvl String
    msg0
        overwrite msg1

        -- add a newline, this makes the output permanent
        liftIO $ hPutStrLn stderr ""
        modify (\ReportState
    st -> ReportState
    st {reportStateCount = 0})

    -- | Add intermediate output to the report.
    --
    -- This will be overwritten by subsequent calls to `report`/`report_`.
    -- Intermediate out may not contain any newlines.
    report_ :: (?verbosity :: LogLevel) => LogLevel -> String -> Report ()
    report_ :: (?verbosity::LogLevel) =>
    LogLevel -> String -> StateT ReportState IO ()
    report_ LogLevel
    lvl String
    msg =
      Bool -> StateT ReportState IO () -> StateT ReportState IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((?verbosity::LogLevel) => LogLevel -> Bool
    LogLevel -> Bool
    shouldLog LogLevel
    lvl) (StateT ReportState IO () -> StateT ReportState IO ())
    -> StateT ReportState IO () -> StateT ReportState IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        StateT ReportState IO Bool
    -> StateT ReportState IO () -> StateT ReportState IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM ((ReportState -> Bool) -> StateT ReportState IO Bool
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets ReportState -> Bool
    reportStateInteractive) (StateT ReportState IO () -> StateT ReportState IO ())
    -> StateT ReportState IO () -> StateT ReportState IO ()
    forall a b. (a -> b) -> a -> b
    $ do
          String -> StateT ReportState IO ()
    overwrite String
    msg
          (ReportState -> ReportState) -> StateT ReportState IO ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify (\ReportState
    st -> ReportState
    st {reportStateCount = length msg})

    -- | Add output to the report, overwrite any intermediate out.
    overwrite :: String -> Report ()
    overwrite :: String -> StateT ReportState IO ()
    overwrite String
    msg = do
      n <- (ReportState -> Int) -> StateT ReportState IO Int
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets ReportState -> Int
    reportStateCount
      let str | Int
    0 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    n     = String
    "\r" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    msg String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    msg) Char
    ' '
              | Bool
    otherwise = String
    msg
      liftIO (hPutStr stderr str)

    -- | Shuffle a list given a seed for an RNG
    shuffle :: Int -> [a] -> [a]
    shuffle :: forall a. Int -> [a] -> [a]
    shuffle Int
    seed [a]
    xs =
        ((Int, a) -> a) -> [(Int, a)] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, a) -> a
    forall a b. (a, b) -> b
    snd
      ([(Int, a)] -> [a]) -> [(Int, a)] -> [a]
    forall a b. (a -> b) -> a -> b
    $ ((Int, a) -> (Int, a) -> Ordering) -> [(Int, a)] -> [(Int, a)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Int -> Int -> Ordering)
    -> ((Int, a) -> Int) -> (Int, a) -> (Int, a) -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (Int, a) -> Int
    forall a b. (a, b) -> a
    fst)
      ([(Int, a)] -> [(Int, a)]) -> [(Int, a)] -> [(Int, a)]
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [a] -> [(Int, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (forall a g. (Random a, RandomGen g) => g -> [a]
    randoms @Int (Int -> StdGen
    mkStdGen Int
    seed)) [a]
    xs

    -- | Run all examples from given module.
    runModule
      :: ModuleConfig
      -> Bool
      -> MVar ()
      -- ^ GHC lock
      -> [String]
      -- ^ Eval GHCi arguments
      -> Chan (ThreadId, ReportUpdate)
      -> ModuleName
      -> Ghc ()
    runModule :: ModuleConfig
    -> Bool
    -> MVar ()
    -> [String]
    -> Chan (ThreadId, ReportUpdate)
    -> String
    -> Ghc ()
    runModule ModuleConfig
    modConfig0 Bool
    implicitPrelude MVar ()
    ghcLock [String]
    evalArgs Chan (ThreadId, ReportUpdate)
    output String
    modName = do
      threadId <- IO ThreadId -> Ghc ThreadId
    forall a. IO a -> Ghc a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO ThreadId
    myThreadId
      let update ReportUpdate
    r = Chan (ThreadId, ReportUpdate) -> (ThreadId, ReportUpdate) -> IO ()
    forall a. Chan a -> a -> IO ()
    writeChan Chan (ThreadId, ReportUpdate)
    output (ThreadId
    threadId, ReportUpdate
    r)

      mod_@(Module module_ setup examples0 modArgs) <- do
    #ifdef mingw32_HOST_OS
        -- XXX: Cannot use multiple GHC APIs at the same time on Windows
        liftIO $ takeMVar ghcLock
        getDocTests modName `finally` liftIO (putMVar ghcLock ())
    #else
        ghcLock `seq` getDocTests modName
    #endif

      liftIO $ update (UpdateModuleParsed modName (count (Module module_ setup examples0 modArgs)))
      let modConfig2 = String
    -> ModuleConfig
    -> [Located String]
    -> Either (Location, String) ModuleConfig
    parseLocatedModuleOptions String
    modName ModuleConfig
    modConfig0 [Located String]
    modArgs

      unless (isEmptyModule mod_) $
        case modConfig2 of
          Left (Location
    loc, String
    flag) ->
            IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ ReportUpdate -> IO ()
    update (Location -> String -> ReportUpdate
    UpdateOptionError Location
    loc String
    flag)

          Right ModuleConfig
    modConfig3 -> do
            let
              examples1 :: [[Located DocTest]]
    examples1
                | ModuleConfig -> Bool
    cfgRandomizeOrder ModuleConfig
    modConfig3 = Int -> [[Located DocTest]] -> [[Located DocTest]]
    forall a. Int -> [a] -> [a]
    shuffle Int
    seed [[Located DocTest]]
    examples0
                | Bool
    otherwise = [[Located DocTest]]
    examples0

              importModule :: Maybe String
    importModule
                | ModuleConfig -> Bool
    cfgImplicitModuleImport ModuleConfig
    modConfig3 = String -> Maybe String
    forall a. a -> Maybe a
    Just (String
    ":m +" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    module_)
                | Bool
    otherwise = Maybe String
    forall a. Maybe a
    Nothing

              preserveIt :: Bool
    preserveIt = ModuleConfig -> Bool
    cfgPreserveIt ModuleConfig
    modConfig3
              seed :: Int
    seed = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (ModuleConfig -> Maybe Int
    cfgSeed ModuleConfig
    modConfig3) -- Should have been set already

              reload :: Interpreter -> IO ()
    reload Interpreter
    repl = do
                IO (Either String String) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Either String String) -> IO ())
    -> IO (Either String String) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Interpreter -> String -> IO (Either String String)
    Interpreter.safeEval Interpreter
    repl String
    ":reload"
                (String -> IO (Either String String)) -> [String] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Interpreter -> String -> IO (Either String String)
    Interpreter.safeEval Interpreter
    repl) ([String] -> IO ()) -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                  if Bool
    implicitPrelude
                  then String
    ":m Prelude" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : Maybe String -> [String]
    forall a. Maybe a -> [a]
    maybeToList Maybe String
    importModule
                  else Maybe String -> [String]
    forall a. Maybe a -> [a]
    maybeToList Maybe String
    importModule

                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    preserveIt (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                  -- Evaluate a dumb expression to populate the 'it' variable NOTE: This is
                  -- one reason why we cannot have safeEval = safeEvalIt: 'it' isn't set in
                  -- a fresh GHCi session.
                  IO (Either String String) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Either String String) -> IO ())
    -> IO (Either String String) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Interpreter -> String -> IO (Either String String)
    Interpreter.safeEval Interpreter
    repl (String -> IO (Either String String))
    -> String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String
    "()"

              setup_ :: Interpreter -> IO ()
    setup_ Interpreter
    repl = do
                Interpreter -> IO ()
    reload Interpreter
    repl
                Maybe [Located DocTest] -> ([Located DocTest] -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ Maybe [Located DocTest]
    setup (([Located DocTest] -> IO ()) -> IO ())
    -> ([Located DocTest] -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[Located DocTest]
    l -> [Located DocTest] -> (Located DocTest -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Located DocTest]
    l ((Located DocTest -> IO ()) -> IO ())
    -> (Located DocTest -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Located Location
    _ DocTest
    x) -> case DocTest
    x of
                  Property String
    _  -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                  Example String
    e ExpectedResult
    _ -> IO (Either String String) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Either String String) -> IO ())
    -> IO (Either String String) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> Interpreter -> String -> IO (Either String String)
    safeEvalWith Bool
    preserveIt Interpreter
    repl String
    e

            let logger :: String -> IO ()
    logger = ReportUpdate -> IO ()
    update (ReportUpdate -> IO ())
    -> (String -> ReportUpdate) -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LogLevel -> String -> ReportUpdate
    UpdateLog LogLevel
    Debug
            IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ (String -> IO ()) -> [String] -> (Interpreter -> IO ()) -> IO ()
    forall a.
    (String -> IO ()) -> [String] -> (Interpreter -> IO a) -> IO a
    Interpreter.withInterpreter String -> IO ()
    logger [String]
    evalArgs ((Interpreter -> IO ()) -> IO ())
    -> (Interpreter -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Interpreter
    repl -> IO () -> IO ()
    forall a. IO a -> IO a
    withCP65001 (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
              -- Try to import this module, if it fails, something is off
              importResult <-
                case Maybe String
    importModule of
                  Maybe String
    Nothing -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> Either String String
    forall a b. b -> Either a b
    Right String
    "")
                  Just String
    i -> Interpreter -> String -> IO (Either String String)
    Interpreter.safeEval Interpreter
    repl String
    i

              case importResult of
                Right String
    "" -> do
                  -- Run setup group
                  successes <-
                    ([Located DocTest] -> IO Bool)
    -> Maybe [Located DocTest] -> IO (Maybe Bool)
    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) -> Maybe a -> m (Maybe b)
    mapM
                      (FromSetup
    -> Bool
    -> Interpreter
    -> IO ()
    -> (ReportUpdate -> IO ())
    -> [Located DocTest]
    -> IO Bool
    runTestGroup FromSetup
    FromSetup Bool
    preserveIt Interpreter
    repl (Interpreter -> IO ()
    reload Interpreter
    repl) ReportUpdate -> IO ()
    update)
                      Maybe [Located DocTest]
    setup

                  -- only run tests, if setup does not produce any errors/failures
                  when
                    (and successes)
                    (mapM_
                      (runTestGroup NotFromSetup preserveIt repl (setup_ repl) update)
                      examples1)
                Either String String
    _ ->
                  ReportUpdate -> IO ()
    update (String -> Either String String -> ReportUpdate
    UpdateImportError String
    module_ Either String String
    importResult)

      -- Signal main thread a module has been tested
      liftIO $ update UpdateModuleDone

    data ReportUpdate
      = UpdateSuccess FromSetup
      -- ^ Test succeeded
      | UpdateModuleParsed ModuleName Int
      -- ^ Parsed module, found /n/ examples
      | UpdateFailure FromSetup Location Expression [String]
      -- ^ Test failed with unexpected result
      | UpdateError FromSetup Location Expression String
      -- ^ Test failed with an error
      | UpdateModuleDone
      -- ^ All examples tested in module
      | UpdateInternalError ModuleName SomeException
      -- ^ Exception caught while executing internal code
      | UpdateImportError ModuleName (Either String String)
      -- ^ Could not import module
      | UpdateOptionError Location String
      -- ^ Unrecognized flag in module specific option
      | UpdateLog LogLevel String
      -- ^ Unstructured message

    makeThreadPool ::
      Int ->
      [String] ->
      (Chan (ThreadId, ReportUpdate) -> ModuleName -> Ghc ()) ->
      IO (Chan ModuleName, Chan (ThreadId, ReportUpdate))
    makeThreadPool :: Int
    -> [String]
    -> (Chan (ThreadId, ReportUpdate) -> String -> Ghc ())
    -> IO (Chan String, Chan (ThreadId, ReportUpdate))
    makeThreadPool Int
    nThreads [String]
    parseArgs Chan (ThreadId, ReportUpdate) -> String -> Ghc ()
    mutator = do
      input <- IO (Chan String)
    forall a. IO (Chan a)
    newChan
      output <- newChan
      forM_ [1..nThreads] $ \Int
    _ ->
        IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ [String] -> Ghc () -> IO ()
    forall a. [String] -> Ghc a -> IO a
    withGhc [String]
    parseArgs (Ghc () -> IO ()) -> Ghc () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Ghc () -> Ghc ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b
    forever (Ghc () -> Ghc ()) -> Ghc () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ do
          modName <- IO String -> Ghc String
    forall a. IO a -> Ghc a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> Ghc String) -> IO String -> Ghc String
    forall a b. (a -> b) -> a -> b
    $ Chan String -> IO String
    forall a. Chan a -> IO a
    readChan Chan String
    input
          threadId <- liftIO myThreadId
          let update SomeException
    e = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Chan (ThreadId, ReportUpdate) -> (ThreadId, ReportUpdate) -> IO ()
    forall a. Chan a -> a -> IO ()
    writeChan Chan (ThreadId, ReportUpdate)
    output (ThreadId
    threadId, String -> SomeException -> ReportUpdate
    UpdateInternalError String
    modName SomeException
    e)
          catches
            (mutator output modName)
            -- Re-throw AsyncException, otherwise execution will not terminate on
            -- SIGINT (ctrl-c).  All AsyncExceptions are re-thrown (not just
            -- UserInterrupt) because all of them indicate severe conditions and
            -- should not occur during normal operation.
            [ Handler (\AsyncException
    e -> AsyncException -> Ghc ()
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (AsyncException
    e :: AsyncException))
            , Handler (\SomeException
    e -> SomeException -> Ghc ()
    forall {m :: * -> *}. MonadIO m => SomeException -> m ()
    update (SomeException
    e :: SomeException))
            ]
      return (input, output)

    reportModuleParsed :: (?verbosity::LogLevel, ?threadId::ThreadId) => ModuleName -> Int -> Report ()
    reportModuleParsed :: (?verbosity::LogLevel, ?threadId::ThreadId) =>
    String -> Int -> StateT ReportState IO ()
    reportModuleParsed String
    modName Int
    nExamples = do
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Debug (String -> String -> Int -> String
    forall r. PrintfType r => String -> r
    printf String
    "Parsed module %s with %d examples" String
    modName Int
    nExamples)
      FromSetup -> Summary -> StateT ReportState IO ()
    updateSummary FromSetup
    NotFromSetup (Int -> Int -> Int -> Int -> Summary
    Summary Int
    nExamples Int
    0 Int
    0 Int
    0)

    reportFailure :: (?verbosity::LogLevel, ?threadId::ThreadId) => FromSetup -> Location -> Expression -> [String] -> Report ()
    reportFailure :: (?verbosity::LogLevel, ?threadId::ThreadId) =>
    FromSetup
    -> Location -> String -> [String] -> StateT ReportState IO ()
    reportFailure FromSetup
    fromSetup Location
    loc String
    expression [String]
    err = do
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error (String -> String -> ShowS
    forall r. PrintfType r => String -> r
    printf String
    "%s: failure in expression `%s'" (Location -> String
    forall a. Show a => a -> String
    show Location
    loc) String
    expression)
      (String -> StateT ReportState IO ())
    -> [String] -> StateT ReportState IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error) [String]
    err
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    ""
      FromSetup -> Summary -> StateT ReportState IO ()
    updateSummary FromSetup
    fromSetup (Int -> Int -> Int -> Int -> Summary
    Summary Int
    0 Int
    1 Int
    0 Int
    1)

    reportError :: (?verbosity::LogLevel, ?threadId::ThreadId) => FromSetup -> Location -> Expression -> String -> Report ()
    reportError :: (?verbosity::LogLevel, ?threadId::ThreadId) =>
    FromSetup
    -> Location -> String -> String -> StateT ReportState IO ()
    reportError FromSetup
    fromSetup Location
    loc String
    expression String
    err = do
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error (String -> String -> ShowS
    forall r. PrintfType r => String -> r
    printf String
    "%s: error in expression `%s'" (Location -> String
    forall a. Show a => a -> String
    show Location
    loc) String
    expression)
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    err
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    ""
      FromSetup -> Summary -> StateT ReportState IO ()
    updateSummary FromSetup
    fromSetup (Int -> Int -> Int -> Int -> Summary
    Summary Int
    0 Int
    1 Int
    1 Int
    0)

    reportOptionError :: (?verbosity::LogLevel, ?threadId::ThreadId) => Location -> String -> Report ()
    reportOptionError :: (?verbosity::LogLevel, ?threadId::ThreadId) =>
    Location -> String -> StateT ReportState IO ()
    reportOptionError Location
    loc String
    opt = do
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error (String -> String -> ShowS
    forall r. PrintfType r => String -> r
    printf String
    "%s: unrecognized option: %s. Try --help to see all options." (Location -> String
    forall a. Show a => a -> String
    show Location
    loc) String
    opt)
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    ""
      FromSetup -> Summary -> StateT ReportState IO ()
    updateSummary FromSetup
    FromSetup (Int -> Int -> Int -> Int -> Summary
    Summary Int
    0 Int
    1 Int
    1 Int
    0)

    reportInternalError :: (?verbosity::LogLevel, ?threadId::ThreadId) => ModuleName -> SomeException -> Report ()
    reportInternalError :: (?verbosity::LogLevel, ?threadId::ThreadId) =>
    String -> SomeException -> StateT ReportState IO ()
    reportInternalError String
    modName SomeException
    err = do
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error (String -> ShowS
    forall r. PrintfType r => String -> r
    printf String
    "Error when executing tests in %s" String
    modName)
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error (SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    err)
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    ""
      FromSetup -> Summary -> StateT ReportState IO ()
    updateSummary FromSetup
    NotFromSetup Summary
    emptySummary{sErrors=1}

    reportImportError :: (?verbosity::LogLevel, ?threadId::ThreadId) => ModuleName -> Either String String -> Report ()
    reportImportError :: (?verbosity::LogLevel, ?threadId::ThreadId) =>
    String -> Either String String -> StateT ReportState IO ()
    reportImportError String
    modName Either String String
    importResult = do
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error (String
    "Could not import module: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    modName String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    ". This can be caused by a number of issues: ")
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    ""
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    " 1. A module found by GHC contained tests, but was not in 'exposed-modules'. If you want"
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    "    to test non-exposed modules follow the instructions here:"
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    "    https://github.com/martijnbastiaan/doctest-parallel#test-non-exposed-modules"
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    ""
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    " 2. For Cabal users: Cabal did not generate a GHC environment file. Either:"
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    "   * Run with '--write-ghc-environment-files=always'"
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    "   * Add 'write-ghc-environment-files: always' to your cabal.project"
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    ""
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    " 3. For Cabal users: Cabal did not generate a GHC environment file in time. This"
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    "    can happen if you use 'cabal test' instead of 'cabal run doctests'. See"
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    "    https://github.com/martijnbastiaan/doctest-parallel/issues/22."
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    ""
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    " 4. The testsuite executable does not have a dependency on your project library. Please"
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    "    add it to the 'build-depends' section of the testsuite executable."
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    ""
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    "See the example project at https://github.com/martijnbastiaan/doctest-parallel/blob/main/example/README.md for more information."
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    ""
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    "The original reason given by GHCi was:"
      (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    ""
      case Either String String
    importResult of
        Left String
    out -> do
          (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    "Unexpected output:"
          (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    out
        Right String
    err -> do
          (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    "Error:"
          (?verbosity::LogLevel, ?threadId::ThreadId) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report LogLevel
    Error String
    err

      FromSetup -> Summary -> StateT ReportState IO ()
    updateSummary FromSetup
    FromSetup Summary
    emptySummary{sErrors=1}

    reportSuccess :: (?verbosity::LogLevel, ?threadId::ThreadId) => FromSetup -> Report ()
    reportSuccess :: (?verbosity::LogLevel, ?threadId::ThreadId) =>
    FromSetup -> StateT ReportState IO ()
    reportSuccess FromSetup
    fromSetup = FromSetup -> Summary -> StateT ReportState IO ()
    updateSummary FromSetup
    fromSetup (Int -> Int -> Int -> Int -> Summary
    Summary Int
    0 Int
    1 Int
    0 Int
    0)

    updateSummary :: FromSetup -> Summary -> Report ()
    updateSummary :: FromSetup -> Summary -> StateT ReportState IO ()
    updateSummary FromSetup
    FromSetup Summary
    summary =
      -- Suppress counts, except for errors and unexpected outputs
      FromSetup -> Summary -> StateT ReportState IO ()
    updateSummary FromSetup
    NotFromSetup Summary
    summary{sExamples=0, sTried=0}
    updateSummary FromSetup
    NotFromSetup Summary
    summary = do
      ReportState n f s <- StateT ReportState IO ReportState
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
      put (ReportState n f $ s `mappend` summary)

    reportProgress :: (?verbosity::LogLevel) => Report ()
    reportProgress :: (?verbosity::LogLevel) => StateT ReportState IO ()
    reportProgress = (ReportState -> String) -> StateT ReportState IO String
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets (Summary -> String
    forall a. Show a => a -> String
    show (Summary -> String)
    -> (ReportState -> Summary) -> ReportState -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ReportState -> Summary
    reportStateSummary) StateT ReportState IO String
    -> (String -> StateT ReportState IO ()) -> StateT ReportState IO ()
    forall a b.
    StateT ReportState IO a
    -> (a -> StateT ReportState IO b) -> StateT ReportState IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (?verbosity::LogLevel) =>
    LogLevel -> String -> StateT ReportState IO ()
    LogLevel -> String -> StateT ReportState IO ()
    report_ LogLevel
    Info

    -- | Run given test group.
    --
    -- The interpreter state is zeroed with @:reload@ first.  This means that you
    -- can reuse the same 'Interpreter' for several test groups.
    runTestGroup ::
      FromSetup ->
      Bool ->
      Interpreter ->
      IO () ->
      (ReportUpdate -> IO ()) ->
      [Located DocTest] ->
      IO Bool
    runTestGroup :: FromSetup
    -> Bool
    -> Interpreter
    -> IO ()
    -> (ReportUpdate -> IO ())
    -> [Located DocTest]
    -> IO Bool
    runTestGroup FromSetup
    fromSetup Bool
    preserveIt Interpreter
    repl IO ()
    setup ReportUpdate -> IO ()
    update [Located DocTest]
    tests = do
      IO ()
    setup
      successExamples <- FromSetup
    -> Bool
    -> Interpreter
    -> (ReportUpdate -> IO ())
    -> [Located Interaction]
    -> IO Bool
    runExampleGroup FromSetup
    fromSetup Bool
    preserveIt Interpreter
    repl ReportUpdate -> IO ()
    update [Located Interaction]
    examples

      successesProperties <- forM properties $ \(Location
    loc, String
    expression) -> do
        r <- do
          IO ()
    setup
          ReportUpdate -> IO ()
    update (LogLevel -> String -> ReportUpdate
    UpdateLog LogLevel
    Verbose (String
    "Started property at " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Location -> String
    forall a. Show a => a -> String
    show Location
    loc))
          Interpreter -> String -> IO PropertyResult
    Property.runProperty Interpreter
    repl String
    expression

        case r of
          PropertyResult
    Property.Success -> do
            ReportUpdate -> IO ()
    update (FromSetup -> ReportUpdate
    UpdateSuccess FromSetup
    fromSetup)
            Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
          Property.Error String
    err -> do
            ReportUpdate -> IO ()
    update (FromSetup -> Location -> String -> String -> ReportUpdate
    UpdateError FromSetup
    fromSetup Location
    loc String
    expression String
    err)
            Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
          Property.Failure String
    msg -> do
            ReportUpdate -> IO ()
    update (FromSetup -> Location -> String -> [String] -> ReportUpdate
    UpdateFailure FromSetup
    fromSetup Location
    loc String
    expression [String
    msg])
            Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False

      pure (successExamples && and successesProperties)
      where
        properties :: [(Location, String)]
    properties = [(Location
    loc, String
    p) | Located Location
    loc (Property String
    p) <- [Located DocTest]
    tests]

        examples :: [Located Interaction]
        examples :: [Located Interaction]
    examples = [Location -> Interaction -> Located Interaction
    forall a. Location -> a -> Located a
    Located Location
    loc (String
    e, ExpectedResult
    r) | Located Location
    loc (Example String
    e ExpectedResult
    r) <- [Located DocTest]
    tests]

    -- |
    -- Execute all expressions from given example in given 'Interpreter' and verify
    -- the output.
    runExampleGroup ::
      FromSetup ->
      Bool ->
      Interpreter ->
      (ReportUpdate -> IO ()) ->
      [Located Interaction] ->
      IO Bool
    runExampleGroup :: FromSetup
    -> Bool
    -> Interpreter
    -> (ReportUpdate -> IO ())
    -> [Located Interaction]
    -> IO Bool
    runExampleGroup FromSetup
    fromSetup Bool
    preserveIt Interpreter
    repl ReportUpdate -> IO ()
    update [Located Interaction]
    examples = do
      threadId <- IO ThreadId
    myThreadId
      go threadId examples
      where
        go :: t -> [Located Interaction] -> IO Bool
    go t
    threadId ((Located Location
    loc (String
    expression, ExpectedResult
    expected)) : [Located Interaction]
    xs) = do
          ReportUpdate -> IO ()
    update (LogLevel -> String -> ReportUpdate
    UpdateLog LogLevel
    Verbose (String
    "Started example at " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Location -> String
    forall a. Show a => a -> String
    show Location
    loc))
          r <- (String -> [String])
    -> Either String String -> Either String [String]
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> [String]
    lines (Either String String -> Either String [String])
    -> IO (Either String String) -> IO (Either String [String])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool -> Interpreter -> String -> IO (Either String String)
    safeEvalWith Bool
    preserveIt Interpreter
    repl String
    expression
          case r of
            Left String
    err -> do
              ReportUpdate -> IO ()
    update (FromSetup -> Location -> String -> String -> ReportUpdate
    UpdateError FromSetup
    fromSetup Location
    loc String
    expression String
    err)
              Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
            Right [String]
    actual -> case ExpectedResult -> [String] -> Result
    mkResult ExpectedResult
    expected [String]
    actual of
              NotEqual [String]
    err -> do
                ReportUpdate -> IO ()
    update (FromSetup -> Location -> String -> [String] -> ReportUpdate
    UpdateFailure FromSetup
    fromSetup Location
    loc String
    expression [String]
    err)
                Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
              Result
    Equal -> do
                ReportUpdate -> IO ()
    update (FromSetup -> ReportUpdate
    UpdateSuccess FromSetup
    fromSetup)
                t -> [Located Interaction] -> IO Bool
    go t
    threadId [Located Interaction]
    xs
        go t
    _ [] =
          Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True

    safeEvalWith :: Bool -> Interpreter -> String -> IO (Either String String)
    safeEvalWith :: Bool -> Interpreter -> String -> IO (Either String String)
    safeEvalWith Bool
    preserveIt
      | Bool
    preserveIt = Interpreter -> String -> IO (Either String String)
    Interpreter.safeEvalIt
      | Bool
    otherwise  = Interpreter -> String -> IO (Either String String)
    Interpreter.safeEval