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

    -----------------------------------------------------------------------------
    -- |
    -- 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,
            printRawCommandAndArgs, printRawCommandAndArgsAndEnv,
            withOutputMarker,

            -- * exceptions
            handleDoesNotExist,

            -- * running programs
            rawSystemExit,
            rawSystemExitCode,
            rawSystemExitWithEnv,
            rawSystemStdout,
            rawSystemStdInOut,
            rawSystemIOWithEnv,
            rawSystemIOWithEnvAndAction,
            createProcessWithEnv,
            maybeExit,
            xargs,
            findProgramVersion,

            -- ** 'IOData' re-export
            --
            -- These types are re-exported from
            -- "Distribution.Utils.IOData" for convience 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,

            -- * Deprecated functions
            findFile,
            findModuleFile,
            findModuleFiles,
      ) 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
    import Distribution.Compat.CopyFile
    import Distribution.Compat.Internal.TempFile
    import Distribution.Compat.FilePath as FilePath
    import Distribution.Compat.Stack
    import Distribution.Verbosity
    import Distribution.Types.PackageId

    #if __GLASGOW_HASKELL__ < 711
    #ifdef VERSION_base
    #define BOOTSTRAPPED_CABAL 1
    #endif
    #else
    #ifdef CURRENT_PACKAGE_KEY
    #define BOOTSTRAPPED_CABAL 1
    #endif
    #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  (createProcess, rawSystem, runInteractiveProcess)
    import System.Process
             ( ProcessHandle
             , showCommandForUser, waitForProcess)
    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 = (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
        POSIXTime
    ts <- IO POSIXTime
    getPOSIXTime
        String
    pname <- IO String
    getProgName
        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 -> IOException)
    -> (String -> String) -> String -> IOException
    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
    AlwaysMark TraceWhen
    VerboseTrace 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 a) -> String -> IO a
    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
    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
        POSIXTime
    ts <- IO POSIXTime
    getPOSIXTime
        String
    pname <- IO String
    getProgName
        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 -> IOException)
    -> (String -> String) -> String -> IOException
    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
    AlwaysMark TraceWhen
    VerboseTrace 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 a) -> String -> IO a
    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

    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?
        POSIXTime
    ts <- IO POSIXTime
    getPOSIXTime
        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 -> IOException)
    -> (String -> String) -> String -> IOException
    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
    AlwaysMark TraceWhen
    VerboseTrace Verbosity
    verbosity
                (String -> IO a) -> String -> IO a
    forall a b. (a -> b) -> a -> b
    $ 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
    forall a. (IOException -> IOException) -> IO a -> IO a
    modifyIOError (POSIXTime -> IOException -> IOException
    f POSIXTime
    ts) IO a
    act
      where
        f :: POSIXTime -> IOException -> IOException
    f POSIXTime
    ts IOException
    ioe = IOException -> String -> IOException
    ioeSetErrorString IOException
    ioe
                 (String -> IOException)
    -> (String -> String) -> String -> IOException
    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
    NeverMark TraceWhen
    VerboseTrace Verbosity
    verbosity
                 (String -> IOException) -> String -> IOException
    forall a b. (a -> b) -> a -> b
    $ 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
    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 =
    #if __GLASGOW_HASKELL__ < 710
        show se
    #else
        e -> String
    forall e. Exception e => e -> String
    Exception.displayException e
    se
    #endif

    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

    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) (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 (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 (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
    /= :: TraceWhen -> TraceWhen -> Bool
    $c/= :: TraceWhen -> TraceWhen -> Bool
    == :: TraceWhen -> TraceWhen -> Bool
    $c== :: 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
    maybeExit :: IO ExitCode -> IO ()
    maybeExit :: IO ExitCode -> IO ()
    maybeExit IO ExitCode
    cmd = do
      ExitCode
    res <- IO ExitCode
    cmd
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ExitCode
    res 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
    res

    printRawCommandAndArgs :: Verbosity -> FilePath -> [String] -> IO ()
    printRawCommandAndArgs :: Verbosity -> String -> [String] -> IO ()
    printRawCommandAndArgs 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
    $
        Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> IO ()
    printRawCommandAndArgsAndEnv Verbosity
    verbosity String
    path [String]
    args Maybe String
    forall a. Maybe a
    Nothing Maybe [(String, String)]
    forall a. Maybe a
    Nothing

    printRawCommandAndArgsAndEnv :: Verbosity
                                 -> FilePath
                                 -> [String]
                                 -> Maybe FilePath
                                 -> Maybe [(String, String)]
                                 -> IO ()
    printRawCommandAndArgsAndEnv :: Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> IO ()
    printRawCommandAndArgsAndEnv Verbosity
    verbosity String
    path [String]
    args Maybe String
    mcwd Maybe [(String, String)]
    menv = do
        case Maybe [(String, String)]
    menv of
            Just [(String, String)]
    env -> Verbosity -> String -> IO ()
    debugNoWrap Verbosity
    verbosity (String
    "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 (m :: * -> *) a. Monad m => a -> m a
    return ()
        case Maybe String
    mcwd of
            Just String
    cwd -> Verbosity -> String -> IO ()
    debugNoWrap Verbosity
    verbosity (String
    "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 (m :: * -> *) a. Monad m => a -> m a
    return ()
        Verbosity -> String -> IO ()
    infoNoWrap Verbosity
    verbosity (String -> [String] -> String
    showCommandForUser String
    path [String]
    args)

    -- Exit with the same exit code if the subcommand 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
    $ do
      Verbosity -> String -> [String] -> IO ()
    printRawCommandAndArgs Verbosity
    verbosity String
    path [String]
    args
      Handle -> IO ()
    hFlush Handle
    stdout
      ExitCode
    exitcode <- String -> [String] -> IO ExitCode
    rawSystem String
    path [String]
    args
      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
        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
        ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith ExitCode
    exitcode

    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
    $ do
      Verbosity -> String -> [String] -> IO ()
    printRawCommandAndArgs Verbosity
    verbosity String
    path [String]
    args
      Handle -> IO ()
    hFlush Handle
    stdout
      ExitCode
    exitcode <- String -> [String] -> IO ExitCode
    rawSystem String
    path [String]
    args
      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
        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
      ExitCode -> IO ExitCode
    forall (m :: * -> *) a. Monad m => a -> m a
    return ExitCode
    exitcode

    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
    $ do
        Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> IO ()
    printRawCommandAndArgsAndEnv Verbosity
    verbosity String
    path [String]
    args Maybe String
    forall a. Maybe a
    Nothing ([(String, String)] -> Maybe [(String, String)]
    forall a. a -> Maybe a
    Just [(String, String)]
    env)
        Handle -> IO ()
    hFlush Handle
    stdout
        (Maybe Handle
    _,Maybe Handle
    _,Maybe Handle
    _,ProcessHandle
    ph) <- CreateProcess
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    createProcess (CreateProcess
     -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
    -> CreateProcess
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    forall a b. (a -> b) -> a -> b
    $
                      (String -> [String] -> CreateProcess
    Process.proc String
    path [String]
    args) { env :: Maybe [(String, String)]
    Process.env = ([(String, String)] -> Maybe [(String, String)]
    forall a. a -> Maybe a
    Just [(String, String)]
    env)
    #ifdef MIN_VERSION_process
    #if MIN_VERSION_process(1,2,0)
    -- delegate_ctlc has been added in process 1.2, and we still want to be able to
    -- bootstrap GHC on systems not having that version
                                               , delegate_ctlc :: Bool
    Process.delegate_ctlc = Bool
    True
    #endif
    #endif
                                               }
        ExitCode
    exitcode <- ProcessHandle -> IO ExitCode
    waitForProcess ProcessHandle
    ph
        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
            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
            ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith ExitCode
    exitcode

    -- Closes the passed in handles before returning.
    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
        (Maybe Handle
    _,Maybe Handle
    _,Maybe Handle
    _,ProcessHandle
    ph) <- Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> StdStream
    -> StdStream
    -> StdStream
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    createProcessWithEnv Verbosity
    verbosity String
    path [String]
    args Maybe String
    mcwd Maybe [(String, String)]
    menv
                                           (Maybe Handle -> StdStream
    mbToStd Maybe Handle
    inp) (Maybe Handle -> StdStream
    mbToStd Maybe Handle
    out) (Maybe Handle -> StdStream
    mbToStd Maybe Handle
    err)
        ExitCode
    exitcode <- ProcessHandle -> IO ExitCode
    waitForProcess ProcessHandle
    ph
        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
          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
        ExitCode -> IO ExitCode
    forall (m :: * -> *) a. Monad m => a -> m a
    return ExitCode
    exitcode
      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

    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
        (Maybe Handle
    _,Maybe Handle
    _,Maybe Handle
    _,ProcessHandle
    ph) <- Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> StdStream
    -> StdStream
    -> StdStream
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    createProcessWithEnv Verbosity
    verbosity String
    path [String]
    args Maybe String
    mcwd Maybe [(String, String)]
    menv
                                           (Maybe Handle -> StdStream
    mbToStd Maybe Handle
    inp) (Maybe Handle -> StdStream
    mbToStd Maybe Handle
    out) (Maybe Handle -> StdStream
    mbToStd Maybe Handle
    err)
        a
    a <- IO a
    action
        ExitCode
    exitcode <- ProcessHandle -> IO ExitCode
    waitForProcess ProcessHandle
    ph
        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
          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
        (ExitCode, a) -> IO (ExitCode, a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ExitCode
    exitcode, a
    a)
      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

    createProcessWithEnv ::
         Verbosity
      -> FilePath
      -> [String]
      -> Maybe FilePath           -- ^ New working dir or inherit
      -> Maybe [(String, String)] -- ^ New environment or inherit
      -> Process.StdStream  -- ^ stdin
      -> Process.StdStream  -- ^ stdout
      -> Process.StdStream  -- ^ stderr
      -> IO (Maybe Handle, Maybe Handle, Maybe Handle,ProcessHandle)
      -- ^ Any handles created for stdin, stdout, or stderr
      -- with 'CreateProcess', and a handle to the process.
    createProcessWithEnv :: Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> StdStream
    -> StdStream
    -> StdStream
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    createProcessWithEnv Verbosity
    verbosity String
    path [String]
    args Maybe String
    mcwd Maybe [(String, String)]
    menv StdStream
    inp StdStream
    out StdStream
    err = (HasCallStack =>
     IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack =>
      IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
     -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
    -> (HasCallStack =>
        IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    forall a b. (a -> b) -> a -> b
    $ do
        Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> IO ()
    printRawCommandAndArgsAndEnv Verbosity
    verbosity String
    path [String]
    args Maybe String
    mcwd Maybe [(String, String)]
    menv
        Handle -> IO ()
    hFlush Handle
    stdout
        (Maybe Handle
    inp', Maybe Handle
    out', Maybe Handle
    err', ProcessHandle
    ph) <- CreateProcess
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    createProcess (CreateProcess
     -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
    -> CreateProcess
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    forall a b. (a -> b) -> a -> b
    $
                                    (String -> [String] -> CreateProcess
    Process.proc String
    path [String]
    args) {
                                        cwd :: Maybe String
    Process.cwd           = Maybe String
    mcwd
                                      , env :: Maybe [(String, String)]
    Process.env           = Maybe [(String, String)]
    menv
                                      , std_in :: StdStream
    Process.std_in        = StdStream
    inp
                                      , std_out :: StdStream
    Process.std_out       = StdStream
    out
                                      , std_err :: StdStream
    Process.std_err       = StdStream
    err
    #ifdef MIN_VERSION_process
    #if MIN_VERSION_process(1,2,0)
    -- delegate_ctlc has been added in process 1.2, and we still want to be able to
    -- bootstrap GHC on systems not having that version
                                      , delegate_ctlc :: Bool
    Process.delegate_ctlc = Bool
    True
    #endif
    #endif
                                      }
        (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Handle
    inp', Maybe Handle
    out', Maybe Handle
    err', ProcessHandle
    ph)

    -- | Run a command and return its output.
    --
    -- The output is assumed to be text in the locale encoding.
    --
    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 (m :: * -> *) a. Monad m => a -> m a
    return mode
    output

    -- | Run a command and return its output, errors and exit status. Optionally
    -- also supply some input. Also provides control over whether 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
      Verbosity -> String -> [String] -> IO ()
    printRawCommandAndArgs Verbosity
    verbosity String
    path [String]
    args

      IO (Handle, Handle, Handle, ProcessHandle)
    -> ((Handle, Handle, Handle, ProcessHandle) -> IO ())
    -> ((Handle, Handle, Handle, ProcessHandle)
        -> IO (mode, String, ExitCode))
    -> IO (mode, String, ExitCode)
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    Exception.bracket
         (String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> IO (Handle, Handle, Handle, ProcessHandle)
    runInteractiveProcess String
    path [String]
    args Maybe String
    mcwd Maybe [(String, String)]
    menv)
         (\(Handle
    inh,Handle
    outh,Handle
    errh,ProcessHandle
    _) -> Handle -> IO ()
    hClose Handle
    inh IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hClose Handle
    outh IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hClose Handle
    errh)
        (((Handle, Handle, Handle, ProcessHandle)
      -> IO (mode, String, ExitCode))
     -> IO (mode, String, ExitCode))
    -> ((Handle, Handle, Handle, ProcessHandle)
        -> IO (mode, String, ExitCode))
    -> IO (mode, String, ExitCode)
    forall a b. (a -> b) -> a -> b
    $ \(Handle
    inh,Handle
    outh,Handle
    errh,ProcessHandle
    pid) -> 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 (mode, String, ExitCode))
    -> IO (mode, String, ExitCode)
    forall a b. NFData a => IO a -> (AsyncM a -> IO b) -> IO b
    withAsyncNF (Handle -> IO String
    hGetContents Handle
    errh) ((AsyncM String -> IO (mode, String, ExitCode))
     -> IO (mode, String, ExitCode))
    -> (AsyncM String -> IO (mode, String, ExitCode))
    -> IO (mode, String, ExitCode)
    forall a b. (a -> b) -> a -> b
    $ \AsyncM String
    errA -> IO mode
    -> (AsyncM mode -> IO (mode, String, ExitCode))
    -> IO (mode, String, ExitCode)
    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 (mode, String, ExitCode))
     -> IO (mode, String, ExitCode))
    -> (AsyncM mode -> IO (mode, String, ExitCode))
    -> IO (mode, String, ExitCode)
    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

            -- wait for the program to terminate
            ExitCode
    exitcode <- ProcessHandle -> IO ExitCode
    waitForProcess ProcessHandle
    pid

            -- 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 (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 (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 (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

        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
    $ \IOException
    e -> case IOException
    e of
            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 (m :: * -> *) a. Monad m => a -> m a
    return ()
            IOException
    _ -> 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 (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 (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 (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 (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 (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    fixedArgs) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [String] -> 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 (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 (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    s

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

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

    {-# DEPRECATED findFile "Use findFileEx instead. This symbol will be removed in Cabal 3.2 (est. December 2019)" #-}
    findFile :: [FilePath]    -- ^search locations
             -> FilePath      -- ^File Name
             -> IO FilePath
    findFile :: [String] -> String -> IO String
    findFile = Verbosity -> [String] -> String -> IO String
    findFileEx Verbosity
    normal

    -- | 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 (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 (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 (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 (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 (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 (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)

    {-# DEPRECATED findModuleFiles "Use findModuleFilesEx instead. This symbol will be removed in Cabal 3.2 (est. December 2019)" #-}
    findModuleFiles :: [FilePath]   -- ^ build prefix (location of objects)
                    -> [String]     -- ^ search suffixes
                    -> [ModuleName] -- ^ modules
                    -> IO [(FilePath, FilePath)]
    findModuleFiles :: [String] -> [String] -> [ModuleName] -> IO [(String, String)]
    findModuleFiles = Verbosity
    -> [String] -> [String] -> [ModuleName] -> IO [(String, String)]
    findModuleFilesEx Verbosity
    normal

    -- | 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)
    traverse (Verbosity
    -> [String] -> [String] -> ModuleName -> IO (String, String)
    findModuleFileEx Verbosity
    verbosity [String]
    searchPath [String]
    extensions) [ModuleName]
    moduleNames

    {-# DEPRECATED findModuleFile "Use findModuleFileEx instead. This symbol will be removed in Cabal 3.2 (est. December 2019)" #-}
    findModuleFile :: [FilePath]  -- ^ build prefix (location of objects)
                   -> [String]    -- ^ search suffixes
                   -> ModuleName  -- ^ module
                   -> IO (FilePath, FilePath)
    findModuleFile :: [String] -> [String] -> ModuleName -> IO (String, String)
    findModuleFile = Verbosity
    -> [String] -> [String] -> ModuleName -> IO (String, String)
    findModuleFileEx Verbosity
    normal

    -- | 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 (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
    "Error: 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 (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 (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 (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String -> [String] -> 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 (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 (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 (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 (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 (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
    return (Permissions -> Bool
    executable Permissions
    perms)
        else Bool -> IO Bool
    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 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".
      OS
    Windows -> [String
    "", String
    "exe"]
      OS
    Ghcjs   -> [String
    "", String
    "exe"]
      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 (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 (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 (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 (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 (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
    return Maybe String
    forall a. Maybe a
    Nothing
            [String
    f] -> Maybe String -> IO (Maybe String)
    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"