    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE LambdaCase #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Distribution.Simple.Utils
    -- Copyright   :  Isaac Jones, Simon Marlow 2003-2004
    -- License     :  BSD3
    --                portions Copyright (c) 2007, Galois Inc.
    --
    -- Maintainer  :  cabal-devel@haskell.org
    -- Portability :  portable
    --
    -- A large and somewhat miscellaneous collection of utility functions used
    -- throughout the rest of the Cabal lib and in other tools that use the Cabal
    -- lib like @cabal-install@. It has a very simple set of logging actions. It
    -- has low level functions for running programs, a bunch of wrappers for
    -- various directory and file functions that do extra logging.

    module Distribution.Simple.Utils (
            cabalVersion,

            -- * logging and errors
            dieNoVerbosity,
            die', dieWithLocation',
            dieNoWrap,
            topHandler, topHandlerWith,
            warn,
            notice, noticeNoWrap, noticeDoc,
            setupMessage,
            info, infoNoWrap,
            debug, debugNoWrap,
            chattyTry,
            annotateIO,
            withOutputMarker,

            -- * exceptions
            handleDoesNotExist,
            ignoreSigPipe,

            -- * running programs
            rawSystemExit,
            rawSystemExitCode,
            rawSystemProc,
            rawSystemProcAction,
            rawSystemExitWithEnv,
            rawSystemStdout,
            rawSystemStdInOut,
            rawSystemIOWithEnv,
            rawSystemIOWithEnvAndAction,
            fromCreatePipe,
            maybeExit,
            xargs,
            findProgramVersion,

            -- ** 'IOData' re-export
            --
            -- These types are re-exported from
            -- "Distribution.Utils.IOData" for convenience as they're
            -- exposed in the API of 'rawSystemStdInOut'
            IOData(..),
            KnownIODataMode (..),
            IODataMode (..),

            -- * copying files
            createDirectoryIfMissingVerbose,
            copyFileVerbose,
            copyFiles,
            copyFileTo,

            -- * installing files
            installOrdinaryFile,
            installExecutableFile,
            installMaybeExecutableFile,
            installOrdinaryFiles,
            installExecutableFiles,
            installMaybeExecutableFiles,
            installDirectoryContents,
            copyDirectoryRecursive,

            -- * File permissions
            doesExecutableExist,
            setFileOrdinary,
            setFileExecutable,

            -- * file names
            currentDir,
            shortRelativePath,
            dropExeExtension,
            exeExtensions,

            -- * finding files
            findFileEx,
            findFileCwd,
            findFirstFile,
            findFileWithExtension,
            findFileCwdWithExtension,
            findFileWithExtension',
            findAllFilesWithExtension,
            findAllFilesCwdWithExtension,
            findModuleFileEx,
            findModuleFilesEx,
            getDirectoryContentsRecursive,

            -- * environment variables
            isInSearchPath,
            addLibraryPath,

            -- * modification time
            moreRecentFile,
            existsAndIsMoreRecentThan,

            -- * temp files and dirs
            TempFileOptions(..), defaultTempFileOptions,
            withTempFile, withTempFileEx,
            withTempDirectory, withTempDirectoryEx,
            createTempDirectory,

            -- * .cabal and .buildinfo files
            defaultPackageDesc,
            findPackageDesc,
            findPackageDescCwd,
            tryFindPackageDesc,
            tryFindPackageDescCwd,
            findHookedPackageDesc,

            -- * reading and writing files safely
            withFileContents,
            writeFileAtomic,
            rewriteFileEx,
            rewriteFileLBS,

            -- * Unicode
            fromUTF8BS,
            fromUTF8LBS,
            toUTF8BS,
            toUTF8LBS,
            readUTF8File,
            withUTF8FileContents,
            writeUTF8File,
            normaliseLineEndings,

            -- * BOM
            ignoreBOM,

            -- * generic utils
            dropWhileEndLE,
            takeWhileEndLE,
            equating,
            comparing,
            isInfixOf,
            intercalate,
            lowercase,
            listUnion,
            listUnionRight,
            ordNub,
            ordNubBy,
            ordNubRight,
            safeHead,
            safeTail,
            safeLast,
            safeInit,
            unintersperse,
            wrapText,
            wrapLine,

            -- * FilePath stuff
            isAbsoluteOnAnyPlatform,
            isRelativeOnAnyPlatform,
      ) where

    import Prelude ()
    import Distribution.Compat.Prelude

    import Distribution.Utils.Generic
    import Distribution.Utils.IOData (IOData(..), IODataMode (..), KnownIODataMode (..))
    import qualified Distribution.Utils.IOData as IOData
    import Distribution.ModuleName as ModuleName
    import Distribution.System
    import Distribution.Version
    import Distribution.Compat.Async (waitCatch, withAsyncNF)
    import Distribution.Compat.CopyFile
    import Distribution.Compat.FilePath as FilePath
    import Distribution.Compat.Internal.TempFile
    import Distribution.Compat.Lens (Lens', over)
    import Distribution.Compat.Stack
    import Distribution.Verbosity
    import Distribution.Types.PackageId

    #ifdef CURRENT_PACKAGE_KEY
    #define BOOTSTRAPPED_CABAL 1
    #endif

    #ifdef BOOTSTRAPPED_CABAL
    import qualified Paths_Cabal (version)
    #endif

    import Distribution.Pretty
    import Distribution.Parsec

    import Data.Typeable
        ( cast )
    import qualified Data.ByteString.Lazy as BS

    import System.Directory
        ( Permissions(executable), getDirectoryContents, getPermissions
        , doesDirectoryExist, doesFileExist, removeFile
        , getModificationTime, createDirectory, removeDirectoryRecursive )
    import System.Environment
        ( getProgName )
    import System.FilePath as FilePath
        ( normalise, (</>), (<.>)
        , getSearchPath, joinPath, takeDirectory, splitExtension
        , splitDirectories, searchPathSeparator )
    import System.IO
        ( Handle, hSetBinaryMode, hGetContents, stderr, stdout, hPutStr, hFlush
        , hClose, hSetBuffering, BufferMode(..), hPutStrLn )
    import System.IO.Error
    import System.IO.Unsafe
        ( unsafeInterleaveIO )
    import qualified Control.Exception as Exception

    import Foreign.C.Error (Errno (..), ePIPE)
    import Data.Time.Clock.POSIX (getPOSIXTime, POSIXTime)
    import Numeric (showFFloat)
    import Distribution.Compat.Process (proc)
    import qualified System.Process as Process
    import qualified GHC.IO.Exception as GHC

    import qualified Text.PrettyPrint as Disp

    -- We only get our own version number when we're building with ourselves
    cabalVersion :: Version
    #if defined(BOOTSTRAPPED_CABAL)
    cabalVersion :: Version
    cabalVersion = Version -> Version
    mkVersion' Version
    Paths_Cabal.version
    #elif defined(CABAL_VERSION)
    cabalVersion = mkVersion [CABAL_VERSION]
    #else
    cabalVersion = mkVersion [3,0]  --used when bootstrapping
    #endif

    -- ----------------------------------------------------------------------------
    -- Exception and logging utils

    -- Cabal's logging infrastructure has a few constraints:
    --
    --  * We must make all logging formatting and emissions decisions based
    --    on the 'Verbosity' parameter, which is the only parameter that is
    --    plumbed to enough call-sites to actually be used for this matter.
    --    (One of Cabal's "big mistakes" is to have never have defined a
    --    monad of its own.)
    --
    --  * When we 'die', we must raise an IOError.  This a backwards
    --    compatibility consideration, because that's what we've raised
    --    previously, and if we change to any other exception type,
    --    exception handlers which match on IOError will no longer work.
    --    One case where it is known we rely on IOError being catchable
    --    is 'readPkgConfigDb' in cabal-install; there may be other
    --    user code that also assumes this.
    --
    --  * The 'topHandler' does not know what 'Verbosity' is, because
    --    it gets called before we've done command line parsing (where
    --    the 'Verbosity' parameter would come from).
    --
    -- This leads to two big architectural choices:
    --
    --  * Although naively we might imagine 'Verbosity' to be a simple
    --    enumeration type, actually it is a full-on abstract data type
    --    that may contain arbitrarily complex information.  At the
    --    moment, it is fully representable as a string, but we might
    --    eventually also use verbosity to let users register their
    --    own logging handler.
    --
    --  * When we call 'die', we perform all the formatting and addition
    --    of extra information we need, and then ship this in the IOError
    --    to the top-level handler.  Here are alternate designs that
    --    don't work:
    --
    --      a) Ship the unformatted info to the handler.  This doesn't
    --      work because at the point the handler gets the message,
    --      we've lost call stacks, and even if we did, we don't have access
    --      to 'Verbosity' to decide whether or not to render it.
    --
    --      b) Print the information at the 'die' site, then raise an
    --      error.  This means that if the exception is subsequently
    --      caught by a handler, we will still have emitted the output,
    --      which is not the correct behavior.
    --
    --    For the top-level handler to "know" that an error message
    --    contains one of these fully formatted packets, we set a sentinel
    --    in one of IOError's extra fields.  This is handled by
    --    'ioeSetVerbatim' and 'ioeGetVerbatim'.
    --

    dieNoVerbosity :: String -> IO a
    dieNoVerbosity :: forall a. String -> IO a
    dieNoVerbosity String
    msg
        = IOException -> IO a
    forall a. IOException -> IO a
    ioError (String -> IOException
    userError String
    msg)
      where
        CallStack
    _ = CallStack
    HasCallStack => CallStack
    callStack -- TODO: Attach CallStack to exception

    -- | Tag an 'IOError' whose error string should be output to the screen
    -- verbatim.
    ioeSetVerbatim :: IOError -> IOError
    ioeSetVerbatim :: IOException -> IOException
    ioeSetVerbatim IOException
    e = IOException -> String -> IOException
    ioeSetLocation IOException
    e String
    "dieVerbatim"

    -- | Check if an 'IOError' should be output verbatim to screen.
    ioeGetVerbatim :: IOError -> Bool
    ioeGetVerbatim :: IOException -> Bool
    ioeGetVerbatim IOException
    e = IOException -> String
    ioeGetLocation IOException
    e String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "dieVerbatim"

    -- | Create a 'userError' whose error text will be output verbatim
    verbatimUserError :: String -> IOError
    verbatimUserError :: String -> IOException
    verbatimUserError = IOException -> IOException
    ioeSetVerbatim (IOException -> IOException)
    -> (String -> IOException) -> String -> IOException
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IOException
    userError

    dieWithLocation' :: Verbosity -> FilePath -> Maybe Int -> String -> IO a
    dieWithLocation' :: forall a. Verbosity -> String -> Maybe Int -> String -> IO a
    dieWithLocation' Verbosity
    verbosity String
    filename Maybe Int
    mb_lineno String
    msg =
        Verbosity -> String -> IO a
    forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity (String -> IO a) -> String -> IO a
    forall a b. (a -> b) -> a -> b
    $
                  String
    filename String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (case Maybe Int
    mb_lineno of
                                Just Int
    lineno -> String
    ":" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    lineno
                                Maybe Int
    Nothing -> String
    "") String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                  String
    ": " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    msg

    die' :: Verbosity -> String -> IO a
    die' :: forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity String
    msg = (HasCallStack => IO a) -> IO a
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO a) -> IO a) -> (HasCallStack => IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ do
        IOException -> IO a
    forall a. IOException -> IO a
    ioError (IOException -> IO a) -> (String -> IOException) -> String -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IOException
    verbatimUserError
              (String -> IO a) -> IO String -> IO a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Verbosity -> String -> IO String
    annotateErrorString Verbosity
    verbosity
              (String -> IO String) -> IO String -> IO String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String) -> (String -> String) -> String -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Verbosity -> String -> String
    wrapTextVerbosity Verbosity
    verbosity
              (String -> IO String) -> IO String -> IO String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String) -> (String -> String) -> String -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    addErrorPrefix
              (String -> IO String) -> IO String -> IO String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> IO String
    prefixWithProgName String
    msg

    dieNoWrap :: Verbosity -> String -> IO a
    dieNoWrap :: forall a. Verbosity -> String -> IO a
    dieNoWrap Verbosity
    verbosity String
    msg = (HasCallStack => IO a) -> IO a
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO a) -> IO a) -> (HasCallStack => IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ do
        -- TODO: should this have program name or not?
        IOException -> IO a
    forall a. IOException -> IO a
    ioError (IOException -> IO a) -> (String -> IOException) -> String -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IOException
    verbatimUserError
              (String -> IO a) -> IO String -> IO a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Verbosity -> String -> IO String
    annotateErrorString Verbosity
    verbosity
                  (String -> String
    addErrorPrefix String
    msg)

    -- | Prefixing a message to indicate that it is a fatal error,
    -- if the 'errorPrefix' is not already present.
    addErrorPrefix :: String -> String
    addErrorPrefix :: String -> String
    addErrorPrefix String
    msg
      | String
    errorPrefix String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    msg = String
    msg
          -- Backpack prefixes its errors already with "Error:", see
          -- 'Distribution.Utils.LogProgress.dieProgress'.
          -- Taking it away there destroys the layout, so we rather
          -- check here whether the prefix is already present.
      | Bool
    otherwise                    = [String] -> String
    unwords [String
    errorPrefix, String
    msg]

    -- | A prefix indicating that a message is a fatal error.
    errorPrefix :: String
    errorPrefix :: String
    errorPrefix = String
    "Error:"

    -- | Prefix an error string with program name from 'getProgName'
    prefixWithProgName :: String -> IO String
    prefixWithProgName :: String -> IO String
    prefixWithProgName String
    msg = do
        String
    pname <- IO String
    getProgName
        String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ String
    pname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    msg

    -- | Annotate an error string with timestamp and 'withMetadata'.
    annotateErrorString :: Verbosity -> String -> IO String
    annotateErrorString :: Verbosity -> String -> IO String
    annotateErrorString Verbosity
    verbosity String
    msg = do
        POSIXTime
    ts <- IO POSIXTime
    getPOSIXTime
        String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ WithCallStack
      (POSIXTime
       -> MarkWhen -> TraceWhen -> Verbosity -> String -> String)
    POSIXTime -> MarkWhen -> TraceWhen -> Verbosity -> String -> String
    withMetadata POSIXTime
    ts MarkWhen
    AlwaysMark TraceWhen
    VerboseTrace Verbosity
    verbosity String
    msg

    -- | Given a block of IO code that may raise an exception, annotate
    -- it with the metadata from the current scope.  Use this as close
    -- to external code that raises IO exceptions as possible, since
    -- this function unconditionally wraps the error message with a trace
    -- (so it is NOT idempotent.)
    annotateIO :: Verbosity -> IO a -> IO a
    annotateIO :: forall a. Verbosity -> IO a -> IO a
    annotateIO Verbosity
    verbosity IO a
    act = do
        POSIXTime
    ts <- IO POSIXTime
    getPOSIXTime
        ((IOException -> IOException) -> IO a -> IO a)
    -> IO a -> (IOException -> IOException) -> IO a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (IOException -> IOException) -> IO a -> IO a
    forall a. (IOException -> IOException) -> IO a -> IO a
    modifyIOError IO a
    act ((IOException -> IOException) -> IO a)
    -> (IOException -> IOException) -> IO a
    forall a b. (a -> b) -> a -> b
    $
          (String -> String) -> IOException -> IOException
    ioeModifyErrorString ((String -> String) -> IOException -> IOException)
    -> (String -> String) -> IOException -> IOException
    forall a b. (a -> b) -> a -> b
    $ WithCallStack
      (POSIXTime
       -> MarkWhen -> TraceWhen -> Verbosity -> String -> String)
    POSIXTime -> MarkWhen -> TraceWhen -> Verbosity -> String -> String
    withMetadata POSIXTime
    ts MarkWhen
    NeverMark TraceWhen
    VerboseTrace Verbosity
    verbosity

    -- | A semantic editor for the error message inside an 'IOError'.
    ioeModifyErrorString :: (String -> String) -> IOError -> IOError
    ioeModifyErrorString :: (String -> String) -> IOException -> IOException
    ioeModifyErrorString = ASetter IOException IOException String String
    -> (String -> String) -> IOException -> IOException
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    over ASetter IOException IOException String String
    Lens' IOException String
    ioeErrorString

    -- | A lens for the error message inside an 'IOError'.
    ioeErrorString :: Lens' IOError String
    ioeErrorString :: Lens' IOException String
    ioeErrorString String -> f String
    f IOException
    ioe = IOException -> String -> IOException
    ioeSetErrorString IOException
    ioe (String -> IOException) -> f String -> f IOException
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> f String
    f (IOException -> String
    ioeGetErrorString IOException
    ioe)

    {-# NOINLINE topHandlerWith #-}
    topHandlerWith :: forall a. (Exception.SomeException -> IO a) -> IO a -> IO a
    topHandlerWith :: forall a. (SomeException -> IO a) -> IO a -> IO a
    topHandlerWith SomeException -> IO a
    cont IO a
    prog = do
        -- By default, stderr to a terminal device is NoBuffering. But this
        -- is *really slow*
        Handle -> BufferMode -> IO ()
    hSetBuffering Handle
    stderr BufferMode
    LineBuffering
        IO a -> [Handler a] -> IO a
    forall a. IO a -> [Handler a] -> IO a
    Exception.catches IO a
    prog [
            (AsyncException -> IO a) -> Handler a
    forall a e. Exception e => (e -> IO a) -> Handler a
    Exception.Handler AsyncException -> IO a
    rethrowAsyncExceptions
          , (ExitCode -> IO a) -> Handler a
    forall a e. Exception e => (e -> IO a) -> Handler a
    Exception.Handler ExitCode -> IO a
    rethrowExitStatus
          , (SomeException -> IO a) -> Handler a
    forall a e. Exception e => (e -> IO a) -> Handler a
    Exception.Handler SomeException -> IO a
    handle
          ]
      where
        -- Let async exceptions rise to the top for the default top-handler
        rethrowAsyncExceptions :: Exception.AsyncException -> IO a
        rethrowAsyncExceptions :: AsyncException -> IO a
    rethrowAsyncExceptions AsyncException
    a = AsyncException -> IO a
    forall e a. Exception e => e -> IO a
    throwIO AsyncException
    a

        -- ExitCode gets thrown asynchronously too, and we don't want to print it
        rethrowExitStatus :: ExitCode -> IO a
        rethrowExitStatus :: ExitCode -> IO a
    rethrowExitStatus = ExitCode -> IO a
    forall e a. Exception e => e -> IO a
    throwIO

        -- Print all other exceptions
        handle :: Exception.SomeException -> IO a
        handle :: SomeException -> IO a
    handle SomeException
    se = do
          Handle -> IO ()
    hFlush Handle
    stdout
          String
    pname <- IO String
    getProgName
          Handle -> String -> IO ()
    hPutStr Handle
    stderr (String -> SomeException -> String
    message String
    pname SomeException
    se)
          SomeException -> IO a
    cont SomeException
    se

        message :: String -> Exception.SomeException -> String
        message :: String -> SomeException -> String
    message String
    pname (Exception.SomeException e
    se) =
          case e -> Maybe IOException
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast e
    se :: Maybe Exception.IOException of
            Just IOException
    ioe
             | IOException -> Bool
    ioeGetVerbatim IOException
    ioe ->
                -- Use the message verbatim
                IOException -> String
    ioeGetErrorString IOException
    ioe String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
             | IOException -> Bool
    isUserError IOException
    ioe ->
              let file :: String
    file         = case IOException -> Maybe String
    ioeGetFileName IOException
    ioe of
                                   Maybe String
    Nothing   -> String
    ""
                                   Just String
    path -> String
    path String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    location String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": "
                  location :: String
    location     = case IOException -> String
    ioeGetLocation IOException
    ioe of
                                   l :: String
    l@(Char
    n:String
    _) | Char -> Bool
    isDigit Char
    n -> Char
    ':' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    l
                                   String
    _                        -> String
    ""
                  detail :: String
    detail       = IOException -> String
    ioeGetErrorString IOException
    ioe
              in String -> String
    wrapText (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    addErrorPrefix (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    pname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    file String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    detail
            Maybe IOException
    _ ->
              e -> String
    forall e. Exception e => e -> String
    displaySomeException e
    se String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"

    -- | BC wrapper around 'Exception.displayException'.
    displaySomeException :: Exception.Exception e => e -> String
    displaySomeException :: forall e. Exception e => e -> String
    displaySomeException e
    se = e -> String
    forall e. Exception e => e -> String
    Exception.displayException e
    se

    topHandler :: IO a -> IO a
    topHandler :: forall a. IO a -> IO a
    topHandler IO a
    prog = (SomeException -> IO a) -> IO a -> IO a
    forall a. (SomeException -> IO a) -> IO a -> IO a
    topHandlerWith (IO a -> SomeException -> IO a
    forall a b. a -> b -> a
    const (IO a -> SomeException -> IO a) -> IO a -> SomeException -> IO a
    forall a b. (a -> b) -> a -> b
    $ ExitCode -> IO a
    forall a. ExitCode -> IO a
    exitWith (Int -> ExitCode
    ExitFailure Int
    1)) IO a
    prog

    -- | Depending on 'isVerboseStderr', set the output handle to 'stderr' or 'stdout'.
    verbosityHandle :: Verbosity -> Handle
    verbosityHandle :: Verbosity -> Handle
    verbosityHandle Verbosity
    verbosity
        | Verbosity -> Bool
    isVerboseStderr Verbosity
    verbosity = Handle
    stderr
        | Bool
    otherwise                 = Handle
    stdout

    -- | Non fatal conditions that may be indicative of an error or problem.
    --
    -- We display these at the 'normal' verbosity level.
    --
    warn :: Verbosity -> String -> IO ()
    warn :: Verbosity -> String -> IO ()
    warn Verbosity
    verbosity String
    msg = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((Verbosity
    verbosity Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    normal) Bool -> Bool -> Bool
    && Bool -> Bool
    not (Verbosity -> Bool
    isVerboseNoWarn Verbosity
    verbosity)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        POSIXTime
    ts <- IO POSIXTime
    getPOSIXTime
        Handle -> IO ()
    hFlush Handle
    stdout
        Handle -> String -> IO ()
    hPutStr Handle
    stderr (String -> IO ()) -> (String -> String) -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WithCallStack
      (POSIXTime
       -> MarkWhen -> TraceWhen -> Verbosity -> String -> String)
    POSIXTime -> MarkWhen -> TraceWhen -> Verbosity -> String -> String
    withMetadata POSIXTime
    ts MarkWhen
    NormalMark TraceWhen
    FlagTrace Verbosity
    verbosity
                       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Verbosity -> String -> String
    wrapTextVerbosity Verbosity
    verbosity
                       (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Warning: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    msg

    -- | Useful status messages.
    --
    -- We display these at the 'normal' verbosity level.
    --
    -- This is for the ordinary helpful status messages that users see. Just
    -- enough information to know that things are working but not floods of detail.
    --
    notice :: Verbosity -> String -> IO ()
    notice :: Verbosity -> String -> IO ()
    notice Verbosity
    verbosity String
    msg = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Verbosity
    verbosity Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    normal) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let h :: Handle
    h = Verbosity -> Handle
    verbosityHandle Verbosity
    verbosity
        POSIXTime
    ts <- IO POSIXTime
    getPOSIXTime
        Handle -> String -> IO ()
    hPutStr Handle
    h
            (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ WithCallStack
      (POSIXTime
       -> MarkWhen -> TraceWhen -> Verbosity -> String -> String)
    POSIXTime -> MarkWhen -> TraceWhen -> Verbosity -> String -> String
    withMetadata POSIXTime
    ts MarkWhen
    NormalMark TraceWhen
    FlagTrace Verbosity
    verbosity
            (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Verbosity -> String -> String
    wrapTextVerbosity Verbosity
    verbosity
            (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    msg

    -- | Display a message at 'normal' verbosity level, but without
    -- wrapping.
    --
    noticeNoWrap :: Verbosity -> String -> IO ()
    noticeNoWrap :: Verbosity -> String -> IO ()
    noticeNoWrap Verbosity
    verbosity String
    msg = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Verbosity
    verbosity Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    normal) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let h :: Handle
    h = Verbosity -> Handle
    verbosityHandle Verbosity
    verbosity
        POSIXTime
    ts <- IO POSIXTime
    getPOSIXTime
        Handle -> String -> IO ()
    hPutStr Handle
    h (String -> IO ()) -> (String -> String) -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WithCallStack
      (POSIXTime
       -> MarkWhen -> TraceWhen -> Verbosity -> String -> String)
    POSIXTime -> MarkWhen -> TraceWhen -> Verbosity -> String -> String
    withMetadata POSIXTime
    ts MarkWhen
    NormalMark TraceWhen
    FlagTrace Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    msg

    -- | Pretty-print a 'Disp.Doc' status message at 'normal' verbosity
    -- level.  Use this if you need fancy formatting.
    --
    noticeDoc :: Verbosity -> Disp.Doc -> IO ()
    noticeDoc :: Verbosity -> Doc -> IO ()
    noticeDoc Verbosity
    verbosity Doc
    msg = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Verbosity
    verbosity Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    normal) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let h :: Handle
    h = Verbosity -> Handle
    verbosityHandle Verbosity
    verbosity
        POSIXTime
    ts <- IO POSIXTime
    getPOSIXTime
        Handle -> String -> IO ()
    hPutStr Handle
    h
            (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ WithCallStack
      (POSIXTime
       -> MarkWhen -> TraceWhen -> Verbosity -> String -> String)
    POSIXTime -> MarkWhen -> TraceWhen -> Verbosity -> String -> String
    withMetadata POSIXTime
    ts MarkWhen
    NormalMark TraceWhen
    FlagTrace Verbosity
    verbosity
            (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Style -> Doc -> String
    Disp.renderStyle Style
    defaultStyle
            (Doc -> String) -> Doc -> String
    forall a b. (a -> b) -> a -> b
    $ Doc
    msg

    -- | Display a "setup status message".  Prefer using setupMessage'
    -- if possible.
    --
    setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()
    setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()
    setupMessage Verbosity
    verbosity String
    msg PackageIdentifier
    pkgid = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Verbosity -> String -> IO ()
    noticeNoWrap Verbosity
    verbosity (String
    msg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Char
    ' 'Char -> String -> String
    forall a. a -> [a] -> [a]
    : PackageIdentifier -> String
    forall a. Pretty a => a -> String
    prettyShow PackageIdentifier
    pkgid String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "...")

    -- | More detail on the operation of some action.
    --
    -- We display these messages when the verbosity level is 'verbose'
    --
    info :: Verbosity -> String -> IO ()
    info :: Verbosity -> String -> IO ()
    info Verbosity
    verbosity String
    msg = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Verbosity
    verbosity Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    verbose) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let h :: Handle
    h = Verbosity -> Handle
    verbosityHandle Verbosity
    verbosity
        POSIXTime
    ts <- IO POSIXTime
    getPOSIXTime
        Handle -> String -> IO ()
    hPutStr Handle
    h
            (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ WithCallStack
      (POSIXTime
       -> MarkWhen -> TraceWhen -> Verbosity -> String -> String)
    POSIXTime -> MarkWhen -> TraceWhen -> Verbosity -> String -> String
    withMetadata POSIXTime
    ts MarkWhen
    NeverMark TraceWhen
    FlagTrace Verbosity
    verbosity
            (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Verbosity -> String -> String
    wrapTextVerbosity Verbosity
    verbosity
            (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    msg

    infoNoWrap :: Verbosity -> String -> IO ()
    infoNoWrap :: Verbosity -> String -> IO ()
    infoNoWrap Verbosity
    verbosity String
    msg = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Verbosity
    verbosity Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    verbose) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let h :: Handle
    h = Verbosity -> Handle
    verbosityHandle Verbosity
    verbosity
        POSIXTime
    ts <- IO POSIXTime
    getPOSIXTime
        Handle -> String -> IO ()
    hPutStr Handle
    h
            (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ WithCallStack
      (POSIXTime
       -> MarkWhen -> TraceWhen -> Verbosity -> String -> String)
    POSIXTime -> MarkWhen -> TraceWhen -> Verbosity -> String -> String
    withMetadata POSIXTime
    ts MarkWhen
    NeverMark TraceWhen
    FlagTrace Verbosity
    verbosity
            (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    msg

    -- | Detailed internal debugging information
    --
    -- We display these messages when the verbosity level is 'deafening'
    --
    debug :: Verbosity -> String -> IO ()
    debug :: Verbosity -> String -> IO ()
    debug Verbosity
    verbosity String
    msg = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Verbosity
    verbosity Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    deafening) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let h :: Handle
    h = Verbosity -> Handle
    verbosityHandle Verbosity
    verbosity
        POSIXTime
    ts <- IO POSIXTime
    getPOSIXTime
        Handle -> String -> IO ()
    hPutStr Handle
    h (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ WithCallStack
      (POSIXTime
       -> MarkWhen -> TraceWhen -> Verbosity -> String -> String)
    POSIXTime -> MarkWhen -> TraceWhen -> Verbosity -> String -> String
    withMetadata POSIXTime
    ts MarkWhen
    NeverMark TraceWhen
    FlagTrace Verbosity
    verbosity
                  (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Verbosity -> String -> String
    wrapTextVerbosity Verbosity
    verbosity
                  (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    msg
        -- ensure that we don't lose output if we segfault/infinite loop
        Handle -> IO ()
    hFlush Handle
    stdout

    -- | A variant of 'debug' that doesn't perform the automatic line
    -- wrapping. Produces better output in some cases.
    debugNoWrap :: Verbosity -> String -> IO ()
    debugNoWrap :: Verbosity -> String -> IO ()
    debugNoWrap Verbosity
    verbosity String
    msg = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Verbosity
    verbosity Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    deafening) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let h :: Handle
    h = Verbosity -> Handle
    verbosityHandle Verbosity
    verbosity
        POSIXTime
    ts <- IO POSIXTime
    getPOSIXTime
        Handle -> String -> IO ()
    hPutStr Handle
    h
            (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ WithCallStack
      (POSIXTime
       -> MarkWhen -> TraceWhen -> Verbosity -> String -> String)
    POSIXTime -> MarkWhen -> TraceWhen -> Verbosity -> String -> String
    withMetadata POSIXTime
    ts MarkWhen
    NeverMark TraceWhen
    FlagTrace Verbosity
    verbosity
            (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    msg
        -- ensure that we don't lose output if we segfault/infinite loop
        Handle -> IO ()
    hFlush Handle
    stdout

    -- | Perform an IO action, catching any IO exceptions and printing an error
    --   if one occurs.
    chattyTry :: String  -- ^ a description of the action we were attempting
              -> IO ()   -- ^ the action itself
              -> IO ()
    chattyTry :: String -> IO () -> IO ()
    chattyTry String
    desc IO ()
    action =
      IO () -> (IOException -> IO ()) -> IO ()
    forall a. IO a -> (IOException -> IO a) -> IO a
    catchIO IO ()
    action ((IOException -> IO ()) -> IO ())
    -> (IOException -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IOException
    exception ->
        Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Error while " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    desc String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ IOException -> String
    forall a. Show a => a -> String
    show IOException
    exception

    -- | Run an IO computation, returning @e@ if it raises a "file
    -- does not exist" error.
    handleDoesNotExist :: a -> IO a -> IO a
    handleDoesNotExist :: forall a. a -> IO a -> IO a
    handleDoesNotExist a
    e =
        (IOException -> Maybe IOException)
    -> (IOException -> IO a) -> IO a -> IO a
    forall e b a.
    Exception e =>
    (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
    Exception.handleJust
          (\IOException
    ioe -> if IOException -> Bool
    isDoesNotExistError IOException
    ioe then IOException -> Maybe IOException
    forall a. a -> Maybe a
    Just IOException
    ioe else Maybe IOException
    forall a. Maybe a
    Nothing)
          (\IOException
    _ -> a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    e)

    -- -----------------------------------------------------------------------------
    -- Helper functions

    -- | Wraps text unless the @+nowrap@ verbosity flag is active
    wrapTextVerbosity :: Verbosity -> String -> String
    wrapTextVerbosity :: Verbosity -> String -> String
    wrapTextVerbosity Verbosity
    verb
      | Verbosity -> Bool
    isVerboseNoWrap Verbosity
    verb = String -> String
    withTrailingNewline
      | Bool
    otherwise            = String -> String
    withTrailingNewline (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    wrapText

    -- | Prepends a timestamp if @+timestamp@ verbosity flag is set
    --
    -- This is used by 'withMetadata'
    --
    withTimestamp :: Verbosity -> POSIXTime -> String -> String
    withTimestamp :: Verbosity -> POSIXTime -> String -> String
    withTimestamp Verbosity
    v POSIXTime
    ts String
    msg
      | Verbosity -> Bool
    isVerboseTimestamp Verbosity
    v  = String
    msg'
      | Bool
    otherwise             = String
    msg -- no-op
      where
        msg' :: String
    msg' = case String -> [String]
    lines String
    msg of
          []      -> String -> String
    tsstr String
    "\n"
          String
    l1:[String]
    rest -> [String] -> String
    unlines (String -> String
    tsstr (Char
    ' 'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    l1) String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    contpfxString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) [String]
    rest)

        -- format timestamp to be prepended to first line with msec precision
        tsstr :: String -> String
    tsstr = Maybe Int -> Double -> String -> String
    forall a. RealFloat a => Maybe Int -> a -> String -> String
    showFFloat (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    3) (POSIXTime -> Double
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac POSIXTime
    ts :: Double)

        -- continuation prefix for subsequent lines of msg
        contpfx :: String
    contpfx = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> String
    tsstr String
    " ")) Char
    ' '

    -- | Wrap output with a marker if @+markoutput@ verbosity flag is set.
    --
    -- NB: Why is markoutput done with start/end markers, and not prefixes?
    -- Markers are more convenient to add (if we want to add prefixes,
    -- we have to 'lines' and then 'map'; here's it's just some
    -- concatenates).  Note that even in the prefix case, we can't
    -- guarantee that the markers are unambiguous, because some of
    -- Cabal's output comes straight from external programs, where
    -- we don't have the ability to interpose on the output.
    --
    -- This is used by 'withMetadata'
    --
    withOutputMarker :: Verbosity -> String -> String
    withOutputMarker :: Verbosity -> String -> String
    withOutputMarker Verbosity
    v String
    xs | Bool -> Bool
    not (Verbosity -> Bool
    isVerboseMarkOutput Verbosity
    v) = String
    xs
    withOutputMarker Verbosity
    _ String
    "" = String
    "" -- Minor optimization, don't mark uselessly
    withOutputMarker Verbosity
    _ String
    xs =
        String
    "-----BEGIN CABAL OUTPUT-----\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
        String -> String
    withTrailingNewline String
    xs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
        String
    "-----END CABAL OUTPUT-----\n"

    -- | Append a trailing newline to a string if it does not
    -- already have a trailing newline.
    --
    withTrailingNewline :: String -> String
    withTrailingNewline :: String -> String
    withTrailingNewline String
    "" = String
    ""
    withTrailingNewline (Char
    x:String
    xs) = Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : Char -> String -> String
    go Char
    x String
    xs
      where
        go :: Char -> String -> String
    go   Char
    _ (Char
    c:String
    cs) = Char
    c Char -> String -> String
    forall a. a -> [a] -> [a]
    : Char -> String -> String
    go Char
    c String
    cs
        go Char
    '\n' String
    "" = String
    ""
        go   Char
    _  String
    "" = String
    "\n"

    -- | Prepend a call-site and/or call-stack based on Verbosity
    --
    withCallStackPrefix :: WithCallStack (TraceWhen -> Verbosity -> String -> String)
    withCallStackPrefix :: WithCallStack (TraceWhen -> Verbosity -> String -> String)
    withCallStackPrefix TraceWhen
    tracer Verbosity
    verbosity String
    s = (HasCallStack => String) -> String
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => String) -> String)
    -> (HasCallStack => String) -> String
    forall a b. (a -> b) -> a -> b
    $
        (if Verbosity -> Bool
    isVerboseCallSite Verbosity
    verbosity
            then String
    HasCallStack => String
    parentSrcLocPrefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                 -- Hack: need a newline before starting output marker :(
                 if Verbosity -> Bool
    isVerboseMarkOutput Verbosity
    verbosity
                    then String
    "\n"
                    else String
    ""
            else String
    "") String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
        (case Verbosity -> TraceWhen -> Maybe String
    traceWhen Verbosity
    verbosity TraceWhen
    tracer of
            Just String
    pre -> String
    pre String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CallStack -> String
    prettyCallStack CallStack
    HasCallStack => CallStack
    callStack String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
            Maybe String
    Nothing  -> String
    "") String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
        String
    s

    -- | When should we emit the call stack?  We always emit
    -- for internal errors, emit the trace for errors when we
    -- are in verbose mode, and otherwise only emit it if
    -- explicitly asked for using the @+callstack@ verbosity
    -- flag.  (At the moment, 'AlwaysTrace' is not used.
    --
    data TraceWhen
        = AlwaysTrace
        | VerboseTrace
        | FlagTrace
        deriving (TraceWhen -> TraceWhen -> Bool
    (TraceWhen -> TraceWhen -> Bool)
    -> (TraceWhen -> TraceWhen -> Bool) -> Eq TraceWhen
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TraceWhen -> TraceWhen -> Bool
    == :: TraceWhen -> TraceWhen -> Bool
    $c/= :: TraceWhen -> TraceWhen -> Bool
    /= :: TraceWhen -> TraceWhen -> Bool
    Eq)

    -- | Determine if we should emit a call stack.
    -- If we trace, it also emits any prefix we should append.
    traceWhen :: Verbosity -> TraceWhen -> Maybe String
    traceWhen :: Verbosity -> TraceWhen -> Maybe String
    traceWhen Verbosity
    _ TraceWhen
    AlwaysTrace = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    ""
    traceWhen Verbosity
    v TraceWhen
    VerboseTrace | Verbosity
    v Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    verbose         = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    ""
    traceWhen Verbosity
    v TraceWhen
    FlagTrace    | Verbosity -> Bool
    isVerboseCallStack Verbosity
    v = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "----\n"
    traceWhen Verbosity
    _ TraceWhen
    _ = Maybe String
    forall a. Maybe a
    Nothing

    -- | When should we output the marker?  Things like 'die'
    -- always get marked, but a 'NormalMark' will only be
    -- output if we're not a quiet verbosity.
    --
    data MarkWhen = AlwaysMark | NormalMark | NeverMark

    -- | Add all necessary metadata to a logging message
    --
    withMetadata :: WithCallStack (POSIXTime -> MarkWhen -> TraceWhen -> Verbosity -> String -> String)
    withMetadata :: WithCallStack
      (POSIXTime
       -> MarkWhen -> TraceWhen -> Verbosity -> String -> String)
    withMetadata POSIXTime
    ts MarkWhen
    marker TraceWhen
    tracer Verbosity
    verbosity String
    x = (HasCallStack => String) -> String
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => String) -> String)
    -> (HasCallStack => String) -> String
    forall a b. (a -> b) -> a -> b
    $
        -- NB: order matters.  Output marker first because we
        -- don't want to capture call stacks.
          String -> String
    withTrailingNewline
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WithCallStack (TraceWhen -> Verbosity -> String -> String)
    TraceWhen -> Verbosity -> String -> String
    withCallStackPrefix TraceWhen
    tracer Verbosity
    verbosity
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (case MarkWhen
    marker of
            MarkWhen
    AlwaysMark -> Verbosity -> String -> String
    withOutputMarker Verbosity
    verbosity
            MarkWhen
    NormalMark | Bool -> Bool
    not (Verbosity -> Bool
    isVerboseQuiet Verbosity
    verbosity)
                       -> Verbosity -> String -> String
    withOutputMarker Verbosity
    verbosity
                       | Bool
    otherwise
                       -> String -> String
    forall a. a -> a
    id
            MarkWhen
    NeverMark  -> String -> String
    forall a. a -> a
    id)
        -- Clear out any existing markers
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    clearMarkers
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Verbosity -> POSIXTime -> String -> String
    withTimestamp Verbosity
    verbosity POSIXTime
    ts
        (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    x

    clearMarkers :: String -> String
    clearMarkers :: String -> String
    clearMarkers String
    s = [String] -> String
    unlines ([String] -> String)
    -> ([String] -> [String]) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    isMarker ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    lines String
    s
      where
        isMarker :: String -> Bool
    isMarker String
    "-----BEGIN CABAL OUTPUT-----" = Bool
    False
        isMarker String
    "-----END CABAL OUTPUT-----"   = Bool
    False
        isMarker String
    _ = Bool
    True

    -- -----------------------------------------------------------------------------
    -- rawSystem variants
    --
    -- These all use 'Distribution.Compat.Process.proc' to ensure we
    -- consistently use process jobs on Windows and Ctrl-C delegation
    -- on Unix.
    --
    -- Additionally, they take care of logging command execution.
    --

    -- | Helper to use with one of the 'rawSystem' variants, and exit
    -- unless the command completes successfully.
    maybeExit :: IO ExitCode -> IO ()
    maybeExit :: IO ExitCode -> IO ()
    maybeExit IO ExitCode
    cmd = do
      ExitCode
    exitcode <- IO ExitCode
    cmd
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ExitCode
    exitcode ExitCode -> ExitCode -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExitCode
    ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith ExitCode
    exitcode

    -- | Log a command execution (that's typically about to happen)
    -- at info level, and log working directory and environment overrides
    -- at debug level if specified.
    --
    logCommand :: Verbosity -> Process.CreateProcess -> IO ()
    logCommand :: Verbosity -> CreateProcess -> IO ()
    logCommand Verbosity
    verbosity CreateProcess
    cp = do
      Verbosity -> String -> IO ()
    infoNoWrap Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Running: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> case CreateProcess -> CmdSpec
    Process.cmdspec CreateProcess
    cp of
        Process.ShellCommand String
    sh -> String
    sh
        Process.RawCommand String
    path [String]
    args -> String -> [String] -> String
    Process.showCommandForUser String
    path [String]
    args
      case CreateProcess -> Maybe [(String, String)]
    Process.env CreateProcess
    cp of
        Just [(String, String)]
    env -> Verbosity -> String -> IO ()
    debugNoWrap Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "with environment: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [(String, String)] -> String
    forall a. Show a => a -> String
    show [(String, String)]
    env
        Maybe [(String, String)]
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      case CreateProcess -> Maybe String
    Process.cwd CreateProcess
    cp of
        Just String
    cwd -> Verbosity -> String -> IO ()
    debugNoWrap Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "with working directory: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    cwd
        Maybe String
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      Handle -> IO ()
    hFlush Handle
    stdout

    -- | Execute the given command with the given arguments, exiting
    -- with the same exit code if the command fails.
    --
    rawSystemExit :: Verbosity -> FilePath -> [String] -> IO ()
    rawSystemExit :: Verbosity -> String -> [String] -> IO ()
    rawSystemExit Verbosity
    verbosity String
    path [String]
    args = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
      IO ExitCode -> IO ()
    maybeExit (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Verbosity -> String -> [String] -> IO ExitCode
    rawSystemExitCode Verbosity
    verbosity String
    path [String]
    args

    -- | Execute the given command with the given arguments, returning
    -- the command's exit code.
    --
    rawSystemExitCode :: Verbosity -> FilePath -> [String] -> IO ExitCode
    rawSystemExitCode :: Verbosity -> String -> [String] -> IO ExitCode
    rawSystemExitCode Verbosity
    verbosity String
    path [String]
    args = (HasCallStack => IO ExitCode) -> IO ExitCode
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ExitCode) -> IO ExitCode)
    -> (HasCallStack => IO ExitCode) -> IO ExitCode
    forall a b. (a -> b) -> a -> b
    $
      Verbosity -> CreateProcess -> IO ExitCode
    rawSystemProc Verbosity
    verbosity (CreateProcess -> IO ExitCode) -> CreateProcess -> IO ExitCode
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> CreateProcess
    proc String
    path [String]
    args

    -- | Execute the given command with the given arguments, returning
    -- the command's exit code.
    --
    -- Create the process argument with 'Distribution.Compat.Process.proc'
    -- to ensure consistent options with other 'rawSystem' functions in this
    -- module.
    --
    rawSystemProc :: Verbosity -> Process.CreateProcess -> IO ExitCode
    rawSystemProc :: Verbosity -> CreateProcess -> IO ExitCode
    rawSystemProc Verbosity
    verbosity CreateProcess
    cp = (HasCallStack => IO ExitCode) -> IO ExitCode
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ExitCode) -> IO ExitCode)
    -> (HasCallStack => IO ExitCode) -> IO ExitCode
    forall a b. (a -> b) -> a -> b
    $ do
      (ExitCode
    exitcode, ()
    _) <- Verbosity
    -> CreateProcess
    -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO ())
    -> IO (ExitCode, ())
    forall a.
    Verbosity
    -> CreateProcess
    -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO a)
    -> IO (ExitCode, a)
    rawSystemProcAction Verbosity
    verbosity CreateProcess
    cp ((Maybe Handle -> Maybe Handle -> Maybe Handle -> IO ())
     -> IO (ExitCode, ()))
    -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO ())
    -> IO (ExitCode, ())
    forall a b. (a -> b) -> a -> b
    $ \Maybe Handle
    _ Maybe Handle
    _ Maybe Handle
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      ExitCode -> IO ExitCode
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ExitCode
    exitcode

    -- | Execute the given command with the given arguments, returning
    -- the command's exit code. 'action' is executed while the command
    -- is running, and would typically be used to communicate with the
    -- process through pipes.
    --
    -- Create the process argument with 'Distribution.Compat.Process.proc'
    -- to ensure consistent options with other 'rawSystem' functions in this
    -- module.
    --
    rawSystemProcAction :: Verbosity -> Process.CreateProcess
                        -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO a)
                        -> IO (ExitCode, a)
    rawSystemProcAction :: forall a.
    Verbosity
    -> CreateProcess
    -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO a)
    -> IO (ExitCode, a)
    rawSystemProcAction Verbosity
    verbosity CreateProcess
    cp Maybe Handle -> Maybe Handle -> Maybe Handle -> IO a
    action = (HasCallStack => IO (ExitCode, a)) -> IO (ExitCode, a)
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO (ExitCode, a)) -> IO (ExitCode, a))
    -> (HasCallStack => IO (ExitCode, a)) -> IO (ExitCode, a)
    forall a b. (a -> b) -> a -> b
    $ do
      Verbosity -> CreateProcess -> IO ()
    logCommand Verbosity
    verbosity CreateProcess
    cp
      (ExitCode
    exitcode, a
    a) <- CreateProcess
    -> (Maybe Handle
        -> Maybe Handle
        -> Maybe Handle
        -> ProcessHandle
        -> IO (ExitCode, a))
    -> IO (ExitCode, a)
    forall a.
    CreateProcess
    -> (Maybe Handle
        -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
    -> IO a
    Process.withCreateProcess CreateProcess
    cp ((Maybe Handle
      -> Maybe Handle
      -> Maybe Handle
      -> ProcessHandle
      -> IO (ExitCode, a))
     -> IO (ExitCode, a))
    -> (Maybe Handle
        -> Maybe Handle
        -> Maybe Handle
        -> ProcessHandle
        -> IO (ExitCode, a))
    -> IO (ExitCode, a)
    forall a b. (a -> b) -> a -> b
    $ \Maybe Handle
    mStdin Maybe Handle
    mStdout Maybe Handle
    mStderr ProcessHandle
    p -> do
        a
    a <- Maybe Handle -> Maybe Handle -> Maybe Handle -> IO a
    action Maybe Handle
    mStdin Maybe Handle
    mStdout Maybe Handle
    mStderr
        ExitCode
    exitcode <- ProcessHandle -> IO ExitCode
    Process.waitForProcess ProcessHandle
    p
        (ExitCode, a) -> IO (ExitCode, a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ExitCode
    exitcode, a
    a)
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ExitCode
    exitcode ExitCode -> ExitCode -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExitCode
    ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let cmd :: String
    cmd = case CreateProcess -> CmdSpec
    Process.cmdspec CreateProcess
    cp of
              Process.ShellCommand String
    sh -> String
    sh
              Process.RawCommand String
    path [String]
    _args -> String
    path
        Verbosity -> String -> IO ()
    debug Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    cmd String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " returned " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ExitCode -> String
    forall a. Show a => a -> String
    show ExitCode
    exitcode
      (ExitCode, a) -> IO (ExitCode, a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ExitCode
    exitcode, a
    a)

    -- | fromJust for dealing with 'Maybe Handle' values as obtained via
    -- 'System.Process.CreatePipe'. Creating a pipe using 'CreatePipe' guarantees
    -- a 'Just' value for the corresponding handle.
    --
    fromCreatePipe :: Maybe Handle -> Handle
    fromCreatePipe :: Maybe Handle -> Handle
    fromCreatePipe = Handle -> (Handle -> Handle) -> Maybe Handle -> Handle
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> Handle
    forall a. HasCallStack => String -> a
    error String
    "fromCreatePipe: Nothing") Handle -> Handle
    forall a. a -> a
    id

    -- | Execute the given command with the given arguments and
    -- environment, exiting with the same exit code if the command fails.
    --
    rawSystemExitWithEnv :: Verbosity
                         -> FilePath
                         -> [String]
                         -> [(String, String)]
                         -> IO ()
    rawSystemExitWithEnv :: Verbosity -> String -> [String] -> [(String, String)] -> IO ()
    rawSystemExitWithEnv Verbosity
    verbosity String
    path [String]
    args [(String, String)]
    env = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
      IO ExitCode -> IO ()
    maybeExit (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Verbosity -> CreateProcess -> IO ExitCode
    rawSystemProc Verbosity
    verbosity (CreateProcess -> IO ExitCode) -> CreateProcess -> IO ExitCode
    forall a b. (a -> b) -> a -> b
    $
        (String -> [String] -> CreateProcess
    proc String
    path [String]
    args) { Process.env = Just env
                         }

    -- | Execute the given command with the given arguments, returning
    -- the command's exit code.
    --
    -- Optional arguments allow setting working directory, environment
    -- and input and output handles.
    --
    rawSystemIOWithEnv :: Verbosity
                       -> FilePath
                       -> [String]
                       -> Maybe FilePath           -- ^ New working dir or inherit
                       -> Maybe [(String, String)] -- ^ New environment or inherit
                       -> Maybe Handle  -- ^ stdin
                       -> Maybe Handle  -- ^ stdout
                       -> Maybe Handle  -- ^ stderr
                       -> IO ExitCode
    rawSystemIOWithEnv :: Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> Maybe Handle
    -> Maybe Handle
    -> Maybe Handle
    -> IO ExitCode
    rawSystemIOWithEnv Verbosity
    verbosity String
    path [String]
    args Maybe String
    mcwd Maybe [(String, String)]
    menv Maybe Handle
    inp Maybe Handle
    out Maybe Handle
    err = (HasCallStack => IO ExitCode) -> IO ExitCode
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ExitCode) -> IO ExitCode)
    -> (HasCallStack => IO ExitCode) -> IO ExitCode
    forall a b. (a -> b) -> a -> b
    $ do
      (ExitCode
    exitcode, ()
    _) <- Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> IO ()
    -> Maybe Handle
    -> Maybe Handle
    -> Maybe Handle
    -> IO (ExitCode, ())
    forall a.
    Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> IO a
    -> Maybe Handle
    -> Maybe Handle
    -> Maybe Handle
    -> IO (ExitCode, a)
    rawSystemIOWithEnvAndAction
        Verbosity
    verbosity String
    path [String]
    args Maybe String
    mcwd Maybe [(String, String)]
    menv IO ()
    action Maybe Handle
    inp Maybe Handle
    out Maybe Handle
    err
      ExitCode -> IO ExitCode
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ExitCode
    exitcode
      where
        action :: IO ()
    action = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Execute the given command with the given arguments, returning
    -- the command's exit code. 'action' is executed while the command
    -- is running, and would typically be used to communicate with the
    -- process through pipes.
    --
    -- Optional arguments allow setting working directory, environment
    -- and input and output handles.
    --
    rawSystemIOWithEnvAndAction
        :: Verbosity
        -> FilePath
        -> [String]
        -> Maybe FilePath           -- ^ New working dir or inherit
        -> Maybe [(String, String)] -- ^ New environment or inherit
        -> IO a          -- ^ action to perform after process is created, but before 'waitForProcess'.
        -> Maybe Handle  -- ^ stdin
        -> Maybe Handle  -- ^ stdout
        -> Maybe Handle  -- ^ stderr
        -> IO (ExitCode, a)
    rawSystemIOWithEnvAndAction :: forall a.
    Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> IO a
    -> Maybe Handle
    -> Maybe Handle
    -> Maybe Handle
    -> IO (ExitCode, a)
    rawSystemIOWithEnvAndAction Verbosity
    verbosity String
    path [String]
    args Maybe String
    mcwd Maybe [(String, String)]
    menv IO a
    action Maybe Handle
    inp Maybe Handle
    out Maybe Handle
    err = (HasCallStack => IO (ExitCode, a)) -> IO (ExitCode, a)
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO (ExitCode, a)) -> IO (ExitCode, a))
    -> (HasCallStack => IO (ExitCode, a)) -> IO (ExitCode, a)
    forall a b. (a -> b) -> a -> b
    $ do
      let cp :: CreateProcess
    cp = (String -> [String] -> CreateProcess
    proc String
    path [String]
    args) { Process.cwd           = mcwd
                                , Process.env           = menv
                                , Process.std_in        = mbToStd inp
                                , Process.std_out       = mbToStd out
                                , Process.std_err       = mbToStd err
                                }
      Verbosity
    -> CreateProcess
    -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO a)
    -> IO (ExitCode, a)
    forall a.
    Verbosity
    -> CreateProcess
    -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO a)
    -> IO (ExitCode, a)
    rawSystemProcAction Verbosity
    verbosity CreateProcess
    cp (\Maybe Handle
    _ Maybe Handle
    _ Maybe Handle
    _ -> IO a
    action)
      where
        mbToStd :: Maybe Handle -> Process.StdStream
        mbToStd :: Maybe Handle -> StdStream
    mbToStd = StdStream -> (Handle -> StdStream) -> Maybe Handle -> StdStream
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe StdStream
    Process.Inherit Handle -> StdStream
    Process.UseHandle

    -- | Execute the given command with the given arguments, returning
    -- the command's output. Exits if the command exits with error.
    --
    -- Provides control over the binary/text mode of the output.
    --
    rawSystemStdout :: forall mode. KnownIODataMode mode => Verbosity -> FilePath -> [String] -> IO mode
    rawSystemStdout :: forall mode.
    KnownIODataMode mode =>
    Verbosity -> String -> [String] -> IO mode
    rawSystemStdout Verbosity
    verbosity String
    path [String]
    args = (HasCallStack => IO mode) -> IO mode
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO mode) -> IO mode)
    -> (HasCallStack => IO mode) -> IO mode
    forall a b. (a -> b) -> a -> b
    $ do
      (mode
    output, String
    errors, ExitCode
    exitCode) <- Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> Maybe IOData
    -> IODataMode mode
    -> IO (mode, String, ExitCode)
    forall mode.
    KnownIODataMode mode =>
    Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> Maybe IOData
    -> IODataMode mode
    -> IO (mode, String, ExitCode)
    rawSystemStdInOut Verbosity
    verbosity String
    path [String]
    args
        Maybe String
    forall a. Maybe a
    Nothing Maybe [(String, String)]
    forall a. Maybe a
    Nothing Maybe IOData
    forall a. Maybe a
    Nothing (IODataMode mode
    forall mode. KnownIODataMode mode => IODataMode mode
    IOData.iodataMode :: IODataMode mode)
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ExitCode
    exitCode ExitCode -> ExitCode -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ExitCode
    ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        Verbosity -> String -> IO ()
    forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity String
    errors
      mode -> IO mode
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return mode
    output

    -- | Execute the given command with the given arguments, returning
    -- the command's output, errors and exit code.
    --
    -- Optional arguments allow setting working directory, environment
    -- and command input.
    --
    -- Provides control over the binary/text mode of the input and output.
    --
    rawSystemStdInOut :: KnownIODataMode mode
                      => Verbosity
                      -> FilePath                 -- ^ Program location
                      -> [String]                 -- ^ Arguments
                      -> Maybe FilePath           -- ^ New working dir or inherit
                      -> Maybe [(String, String)] -- ^ New environment or inherit
                      -> Maybe IOData             -- ^ input text and binary mode
                      -> IODataMode mode          -- ^ iodata mode, acts as proxy
                      -> IO (mode, String, ExitCode) -- ^ output, errors, exit
    rawSystemStdInOut :: forall mode.
    KnownIODataMode mode =>
    Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> Maybe IOData
    -> IODataMode mode
    -> IO (mode, String, ExitCode)
    rawSystemStdInOut Verbosity
    verbosity String
    path [String]
    args Maybe String
    mcwd Maybe [(String, String)]
    menv Maybe IOData
    input IODataMode mode
    _ = (HasCallStack => IO (mode, String, ExitCode))
    -> IO (mode, String, ExitCode)
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO (mode, String, ExitCode))
     -> IO (mode, String, ExitCode))
    -> (HasCallStack => IO (mode, String, ExitCode))
    -> IO (mode, String, ExitCode)
    forall a b. (a -> b) -> a -> b
    $ do
      let cp :: CreateProcess
    cp = (String -> [String] -> CreateProcess
    proc String
    path [String]
    args) { Process.cwd     = mcwd
                                , Process.env     = menv
                                , Process.std_in  = Process.CreatePipe
                                , Process.std_out = Process.CreatePipe
                                , Process.std_err = Process.CreatePipe
                                }

      (ExitCode
    exitcode, (Either SomeException mode
    mberr1, Either SomeException String
    mberr2)) <- Verbosity
    -> CreateProcess
    -> (Maybe Handle
        -> Maybe Handle
        -> Maybe Handle
        -> IO (Either SomeException mode, Either SomeException String))
    -> IO
         (ExitCode,
          (Either SomeException mode, Either SomeException String))
    forall a.
    Verbosity
    -> CreateProcess
    -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO a)
    -> IO (ExitCode, a)
    rawSystemProcAction Verbosity
    verbosity CreateProcess
    cp ((Maybe Handle
      -> Maybe Handle
      -> Maybe Handle
      -> IO (Either SomeException mode, Either SomeException String))
     -> IO
          (ExitCode,
           (Either SomeException mode, Either SomeException String)))
    -> (Maybe Handle
        -> Maybe Handle
        -> Maybe Handle
        -> IO (Either SomeException mode, Either SomeException String))
    -> IO
         (ExitCode,
          (Either SomeException mode, Either SomeException String))
    forall a b. (a -> b) -> a -> b
    $ \Maybe Handle
    mb_in Maybe Handle
    mb_out Maybe Handle
    mb_err -> do
        let (Handle
    inh, Handle
    outh, Handle
    errh) = (Maybe Handle -> Handle
    fromCreatePipe Maybe Handle
    mb_in, Maybe Handle -> Handle
    fromCreatePipe Maybe Handle
    mb_out, Maybe Handle -> Handle
    fromCreatePipe Maybe Handle
    mb_err)
        (IO (Either SomeException mode, Either SomeException String)
     -> IO ()
     -> IO (Either SomeException mode, Either SomeException String))
    -> IO ()
    -> IO (Either SomeException mode, Either SomeException String)
    -> IO (Either SomeException mode, Either SomeException String)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip IO (Either SomeException mode, Either SomeException String)
    -> IO ()
    -> IO (Either SomeException mode, Either SomeException String)
    forall a b. IO a -> IO b -> IO a
    Exception.finally (Handle -> IO ()
    hClose Handle
    inh IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hClose Handle
    outh IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hClose Handle
    errh) (IO (Either SomeException mode, Either SomeException String)
     -> IO (Either SomeException mode, Either SomeException String))
    -> IO (Either SomeException mode, Either SomeException String)
    -> IO (Either SomeException mode, Either SomeException String)
    forall a b. (a -> b) -> a -> b
    $ do
          -- output mode depends on what the caller wants
          -- but the errors are always assumed to be text (in the current locale)
          Handle -> Bool -> IO ()
    hSetBinaryMode Handle
    errh Bool
    False

          -- fork off a couple threads to pull on the stderr and stdout
          -- so if the process writes to stderr we do not block.

          IO String
    -> (AsyncM String
        -> IO (Either SomeException mode, Either SomeException String))
    -> IO (Either SomeException mode, Either SomeException String)
    forall a b. NFData a => IO a -> (AsyncM a -> IO b) -> IO b
    withAsyncNF (Handle -> IO String
    hGetContents Handle
    errh) ((AsyncM String
      -> IO (Either SomeException mode, Either SomeException String))
     -> IO (Either SomeException mode, Either SomeException String))
    -> (AsyncM String
        -> IO (Either SomeException mode, Either SomeException String))
    -> IO (Either SomeException mode, Either SomeException String)
    forall a b. (a -> b) -> a -> b
    $ \AsyncM String
    errA -> IO mode
    -> (AsyncM mode
        -> IO (Either SomeException mode, Either SomeException String))
    -> IO (Either SomeException mode, Either SomeException String)
    forall a b. NFData a => IO a -> (AsyncM a -> IO b) -> IO b
    withAsyncNF (Handle -> IO mode
    forall mode. KnownIODataMode mode => Handle -> IO mode
    IOData.hGetIODataContents Handle
    outh) ((AsyncM mode
      -> IO (Either SomeException mode, Either SomeException String))
     -> IO (Either SomeException mode, Either SomeException String))
    -> (AsyncM mode
        -> IO (Either SomeException mode, Either SomeException String))
    -> IO (Either SomeException mode, Either SomeException String)
    forall a b. (a -> b) -> a -> b
    $ \AsyncM mode
    outA -> do
            -- push all the input, if any
            IO () -> IO ()
    ignoreSigPipe (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ case Maybe IOData
    input of
              Maybe IOData
    Nothing        -> Handle -> IO ()
    hClose Handle
    inh
              Just IOData
    inputData -> Handle -> IOData -> IO ()
    IOData.hPutContents Handle
    inh IOData
    inputData

            -- wait for both to finish
            Either SomeException mode
    mberr1 <- AsyncM mode -> IO (Either SomeException mode)
    forall a. AsyncM a -> IO (Either SomeException a)
    waitCatch AsyncM mode
    outA
            Either SomeException String
    mberr2 <- AsyncM String -> IO (Either SomeException String)
    forall a. AsyncM a -> IO (Either SomeException a)
    waitCatch AsyncM String
    errA
            (Either SomeException mode, Either SomeException String)
    -> IO (Either SomeException mode, Either SomeException String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either SomeException mode
    mberr1, Either SomeException String
    mberr2)

      -- get the stderr, so it can be added to error message
      String
    err <- Either SomeException String -> IO String
    forall a. Either SomeException a -> IO a
    reportOutputIOError Either SomeException String
    mberr2

      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ExitCode
    exitcode ExitCode -> ExitCode -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExitCode
    ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        Verbosity -> String -> IO ()
    debug Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    path String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " returned " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ExitCode -> String
    forall a. Show a => a -> String
    show ExitCode
    exitcode
                       String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    err then String
    "" else
                          String
    " with error message:\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    err
                       String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ case Maybe IOData
    input of
                            Maybe IOData
    Nothing       -> String
    ""
                            Just IOData
    d | IOData -> Bool
    IOData.null IOData
    d  -> String
    ""
                            Just (IODataText String
    inp)   -> String
    "\nstdin input:\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    inp
                            Just (IODataBinary ByteString
    inp) -> String
    "\nstdin input (binary):\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> String
    forall a. Show a => a -> String
    show ByteString
    inp

      -- Check if we hit an exception while consuming the output
      -- (e.g. a text decoding error)
      mode
    out <- Either SomeException mode -> IO mode
    forall a. Either SomeException a -> IO a
    reportOutputIOError Either SomeException mode
    mberr1

      (mode, String, ExitCode) -> IO (mode, String, ExitCode)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (mode
    out, String
    err, ExitCode
    exitcode)
      where
        reportOutputIOError :: Either Exception.SomeException a -> IO a
        reportOutputIOError :: forall a. Either SomeException a -> IO a
    reportOutputIOError (Right a
    x) = a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
        reportOutputIOError (Left SomeException
    exc) = case SomeException -> Maybe IOException
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    exc of
            Just IOException
    ioe -> IOException -> IO a
    forall e a. Exception e => e -> IO a
    throwIO (IOException -> String -> IOException
    ioeSetFileName IOException
    ioe (String
    "output of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    path))
            Maybe IOException
    Nothing  -> SomeException -> IO a
    forall e a. Exception e => e -> IO a
    throwIO SomeException
    exc

    -- | Ignore SIGPIPE in a subcomputation.
    --
    ignoreSigPipe :: IO () -> IO ()
    ignoreSigPipe :: IO () -> IO ()
    ignoreSigPipe = (IOException -> IO ()) -> IO () -> IO ()
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    Exception.handle ((IOException -> IO ()) -> IO () -> IO ())
    -> (IOException -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \case
        GHC.IOError { ioe_type :: IOException -> IOErrorType
    GHC.ioe_type  = IOErrorType
    GHC.ResourceVanished, ioe_errno :: IOException -> Maybe CInt
    GHC.ioe_errno = Just CInt
    ioe }
            | CInt -> Errno
    Errno CInt
    ioe Errno -> Errno -> Bool
    forall a. Eq a => a -> a -> Bool
    == Errno
    ePIPE -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        IOException
    e -> IOException -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO IOException
    e

    -- | Look for a program and try to find it's version number. It can accept
    -- either an absolute path or the name of a program binary, in which case we
    -- will look for the program on the path.
    --
    findProgramVersion :: String             -- ^ version args
                       -> (String -> String) -- ^ function to select version
                                             --   number from program output
                       -> Verbosity
                       -> FilePath           -- ^ location
                       -> IO (Maybe Version)
    findProgramVersion :: String
    -> (String -> String) -> Verbosity -> String -> IO (Maybe Version)
    findProgramVersion String
    versionArg String -> String
    selectVersion Verbosity
    verbosity String
    path = (HasCallStack => IO (Maybe Version)) -> IO (Maybe Version)
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO (Maybe Version)) -> IO (Maybe Version))
    -> (HasCallStack => IO (Maybe Version)) -> IO (Maybe Version)
    forall a b. (a -> b) -> a -> b
    $ do
      String
    str <- Verbosity -> String -> [String] -> IO String
    forall mode.
    KnownIODataMode mode =>
    Verbosity -> String -> [String] -> IO mode
    rawSystemStdout Verbosity
    verbosity String
    path [String
    versionArg]
             IO String -> (IOException -> IO String) -> IO String
    forall a. IO a -> (IOException -> IO a) -> IO a
    `catchIO`   (\IOException
    _ -> String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "")
             IO String -> (ExitCode -> IO String) -> IO String
    forall a. IO a -> (ExitCode -> IO a) -> IO a
    `catchExit` (\ExitCode
    _ -> String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "")
      let version :: Maybe Version
          version :: Maybe Version
    version = String -> Maybe Version
    forall a. Parsec a => String -> Maybe a
    simpleParsec (String -> String
    selectVersion String
    str)
      case Maybe Version
    version of
          Maybe Version
    Nothing -> Verbosity -> String -> IO ()
    warn Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "cannot determine version of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    path
                                   String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " :\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    str
          Just Version
    v  -> Verbosity -> String -> IO ()
    debug Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    path String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " is version " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Version -> String
    forall a. Pretty a => a -> String
    prettyShow Version
    v
      Maybe Version -> IO (Maybe Version)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Version
    version

    -- | Like the Unix xargs program. Useful for when we've got very long command
    -- lines that might overflow an OS limit on command line length and so you
    -- need to invoke a command multiple times to get all the args in.
    --
    -- Use it with either of the rawSystem variants above. For example:
    --
    -- > xargs (32*1024) (rawSystemExit verbosity) prog fixedArgs bigArgs
    --
    xargs :: Int -> ([String] -> IO ())
          -> [String] -> [String] -> IO ()
    xargs :: Int -> ([String] -> IO ()) -> [String] -> [String] -> IO ()
    xargs Int
    maxSize [String] -> IO ()
    rawSystemFun [String]
    fixedArgs [String]
    bigArgs =
      let fixedArgSize :: Int
    fixedArgSize = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ((String -> Int) -> [String] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    fixedArgs) 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]
    fixedArgs
          chunkSize :: Int
    chunkSize = Int
    maxSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fixedArgSize
       in ([String] -> IO ()) -> [[String]] -> IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ ([String] -> IO ()
    rawSystemFun ([String] -> IO ()) -> ([String] -> [String]) -> [String] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([String]
    fixedArgs [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++)) (Int -> [String] -> [[String]]
    forall {t :: * -> *} {a}. Foldable t => Int -> [t a] -> [[t a]]
    chunks Int
    chunkSize [String]
    bigArgs)

      where chunks :: Int -> [t a] -> [[t a]]
    chunks Int
    len = ([t a] -> Maybe ([t a], [t a])) -> [t a] -> [[t a]]
    forall b a. (b -> Maybe (a, b)) -> b -> [a]
    unfoldr (([t a] -> Maybe ([t a], [t a])) -> [t a] -> [[t a]])
    -> ([t a] -> Maybe ([t a], [t a])) -> [t a] -> [[t a]]
    forall a b. (a -> b) -> a -> b
    $ \[t a]
    s ->
              if [t a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [t a]
    s then Maybe ([t a], [t a])
    forall a. Maybe a
    Nothing
                        else ([t a], [t a]) -> Maybe ([t a], [t a])
    forall a. a -> Maybe a
    Just ([t a] -> Int -> [t a] -> ([t a], [t a])
    forall {t :: * -> *} {a}.
    Foldable t =>
    [t a] -> Int -> [t a] -> ([t a], [t a])
    chunk [] Int
    len [t a]
    s)

            chunk :: [t a] -> Int -> [t a] -> ([t a], [t a])
    chunk [t a]
    acc Int
    _   []     = ([t a] -> [t a]
    forall a. [a] -> [a]
    reverse [t a]
    acc,[])
            chunk [t a]
    acc Int
    len (t a
    s:[t a]
    ss)
              | Int
    len' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    len = [t a] -> Int -> [t a] -> ([t a], [t a])
    chunk (t a
    st a -> [t a] -> [t a]
    forall a. a -> [a] -> [a]
    :[t a]
    acc) (Int
    lenInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    len'Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) [t a]
    ss
              | Bool
    otherwise  = ([t a] -> [t a]
    forall a. [a] -> [a]
    reverse [t a]
    acc, t a
    st a -> [t a] -> [t a]
    forall a. a -> [a] -> [a]
    :[t a]
    ss)
              where len' :: Int
    len' = t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    s

    -- ------------------------------------------------------------
    -- * File Utilities
    -- ------------------------------------------------------------

    ----------------
    -- Finding files

    -- | Find a file by looking in a search path. The file path must match exactly.
    --
    -- @since 3.4.0.0
    findFileCwd
        :: Verbosity
        -> FilePath      -- ^ cwd
        -> [FilePath]    -- ^ relative search location
        -> FilePath      -- ^ File Name
        -> IO FilePath
    findFileCwd :: Verbosity -> String -> [String] -> String -> IO String
    findFileCwd Verbosity
    verbosity String
    cwd [String]
    searchPath String
    fileName =
      (String -> String) -> [String] -> IO (Maybe String)
    forall a. (a -> String) -> [a] -> IO (Maybe a)
    findFirstFile (String
    cwd String -> String -> String
    </>)
        [ String
    path String -> String -> String
    </> String
    fileName
        | String
    path <- [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub [String]
    searchPath]
      IO (Maybe String) -> (Maybe String -> IO String) -> IO String
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO String -> (String -> IO String) -> Maybe String -> IO String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Verbosity -> String -> IO String
    forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ String
    fileName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " doesn't exist") String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    -- | Find a file by looking in a search path. The file path must match exactly.
    --
    findFileEx :: Verbosity
               -> [FilePath]    -- ^search locations
               -> FilePath      -- ^File Name
               -> IO FilePath
    findFileEx :: Verbosity -> [String] -> String -> IO String
    findFileEx Verbosity
    verbosity [String]
    searchPath String
    fileName =
      (String -> String) -> [String] -> IO (Maybe String)
    forall a. (a -> String) -> [a] -> IO (Maybe a)
    findFirstFile String -> String
    forall a. a -> a
    id
        [ String
    path String -> String -> String
    </> String
    fileName
        | String
    path <- [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub [String]
    searchPath]
      IO (Maybe String) -> (Maybe String -> IO String) -> IO String
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO String -> (String -> IO String) -> Maybe String -> IO String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Verbosity -> String -> IO String
    forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ String
    fileName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " doesn't exist") String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    -- | Find a file by looking in a search path with one of a list of possible
    -- file extensions. The file base name should be given and it will be tried
    -- with each of the extensions in each element of the search path.
    --
    findFileWithExtension :: [String]
                          -> [FilePath]
                          -> FilePath
                          -> IO (Maybe FilePath)
    findFileWithExtension :: [String] -> [String] -> String -> IO (Maybe String)
    findFileWithExtension [String]
    extensions [String]
    searchPath String
    baseName =
      (String -> String) -> [String] -> IO (Maybe String)
    forall a. (a -> String) -> [a] -> IO (Maybe a)
    findFirstFile String -> String
    forall a. a -> a
    id
        [ String
    path String -> String -> String
    </> String
    baseName String -> String -> String
    <.> String
    ext
        | String
    path <- [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub [String]
    searchPath
        , String
    ext <- [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub [String]
    extensions ]

    -- | @since 3.4.0.0
    findFileCwdWithExtension
        :: FilePath
        -> [String]
        -> [FilePath]
        -> FilePath
        -> IO (Maybe FilePath)
    findFileCwdWithExtension :: String -> [String] -> [String] -> String -> IO (Maybe String)
    findFileCwdWithExtension String
    cwd [String]
    extensions [String]
    searchPath String
    baseName =
      (String -> String) -> [String] -> IO (Maybe String)
    forall a. (a -> String) -> [a] -> IO (Maybe a)
    findFirstFile (String
    cwd String -> String -> String
    </>)
        [ String
    path String -> String -> String
    </> String
    baseName String -> String -> String
    <.> String
    ext
        | String
    path <- [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub [String]
    searchPath
        , String
    ext <- [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub [String]
    extensions ]

    -- | @since 3.4.0.0
    findAllFilesCwdWithExtension
        :: FilePath       -- ^ cwd
        -> [String]       -- ^ extensions
        -> [FilePath]     -- ^ relative search locations
        -> FilePath       -- ^ basename
        -> IO [FilePath]
    findAllFilesCwdWithExtension :: String -> [String] -> [String] -> String -> IO [String]
    findAllFilesCwdWithExtension String
    cwd [String]
    extensions [String]
    searchPath String
    basename =
      (String -> String) -> [String] -> IO [String]
    forall a. (a -> String) -> [a] -> IO [a]
    findAllFiles (String
    cwd String -> String -> String
    </>)
        [ String
    path String -> String -> String
    </> String
    basename String -> String -> String
    <.> String
    ext
        | String
    path <- [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub [String]
    searchPath
        , String
    ext <- [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub [String]
    extensions ]

    findAllFilesWithExtension :: [String]
                              -> [FilePath]
                              -> FilePath
                              -> IO [FilePath]
    findAllFilesWithExtension :: [String] -> [String] -> String -> IO [String]
    findAllFilesWithExtension [String]
    extensions [String]
    searchPath String
    basename =
      (String -> String) -> [String] -> IO [String]
    forall a. (a -> String) -> [a] -> IO [a]
    findAllFiles String -> String
    forall a. a -> a
    id
        [ String
    path String -> String -> String
    </> String
    basename String -> String -> String
    <.> String
    ext
        | String
    path <- [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub [String]
    searchPath
        , String
    ext <- [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub [String]
    extensions ]

    -- | Like 'findFileWithExtension' but returns which element of the search path
    -- the file was found in, and the file path relative to that base directory.
    --
    findFileWithExtension' :: [String]
                           -> [FilePath]
                           -> FilePath
                           -> IO (Maybe (FilePath, FilePath))
    findFileWithExtension' :: [String] -> [String] -> String -> IO (Maybe (String, String))
    findFileWithExtension' [String]
    extensions [String]
    searchPath String
    baseName =
      ((String, String) -> String)
    -> [(String, String)] -> IO (Maybe (String, String))
    forall a. (a -> String) -> [a] -> IO (Maybe a)
    findFirstFile ((String -> String -> String) -> (String, String) -> String
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry String -> String -> String
    (</>))
        [ (String
    path, String
    baseName String -> String -> String
    <.> String
    ext)
        | String
    path <- [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub [String]
    searchPath
        , String
    ext <- [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub [String]
    extensions ]

    findFirstFile :: (a -> FilePath) -> [a] -> IO (Maybe a)
    findFirstFile :: forall a. (a -> String) -> [a] -> IO (Maybe a)
    findFirstFile a -> String
    file = [a] -> IO (Maybe a)
    findFirst
      where findFirst :: [a] -> IO (Maybe a)
    findFirst []     = Maybe a -> IO (Maybe a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
            findFirst (a
    x:[a]
    xs) = do Bool
    exists <- String -> IO Bool
    doesFileExist (a -> String
    file a
    x)
                                  if Bool
    exists
                                    then Maybe a -> IO (Maybe a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x)
                                    else [a] -> IO (Maybe a)
    findFirst [a]
    xs

    findAllFiles :: (a -> FilePath) -> [a] -> IO [a]
    findAllFiles :: forall a. (a -> String) -> [a] -> IO [a]
    findAllFiles a -> String
    file = (a -> IO Bool) -> [a] -> IO [a]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM (String -> IO Bool
    doesFileExist (String -> IO Bool) -> (a -> String) -> a -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    file)

    -- | Finds the files corresponding to a list of Haskell module names.
    --
    -- As 'findModuleFile' but for a list of module names.
    --
    findModuleFilesEx :: Verbosity
                      -> [FilePath]   -- ^ build prefix (location of objects)
                      -> [String]     -- ^ search suffixes
                      -> [ModuleName] -- ^ modules
                      -> IO [(FilePath, FilePath)]
    findModuleFilesEx :: Verbosity
    -> [String] -> [String] -> [ModuleName] -> IO [(String, String)]
    findModuleFilesEx Verbosity
    verbosity [String]
    searchPath [String]
    extensions [ModuleName]
    moduleNames =
      (ModuleName -> IO (String, String))
    -> [ModuleName] -> IO [(String, String)]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse (Verbosity
    -> [String] -> [String] -> ModuleName -> IO (String, String)
    findModuleFileEx Verbosity
    verbosity [String]
    searchPath [String]
    extensions) [ModuleName]
    moduleNames

    -- | Find the file corresponding to a Haskell module name.
    --
    -- This is similar to 'findFileWithExtension'' but specialised to a module
    -- name. The function fails if the file corresponding to the module is missing.
    --
    findModuleFileEx :: Verbosity
                     -> [FilePath]  -- ^ build prefix (location of objects)
                     -> [String]    -- ^ search suffixes
                     -> ModuleName  -- ^ module
                     -> IO (FilePath, FilePath)
    findModuleFileEx :: Verbosity
    -> [String] -> [String] -> ModuleName -> IO (String, String)
    findModuleFileEx Verbosity
    verbosity [String]
    searchPath [String]
    extensions ModuleName
    mod_name =
          IO (String, String)
    -> ((String, String) -> IO (String, String))
    -> Maybe (String, String)
    -> IO (String, String)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO (String, String)
    notFound (String, String) -> IO (String, String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
      (Maybe (String, String) -> IO (String, String))
    -> IO (Maybe (String, String)) -> IO (String, String)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [String] -> [String] -> String -> IO (Maybe (String, String))
    findFileWithExtension' [String]
    extensions [String]
    searchPath
                                 (ModuleName -> String
    ModuleName.toFilePath ModuleName
    mod_name)
      where
        notFound :: IO (String, String)
    notFound = Verbosity -> String -> IO (String, String)
    forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity (String -> IO (String, String)) -> String -> IO (String, String)
    forall a b. (a -> b) -> a -> b
    $
          String
    "Could not find module: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ModuleName -> String
    forall a. Pretty a => a -> String
    prettyShow ModuleName
    mod_name
          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " with any suffix: "          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    forall a. Show a => a -> String
    show [String]
    extensions
          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " in the search path: "       String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    forall a. Show a => a -> String
    show [String]
    searchPath

    -- | List all the files in a directory and all subdirectories.
    --
    -- The order places files in sub-directories after all the files in their
    -- parent directories. The list is generated lazily so is not well defined if
    -- the source directory structure changes before the list is used.
    --
    getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
    getDirectoryContentsRecursive :: String -> IO [String]
    getDirectoryContentsRecursive String
    topdir = [String] -> IO [String]
    recurseDirectories [String
    ""]
      where
        recurseDirectories :: [FilePath] -> IO [FilePath]
        recurseDirectories :: [String] -> IO [String]
    recurseDirectories []         = [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        recurseDirectories (String
    dir:[String]
    dirs) = IO [String] -> IO [String]
    forall a. IO a -> IO a
    unsafeInterleaveIO (IO [String] -> IO [String]) -> IO [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ do
          ([String]
    files, [String]
    dirs') <- [String] -> [String] -> [String] -> IO ([String], [String])
    collect [] [] ([String] -> IO ([String], [String]))
    -> IO [String] -> IO ([String], [String])
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> IO [String]
    getDirectoryContents (String
    topdir String -> String -> String
    </> String
    dir)
          [String]
    files' <- [String] -> IO [String]
    recurseDirectories ([String]
    dirs' [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    dirs)
          [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String]
    files [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    files')

          where
            collect :: [String] -> [String] -> [String] -> IO ([String], [String])
    collect [String]
    files [String]
    dirs' []              = ([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]
    reverse [String]
    files
                                                         ,[String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    dirs')
            collect [String]
    files [String]
    dirs' (String
    entry:[String]
    entries) | String -> Bool
    ignore String
    entry
                                                = [String] -> [String] -> [String] -> IO ([String], [String])
    collect [String]
    files [String]
    dirs' [String]
    entries
            collect [String]
    files [String]
    dirs' (String
    entry:[String]
    entries) = do
              let dirEntry :: String
    dirEntry = String
    dir String -> String -> String
    </> String
    entry
              Bool
    isDirectory <- String -> IO Bool
    doesDirectoryExist (String
    topdir String -> String -> String
    </> String
    dirEntry)
              if Bool
    isDirectory
                then [String] -> [String] -> [String] -> IO ([String], [String])
    collect [String]
    files (String
    dirEntryString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    dirs') [String]
    entries
                else [String] -> [String] -> [String] -> IO ([String], [String])
    collect (String
    dirEntryString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    files) [String]
    dirs' [String]
    entries

            ignore :: String -> Bool
    ignore [Char
    '.']      = Bool
    True
            ignore [Char
    '.', Char
    '.'] = Bool
    True
            ignore String
    _          = Bool
    False

    ------------------------
    -- Environment variables

    -- | Is this directory in the system search path?
    isInSearchPath :: FilePath -> IO Bool
    isInSearchPath :: String -> IO Bool
    isInSearchPath String
    path = ([String] -> Bool) -> IO [String] -> IO Bool
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem String
    path) IO [String]
    getSearchPath

    addLibraryPath :: OS
                   -> [FilePath]
                   -> [(String,String)]
                   -> [(String,String)]
    addLibraryPath :: OS -> [String] -> [(String, String)] -> [(String, String)]
    addLibraryPath OS
    os [String]
    paths = [(String, String)] -> [(String, String)]
    addEnv
      where
        pathsString :: String
    pathsString = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char
    searchPathSeparator] [String]
    paths
        ldPath :: String
    ldPath = case OS
    os of
                   OS
    OSX -> String
    "DYLD_LIBRARY_PATH"
                   OS
    _   -> String
    "LD_LIBRARY_PATH"

        addEnv :: [(String, String)] -> [(String, String)]
    addEnv [] = [(String
    ldPath,String
    pathsString)]
        addEnv ((String
    key,String
    value):[(String, String)]
    xs)
          | String
    key String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    ldPath =
              if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    value
                 then (String
    key,String
    pathsString)(String, String) -> [(String, String)] -> [(String, String)]
    forall a. a -> [a] -> [a]
    :[(String, String)]
    xs
                 else (String
    key,String
    value String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Char
    searchPathSeparatorChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    pathsString))(String, String) -> [(String, String)] -> [(String, String)]
    forall a. a -> [a] -> [a]
    :[(String, String)]
    xs
          | Bool
    otherwise     = (String
    key,String
    value)(String, String) -> [(String, String)] -> [(String, String)]
    forall a. a -> [a] -> [a]
    :[(String, String)] -> [(String, String)]
    addEnv [(String, String)]
    xs

    --------------------
    -- Modification time

    -- | Compare the modification times of two files to see if the first is newer
    -- than the second. The first file must exist but the second need not.
    -- The expected use case is when the second file is generated using the first.
    -- In this use case, if the result is True then the second file is out of date.
    --
    moreRecentFile :: FilePath -> FilePath -> IO Bool
    moreRecentFile :: String -> String -> IO Bool
    moreRecentFile String
    a String
    b = do
      Bool
    exists <- String -> IO Bool
    doesFileExist String
    b
      if Bool -> Bool
    not Bool
    exists
        then Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
        else do UTCTime
    tb <- String -> IO UTCTime
    getModificationTime String
    b
                UTCTime
    ta <- String -> IO UTCTime
    getModificationTime String
    a
                Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UTCTime
    ta UTCTime -> UTCTime -> Bool
    forall a. Ord a => a -> a -> Bool
    > UTCTime
    tb)

    -- | Like 'moreRecentFile', but also checks that the first file exists.
    existsAndIsMoreRecentThan :: FilePath -> FilePath -> IO Bool
    existsAndIsMoreRecentThan :: String -> String -> IO Bool
    existsAndIsMoreRecentThan String
    a String
    b = do
      Bool
    exists <- String -> IO Bool
    doesFileExist String
    a
      if Bool -> Bool
    not Bool
    exists
        then Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        else String
    a String -> String -> IO Bool
    `moreRecentFile` String
    b

    ----------------------------------------
    -- Copying and installing files and dirs

    -- | Same as 'createDirectoryIfMissing' but logs at higher verbosity levels.
    --
    createDirectoryIfMissingVerbose :: Verbosity
                                    -> Bool     -- ^ Create its parents too?
                                    -> FilePath
                                    -> IO ()
    createDirectoryIfMissingVerbose :: Verbosity -> Bool -> String -> IO ()
    createDirectoryIfMissingVerbose Verbosity
    verbosity Bool
    create_parents String
    path0
      | Bool
    create_parents = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> IO ()
    createDirs (String -> [String]
    parents String
    path0)
      | Bool
    otherwise      = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> IO ()
    createDirs (Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take Int
    1 (String -> [String]
    parents String
    path0))
      where
        parents :: String -> [String]
    parents = [String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String -> String) -> [String] -> [String]
    forall a. (a -> a -> a) -> [a] -> [a]
    scanl1 String -> String -> String
    (</>) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    splitDirectories (String -> [String]) -> (String -> String) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    normalise

        createDirs :: [String] -> IO ()
    createDirs []         = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        createDirs (String
    dir:[])   = String -> (IOException -> IO ()) -> IO ()
    createDir String
    dir IOException -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO
        createDirs (String
    dir:[String]
    dirs) =
          String -> (IOException -> IO ()) -> IO ()
    createDir String
    dir ((IOException -> IO ()) -> IO ())
    -> (IOException -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IOException
    _ -> do
            [String] -> IO ()
    createDirs [String]
    dirs
            String -> (IOException -> IO ()) -> IO ()
    createDir String
    dir IOException -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO

        createDir :: FilePath -> (IOException -> IO ()) -> IO ()
        createDir :: String -> (IOException -> IO ()) -> IO ()
    createDir String
    dir IOException -> IO ()
    notExistHandler = do
          Either IOException ()
    r <- IO () -> IO (Either IOException ())
    forall a. IO a -> IO (Either IOException a)
    tryIO (IO () -> IO (Either IOException ()))
    -> IO () -> IO (Either IOException ())
    forall a b. (a -> b) -> a -> b
    $ Verbosity -> String -> IO ()
    createDirectoryVerbose Verbosity
    verbosity String
    dir
          case (Either IOException ()
    r :: Either IOException ()) of
            Right ()                   -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            Left  IOException
    e
              | IOException -> Bool
    isDoesNotExistError  IOException
    e -> IOException -> IO ()
    notExistHandler IOException
    e
              -- createDirectory (and indeed POSIX mkdir) does not distinguish
              -- between a dir already existing and a file already existing. So we
              -- check for it here. Unfortunately there is a slight race condition
              -- here, but we think it is benign. It could report an exception in
              -- the case that the dir did exist but another process deletes the
              -- directory and creates a file in its place before we can check
              -- that the directory did indeed exist.
              | IOException -> Bool
    isAlreadyExistsError IOException
    e -> (do
                  Bool
    isDir <- String -> IO Bool
    doesDirectoryExist String
    dir
                  Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    isDir (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IOException -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO IOException
    e
                  ) IO () -> (IOException -> IO ()) -> IO ()
    forall a. IO a -> (IOException -> IO a) -> IO a
    `catchIO` ((\IOException
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) :: IOException -> IO ())
              | Bool
    otherwise              -> IOException -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO IOException
    e

    createDirectoryVerbose :: Verbosity -> FilePath -> IO ()
    createDirectoryVerbose :: Verbosity -> String -> IO ()
    createDirectoryVerbose Verbosity
    verbosity String
    dir = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Verbosity -> String -> IO ()
    info Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "creating " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dir
      String -> IO ()
    createDirectory String
    dir
      String -> IO ()
    setDirOrdinary String
    dir

    -- | Copies a file without copying file permissions. The target file is created
    -- with default permissions. Any existing target file is replaced.
    --
    -- At higher verbosity levels it logs an info message.
    --
    copyFileVerbose :: Verbosity -> FilePath -> FilePath -> IO ()
    copyFileVerbose :: Verbosity -> String -> String -> IO ()
    copyFileVerbose Verbosity
    verbosity String
    src String
    dest = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Verbosity -> String -> IO ()
    info Verbosity
    verbosity (String
    "copy " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    src String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " to " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dest)
      String -> String -> IO ()
    copyFile String
    src String
    dest

    -- | Install an ordinary file. This is like a file copy but the permissions
    -- are set appropriately for an installed file. On Unix it is \"-rw-r--r--\"
    -- while on Windows it uses the default permissions for the target directory.
    --
    installOrdinaryFile :: Verbosity -> FilePath -> FilePath -> IO ()
    installOrdinaryFile :: Verbosity -> String -> String -> IO ()
    installOrdinaryFile Verbosity
    verbosity String
    src String
    dest = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Verbosity -> String -> IO ()
    info Verbosity
    verbosity (String
    "Installing " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    src String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " to " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dest)
      String -> String -> IO ()
    copyOrdinaryFile String
    src String
    dest

    -- | Install an executable file. This is like a file copy but the permissions
    -- are set appropriately for an installed file. On Unix it is \"-rwxr-xr-x\"
    -- while on Windows it uses the default permissions for the target directory.
    --
    installExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()
    installExecutableFile :: Verbosity -> String -> String -> IO ()
    installExecutableFile Verbosity
    verbosity String
    src String
    dest = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Verbosity -> String -> IO ()
    info Verbosity
    verbosity (String
    "Installing executable " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    src String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " to " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dest)
      String -> String -> IO ()
    copyExecutableFile String
    src String
    dest

    -- | Install a file that may or not be executable, preserving permissions.
    installMaybeExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()
    installMaybeExecutableFile :: Verbosity -> String -> String -> IO ()
    installMaybeExecutableFile Verbosity
    verbosity String
    src String
    dest = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Permissions
    perms <- String -> IO Permissions
    getPermissions String
    src
      if (Permissions -> Bool
    executable Permissions
    perms) --only checks user x bit
        then Verbosity -> String -> String -> IO ()
    installExecutableFile Verbosity
    verbosity String
    src String
    dest
        else Verbosity -> String -> String -> IO ()
    installOrdinaryFile   Verbosity
    verbosity String
    src String
    dest

    -- | Given a relative path to a file, copy it to the given directory, preserving
    -- the relative path and creating the parent directories if needed.
    copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()
    copyFileTo :: Verbosity -> String -> String -> IO ()
    copyFileTo Verbosity
    verbosity String
    dir String
    file = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      let targetFile :: String
    targetFile = String
    dir String -> String -> String
    </> String
    file
      Verbosity -> Bool -> String -> IO ()
    createDirectoryIfMissingVerbose Verbosity
    verbosity Bool
    True (String -> String
    takeDirectory String
    targetFile)
      Verbosity -> String -> String -> IO ()
    installOrdinaryFile Verbosity
    verbosity String
    file String
    targetFile

    -- | Common implementation of 'copyFiles', 'installOrdinaryFiles',
    -- 'installExecutableFiles' and 'installMaybeExecutableFiles'.
    copyFilesWith :: (Verbosity -> FilePath -> FilePath -> IO ())
                  -> Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
    copyFilesWith :: (Verbosity -> String -> String -> IO ())
    -> Verbosity -> String -> [(String, String)] -> IO ()
    copyFilesWith Verbosity -> String -> String -> IO ()
    doCopy Verbosity
    verbosity String
    targetDir [(String, String)]
    srcFiles = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do

      -- Create parent directories for everything
      let dirs :: [String]
    dirs = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    targetDir String -> String -> String
    </>) ([String] -> [String])
    -> ([(String, String)] -> [String])
    -> [(String, String)]
    -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub ([String] -> [String])
    -> ([(String, String)] -> [String])
    -> [(String, String)]
    -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String, String) -> String) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String
    takeDirectory (String -> String)
    -> ((String, String) -> String) -> (String, String) -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, String) -> String
    forall a b. (a, b) -> b
    snd) ([(String, String)] -> [String]) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [(String, String)]
    srcFiles
      (String -> IO ()) -> [String] -> IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ (Verbosity -> Bool -> String -> IO ()
    createDirectoryIfMissingVerbose Verbosity
    verbosity Bool
    True) [String]
    dirs

      -- Copy all the files
      [IO ()] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [ let src :: String
    src  = String
    srcBase   String -> String -> String
    </> String
    srcFile
                      dest :: String
    dest = String
    targetDir String -> String -> String
    </> String
    srcFile
                   in Verbosity -> String -> String -> IO ()
    doCopy Verbosity
    verbosity String
    src String
    dest
                | (String
    srcBase, String
    srcFile) <- [(String, String)]
    srcFiles ]

    -- | Copies a bunch of files to a target directory, preserving the directory
    -- structure in the target location. The target directories are created if they
    -- do not exist.
    --
    -- The files are identified by a pair of base directory and a path relative to
    -- that base. It is only the relative part that is preserved in the
    -- destination.
    --
    -- For example:
    --
    -- > copyFiles normal "dist/src"
    -- >    [("", "src/Foo.hs"), ("dist/build/", "src/Bar.hs")]
    --
    -- This would copy \"src\/Foo.hs\" to \"dist\/src\/src\/Foo.hs\" and
    -- copy \"dist\/build\/src\/Bar.hs\" to \"dist\/src\/src\/Bar.hs\".
    --
    -- This operation is not atomic. Any IO failure during the copy (including any
    -- missing source files) leaves the target in an unknown state so it is best to
    -- use it with a freshly created directory so that it can be simply deleted if
    -- anything goes wrong.
    --
    copyFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
    copyFiles :: Verbosity -> String -> [(String, String)] -> IO ()
    copyFiles Verbosity
    v String
    fp [(String, String)]
    fs = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((Verbosity -> String -> String -> IO ())
    -> Verbosity -> String -> [(String, String)] -> IO ()
    copyFilesWith Verbosity -> String -> String -> IO ()
    copyFileVerbose Verbosity
    v String
    fp [(String, String)]
    fs)

    -- | This is like 'copyFiles' but uses 'installOrdinaryFile'.
    --
    installOrdinaryFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
    installOrdinaryFiles :: Verbosity -> String -> [(String, String)] -> IO ()
    installOrdinaryFiles Verbosity
    v String
    fp [(String, String)]
    fs = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((Verbosity -> String -> String -> IO ())
    -> Verbosity -> String -> [(String, String)] -> IO ()
    copyFilesWith Verbosity -> String -> String -> IO ()
    installOrdinaryFile Verbosity
    v String
    fp [(String, String)]
    fs)

    -- | This is like 'copyFiles' but uses 'installExecutableFile'.
    --
    installExecutableFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)]
                              -> IO ()
    installExecutableFiles :: Verbosity -> String -> [(String, String)] -> IO ()
    installExecutableFiles Verbosity
    v String
    fp [(String, String)]
    fs = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((Verbosity -> String -> String -> IO ())
    -> Verbosity -> String -> [(String, String)] -> IO ()
    copyFilesWith Verbosity -> String -> String -> IO ()
    installExecutableFile Verbosity
    v String
    fp [(String, String)]
    fs)

    -- | This is like 'copyFiles' but uses 'installMaybeExecutableFile'.
    --
    installMaybeExecutableFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)]
                                   -> IO ()
    installMaybeExecutableFiles :: Verbosity -> String -> [(String, String)] -> IO ()
    installMaybeExecutableFiles Verbosity
    v String
    fp [(String, String)]
    fs = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((Verbosity -> String -> String -> IO ())
    -> Verbosity -> String -> [(String, String)] -> IO ()
    copyFilesWith Verbosity -> String -> String -> IO ()
    installMaybeExecutableFile Verbosity
    v String
    fp [(String, String)]
    fs)

    -- | This installs all the files in a directory to a target location,
    -- preserving the directory layout. All the files are assumed to be ordinary
    -- rather than executable files.
    --
    installDirectoryContents :: Verbosity -> FilePath -> FilePath -> IO ()
    installDirectoryContents :: Verbosity -> String -> String -> IO ()
    installDirectoryContents Verbosity
    verbosity String
    srcDir String
    destDir = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Verbosity -> String -> IO ()
    info Verbosity
    verbosity (String
    "copy directory '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    srcDir String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "' to '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    destDir String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'.")
      [String]
    srcFiles <- String -> IO [String]
    getDirectoryContentsRecursive String
    srcDir
      Verbosity -> String -> [(String, String)] -> IO ()
    installOrdinaryFiles Verbosity
    verbosity String
    destDir [ (String
    srcDir, String
    f) | String
    f <- [String]
    srcFiles ]

    -- | Recursively copy the contents of one directory to another path.
    copyDirectoryRecursive :: Verbosity -> FilePath -> FilePath -> IO ()
    copyDirectoryRecursive :: Verbosity -> String -> String -> IO ()
    copyDirectoryRecursive Verbosity
    verbosity String
    srcDir String
    destDir = (HasCallStack => IO ()) -> IO ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
    -> (HasCallStack => IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Verbosity -> String -> IO ()
    info Verbosity
    verbosity (String
    "copy directory '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    srcDir String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "' to '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    destDir String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'.")
      [String]
    srcFiles <- String -> IO [String]
    getDirectoryContentsRecursive String
    srcDir
      (Verbosity -> String -> String -> IO ())
    -> Verbosity -> String -> [(String, String)] -> IO ()
    copyFilesWith ((String -> String -> IO ())
    -> Verbosity -> String -> String -> IO ()
    forall a b. a -> b -> a
    const String -> String -> IO ()
    copyFile) Verbosity
    verbosity String
    destDir [ (String
    srcDir, String
    f)
                                                       | String
    f <- [String]
    srcFiles ]

    -------------------
    -- File permissions

    -- | Like 'doesFileExist', but also checks that the file is executable.
    doesExecutableExist :: FilePath -> IO Bool
    doesExecutableExist :: String -> IO Bool
    doesExecutableExist String
    f = do
      Bool
    exists <- String -> IO Bool
    doesFileExist String
    f
      if Bool
    exists
        then do Permissions
    perms <- String -> IO Permissions
    getPermissions String
    f
                Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Permissions -> Bool
    executable Permissions
    perms)
        else Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    ---------------------------
    -- Temporary files and dirs

    -- | Advanced options for 'withTempFile' and 'withTempDirectory'.
    data TempFileOptions = TempFileOptions {
      TempFileOptions -> Bool
    optKeepTempFiles :: Bool  -- ^ Keep temporary files?
      }

    defaultTempFileOptions :: TempFileOptions
    defaultTempFileOptions :: TempFileOptions
    defaultTempFileOptions = TempFileOptions { optKeepTempFiles :: Bool
    optKeepTempFiles = Bool
    False }

    -- | Use a temporary filename that doesn't already exist.
    --
    withTempFile :: FilePath    -- ^ Temp dir to create the file in
                    -> String   -- ^ File name template. See 'openTempFile'.
                    -> (FilePath -> Handle -> IO a) -> IO a
    withTempFile :: forall a. String -> String -> (String -> Handle -> IO a) -> IO a
    withTempFile String
    tmpDir String
    template String -> Handle -> IO a
    action =
      TempFileOptions
    -> String -> String -> (String -> Handle -> IO a) -> IO a
    forall a.
    TempFileOptions
    -> String -> String -> (String -> Handle -> IO a) -> IO a
    withTempFileEx TempFileOptions
    defaultTempFileOptions String
    tmpDir String
    template String -> Handle -> IO a
    action

    -- | A version of 'withTempFile' that additionally takes a 'TempFileOptions'
    -- argument.
    withTempFileEx :: TempFileOptions
                     -> FilePath -- ^ Temp dir to create the file in
                     -> String   -- ^ File name template. See 'openTempFile'.
                     -> (FilePath -> Handle -> IO a) -> IO a
    withTempFileEx :: forall a.
    TempFileOptions
    -> String -> String -> (String -> Handle -> IO a) -> IO a
    withTempFileEx TempFileOptions
    opts String
    tmpDir String
    template String -> Handle -> IO a
    action =
      IO (String, Handle)
    -> ((String, Handle) -> IO ())
    -> ((String, Handle) -> IO a)
    -> IO a
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    Exception.bracket
        (String -> String -> IO (String, Handle)
    openTempFile String
    tmpDir String
    template)
        (\(String
    name, Handle
    handle) -> do Handle -> IO ()
    hClose Handle
    handle
                               Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (TempFileOptions -> Bool
    optKeepTempFiles TempFileOptions
    opts) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                                 () -> IO () -> IO ()
    forall a. a -> IO a -> IO a
    handleDoesNotExist () (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO ()
    removeFile (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    name)
        (((String, Handle) -> WithCallStack (IO a))
    -> WithCallStack ((String, Handle) -> IO a)
    forall a b.
    (a -> WithCallStack (IO b)) -> WithCallStack (a -> IO b)
    withLexicalCallStack (\(String, Handle)
    x -> (String -> Handle -> IO a) -> (String, Handle) -> IO a
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry String -> Handle -> IO a
    action (String, Handle)
    x))

    -- | Create and use a temporary directory.
    --
    -- Creates a new temporary directory inside the given directory, making use
    -- of the template. The temp directory is deleted after use. For example:
    --
    -- > withTempDirectory verbosity "src" "sdist." $ \tmpDir -> do ...
    --
    -- The @tmpDir@ will be a new subdirectory of the given directory, e.g.
    -- @src/sdist.342@.
    --
    withTempDirectory :: Verbosity -> FilePath -> String -> (FilePath -> IO a) -> IO a
    withTempDirectory :: forall a. Verbosity -> String -> String -> (String -> IO a) -> IO a
    withTempDirectory Verbosity
    verbosity String
    targetDir String
    template String -> IO a
    f = (HasCallStack => IO a) -> IO a
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO a) -> IO a) -> (HasCallStack => IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $
      Verbosity
    -> TempFileOptions -> String -> String -> (String -> IO a) -> IO a
    forall a.
    Verbosity
    -> TempFileOptions -> String -> String -> (String -> IO a) -> IO a
    withTempDirectoryEx Verbosity
    verbosity TempFileOptions
    defaultTempFileOptions String
    targetDir String
    template
        ((String -> HasCallStack => IO a) -> WithCallStack (String -> IO a)
    forall a b.
    (a -> WithCallStack (IO b)) -> WithCallStack (a -> IO b)
    withLexicalCallStack (\String
    x -> String -> IO a
    f String
    x))

    -- | A version of 'withTempDirectory' that additionally takes a
    -- 'TempFileOptions' argument.
    withTempDirectoryEx :: Verbosity -> TempFileOptions
                           -> FilePath -> String -> (FilePath -> IO a) -> IO a
    withTempDirectoryEx :: forall a.
    Verbosity
    -> TempFileOptions -> String -> String -> (String -> IO a) -> IO a
    withTempDirectoryEx Verbosity
    _verbosity TempFileOptions
    opts String
    targetDir String
    template String -> IO a
    f = (HasCallStack => IO a) -> IO a
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => IO a) -> IO a) -> (HasCallStack => IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $
      IO String -> (String -> IO ()) -> (String -> IO a) -> IO a
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    Exception.bracket
        (String -> String -> IO String
    createTempDirectory String
    targetDir String
    template)
        (Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (TempFileOptions -> Bool
    optKeepTempFiles TempFileOptions
    opts)
         (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . () -> IO () -> IO ()
    forall a. a -> IO a -> IO a
    handleDoesNotExist () (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO ()
    removeDirectoryRecursive)
        ((String -> HasCallStack => IO a) -> WithCallStack (String -> IO a)
    forall a b.
    (a -> WithCallStack (IO b)) -> WithCallStack (a -> IO b)
    withLexicalCallStack (\String
    x -> String -> IO a
    f String
    x))

    -----------------------------------
    -- Safely reading and writing files

    -- | Write a file but only if it would have new content. If we would be writing
    -- the same as the existing content then leave the file as is so that we do not
    -- update the file's modification time.
    --
    -- NB: Before Cabal-3.0 the file content was assumed to be
    --     ASCII-representable. Since Cabal-3.0 the file is assumed to be
    --     UTF-8 encoded.
    rewriteFileEx :: Verbosity -> FilePath -> String -> IO ()
    rewriteFileEx :: Verbosity -> String -> String -> IO ()
    rewriteFileEx Verbosity
    verbosity String
    path =
      Verbosity -> String -> ByteString -> IO ()
    rewriteFileLBS Verbosity
    verbosity String
    path (ByteString -> IO ()) -> (String -> ByteString) -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ByteString
    toUTF8LBS

    -- | Same as `rewriteFileEx` but for 'ByteString's.
    rewriteFileLBS :: Verbosity -> FilePath -> BS.ByteString -> IO ()
    rewriteFileLBS :: Verbosity -> String -> ByteString -> IO ()
    rewriteFileLBS Verbosity
    verbosity String
    path ByteString
    newContent =
      (IO () -> (IOException -> IO ()) -> IO ())
    -> (IOException -> IO ()) -> IO () -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip IO () -> (IOException -> IO ()) -> IO ()
    forall a. IO a -> (IOException -> IO a) -> IO a
    catchIO IOException -> IO ()
    mightNotExist (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        ByteString
    existingContent <- Verbosity -> IO ByteString -> IO ByteString
    forall a. Verbosity -> IO a -> IO a
    annotateIO Verbosity
    verbosity (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> IO ByteString
    BS.readFile String
    path
        Int64
    _ <- Int64 -> IO Int64
    forall a. a -> IO a
    evaluate (ByteString -> Int64
    BS.length ByteString
    existingContent)
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ByteString
    existingContent ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    newContent) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          Verbosity -> IO () -> IO ()
    forall a. Verbosity -> IO a -> IO a
    annotateIO Verbosity
    verbosity (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            String -> ByteString -> IO ()
    writeFileAtomic String
    path ByteString
    newContent
      where
        mightNotExist :: IOException -> IO ()
    mightNotExist IOException
    e | IOException -> Bool
    isDoesNotExistError IOException
    e
                        = Verbosity -> IO () -> IO ()
    forall a. Verbosity -> IO a -> IO a
    annotateIO Verbosity
    verbosity (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString -> IO ()
    writeFileAtomic String
    path ByteString
    newContent
                        | Bool
    otherwise
                        = IOException -> IO ()
    forall a. IOException -> IO a
    ioError IOException
    e

    -- | The path name that represents the current directory.
    -- In Unix, it's @\".\"@, but this is system-specific.
    -- (E.g. AmigaOS uses the empty string @\"\"@ for the current directory.)
    currentDir :: FilePath
    currentDir :: String
    currentDir = String
    "."

    shortRelativePath :: FilePath -> FilePath -> FilePath
    shortRelativePath :: String -> String -> String
    shortRelativePath String
    from String
    to =
        case [String] -> [String] -> ([String], [String])
    forall a. Eq a => [a] -> [a] -> ([a], [a])
    dropCommonPrefix (String -> [String]
    splitDirectories String
    from) (String -> [String]
    splitDirectories String
    to) of
            ([String]
    stuff, [String]
    path) -> [String] -> String
    joinPath ((String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> String
    forall a b. a -> b -> a
    const String
    "..") [String]
    stuff [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    path)
      where
        dropCommonPrefix :: Eq a => [a] -> [a] -> ([a],[a])
        dropCommonPrefix :: forall a. Eq a => [a] -> [a] -> ([a], [a])
    dropCommonPrefix (a
    x:[a]
    xs) (a
    y:[a]
    ys)
            | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    y    = [a] -> [a] -> ([a], [a])
    forall a. Eq a => [a] -> [a] -> ([a], [a])
    dropCommonPrefix [a]
    xs [a]
    ys
        dropCommonPrefix [a]
    xs [a]
    ys = ([a]
    xs,[a]
    ys)

    -- | Drop the extension if it's one of 'exeExtensions', or return the path
    -- unchanged.
    dropExeExtension :: FilePath -> FilePath
    dropExeExtension :: String -> String
    dropExeExtension String
    filepath =
      -- System.FilePath's extension handling functions are horribly
      -- inconsistent, consider:
      --
      --     isExtensionOf "" "foo"  == False but
      --     isExtensionOf "" "foo." == True.
      --
      -- On the other hand stripExtension doesn't remove the empty extension:
      --
      --    stripExtension "" "foo." == Just "foo."
      --
      -- Since by "" in exeExtensions we mean 'no extension' anyways we can
      -- just always ignore it here.
      let exts :: [String]
    exts = [ String
    ext | String
    ext <- [String]
    exeExtensions, String
    ext String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    "" ] in
      String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    filepath (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ do
        String
    ext <- (String -> Bool) -> [String] -> Maybe String
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (String -> String -> Bool
    `FilePath.isExtensionOf` String
    filepath) [String]
    exts
        String
    ext String -> String -> Maybe String
    `FilePath.stripExtension` String
    filepath

    -- | List of possible executable file extensions on the current build
    -- platform.
    exeExtensions :: [String]
    exeExtensions :: [String]
    exeExtensions = case (Arch
    buildArch, OS
    buildOS) of
      -- Possible improvement: on Windows, read the list of extensions from the
      -- PATHEXT environment variable. By default PATHEXT is ".com; .exe; .bat;
      -- .cmd".
      (Arch
    _, OS
    Windows) -> [String
    "", String
    "exe"]
      (Arch
    _, OS
    Ghcjs)   -> [String
    "", String
    "exe"]
      (Arch
    Wasm32, OS
    _)  -> [String
    "", String
    "wasm"]
      (Arch, OS)
    _       -> [String
    ""]

    -- ------------------------------------------------------------
    -- * Finding the description file
    -- ------------------------------------------------------------

    -- | Package description file (/pkgname/@.cabal@)
    defaultPackageDesc :: Verbosity -> IO FilePath
    defaultPackageDesc :: Verbosity -> IO String
    defaultPackageDesc Verbosity
    verbosity = Verbosity -> String -> IO String
    tryFindPackageDesc Verbosity
    verbosity String
    currentDir

    -- |Find a package description file in the given directory.  Looks for
    -- @.cabal@ files.
    findPackageDesc :: FilePath                    -- ^Where to look
                    -> IO (Either String FilePath) -- ^<pkgname>.cabal
    findPackageDesc :: String -> IO (Either String String)
    findPackageDesc = String -> String -> IO (Either String String)
    findPackageDescCwd String
    "."

    -- | @since 3.4.0.0
    findPackageDescCwd
        :: FilePath                    -- ^ project root
        -> FilePath                    -- ^ relative directory
        -> IO (Either String FilePath) -- ^ <pkgname>.cabal relative to the project root
    findPackageDescCwd :: String -> String -> IO (Either String String)
    findPackageDescCwd String
    cwd String
    dir
     = do [String]
    files <- String -> IO [String]
    getDirectoryContents (String
    cwd String -> String -> String
    </> String
    dir)
          -- to make sure we do not mistake a ~/.cabal/ dir for a <pkgname>.cabal
          -- file we filter to exclude dirs and null base file names:
          [(String, String)]
    cabalFiles <- ((String, String) -> IO Bool)
    -> [(String, String)] -> IO [(String, String)]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM (String -> IO Bool
    doesFileExist (String -> IO Bool)
    -> ((String, String) -> String) -> (String, String) -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, String) -> String
    forall a b. (a, b) -> b
    snd)
                           [ (String
    dir String -> String -> String
    </> String
    file, String
    cwd String -> String -> String
    </> String
    dir String -> String -> String
    </> String
    file)
                           | String
    file <- [String]
    files
                           , let (String
    name, String
    ext) = String -> (String, String)
    splitExtension String
    file
                           , Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    name) Bool -> Bool -> Bool
    && String
    ext String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    ".cabal" ]
          case ((String, String) -> String) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> String
    forall a b. (a, b) -> a
    fst [(String, String)]
    cabalFiles of
            []          -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Either String String
    forall a b. a -> Either a b
    Left  String
    noDesc)
            [String
    cabalFile] -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Either String String
    forall a b. b -> Either a b
    Right String
    cabalFile)
            [String]
    multiple    -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Either String String
    forall a b. a -> Either a b
    Left  (String -> Either String String) -> String -> Either String String
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    multiDesc [String]
    multiple)

      where
        noDesc :: String
        noDesc :: String
    noDesc = String
    "No cabal file found.\n"
                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Please create a package description file <pkgname>.cabal"

        multiDesc :: [String] -> String
        multiDesc :: [String] -> String
    multiDesc [String]
    l = String
    "Multiple cabal files found.\n"
                      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Please use only one of: "
                      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " [String]
    l

    -- |Like 'findPackageDesc', but calls 'die' in case of error.
    tryFindPackageDesc :: Verbosity -> FilePath -> IO FilePath
    tryFindPackageDesc :: Verbosity -> String -> IO String
    tryFindPackageDesc Verbosity
    verbosity String
    dir =
      (String -> IO String)
    -> (String -> IO String) -> Either String String -> IO String
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Verbosity -> String -> IO String
    forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity) String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO String)
    -> IO (Either String String) -> IO String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> IO (Either String String)
    findPackageDesc String
    dir

    -- | Like 'findPackageDescCwd', but calls 'die' in case of error.
    --
    -- @since 3.4.0.0
    tryFindPackageDescCwd :: Verbosity -> FilePath -> FilePath -> IO FilePath
    tryFindPackageDescCwd :: Verbosity -> String -> String -> IO String
    tryFindPackageDescCwd Verbosity
    verbosity String
    cwd String
    dir =
      (String -> IO String)
    -> (String -> IO String) -> Either String String -> IO String
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Verbosity -> String -> IO String
    forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity) String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO String)
    -> IO (Either String String) -> IO String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> String -> IO (Either String String)
    findPackageDescCwd String
    cwd String
    dir

    -- |Find auxiliary package information in the given directory.
    -- Looks for @.buildinfo@ files.
    findHookedPackageDesc
        :: Verbosity
        -> FilePath                 -- ^Directory to search
        -> IO (Maybe FilePath)      -- ^/dir/@\/@/pkgname/@.buildinfo@, if present
    findHookedPackageDesc :: Verbosity -> String -> IO (Maybe String)
    findHookedPackageDesc Verbosity
    verbosity String
    dir = do
        [String]
    files <- String -> IO [String]
    getDirectoryContents String
    dir
        [String]
    buildInfoFiles <- (String -> IO Bool) -> [String] -> IO [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> IO Bool
    doesFileExist
                            [ String
    dir String -> String -> String
    </> String
    file
                            | String
    file <- [String]
    files
                            , let (String
    name, String
    ext) = String -> (String, String)
    splitExtension String
    file
                            , Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    name) Bool -> Bool -> Bool
    && String
    ext String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    buildInfoExt ]
        case [String]
    buildInfoFiles of
            []  -> Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe String
    forall a. Maybe a
    Nothing
            [String
    f] -> Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    f)
            [String]
    _   -> Verbosity -> String -> IO (Maybe String)
    forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity (String
    "Multiple files with extension " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    buildInfoExt)

    buildInfoExt  :: String
    buildInfoExt :: String
    buildInfoExt = String
    ".buildinfo"