    {-# LANGUAGE BangPatterns #-}

    -- | Note: this module is re-exported as a whole from "Test.Tasty.Runners"
    module Test.Tasty.Runners.Utils where

    import Control.Exception
    import Control.Applicative
    import Control.Concurrent (mkWeakThreadId, myThreadId)
    import Control.Monad (forM_)
    import Data.Typeable (Typeable)
    import Prelude  -- Silence AMP import warnings
    import Text.Printf
    import Foreign.C (CInt)

    #if MIN_VERSION_base(4,11,0)
    import GHC.Clock (getMonotonicTime)
    #else
    import Data.Time.Clock.POSIX (getPOSIXTime)
    #endif

    #ifdef VERSION_unix
    #include "HsUnixConfig.h"
    #ifdef HAVE_SIGNAL_H
    #define INSTALL_HANDLERS 1
    #else
    #define INSTALL_HANDLERS 0
    #endif
    #else
    #define INSTALL_HANDLERS 0
    #endif

    #if INSTALL_HANDLERS
    import System.Posix.Signals
    import System.Mem.Weak (deRefWeak)
    #endif

    import Test.Tasty.Core (Time)

    -- | Catch possible exceptions that may arise when evaluating a string.
    -- For normal (total) strings, this is a no-op.
    --
    -- This function should be used to display messages generated by the test
    -- suite (such as test result descriptions).
    --
    -- See e.g. <https://github.com/UnkindPartition/tasty/issues/25>.
    --
    -- @since 0.10.1
    formatMessage :: String -> IO String
    formatMessage :: String -> IO String
    formatMessage = Int -> String -> IO String
    go Int
    3
      where
        -- to avoid infinite recursion, we introduce the recursion limit
        go :: Int -> String -> IO String
        go :: Int -> String -> IO String
    go Int
    0        String
    _ = String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "exceptions keep throwing other exceptions!"
        go Int
    recLimit String
    msg = do
          mbStr <- IO () -> IO (Either SomeException ())
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO () -> IO (Either SomeException ()))
    -> IO () -> IO (Either SomeException ())
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    evaluate (() -> IO ()) -> () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> ()
    forall a. [a] -> ()
    forceElements String
    msg
          case mbStr of
            Right () -> String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    msg
            Left SomeException
    e' -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "message threw an exception: %s" (String -> String) -> IO String -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> String -> IO String
    go (Int
    recLimitInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (SomeException -> String
    forall a. Show a => a -> String
    show (SomeException
    e' :: SomeException))

    -- | Force elements of a list
    -- (<https://ro-che.info/articles/2015-05-28-force-list>).
    --
    -- @since 1.0.1
    forceElements :: [a] -> ()
    forceElements :: forall a. [a] -> ()
    forceElements = (a -> () -> ()) -> () -> [a] -> ()
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr a -> () -> ()
    forall a b. a -> b -> b
    seq ()

    -- from https://ro-che.info/articles/2014-07-30-bracket
    -- | Install signal handlers so that e.g. the cursor is restored if the test
    -- suite is killed by SIGTERM. Upon a signal, a 'SignalException' will be
    -- thrown to the thread that has executed this action.
    --
    -- This function is called automatically from the @defaultMain*@ family of
    -- functions. You only need to call it explicitly if you call
    -- 'Test.Tasty.Runners.tryIngredients' yourself.
    --
    -- This function does nothing when POSIX signals are not supported.
    --
    -- @since 1.2.1
    installSignalHandlers :: IO ()
    installSignalHandlers :: IO ()
    installSignalHandlers = do
    #if INSTALL_HANDLERS
      main_thread_id <- IO ThreadId
    myThreadId
      weak_tid <- mkWeakThreadId main_thread_id
      forM_ [ sigHUP, sigTERM, sigUSR1, sigUSR2, sigXCPU, sigXFSZ ] $ \CInt
    sig ->
        CInt -> Handler -> Maybe SignalSet -> IO Handler
    installHandler CInt
    sig (IO () -> Handler
    Catch (IO () -> Handler) -> IO () -> Handler
    forall a b. (a -> b) -> a -> b
    $ Weak ThreadId -> CInt -> IO ()
    send_exception Weak ThreadId
    weak_tid CInt
    sig) Maybe SignalSet
    forall a. Maybe a
    Nothing
      where
        send_exception :: Weak ThreadId -> CInt -> IO ()
    send_exception Weak ThreadId
    weak_tid CInt
    sig = do
          m <- Weak ThreadId -> IO (Maybe ThreadId)
    forall v. Weak v -> IO (Maybe v)
    deRefWeak Weak ThreadId
    weak_tid
          case m of
            Maybe ThreadId
    Nothing  -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            Just ThreadId
    tid -> ThreadId -> SomeException -> IO ()
    forall e. Exception e => ThreadId -> e -> IO ()
    throwTo ThreadId
    tid (SignalException -> SomeException
    forall e. Exception e => e -> SomeException
    toException (SignalException -> SomeException)
    -> SignalException -> SomeException
    forall a b. (a -> b) -> a -> b
    $ CInt -> SignalException
    SignalException CInt
    sig)
    #else
      return ()
    #endif

    -- | This exception is thrown when the program receives a signal, assuming
    -- 'installSignalHandlers' was called.
    --
    -- The 'CInt' field contains the signal number, as in
    -- 'System.Posix.Signals.Signal'. We don't use that type synonym, however,
    -- because it's not available on non-UNIXes.
    --
    -- @since 1.2.1
    newtype SignalException = SignalException CInt
      deriving (Int -> SignalException -> String -> String
    [SignalException] -> String -> String
    SignalException -> String
    (Int -> SignalException -> String -> String)
    -> (SignalException -> String)
    -> ([SignalException] -> String -> String)
    -> Show SignalException
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> SignalException -> String -> String
    showsPrec :: Int -> SignalException -> String -> String
    $cshow :: SignalException -> String
    show :: SignalException -> String
    $cshowList :: [SignalException] -> String -> String
    showList :: [SignalException] -> String -> String
    Show, Typeable)
    instance Exception SignalException

    -- | Measure the time taken by an 'IO' action to run.
    --
    -- @since 1.2.2
    timed :: IO a -> IO (Time, a)
    timed :: forall a. IO a -> IO (Time, a)
    timed IO a
    t = do
      start <- IO Time
    getTime
      !r    <- t
      end   <- getTime
      return (end-start, r)

    #if MIN_VERSION_base(4,11,0)
    -- | Get monotonic time.
    --
    -- Warning: This is not the system time, but a monotonically increasing time
    -- that facilitates reliable measurement of time differences.
    --
    -- @since 1.2.2
    getTime :: IO Time
    getTime :: IO Time
    getTime = IO Time
    getMonotonicTime
    #else
    -- | Get system time.
    --
    -- @since 1.2.2
    getTime :: IO Time
    getTime = realToFrac <$> getPOSIXTime
    #endif