{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE BangPatterns #-}
module Distribution.Simple.Utils (
cabalVersion,
die, dieWithLocation,
dieNoVerbosity,
die', dieWithLocation',
dieNoWrap,
topHandler, topHandlerWith,
warn,
notice, noticeNoWrap, noticeDoc,
setupMessage,
info, infoNoWrap,
debug, debugNoWrap,
chattyTry,
annotateIO,
printRawCommandAndArgs, printRawCommandAndArgsAndEnv,
withOutputMarker,
handleDoesNotExist,
rawSystemExit,
rawSystemExitCode,
rawSystemExitWithEnv,
rawSystemStdout,
rawSystemStdInOut,
rawSystemIOWithEnv,
createProcessWithEnv,
maybeExit,
xargs,
findProgramLocation,
findProgramVersion,
IOData(..),
IODataMode(..),
smartCopySources,
createDirectoryIfMissingVerbose,
copyFileVerbose,
copyDirectoryRecursiveVerbose,
copyFiles,
copyFileTo,
installOrdinaryFile,
installExecutableFile,
installMaybeExecutableFile,
installOrdinaryFiles,
installExecutableFiles,
installMaybeExecutableFiles,
installDirectoryContents,
copyDirectoryRecursive,
doesExecutableExist,
setFileOrdinary,
setFileExecutable,
currentDir,
shortRelativePath,
dropExeExtension,
exeExtensions,
findFile,
findFirstFile,
findFileWithExtension,
findFileWithExtension',
findAllFilesWithExtension,
findModuleFile,
findModuleFiles,
getDirectoryContentsRecursive,
isInSearchPath,
addLibraryPath,
moreRecentFile,
existsAndIsMoreRecentThan,
TempFileOptions(..), defaultTempFileOptions,
withTempFile, withTempFileEx,
withTempDirectory, withTempDirectoryEx,
createTempDirectory,
defaultPackageDesc,
findPackageDesc,
tryFindPackageDesc,
defaultHookedPackageDesc,
findHookedPackageDesc,
withFileContents,
writeFileAtomic,
rewriteFile,
rewriteFileEx,
fromUTF8BS,
fromUTF8LBS,
toUTF8BS,
toUTF8LBS,
readUTF8File,
withUTF8FileContents,
writeUTF8File,
normaliseLineEndings,
ignoreBOM,
dropWhileEndLE,
takeWhileEndLE,
equating,
comparing,
isInfixOf,
intercalate,
lowercase,
listUnion,
listUnionRight,
ordNub,
ordNubBy,
ordNubRight,
safeTail,
unintersperse,
wrapText,
wrapLine,
isAbsoluteOnAnyPlatform,
isRelativeOnAnyPlatform,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Utils.Generic
import Distribution.Utils.IOData (IOData(..), IODataMode(..))
import qualified Distribution.Utils.IOData as IOData
import Distribution.ModuleName as ModuleName
import Distribution.System
import Distribution.Version
import Distribution.Compat.CopyFile
import Distribution.Compat.Internal.TempFile
import Distribution.Compat.Exception
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 Control.Concurrent.MVar
( newEmptyMVar, putMVar, takeMVar )
import Data.Typeable
( cast )
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
import System.Directory
( Permissions(executable), getDirectoryContents, getPermissions
, doesDirectoryExist, doesFileExist, removeFile, findExecutable
, getModificationTime, createDirectory, removeDirectoryRecursive )
import System.Environment
( getProgName )
import System.Exit
( exitWith, ExitCode(..) )
import System.FilePath
( normalise, (</>), (<.>)
, getSearchPath, joinPath, takeDirectory, splitExtension
, splitDirectories, searchPathSeparator )
import System.IO
( Handle, hSetBinaryMode, hGetContents, stderr, stdout, hPutStr, hFlush
, hClose, hSetBuffering, BufferMode(..) )
import System.IO.Error
import System.IO.Unsafe
( unsafeInterleaveIO )
import qualified Control.Exception as Exception
import Data.Time.Clock.POSIX (getPOSIXTime, POSIXTime)
import Control.Exception (IOException, evaluate, throwIO)
import Control.Concurrent (forkIO)
import Numeric (showFFloat)
import qualified System.Process as Process
( CreateProcess(..), StdStream(..), proc)
import System.Process
( ProcessHandle, createProcess, rawSystem, runInteractiveProcess
, showCommandForUser, waitForProcess)
import qualified Text.PrettyPrint as Disp
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 [1,9999]
#endif
{-# DEPRECATED dieWithLocation "Messages thrown with dieWithLocation can't be controlled with Verbosity; use dieWithLocation' instead" #-}
dieWithLocation :: FilePath -> Maybe Int -> String -> IO a
dieWithLocation :: FilePath -> Maybe Int -> FilePath -> IO a
dieWithLocation filename :: FilePath
filename lineno :: Maybe Int
lineno msg :: FilePath
msg =
IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> (IOError -> IOError) -> IOError -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> IOError -> IOError
forall a. Show a => Maybe a -> IOError -> IOError
setLocation Maybe Int
lineno
(IOError -> IOError) -> (IOError -> IOError) -> IOError -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IOError -> FilePath -> IOError) -> FilePath -> IOError -> IOError
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOError -> FilePath -> IOError
ioeSetFileName (FilePath -> FilePath
normalise FilePath
filename)
(IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath -> IOError
userError FilePath
msg
where
setLocation :: Maybe a -> IOError -> IOError
setLocation Nothing err :: IOError
err = IOError
err
setLocation (Just n :: a
n) err :: IOError
err = IOError -> FilePath -> IOError
ioeSetLocation IOError
err (a -> FilePath
forall a. Show a => a -> FilePath
show a
n)
CallStack
_ = CallStack
HasCallStack => CallStack
callStack
{-# DEPRECATED die "Messages thrown with die can't be controlled with Verbosity; use die' instead, or dieNoVerbosity if Verbosity truly is not available" #-}
die :: String -> IO a
die :: FilePath -> IO a
die = FilePath -> IO a
forall a. FilePath -> IO a
dieNoVerbosity
dieNoVerbosity :: String -> IO a
dieNoVerbosity :: FilePath -> IO a
dieNoVerbosity msg :: FilePath
msg
= IOError -> IO a
forall a. IOError -> IO a
ioError (FilePath -> IOError
userError FilePath
msg)
where
CallStack
_ = CallStack
HasCallStack => CallStack
callStack
ioeSetVerbatim :: IOError -> IOError
ioeSetVerbatim :: IOError -> IOError
ioeSetVerbatim e :: IOError
e = IOError -> FilePath -> IOError
ioeSetLocation IOError
e "dieVerbatim"
ioeGetVerbatim :: IOError -> Bool
ioeGetVerbatim :: IOError -> Bool
ioeGetVerbatim e :: IOError
e = IOError -> FilePath
ioeGetLocation IOError
e FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "dieVerbatim"
verbatimUserError :: String -> IOError
verbatimUserError :: FilePath -> IOError
verbatimUserError = IOError -> IOError
ioeSetVerbatim (IOError -> IOError)
-> (FilePath -> IOError) -> FilePath -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOError
userError
dieWithLocation' :: Verbosity -> FilePath -> Maybe Int -> String -> IO a
dieWithLocation' :: Verbosity -> FilePath -> Maybe Int -> FilePath -> IO a
dieWithLocation' verbosity :: Verbosity
verbosity filename :: FilePath
filename mb_lineno :: Maybe Int
mb_lineno msg :: FilePath
msg = IO a -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
POSIXTime
ts <- IO POSIXTime
getPOSIXTime
FilePath
pname <- IO FilePath
getProgName
IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> (FilePath -> IOError) -> FilePath -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOError
verbatimUserError
(FilePath -> IOError)
-> (FilePath -> FilePath) -> FilePath -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCallStack
(POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath)
POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath
withMetadata POSIXTime
ts MarkWhen
AlwaysMark TraceWhen
VerboseTrace Verbosity
verbosity
(FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> FilePath -> FilePath
wrapTextVerbosity Verbosity
verbosity
(FilePath -> IO a) -> FilePath -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath
pname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
filename FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (case Maybe Int
mb_lineno of
Just lineno :: Int
lineno -> ":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
lineno
Nothing -> "") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg
die' :: Verbosity -> String -> IO a
die' :: Verbosity -> FilePath -> IO a
die' verbosity :: Verbosity
verbosity msg :: FilePath
msg = IO a -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
POSIXTime
ts <- IO POSIXTime
getPOSIXTime
FilePath
pname <- IO FilePath
getProgName
IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> (FilePath -> IOError) -> FilePath -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOError
verbatimUserError
(FilePath -> IOError)
-> (FilePath -> FilePath) -> FilePath -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCallStack
(POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath)
POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath
withMetadata POSIXTime
ts MarkWhen
AlwaysMark TraceWhen
VerboseTrace Verbosity
verbosity
(FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> FilePath -> FilePath
wrapTextVerbosity Verbosity
verbosity
(FilePath -> IO a) -> FilePath -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath
pname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg
dieNoWrap :: Verbosity -> String -> IO a
dieNoWrap :: Verbosity -> FilePath -> IO a
dieNoWrap verbosity :: Verbosity
verbosity msg :: FilePath
msg = IO a -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
POSIXTime
ts <- IO POSIXTime
getPOSIXTime
IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> (FilePath -> IOError) -> FilePath -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOError
verbatimUserError
(FilePath -> IOError)
-> (FilePath -> FilePath) -> FilePath -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCallStack
(POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath)
POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath
withMetadata POSIXTime
ts MarkWhen
AlwaysMark TraceWhen
VerboseTrace Verbosity
verbosity
(FilePath -> IO a) -> FilePath -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath
msg
annotateIO :: Verbosity -> IO a -> IO a
annotateIO :: Verbosity -> IO a -> IO a
annotateIO verbosity :: Verbosity
verbosity act :: IO a
act = do
POSIXTime
ts <- IO POSIXTime
getPOSIXTime
(IOError -> IOError) -> IO a -> IO a
forall a. (IOError -> IOError) -> IO a -> IO a
modifyIOError (POSIXTime -> IOError -> IOError
f POSIXTime
ts) IO a
IO a
act
where
f :: POSIXTime -> IOError -> IOError
f ts :: POSIXTime
ts ioe :: IOError
ioe = IOError -> FilePath -> IOError
ioeSetErrorString IOError
ioe
(FilePath -> IOError)
-> (FilePath -> FilePath) -> FilePath -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCallStack
(POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath)
POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath
withMetadata POSIXTime
ts MarkWhen
NeverMark TraceWhen
VerboseTrace Verbosity
verbosity
(FilePath -> IOError) -> FilePath -> IOError
forall a b. (a -> b) -> a -> b
$ IOError -> FilePath
ioeGetErrorString IOError
ioe
{-# NOINLINE topHandlerWith #-}
topHandlerWith :: forall a. (Exception.SomeException -> IO a) -> IO a -> IO a
topHandlerWith :: (SomeException -> IO a) -> IO a -> IO a
topHandlerWith cont :: SomeException -> IO a
cont prog :: IO a
prog = do
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
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
rethrowAsyncExceptions :: Exception.AsyncException -> NoCallStackIO a
rethrowAsyncExceptions :: AsyncException -> IO a
rethrowAsyncExceptions a :: AsyncException
a = AsyncException -> IO a
forall e a. Exception e => e -> IO a
throwIO AsyncException
a
rethrowExitStatus :: ExitCode -> NoCallStackIO a
rethrowExitStatus :: ExitCode -> IO a
rethrowExitStatus = ExitCode -> IO a
forall e a. Exception e => e -> IO a
throwIO
handle :: Exception.SomeException -> NoCallStackIO a
handle :: SomeException -> IO a
handle se :: SomeException
se = do
Handle -> IO ()
hFlush Handle
stdout
FilePath
pname <- IO FilePath
getProgName
Handle -> FilePath -> IO ()
hPutStr Handle
stderr (FilePath -> SomeException -> FilePath
message FilePath
pname SomeException
se)
SomeException -> IO a
cont SomeException
se
message :: String -> Exception.SomeException -> String
message :: FilePath -> SomeException -> FilePath
message pname :: FilePath
pname (Exception.SomeException se :: e
se) =
case e -> Maybe IOError
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
se :: Maybe Exception.IOException of
Just ioe :: IOError
ioe
| IOError -> Bool
ioeGetVerbatim IOError
ioe ->
IOError -> FilePath
ioeGetErrorString IOError
ioe FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\n"
| IOError -> Bool
isUserError IOError
ioe ->
let file :: FilePath
file = case IOError -> Maybe FilePath
ioeGetFileName IOError
ioe of
Nothing -> ""
Just path :: FilePath
path -> FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
location FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ": "
location :: FilePath
location = case IOError -> FilePath
ioeGetLocation IOError
ioe of
l :: FilePath
l@(n :: Char
n:_) | Char -> Bool
isDigit Char
n -> ':' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
l
_ -> ""
detail :: FilePath
detail = IOError -> FilePath
ioeGetErrorString IOError
ioe
in FilePath -> FilePath
wrapText (FilePath
pname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
detail)
_ ->
e -> FilePath
forall e. Exception e => e -> FilePath
displaySomeException e
se FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\n"
displaySomeException :: Exception.Exception e => e -> String
displaySomeException :: e -> FilePath
displaySomeException se :: e
se =
#if __GLASGOW_HASKELL__ < 710
show se
#else
e -> FilePath
forall e. Exception e => e -> FilePath
Exception.displayException e
se
#endif
topHandler :: IO a -> IO a
topHandler :: IO a -> IO a
topHandler prog :: 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 1)) IO a
prog
warn :: Verbosity -> String -> IO ()
warn :: Verbosity -> FilePath -> IO ()
warn verbosity :: Verbosity
verbosity msg :: FilePath
msg = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> 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 -> FilePath -> IO ()
hPutStr Handle
stderr (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCallStack
(POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath)
POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath
withMetadata POSIXTime
ts MarkWhen
NormalMark TraceWhen
FlagTrace Verbosity
verbosity
(FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> FilePath -> FilePath
wrapTextVerbosity Verbosity
verbosity
(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Warning: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg
notice :: Verbosity -> String -> IO ()
notice :: Verbosity -> FilePath -> IO ()
notice verbosity :: Verbosity
verbosity msg :: FilePath
msg = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> 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 -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCallStack
(POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath)
POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath
withMetadata POSIXTime
ts MarkWhen
NormalMark TraceWhen
FlagTrace Verbosity
verbosity
(FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> FilePath -> FilePath
wrapTextVerbosity Verbosity
verbosity
(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
msg
noticeNoWrap :: Verbosity -> String -> IO ()
noticeNoWrap :: Verbosity -> FilePath -> IO ()
noticeNoWrap verbosity :: Verbosity
verbosity msg :: FilePath
msg = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> 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 -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCallStack
(POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath)
POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath
withMetadata POSIXTime
ts MarkWhen
NormalMark TraceWhen
FlagTrace Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
msg
noticeDoc :: Verbosity -> Disp.Doc -> IO ()
noticeDoc :: Verbosity -> Doc -> IO ()
noticeDoc verbosity :: Verbosity
verbosity msg :: Doc
msg = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> 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 -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (Doc -> FilePath) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCallStack
(POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath)
POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath
withMetadata POSIXTime
ts MarkWhen
NormalMark TraceWhen
FlagTrace Verbosity
verbosity
(FilePath -> FilePath) -> (Doc -> FilePath) -> Doc -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Doc -> FilePath
Disp.renderStyle Style
defaultStyle (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc
msg
setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()
setupMessage :: Verbosity -> FilePath -> PackageIdentifier -> IO ()
setupMessage verbosity :: Verbosity
verbosity msg :: FilePath
msg pkgid :: PackageIdentifier
pkgid = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
noticeNoWrap Verbosity
verbosity (FilePath
msg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ' 'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "...")
info :: Verbosity -> String -> IO ()
info :: Verbosity -> FilePath -> IO ()
info verbosity :: Verbosity
verbosity msg :: FilePath
msg = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> 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
POSIXTime
ts <- IO POSIXTime
getPOSIXTime
Handle -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCallStack
(POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath)
POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath
withMetadata POSIXTime
ts MarkWhen
NeverMark TraceWhen
FlagTrace Verbosity
verbosity
(FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> FilePath -> FilePath
wrapTextVerbosity Verbosity
verbosity
(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
msg
infoNoWrap :: Verbosity -> String -> IO ()
infoNoWrap :: Verbosity -> FilePath -> IO ()
infoNoWrap verbosity :: Verbosity
verbosity msg :: FilePath
msg = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> 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
POSIXTime
ts <- IO POSIXTime
getPOSIXTime
Handle -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCallStack
(POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath)
POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath
withMetadata POSIXTime
ts MarkWhen
NeverMark TraceWhen
FlagTrace Verbosity
verbosity
(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
msg
debug :: Verbosity -> String -> IO ()
debug :: Verbosity -> FilePath -> IO ()
debug verbosity :: Verbosity
verbosity msg :: FilePath
msg = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> 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
POSIXTime
ts <- IO POSIXTime
getPOSIXTime
Handle -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCallStack
(POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath)
POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath
withMetadata POSIXTime
ts MarkWhen
NeverMark TraceWhen
FlagTrace Verbosity
verbosity
(FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> FilePath -> FilePath
wrapTextVerbosity Verbosity
verbosity
(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
msg
Handle -> IO ()
hFlush Handle
stdout
debugNoWrap :: Verbosity -> String -> IO ()
debugNoWrap :: Verbosity -> FilePath -> IO ()
debugNoWrap verbosity :: Verbosity
verbosity msg :: FilePath
msg = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> 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
POSIXTime
ts <- IO POSIXTime
getPOSIXTime
Handle -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCallStack
(POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath)
POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath
withMetadata POSIXTime
ts MarkWhen
NeverMark TraceWhen
FlagTrace Verbosity
verbosity
(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
msg
Handle -> IO ()
hFlush Handle
stdout
chattyTry :: String
-> IO ()
-> IO ()
chattyTry :: FilePath -> IO () -> IO ()
chattyTry desc :: FilePath
desc action :: IO ()
action =
IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
catchIO IO ()
IO ()
action ((IOError -> IO ()) -> IO ()) -> (IOError -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \exception :: IOError
exception ->
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Error while " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
desc FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IOError -> FilePath
forall a. Show a => a -> FilePath
show IOError
exception
handleDoesNotExist :: a -> NoCallStackIO a -> NoCallStackIO a
handleDoesNotExist :: a -> NoCallStackIO a -> NoCallStackIO a
handleDoesNotExist e :: a
e =
(IOError -> Maybe IOError)
-> (IOError -> NoCallStackIO a)
-> NoCallStackIO a
-> NoCallStackIO a
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
Exception.handleJust
(\ioe :: IOError
ioe -> if IOError -> Bool
isDoesNotExistError IOError
ioe then IOError -> Maybe IOError
forall a. a -> Maybe a
Just IOError
ioe else Maybe IOError
forall a. Maybe a
Nothing)
(\_ -> a -> NoCallStackIO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
e)
wrapTextVerbosity :: Verbosity -> String -> String
wrapTextVerbosity :: Verbosity -> FilePath -> FilePath
wrapTextVerbosity verb :: Verbosity
verb
| Verbosity -> Bool
isVerboseNoWrap Verbosity
verb = FilePath -> FilePath
withTrailingNewline
| Bool
otherwise = FilePath -> FilePath
withTrailingNewline (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
wrapText
withTimestamp :: Verbosity -> POSIXTime -> String -> String
withTimestamp :: Verbosity -> POSIXTime -> FilePath -> FilePath
withTimestamp v :: Verbosity
v ts :: POSIXTime
ts msg :: FilePath
msg
| Verbosity -> Bool
isVerboseTimestamp Verbosity
v = FilePath
msg'
| Bool
otherwise = FilePath
msg
where
msg' :: FilePath
msg' = case FilePath -> [FilePath]
lines FilePath
msg of
[] -> FilePath -> FilePath
tsstr "\n"
l1 :: FilePath
l1:rest :: [FilePath]
rest -> [FilePath] -> FilePath
unlines (FilePath -> FilePath
tsstr (' 'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
l1) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
contpfxFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) [FilePath]
rest)
tsstr :: FilePath -> FilePath
tsstr = Maybe Int -> Double -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just 3) (POSIXTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac POSIXTime
ts :: Double)
contpfx :: FilePath
contpfx = Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> FilePath
tsstr " ")) ' '
withOutputMarker :: Verbosity -> String -> String
withOutputMarker :: Verbosity -> FilePath -> FilePath
withOutputMarker v :: Verbosity
v xs :: FilePath
xs | Bool -> Bool
not (Verbosity -> Bool
isVerboseMarkOutput Verbosity
v) = FilePath
xs
withOutputMarker _ "" = ""
withOutputMarker _ xs :: FilePath
xs =
"-----BEGIN CABAL OUTPUT-----\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath -> FilePath
withTrailingNewline FilePath
xs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
"-----END CABAL OUTPUT-----\n"
withTrailingNewline :: String -> String
withTrailingNewline :: FilePath -> FilePath
withTrailingNewline "" = ""
withTrailingNewline (x :: Char
x:xs :: FilePath
xs) = Char
x Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: Char -> FilePath -> FilePath
go Char
x FilePath
xs
where
go :: Char -> FilePath -> FilePath
go _ (c :: Char
c:cs :: FilePath
cs) = Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: Char -> FilePath -> FilePath
go Char
c FilePath
cs
go '\n' "" = ""
go _ "" = "\n"
withCallStackPrefix :: WithCallStack (TraceWhen -> Verbosity -> String -> String)
withCallStackPrefix :: TraceWhen -> Verbosity -> FilePath -> FilePath
withCallStackPrefix tracer :: TraceWhen
tracer verbosity :: Verbosity
verbosity s :: FilePath
s = (HasCallStack => FilePath) -> FilePath
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => FilePath) -> FilePath)
-> (HasCallStack => FilePath) -> FilePath
forall a b. (a -> b) -> a -> b
$
(if Verbosity -> Bool
isVerboseCallSite Verbosity
verbosity
then FilePath
HasCallStack => FilePath
parentSrcLocPrefix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
if Verbosity -> Bool
isVerboseMarkOutput Verbosity
verbosity
then "\n"
else ""
else "") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
(case Verbosity -> TraceWhen -> Maybe FilePath
traceWhen Verbosity
verbosity TraceWhen
tracer of
Just pre :: FilePath
pre -> FilePath
pre FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CallStack -> FilePath
prettyCallStack CallStack
HasCallStack => CallStack
callStack FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\n"
Nothing -> "") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
s
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)
traceWhen :: Verbosity -> TraceWhen -> Maybe String
traceWhen :: Verbosity -> TraceWhen -> Maybe FilePath
traceWhen _ AlwaysTrace = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just ""
traceWhen v :: Verbosity
v VerboseTrace | Verbosity
v Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
verbose = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just ""
traceWhen v :: Verbosity
v FlagTrace | Verbosity -> Bool
isVerboseCallStack Verbosity
v = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "----\n"
traceWhen _ _ = Maybe FilePath
forall a. Maybe a
Nothing
data MarkWhen = AlwaysMark | NormalMark | NeverMark
withMetadata :: WithCallStack (POSIXTime -> MarkWhen -> TraceWhen -> Verbosity -> String -> String)
withMetadata :: POSIXTime
-> MarkWhen -> TraceWhen -> Verbosity -> FilePath -> FilePath
withMetadata ts :: POSIXTime
ts marker :: MarkWhen
marker tracer :: TraceWhen
tracer verbosity :: Verbosity
verbosity x :: FilePath
x = (HasCallStack => FilePath) -> FilePath
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => FilePath) -> FilePath)
-> (HasCallStack => FilePath) -> FilePath
forall a b. (a -> b) -> a -> b
$
FilePath -> FilePath
withTrailingNewline
(FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCallStack (TraceWhen -> Verbosity -> FilePath -> FilePath)
TraceWhen -> Verbosity -> FilePath -> FilePath
withCallStackPrefix TraceWhen
tracer Verbosity
verbosity
(FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (case MarkWhen
marker of
AlwaysMark -> Verbosity -> FilePath -> FilePath
withOutputMarker Verbosity
verbosity
NormalMark | Bool -> Bool
not (Verbosity -> Bool
isVerboseQuiet Verbosity
verbosity)
-> Verbosity -> FilePath -> FilePath
withOutputMarker Verbosity
verbosity
| Bool
otherwise
-> FilePath -> FilePath
forall a. a -> a
id
NeverMark -> FilePath -> FilePath
forall a. a -> a
id)
(FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
clearMarkers
(FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> POSIXTime -> FilePath -> FilePath
withTimestamp Verbosity
verbosity POSIXTime
ts
(FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
x
clearMarkers :: String -> String
clearMarkers :: FilePath -> FilePath
clearMarkers s :: FilePath
s = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isMarker ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines FilePath
s
where
isMarker :: FilePath -> Bool
isMarker "-----BEGIN CABAL OUTPUT-----" = Bool
False
isMarker "-----END CABAL OUTPUT-----" = Bool
False
isMarker _ = Bool
True
maybeExit :: IO ExitCode -> IO ()
maybeExit :: IO ExitCode -> IO ()
maybeExit cmd :: IO ExitCode
cmd = do
ExitCode
res <- IO ExitCode
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 -> FilePath -> [FilePath] -> IO ()
printRawCommandAndArgs verbosity :: Verbosity
verbosity path :: FilePath
path args :: [FilePath]
args = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO ()
printRawCommandAndArgsAndEnv Verbosity
verbosity FilePath
path [FilePath]
args Maybe FilePath
forall a. Maybe a
Nothing Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
printRawCommandAndArgsAndEnv :: Verbosity
-> FilePath
-> [String]
-> Maybe FilePath
-> Maybe [(String, String)]
-> IO ()
printRawCommandAndArgsAndEnv :: Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO ()
printRawCommandAndArgsAndEnv verbosity :: Verbosity
verbosity path :: FilePath
path args :: [FilePath]
args mcwd :: Maybe FilePath
mcwd menv :: Maybe [(FilePath, FilePath)]
menv = do
case Maybe [(FilePath, FilePath)]
menv of
Just env :: [(FilePath, FilePath)]
env -> Verbosity -> FilePath -> IO ()
debugNoWrap Verbosity
verbosity ("Environment: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)] -> FilePath
forall a. Show a => a -> FilePath
show [(FilePath, FilePath)]
env)
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Maybe FilePath
mcwd of
Just cwd :: FilePath
cwd -> Verbosity -> FilePath -> IO ()
debugNoWrap Verbosity
verbosity ("Working directory: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
cwd)
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Verbosity -> FilePath -> IO ()
infoNoWrap Verbosity
verbosity (FilePath -> [FilePath] -> FilePath
showCommandForUser FilePath
path [FilePath]
args)
rawSystemExit :: Verbosity -> FilePath -> [String] -> IO ()
rawSystemExit :: Verbosity -> FilePath -> [FilePath] -> IO ()
rawSystemExit verbosity :: Verbosity
verbosity path :: FilePath
path args :: [FilePath]
args = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> [FilePath] -> IO ()
printRawCommandAndArgs Verbosity
verbosity FilePath
path [FilePath]
args
Handle -> IO ()
hFlush Handle
stdout
ExitCode
exitcode <- FilePath -> [FilePath] -> IO ExitCode
rawSystem FilePath
path [FilePath]
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 -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " returned " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ExitCode -> FilePath
forall a. Show a => a -> FilePath
show ExitCode
exitcode
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
exitcode
rawSystemExitCode :: Verbosity -> FilePath -> [String] -> IO ExitCode
rawSystemExitCode :: Verbosity -> FilePath -> [FilePath] -> IO ExitCode
rawSystemExitCode verbosity :: Verbosity
verbosity path :: FilePath
path args :: [FilePath]
args = IO ExitCode -> IO ExitCode
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO ExitCode -> IO ExitCode) -> IO ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> [FilePath] -> IO ()
printRawCommandAndArgs Verbosity
verbosity FilePath
path [FilePath]
args
Handle -> IO ()
hFlush Handle
stdout
ExitCode
exitcode <- FilePath -> [FilePath] -> IO ExitCode
rawSystem FilePath
path [FilePath]
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 -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " returned " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ExitCode -> FilePath
forall a. Show a => a -> FilePath
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
-> FilePath -> [FilePath] -> [(FilePath, FilePath)] -> IO ()
rawSystemExitWithEnv verbosity :: Verbosity
verbosity path :: FilePath
path args :: [FilePath]
args env :: [(FilePath, FilePath)]
env = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO ()
printRawCommandAndArgsAndEnv Verbosity
verbosity FilePath
path [FilePath]
args Maybe FilePath
forall a. Maybe a
Nothing ([(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just [(FilePath, FilePath)]
env)
Handle -> IO ()
hFlush Handle
stdout
(_,_,_,ph :: 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
$
(FilePath -> [FilePath] -> CreateProcess
Process.proc FilePath
path [FilePath]
args) { env :: Maybe [(FilePath, FilePath)]
Process.env = ([(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just [(FilePath, FilePath)]
env)
#ifdef MIN_VERSION_process
#if MIN_VERSION_process(1,2,0)
, 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 -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " returned " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ExitCode -> FilePath
forall a. Show a => a -> FilePath
show ExitCode
exitcode
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
exitcode
rawSystemIOWithEnv :: Verbosity
-> FilePath
-> [String]
-> Maybe FilePath
-> Maybe [(String, String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ExitCode
rawSystemIOWithEnv :: Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ExitCode
rawSystemIOWithEnv verbosity :: Verbosity
verbosity path :: FilePath
path args :: [FilePath]
args mcwd :: Maybe FilePath
mcwd menv :: Maybe [(FilePath, FilePath)]
menv inp :: Maybe Handle
inp out :: Maybe Handle
out err :: Maybe Handle
err = IO ExitCode -> IO ExitCode
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO ExitCode -> IO ExitCode) -> IO ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ do
(_,_,_,ph :: ProcessHandle
ph) <- Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> StdStream
-> StdStream
-> StdStream
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcessWithEnv Verbosity
verbosity FilePath
path [FilePath]
args Maybe FilePath
mcwd Maybe [(FilePath, FilePath)]
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 -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " returned " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ExitCode -> FilePath
forall a. Show a => a -> FilePath
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
createProcessWithEnv ::
Verbosity
-> FilePath
-> [String]
-> Maybe FilePath
-> Maybe [(String, String)]
-> Process.StdStream
-> Process.StdStream
-> Process.StdStream
-> IO (Maybe Handle, Maybe Handle, Maybe Handle,ProcessHandle)
createProcessWithEnv :: Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> StdStream
-> StdStream
-> StdStream
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcessWithEnv verbosity :: Verbosity
verbosity path :: FilePath
path args :: [FilePath]
args mcwd :: Maybe FilePath
mcwd menv :: Maybe [(FilePath, FilePath)]
menv inp :: StdStream
inp out :: StdStream
out err :: StdStream
err = IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> 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
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO ()
printRawCommandAndArgsAndEnv Verbosity
verbosity FilePath
path [FilePath]
args Maybe FilePath
mcwd Maybe [(FilePath, FilePath)]
menv
Handle -> IO ()
hFlush Handle
stdout
(inp' :: Maybe Handle
inp', out' :: Maybe Handle
out', err' :: Maybe Handle
err', ph :: 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
$
(FilePath -> [FilePath] -> CreateProcess
Process.proc FilePath
path [FilePath]
args) {
cwd :: Maybe FilePath
Process.cwd = Maybe FilePath
mcwd
, env :: Maybe [(FilePath, FilePath)]
Process.env = Maybe [(FilePath, FilePath)]
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 :: 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)
rawSystemStdout :: Verbosity -> FilePath -> [String] -> IO String
rawSystemStdout :: Verbosity -> FilePath -> [FilePath] -> IO FilePath
rawSystemStdout verbosity :: Verbosity
verbosity path :: FilePath
path args :: [FilePath]
args = IO FilePath -> IO FilePath
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ do
(IODataText output :: FilePath
output, errors :: FilePath
errors, exitCode :: ExitCode
exitCode) <- Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Maybe IOData
-> IODataMode
-> IO (IOData, FilePath, ExitCode)
rawSystemStdInOut Verbosity
verbosity FilePath
path [FilePath]
args
Maybe FilePath
forall a. Maybe a
Nothing Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
Maybe IOData
forall a. Maybe a
Nothing IODataMode
IODataModeText
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
$
FilePath -> IO ()
forall a. FilePath -> IO a
die FilePath
errors
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output
rawSystemStdInOut :: Verbosity
-> FilePath
-> [String]
-> Maybe FilePath
-> Maybe [(String, String)]
-> Maybe IOData
-> IODataMode
-> IO (IOData, String, ExitCode)
rawSystemStdInOut :: Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Maybe IOData
-> IODataMode
-> IO (IOData, FilePath, ExitCode)
rawSystemStdInOut verbosity :: Verbosity
verbosity path :: FilePath
path args :: [FilePath]
args mcwd :: Maybe FilePath
mcwd menv :: Maybe [(FilePath, FilePath)]
menv input :: Maybe IOData
input outputMode :: IODataMode
outputMode = IO (IOData, FilePath, ExitCode) -> IO (IOData, FilePath, ExitCode)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO (IOData, FilePath, ExitCode)
-> IO (IOData, FilePath, ExitCode))
-> IO (IOData, FilePath, ExitCode)
-> IO (IOData, FilePath, ExitCode)
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> [FilePath] -> IO ()
printRawCommandAndArgs Verbosity
verbosity FilePath
path [FilePath]
args
IO (Handle, Handle, Handle, ProcessHandle)
-> ((Handle, Handle, Handle, ProcessHandle) -> IO ())
-> ((Handle, Handle, Handle, ProcessHandle)
-> IO (IOData, FilePath, ExitCode))
-> IO (IOData, FilePath, ExitCode)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket
(FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess FilePath
path [FilePath]
args Maybe FilePath
mcwd Maybe [(FilePath, FilePath)]
menv)
(\(inh :: Handle
inh,outh :: Handle
outh,errh :: Handle
errh,_) -> 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 (IOData, FilePath, ExitCode))
-> IO (IOData, FilePath, ExitCode))
-> ((Handle, Handle, Handle, ProcessHandle)
-> IO (IOData, FilePath, ExitCode))
-> IO (IOData, FilePath, ExitCode)
forall a b. (a -> b) -> a -> b
$ \(inh :: Handle
inh,outh :: Handle
outh,errh :: Handle
errh,pid :: ProcessHandle
pid) -> do
Handle -> Bool -> IO ()
hSetBinaryMode Handle
errh Bool
False
FilePath
err <- Handle -> IO FilePath
hGetContents Handle
errh
IOData
out <- Handle -> IODataMode -> IO IOData
IOData.hGetContents Handle
outh IODataMode
outputMode
MVar (Either IOError ())
mv <- IO (MVar (Either IOError ()))
forall a. IO (MVar a)
newEmptyMVar
let force :: a -> IO ()
force str :: a
str = do
Either IOError ()
mberr <- IO () -> IO (Either IOError ())
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (() -> IO ()
forall a. a -> IO a
evaluate (a -> ()
forall a. NFData a => a -> ()
rnf a
str) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
MVar (Either IOError ()) -> Either IOError () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either IOError ())
mv (Either IOError ()
mberr :: Either IOError ())
ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IOData -> IO ()
forall a. NFData a => a -> IO ()
force IOData
out
ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall a. NFData a => a -> IO ()
force FilePath
err
case Maybe IOData
input of
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just inputData :: IOData
inputData -> do
Handle -> IOData -> IO ()
IOData.hPutContents Handle
inh IOData
inputData
Either IOError ()
mberr1 <- MVar (Either IOError ()) -> IO (Either IOError ())
forall a. MVar a -> IO a
takeMVar MVar (Either IOError ())
mv
Either IOError ()
mberr2 <- MVar (Either IOError ()) -> IO (Either IOError ())
forall a. MVar a -> IO a
takeMVar MVar (Either IOError ())
mv
ExitCode
exitcode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pid
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 -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " returned " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ExitCode -> FilePath
forall a. Show a => a -> FilePath
show ExitCode
exitcode
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
err then "" else
" with error message:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ case Maybe IOData
input of
Nothing -> ""
Just d :: IOData
d | IOData -> Bool
IOData.null IOData
d -> ""
Just (IODataText inp :: FilePath
inp) -> "\nstdin input:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
inp
Just (IODataBinary inp :: ByteString
inp) -> "\nstdin input (binary):\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
inp
Either IOError () -> IO ()
reportOutputIOError Either IOError ()
mberr1
Either IOError () -> IO ()
reportOutputIOError Either IOError ()
mberr2
(IOData, FilePath, ExitCode) -> IO (IOData, FilePath, ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (IOData
out, FilePath
err, ExitCode
exitcode)
where
reportOutputIOError :: Either IOError () -> NoCallStackIO ()
reportOutputIOError :: Either IOError () -> IO ()
reportOutputIOError =
(IOError -> IO ()) -> (() -> IO ()) -> Either IOError () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e :: IOError
e -> IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOError -> FilePath -> IOError
ioeSetFileName IOError
e ("output of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path)))
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# DEPRECATED findProgramLocation
"No longer used within Cabal, try findProgramOnSearchPath" #-}
findProgramLocation :: Verbosity -> FilePath -> IO (Maybe FilePath)
findProgramLocation :: Verbosity -> FilePath -> IO (Maybe FilePath)
findProgramLocation verbosity :: Verbosity
verbosity prog :: FilePath
prog = IO (Maybe FilePath) -> IO (Maybe FilePath)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO (Maybe FilePath) -> IO (Maybe FilePath))
-> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "searching for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
prog FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " in path."
Maybe FilePath
res <- FilePath -> IO (Maybe FilePath)
findExecutable FilePath
prog
case Maybe FilePath
res of
Nothing -> Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity ("Cannot find " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
prog FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " on the path")
Just path :: FilePath
path -> Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity ("found " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
prog FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " at "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path)
Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
res
findProgramVersion :: String
-> (String -> String)
-> Verbosity
-> FilePath
-> IO (Maybe Version)
findProgramVersion :: FilePath
-> (FilePath -> FilePath)
-> Verbosity
-> FilePath
-> IO (Maybe Version)
findProgramVersion versionArg :: FilePath
versionArg selectVersion :: FilePath -> FilePath
selectVersion verbosity :: Verbosity
verbosity path :: FilePath
path = IO (Maybe Version) -> IO (Maybe Version)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO (Maybe Version) -> IO (Maybe Version))
-> IO (Maybe Version) -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ do
FilePath
str <- Verbosity -> FilePath -> [FilePath] -> IO FilePath
rawSystemStdout Verbosity
verbosity FilePath
path [FilePath
versionArg]
IO FilePath -> (IOError -> IO FilePath) -> IO FilePath
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIO` (\_ -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return "")
IO FilePath -> (ExitCode -> IO FilePath) -> IO FilePath
forall a. IO a -> (ExitCode -> IO a) -> IO a
`catchExit` (\_ -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return "")
let version :: Maybe Version
version :: Maybe Version
version = FilePath -> Maybe Version
forall a. Parsec a => FilePath -> Maybe a
simpleParsec (FilePath -> FilePath
selectVersion FilePath
str)
case Maybe Version
version of
Nothing -> Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "cannot determine version of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " :\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
str
Just v :: Version
v -> Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " is version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
v
Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Version
version
xargs :: Int -> ([String] -> IO ())
-> [String] -> [String] -> IO ()
xargs :: Int -> ([FilePath] -> IO ()) -> [FilePath] -> [FilePath] -> IO ()
xargs maxSize :: Int
maxSize rawSystemFun :: [FilePath] -> IO ()
rawSystemFun fixedArgs :: [FilePath]
fixedArgs bigArgs :: [FilePath]
bigArgs =
let fixedArgSize :: Int
fixedArgSize = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((FilePath -> Int) -> [FilePath] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
fixedArgs) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
fixedArgs
chunkSize :: Int
chunkSize = Int
maxSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fixedArgSize
in ([FilePath] -> IO ()) -> [[FilePath]] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ([FilePath] -> IO ()
[FilePath] -> IO ()
rawSystemFun ([FilePath] -> IO ())
-> ([FilePath] -> [FilePath]) -> [FilePath] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath]
fixedArgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++)) (Int -> [FilePath] -> [[FilePath]]
forall (t :: * -> *) a. Foldable t => Int -> [t a] -> [[t a]]
chunks Int
chunkSize [FilePath]
bigArgs)
where chunks :: Int -> [t a] -> [[t a]]
chunks len :: 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
$ \s :: [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 acc :: [t a]
acc _ [] = ([t a] -> [t a]
forall a. [a] -> [a]
reverse [t a]
acc,[])
chunk acc :: [t a]
acc len :: Int
len (s :: t a
s:ss :: [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
-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
findFile :: [FilePath]
-> FilePath
-> IO FilePath
findFile :: [FilePath] -> FilePath -> IO FilePath
findFile searchPath :: [FilePath]
searchPath fileName :: FilePath
fileName =
(FilePath -> FilePath) -> [FilePath] -> IO (Maybe FilePath)
forall a. (a -> FilePath) -> [a] -> NoCallStackIO (Maybe a)
findFirstFile FilePath -> FilePath
forall a. a -> a
id
[ FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
fileName
| FilePath
path <- [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub [FilePath]
searchPath]
IO (Maybe FilePath)
-> (Maybe FilePath -> IO FilePath) -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO FilePath
forall a. FilePath -> IO a
die (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
fileName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " doesn't exist") FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return
findFileWithExtension :: [String]
-> [FilePath]
-> FilePath
-> NoCallStackIO (Maybe FilePath)
findFileWithExtension :: [FilePath] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileWithExtension extensions :: [FilePath]
extensions searchPath :: [FilePath]
searchPath baseName :: FilePath
baseName =
(FilePath -> FilePath) -> [FilePath] -> IO (Maybe FilePath)
forall a. (a -> FilePath) -> [a] -> NoCallStackIO (Maybe a)
findFirstFile FilePath -> FilePath
forall a. a -> a
id
[ FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
baseName FilePath -> FilePath -> FilePath
<.> FilePath
ext
| FilePath
path <- [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub [FilePath]
searchPath
, FilePath
ext <- [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub [FilePath]
extensions ]
findAllFilesWithExtension :: [String]
-> [FilePath]
-> FilePath
-> NoCallStackIO [FilePath]
findAllFilesWithExtension :: [FilePath] -> [FilePath] -> FilePath -> NoCallStackIO [FilePath]
findAllFilesWithExtension extensions :: [FilePath]
extensions searchPath :: [FilePath]
searchPath basename :: FilePath
basename =
(FilePath -> FilePath) -> [FilePath] -> NoCallStackIO [FilePath]
forall a. (a -> FilePath) -> [a] -> NoCallStackIO [a]
findAllFiles FilePath -> FilePath
forall a. a -> a
id
[ FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
basename FilePath -> FilePath -> FilePath
<.> FilePath
ext
| FilePath
path <- [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub [FilePath]
searchPath
, FilePath
ext <- [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub [FilePath]
extensions ]
findFileWithExtension' :: [String]
-> [FilePath]
-> FilePath
-> NoCallStackIO (Maybe (FilePath, FilePath))
findFileWithExtension' :: [FilePath]
-> [FilePath]
-> FilePath
-> NoCallStackIO (Maybe (FilePath, FilePath))
findFileWithExtension' extensions :: [FilePath]
extensions searchPath :: [FilePath]
searchPath baseName :: FilePath
baseName =
((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)]
-> NoCallStackIO (Maybe (FilePath, FilePath))
forall a. (a -> FilePath) -> [a] -> NoCallStackIO (Maybe a)
findFirstFile ((FilePath -> FilePath -> FilePath)
-> (FilePath, FilePath) -> FilePath
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> FilePath -> FilePath
(</>))
[ (FilePath
path, FilePath
baseName FilePath -> FilePath -> FilePath
<.> FilePath
ext)
| FilePath
path <- [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub [FilePath]
searchPath
, FilePath
ext <- [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub [FilePath]
extensions ]
findFirstFile :: (a -> FilePath) -> [a] -> NoCallStackIO (Maybe a)
findFirstFile :: (a -> FilePath) -> [a] -> NoCallStackIO (Maybe a)
findFirstFile file :: a -> FilePath
file = [a] -> NoCallStackIO (Maybe a)
findFirst
where findFirst :: [a] -> NoCallStackIO (Maybe a)
findFirst [] = Maybe a -> NoCallStackIO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
findFirst (x :: a
x:xs :: [a]
xs) = do Bool
exists <- FilePath -> IO Bool
doesFileExist (a -> FilePath
file a
x)
if Bool
exists
then Maybe a -> NoCallStackIO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
else [a] -> NoCallStackIO (Maybe a)
findFirst [a]
xs
findAllFiles :: (a -> FilePath) -> [a] -> NoCallStackIO [a]
findAllFiles :: (a -> FilePath) -> [a] -> NoCallStackIO [a]
findAllFiles file :: a -> FilePath
file = (a -> IO Bool) -> [a] -> NoCallStackIO [a]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> (a -> FilePath) -> a -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FilePath
file)
findModuleFiles :: [FilePath]
-> [String]
-> [ModuleName]
-> IO [(FilePath, FilePath)]
findModuleFiles :: [FilePath]
-> [FilePath] -> [ModuleName] -> IO [(FilePath, FilePath)]
findModuleFiles searchPath :: [FilePath]
searchPath extensions :: [FilePath]
extensions moduleNames :: [ModuleName]
moduleNames =
(ModuleName -> IO (FilePath, FilePath))
-> [ModuleName] -> IO [(FilePath, FilePath)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([FilePath] -> [FilePath] -> ModuleName -> IO (FilePath, FilePath)
findModuleFile [FilePath]
searchPath [FilePath]
extensions) [ModuleName]
moduleNames
findModuleFile :: [FilePath]
-> [String]
-> ModuleName
-> IO (FilePath, FilePath)
findModuleFile :: [FilePath] -> [FilePath] -> ModuleName -> IO (FilePath, FilePath)
findModuleFile searchPath :: [FilePath]
searchPath extensions :: [FilePath]
extensions mod_name :: ModuleName
mod_name =
IO (FilePath, FilePath)
-> ((FilePath, FilePath) -> IO (FilePath, FilePath))
-> Maybe (FilePath, FilePath)
-> IO (FilePath, FilePath)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (FilePath, FilePath)
forall a. IO a
notFound (FilePath, FilePath) -> IO (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Maybe (FilePath, FilePath) -> IO (FilePath, FilePath))
-> NoCallStackIO (Maybe (FilePath, FilePath))
-> IO (FilePath, FilePath)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [FilePath]
-> [FilePath]
-> FilePath
-> NoCallStackIO (Maybe (FilePath, FilePath))
findFileWithExtension' [FilePath]
extensions [FilePath]
searchPath
(ModuleName -> FilePath
ModuleName.toFilePath ModuleName
mod_name)
where
notFound :: IO a
notFound = FilePath -> IO a
forall a. FilePath -> IO a
die (FilePath -> IO a) -> FilePath -> IO a
forall a b. (a -> b) -> a -> b
$ "Error: Could not find module: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
mod_name
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " with any suffix: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
extensions
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " in the search path: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
searchPath
getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
getDirectoryContentsRecursive topdir :: FilePath
topdir = [FilePath] -> IO [FilePath]
recurseDirectories [""]
where
recurseDirectories :: [FilePath] -> IO [FilePath]
recurseDirectories :: [FilePath] -> IO [FilePath]
recurseDirectories [] = [FilePath] -> NoCallStackIO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
recurseDirectories (dir :: FilePath
dir:dirs :: [FilePath]
dirs) = NoCallStackIO [FilePath] -> NoCallStackIO [FilePath]
forall a. IO a -> IO a
unsafeInterleaveIO (NoCallStackIO [FilePath] -> NoCallStackIO [FilePath])
-> NoCallStackIO [FilePath] -> NoCallStackIO [FilePath]
forall a b. (a -> b) -> a -> b
$ do
(files :: [FilePath]
files, dirs' :: [FilePath]
dirs') <- [FilePath]
-> [FilePath] -> [FilePath] -> IO ([FilePath], [FilePath])
collect [] [] ([FilePath] -> IO ([FilePath], [FilePath]))
-> NoCallStackIO [FilePath] -> IO ([FilePath], [FilePath])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> NoCallStackIO [FilePath]
getDirectoryContents (FilePath
topdir FilePath -> FilePath -> FilePath
</> FilePath
dir)
[FilePath]
files' <- [FilePath] -> IO [FilePath]
recurseDirectories ([FilePath]
dirs' [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
dirs)
[FilePath] -> NoCallStackIO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
files [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
files')
where
collect :: [FilePath]
-> [FilePath] -> [FilePath] -> IO ([FilePath], [FilePath])
collect files :: [FilePath]
files dirs' :: [FilePath]
dirs' [] = ([FilePath], [FilePath]) -> IO ([FilePath], [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
files
,[FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
dirs')
collect files :: [FilePath]
files dirs' :: [FilePath]
dirs' (entry :: FilePath
entry:entries :: [FilePath]
entries) | FilePath -> Bool
ignore FilePath
entry
= [FilePath]
-> [FilePath] -> [FilePath] -> IO ([FilePath], [FilePath])
collect [FilePath]
files [FilePath]
dirs' [FilePath]
entries
collect files :: [FilePath]
files dirs' :: [FilePath]
dirs' (entry :: FilePath
entry:entries :: [FilePath]
entries) = do
let dirEntry :: FilePath
dirEntry = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
entry
Bool
isDirectory <- FilePath -> IO Bool
doesDirectoryExist (FilePath
topdir FilePath -> FilePath -> FilePath
</> FilePath
dirEntry)
if Bool
isDirectory
then [FilePath]
-> [FilePath] -> [FilePath] -> IO ([FilePath], [FilePath])
collect [FilePath]
files (FilePath
dirEntryFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
dirs') [FilePath]
entries
else [FilePath]
-> [FilePath] -> [FilePath] -> IO ([FilePath], [FilePath])
collect (FilePath
dirEntryFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
files) [FilePath]
dirs' [FilePath]
entries
ignore :: FilePath -> Bool
ignore ['.'] = Bool
True
ignore ['.', '.'] = Bool
True
ignore _ = Bool
False
isInSearchPath :: FilePath -> NoCallStackIO Bool
isInSearchPath :: FilePath -> IO Bool
isInSearchPath path :: FilePath
path = ([FilePath] -> Bool) -> NoCallStackIO [FilePath] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FilePath
path) NoCallStackIO [FilePath]
getSearchPath
addLibraryPath :: OS
-> [FilePath]
-> [(String,String)]
-> [(String,String)]
addLibraryPath :: OS
-> [FilePath] -> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
addLibraryPath os :: OS
os paths :: [FilePath]
paths = [(FilePath, FilePath)] -> [(FilePath, FilePath)]
addEnv
where
pathsString :: FilePath
pathsString = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] [FilePath]
paths
ldPath :: FilePath
ldPath = case OS
os of
OSX -> "DYLD_LIBRARY_PATH"
_ -> "LD_LIBRARY_PATH"
addEnv :: [(FilePath, FilePath)] -> [(FilePath, FilePath)]
addEnv [] = [(FilePath
ldPath,FilePath
pathsString)]
addEnv ((key :: FilePath
key,value :: FilePath
value):xs :: [(FilePath, FilePath)]
xs)
| FilePath
key FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
ldPath =
if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
value
then (FilePath
key,FilePath
pathsString)(FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
:[(FilePath, FilePath)]
xs
else (FilePath
key,FilePath
value FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Char
searchPathSeparatorChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
pathsString))(FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
:[(FilePath, FilePath)]
xs
| Bool
otherwise = (FilePath
key,FilePath
value)(FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
:[(FilePath, FilePath)] -> [(FilePath, FilePath)]
addEnv [(FilePath, FilePath)]
xs
moreRecentFile :: FilePath -> FilePath -> NoCallStackIO Bool
moreRecentFile :: FilePath -> FilePath -> IO Bool
moreRecentFile a :: FilePath
a b :: FilePath
b = do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
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 <- FilePath -> IO UTCTime
getModificationTime FilePath
b
UTCTime
ta <- FilePath -> IO UTCTime
getModificationTime FilePath
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)
existsAndIsMoreRecentThan :: FilePath -> FilePath -> NoCallStackIO Bool
existsAndIsMoreRecentThan :: FilePath -> FilePath -> IO Bool
existsAndIsMoreRecentThan a :: FilePath
a b :: FilePath
b = do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
a
if Bool -> Bool
not Bool
exists
then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else FilePath
a FilePath -> FilePath -> IO Bool
`moreRecentFile` FilePath
b
createDirectoryIfMissingVerbose :: Verbosity
-> Bool
-> FilePath
-> IO ()
createDirectoryIfMissingVerbose :: Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose verbosity :: Verbosity
verbosity create_parents :: Bool
create_parents path0 :: FilePath
path0
| Bool
create_parents = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> IO ()
createDirs (FilePath -> [FilePath]
parents FilePath
path0)
| Bool
otherwise = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> IO ()
createDirs (Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take 1 (FilePath -> [FilePath]
parents FilePath
path0))
where
parents :: FilePath -> [FilePath]
parents = [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 FilePath -> FilePath -> FilePath
(</>) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories (FilePath -> [FilePath])
-> (FilePath -> FilePath) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
normalise
createDirs :: [FilePath] -> IO ()
createDirs [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
createDirs (dir :: FilePath
dir:[]) = FilePath -> (IOError -> IO ()) -> IO ()
createDir FilePath
dir IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO
createDirs (dir :: FilePath
dir:dirs :: [FilePath]
dirs) =
FilePath -> (IOError -> IO ()) -> IO ()
createDir FilePath
dir ((IOError -> IO ()) -> IO ()) -> (IOError -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \_ -> do
[FilePath] -> IO ()
createDirs [FilePath]
dirs
FilePath -> (IOError -> IO ()) -> IO ()
createDir FilePath
dir IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO
createDir :: FilePath -> (IOException -> IO ()) -> IO ()
createDir :: FilePath -> (IOError -> IO ()) -> IO ()
createDir dir :: FilePath
dir notExistHandler :: IOError -> IO ()
notExistHandler = do
Either IOError ()
r <- IO () -> IO (Either IOError ())
forall a. IO a -> IO (Either IOError a)
tryIO (IO () -> IO (Either IOError ()))
-> IO () -> IO (Either IOError ())
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
createDirectoryVerbose Verbosity
verbosity FilePath
dir
case (Either IOError ()
r :: Either IOException ()) of
Right () -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left e :: IOError
e
| IOError -> Bool
isDoesNotExistError IOError
e -> IOError -> IO ()
notExistHandler IOError
e
| IOError -> Bool
isAlreadyExistsError IOError
e -> (do
Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
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
$ IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOError
e
) IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIO` ((\_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) :: IOException -> IO ())
| Bool
otherwise -> IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOError
e
createDirectoryVerbose :: Verbosity -> FilePath -> IO ()
createDirectoryVerbose :: Verbosity -> FilePath -> IO ()
createDirectoryVerbose verbosity :: Verbosity
verbosity dir :: FilePath
dir = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "creating " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dir
FilePath -> IO ()
createDirectory FilePath
dir
FilePath -> IO ()
setDirOrdinary FilePath
dir
copyFileVerbose :: Verbosity -> FilePath -> FilePath -> IO ()
copyFileVerbose :: Verbosity -> FilePath -> FilePath -> IO ()
copyFileVerbose verbosity :: Verbosity
verbosity src :: FilePath
src dest :: FilePath
dest = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity ("copy " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
src FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dest)
FilePath -> FilePath -> IO ()
copyFile FilePath
src FilePath
dest
installOrdinaryFile :: Verbosity -> FilePath -> FilePath -> IO ()
installOrdinaryFile :: Verbosity -> FilePath -> FilePath -> IO ()
installOrdinaryFile verbosity :: Verbosity
verbosity src :: FilePath
src dest :: FilePath
dest = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity ("Installing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
src FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dest)
FilePath -> FilePath -> IO ()
copyOrdinaryFile FilePath
src FilePath
dest
installExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()
installExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()
installExecutableFile verbosity :: Verbosity
verbosity src :: FilePath
src dest :: FilePath
dest = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity ("Installing executable " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
src FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dest)
FilePath -> FilePath -> IO ()
copyExecutableFile FilePath
src FilePath
dest
installMaybeExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()
installMaybeExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()
installMaybeExecutableFile verbosity :: Verbosity
verbosity src :: FilePath
src dest :: FilePath
dest = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Permissions
perms <- FilePath -> IO Permissions
getPermissions FilePath
src
if (Permissions -> Bool
executable Permissions
perms)
then Verbosity -> FilePath -> FilePath -> IO ()
installExecutableFile Verbosity
verbosity FilePath
src FilePath
dest
else Verbosity -> FilePath -> FilePath -> IO ()
installOrdinaryFile Verbosity
verbosity FilePath
src FilePath
dest
copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()
copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()
copyFileTo verbosity :: Verbosity
verbosity dir :: FilePath
dir file :: FilePath
file = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let targetFile :: FilePath
targetFile = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (FilePath -> FilePath
takeDirectory FilePath
targetFile)
Verbosity -> FilePath -> FilePath -> IO ()
installOrdinaryFile Verbosity
verbosity FilePath
file FilePath
targetFile
copyFilesWith :: (Verbosity -> FilePath -> FilePath -> IO ())
-> Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith :: (Verbosity -> FilePath -> FilePath -> IO ())
-> Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith doCopy :: Verbosity -> FilePath -> FilePath -> IO ()
doCopy verbosity :: Verbosity
verbosity targetDir :: FilePath
targetDir srcFiles :: [(FilePath, FilePath)]
srcFiles = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let dirs :: [FilePath]
dirs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
targetDir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> ([(FilePath, FilePath)] -> [FilePath])
-> [(FilePath, FilePath)]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath])
-> ([(FilePath, FilePath)] -> [FilePath])
-> [(FilePath, FilePath)]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath
takeDirectory (FilePath -> FilePath)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd) ([(FilePath, FilePath)] -> [FilePath])
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)]
srcFiles
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True) [FilePath]
dirs
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ let src :: FilePath
src = FilePath
srcBase FilePath -> FilePath -> FilePath
</> FilePath
srcFile
dest :: FilePath
dest = FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
srcFile
in Verbosity -> FilePath -> FilePath -> IO ()
doCopy Verbosity
verbosity FilePath
src FilePath
dest
| (srcBase :: FilePath
srcBase, srcFile :: FilePath
srcFile) <- [(FilePath, FilePath)]
srcFiles ]
copyFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFiles v :: Verbosity
v fp :: FilePath
fp fs :: [(FilePath, FilePath)]
fs = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((Verbosity -> FilePath -> FilePath -> IO ())
-> Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith Verbosity -> FilePath -> FilePath -> IO ()
copyFileVerbose Verbosity
v FilePath
fp [(FilePath, FilePath)]
fs)
installOrdinaryFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
installOrdinaryFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
installOrdinaryFiles v :: Verbosity
v fp :: FilePath
fp fs :: [(FilePath, FilePath)]
fs = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((Verbosity -> FilePath -> FilePath -> IO ())
-> Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith Verbosity -> FilePath -> FilePath -> IO ()
installOrdinaryFile Verbosity
v FilePath
fp [(FilePath, FilePath)]
fs)
installExecutableFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)]
-> IO ()
installExecutableFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
installExecutableFiles v :: Verbosity
v fp :: FilePath
fp fs :: [(FilePath, FilePath)]
fs = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((Verbosity -> FilePath -> FilePath -> IO ())
-> Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith Verbosity -> FilePath -> FilePath -> IO ()
installExecutableFile Verbosity
v FilePath
fp [(FilePath, FilePath)]
fs)
installMaybeExecutableFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)]
-> IO ()
installMaybeExecutableFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
installMaybeExecutableFiles v :: Verbosity
v fp :: FilePath
fp fs :: [(FilePath, FilePath)]
fs = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((Verbosity -> FilePath -> FilePath -> IO ())
-> Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith Verbosity -> FilePath -> FilePath -> IO ()
installMaybeExecutableFile Verbosity
v FilePath
fp [(FilePath, FilePath)]
fs)
installDirectoryContents :: Verbosity -> FilePath -> FilePath -> IO ()
installDirectoryContents :: Verbosity -> FilePath -> FilePath -> IO ()
installDirectoryContents verbosity :: Verbosity
verbosity srcDir :: FilePath
srcDir destDir :: FilePath
destDir = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity ("copy directory '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
srcDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "' to '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
destDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "'.")
[FilePath]
srcFiles <- FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
srcDir
Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
installOrdinaryFiles Verbosity
verbosity FilePath
destDir [ (FilePath
srcDir, FilePath
f) | FilePath
f <- [FilePath]
srcFiles ]
copyDirectoryRecursive :: Verbosity -> FilePath -> FilePath -> IO ()
copyDirectoryRecursive :: Verbosity -> FilePath -> FilePath -> IO ()
copyDirectoryRecursive verbosity :: Verbosity
verbosity srcDir :: FilePath
srcDir destDir :: FilePath
destDir = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity ("copy directory '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
srcDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "' to '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
destDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "'.")
[FilePath]
srcFiles <- FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
srcDir
(Verbosity -> FilePath -> FilePath -> IO ())
-> Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith ((FilePath -> FilePath -> IO ())
-> Verbosity -> FilePath -> FilePath -> IO ()
forall a b. a -> b -> a
const FilePath -> FilePath -> IO ()
copyFile) Verbosity
verbosity FilePath
destDir [ (FilePath
srcDir, FilePath
f)
| FilePath
f <- [FilePath]
srcFiles ]
doesExecutableExist :: FilePath -> NoCallStackIO Bool
doesExecutableExist :: FilePath -> IO Bool
doesExecutableExist f :: FilePath
f = do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
f
if Bool
exists
then do Permissions
perms <- FilePath -> IO Permissions
getPermissions FilePath
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
{-# DEPRECATED smartCopySources
"Use findModuleFiles and copyFiles or installOrdinaryFiles" #-}
smartCopySources :: Verbosity -> [FilePath] -> FilePath
-> [ModuleName] -> [String] -> IO ()
smartCopySources :: Verbosity
-> [FilePath] -> FilePath -> [ModuleName] -> [FilePath] -> IO ()
smartCopySources verbosity :: Verbosity
verbosity searchPath :: [FilePath]
searchPath targetDir :: FilePath
targetDir moduleNames :: [ModuleName]
moduleNames extensions :: [FilePath]
extensions = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[FilePath]
-> [FilePath] -> [ModuleName] -> IO [(FilePath, FilePath)]
findModuleFiles [FilePath]
searchPath [FilePath]
extensions [ModuleName]
moduleNames
IO [(FilePath, FilePath)]
-> ([(FilePath, FilePath)] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFiles Verbosity
verbosity FilePath
targetDir
{-# DEPRECATED copyDirectoryRecursiveVerbose
"You probably want installDirectoryContents instead" #-}
copyDirectoryRecursiveVerbose :: Verbosity -> FilePath -> FilePath -> IO ()
copyDirectoryRecursiveVerbose :: Verbosity -> FilePath -> FilePath -> IO ()
copyDirectoryRecursiveVerbose verbosity :: Verbosity
verbosity srcDir :: FilePath
srcDir destDir :: FilePath
destDir = IO () -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity ("copy directory '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
srcDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "' to '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
destDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "'.")
[FilePath]
srcFiles <- FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
srcDir
Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFiles Verbosity
verbosity FilePath
destDir [ (FilePath
srcDir, FilePath
f) | FilePath
f <- [FilePath]
srcFiles ]
data TempFileOptions = TempFileOptions {
TempFileOptions -> Bool
optKeepTempFiles :: Bool
}
defaultTempFileOptions :: TempFileOptions
defaultTempFileOptions :: TempFileOptions
defaultTempFileOptions = TempFileOptions :: Bool -> TempFileOptions
TempFileOptions { optKeepTempFiles :: Bool
optKeepTempFiles = Bool
False }
withTempFile :: FilePath
-> String
-> (FilePath -> Handle -> IO a) -> IO a
withTempFile :: FilePath -> FilePath -> (FilePath -> Handle -> IO a) -> IO a
withTempFile tmpDir :: FilePath
tmpDir template :: FilePath
template action :: FilePath -> Handle -> IO a
action =
TempFileOptions
-> FilePath -> FilePath -> (FilePath -> Handle -> IO a) -> IO a
forall a.
TempFileOptions
-> FilePath -> FilePath -> (FilePath -> Handle -> IO a) -> IO a
withTempFileEx TempFileOptions
defaultTempFileOptions FilePath
tmpDir FilePath
template FilePath -> Handle -> IO a
action
withTempFileEx :: TempFileOptions
-> FilePath
-> String
-> (FilePath -> Handle -> IO a) -> IO a
withTempFileEx :: TempFileOptions
-> FilePath -> FilePath -> (FilePath -> Handle -> IO a) -> IO a
withTempFileEx opts :: TempFileOptions
opts tmpDir :: FilePath
tmpDir template :: FilePath
template action :: FilePath -> Handle -> IO a
action =
IO (FilePath, Handle)
-> ((FilePath, Handle) -> IO ())
-> ((FilePath, Handle) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket
(FilePath -> FilePath -> IO (FilePath, Handle)
openTempFile FilePath
tmpDir FilePath
template)
(\(name :: FilePath
name, handle :: 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 -> NoCallStackIO a -> NoCallStackIO a
handleDoesNotExist () (IO () -> IO ()) -> (FilePath -> IO ()) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
name)
(((FilePath, Handle) -> IO a)
-> WithCallStack ((FilePath, Handle) -> IO a)
forall a b.
(a -> WithCallStack (IO b)) -> WithCallStack (a -> IO b)
withLexicalCallStack ((FilePath -> Handle -> IO a) -> (FilePath, Handle) -> IO a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> Handle -> IO a
FilePath -> Handle -> IO a
action))
withTempDirectory :: Verbosity -> FilePath -> String -> (FilePath -> IO a) -> IO a
withTempDirectory :: Verbosity -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempDirectory verbosity :: Verbosity
verbosity targetDir :: FilePath
targetDir template :: FilePath
template f :: FilePath -> IO a
f = IO a -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
Verbosity
-> TempFileOptions
-> FilePath
-> FilePath
-> (FilePath -> IO a)
-> IO a
forall a.
Verbosity
-> TempFileOptions
-> FilePath
-> FilePath
-> (FilePath -> IO a)
-> IO a
withTempDirectoryEx Verbosity
verbosity TempFileOptions
defaultTempFileOptions FilePath
targetDir FilePath
template
((FilePath -> IO a) -> WithCallStack (FilePath -> IO a)
forall a b.
(a -> WithCallStack (IO b)) -> WithCallStack (a -> IO b)
withLexicalCallStack FilePath -> IO a
f)
withTempDirectoryEx :: Verbosity -> TempFileOptions
-> FilePath -> String -> (FilePath -> IO a) -> IO a
withTempDirectoryEx :: Verbosity
-> TempFileOptions
-> FilePath
-> FilePath
-> (FilePath -> IO a)
-> IO a
withTempDirectoryEx _verbosity :: Verbosity
_verbosity opts :: TempFileOptions
opts targetDir :: FilePath
targetDir template :: FilePath
template f :: FilePath -> IO a
f = IO a -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
IO FilePath -> (FilePath -> IO ()) -> (FilePath -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket
(FilePath -> FilePath -> IO FilePath
createTempDirectory FilePath
targetDir FilePath
template)
(Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TempFileOptions -> Bool
optKeepTempFiles TempFileOptions
opts)
(IO () -> IO ()) -> (FilePath -> IO ()) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> IO () -> IO ()
forall a. a -> NoCallStackIO a -> NoCallStackIO a
handleDoesNotExist () (IO () -> IO ()) -> (FilePath -> IO ()) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
removeDirectoryRecursive)
((FilePath -> IO a) -> WithCallStack (FilePath -> IO a)
forall a b.
(a -> WithCallStack (IO b)) -> WithCallStack (a -> IO b)
withLexicalCallStack FilePath -> IO a
f)
{-# DEPRECATED rewriteFile "Use rewriteFileEx so that Verbosity is respected" #-}
rewriteFile :: FilePath -> String -> IO ()
rewriteFile :: FilePath -> FilePath -> IO ()
rewriteFile = Verbosity -> FilePath -> FilePath -> IO ()
rewriteFileEx Verbosity
normal
rewriteFileEx :: Verbosity -> FilePath -> String -> IO ()
rewriteFileEx :: Verbosity -> FilePath -> FilePath -> IO ()
rewriteFileEx verbosity :: Verbosity
verbosity path :: FilePath
path newContent :: FilePath
newContent =
(IO () -> (IOError -> IO ()) -> IO ())
-> (IOError -> IO ()) -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
catchIO IOError -> IO ()
mightNotExist (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath
existingContent <- Verbosity -> IO FilePath -> IO FilePath
forall a. Verbosity -> IO a -> IO a
annotateIO Verbosity
verbosity (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFile FilePath
path
Int
_ <- Int -> IO Int
forall a. a -> IO a
evaluate (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
existingContent)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath
existingContent FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
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
$
FilePath -> ByteString -> IO ()
writeFileAtomic FilePath
path (FilePath -> ByteString
BS.Char8.pack FilePath
newContent)
where
mightNotExist :: IOError -> IO ()
mightNotExist e :: IOError
e | IOError -> Bool
isDoesNotExistError IOError
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
$ FilePath -> ByteString -> IO ()
writeFileAtomic FilePath
path
(FilePath -> ByteString
BS.Char8.pack FilePath
newContent)
| Bool
otherwise
= IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
e
currentDir :: FilePath
currentDir :: FilePath
currentDir = "."
shortRelativePath :: FilePath -> FilePath -> FilePath
shortRelativePath :: FilePath -> FilePath -> FilePath
shortRelativePath from :: FilePath
from to :: FilePath
to =
case [FilePath] -> [FilePath] -> ([FilePath], [FilePath])
forall a. Eq a => [a] -> [a] -> ([a], [a])
dropCommonPrefix (FilePath -> [FilePath]
splitDirectories FilePath
from) (FilePath -> [FilePath]
splitDirectories FilePath
to) of
(stuff :: [FilePath]
stuff, path :: [FilePath]
path) -> [FilePath] -> FilePath
joinPath ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
forall a b. a -> b -> a
const "..") [FilePath]
stuff [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
path)
where
dropCommonPrefix :: Eq a => [a] -> [a] -> ([a],[a])
dropCommonPrefix :: [a] -> [a] -> ([a], [a])
dropCommonPrefix (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [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 xs :: [a]
xs ys :: [a]
ys = ([a]
xs,[a]
ys)
dropExeExtension :: FilePath -> FilePath
dropExeExtension :: FilePath -> FilePath
dropExeExtension filepath :: FilePath
filepath =
case FilePath -> (FilePath, FilePath)
splitExtension FilePath
filepath of
(filepath' :: FilePath
filepath', extension :: FilePath
extension) | FilePath
extension FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
exeExtensions -> FilePath
filepath'
| Bool
otherwise -> FilePath
filepath
exeExtensions :: [String]
exeExtensions :: [FilePath]
exeExtensions = case OS
buildOS of
Windows -> ["", "exe"]
Ghcjs -> ["", "exe"]
_ -> [""]
defaultPackageDesc :: Verbosity -> IO FilePath
defaultPackageDesc :: Verbosity -> IO FilePath
defaultPackageDesc _verbosity :: Verbosity
_verbosity = FilePath -> IO FilePath
tryFindPackageDesc FilePath
currentDir
findPackageDesc :: FilePath
-> NoCallStackIO (Either String FilePath)
findPackageDesc :: FilePath -> NoCallStackIO (Either FilePath FilePath)
findPackageDesc dir :: FilePath
dir
= do [FilePath]
files <- FilePath -> NoCallStackIO [FilePath]
getDirectoryContents FilePath
dir
[FilePath]
cabalFiles <- (FilePath -> IO Bool) -> [FilePath] -> NoCallStackIO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist
[ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file
| FilePath
file <- [FilePath]
files
, let (name :: FilePath
name, ext :: FilePath
ext) = FilePath -> (FilePath, FilePath)
splitExtension FilePath
file
, Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
name) Bool -> Bool -> Bool
&& FilePath
ext FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ".cabal" ]
case [FilePath]
cabalFiles of
[] -> Either FilePath FilePath
-> NoCallStackIO (Either FilePath FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left FilePath
noDesc)
[cabalFile :: FilePath
cabalFile] -> Either FilePath FilePath
-> NoCallStackIO (Either FilePath FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right FilePath
cabalFile)
multiple :: [FilePath]
multiple -> Either FilePath FilePath
-> NoCallStackIO (Either FilePath FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left (FilePath -> Either FilePath FilePath)
-> FilePath -> Either FilePath FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
multiDesc [FilePath]
multiple)
where
noDesc :: String
noDesc :: FilePath
noDesc = "No cabal file found.\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "Please create a package description file <pkgname>.cabal"
multiDesc :: [String] -> String
multiDesc :: [FilePath] -> FilePath
multiDesc l :: [FilePath]
l = "Multiple cabal files found.\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "Please use only one of: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate ", " [FilePath]
l
tryFindPackageDesc :: FilePath -> IO FilePath
tryFindPackageDesc :: FilePath -> IO FilePath
tryFindPackageDesc dir :: FilePath
dir = (FilePath -> IO FilePath)
-> (FilePath -> IO FilePath)
-> Either FilePath FilePath
-> IO FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO FilePath
forall a. FilePath -> IO a
die FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath FilePath -> IO FilePath)
-> NoCallStackIO (Either FilePath FilePath) -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> NoCallStackIO (Either FilePath FilePath)
findPackageDesc FilePath
dir
{-# DEPRECATED defaultHookedPackageDesc "Use findHookedPackageDesc with the proper base directory instead" #-}
defaultHookedPackageDesc :: IO (Maybe FilePath)
defaultHookedPackageDesc :: IO (Maybe FilePath)
defaultHookedPackageDesc = FilePath -> IO (Maybe FilePath)
findHookedPackageDesc FilePath
currentDir
findHookedPackageDesc
:: FilePath
-> IO (Maybe FilePath)
findHookedPackageDesc :: FilePath -> IO (Maybe FilePath)
findHookedPackageDesc dir :: FilePath
dir = do
[FilePath]
files <- FilePath -> NoCallStackIO [FilePath]
getDirectoryContents FilePath
dir
[FilePath]
buildInfoFiles <- (FilePath -> IO Bool) -> [FilePath] -> NoCallStackIO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist
[ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file
| FilePath
file <- [FilePath]
files
, let (name :: FilePath
name, ext :: FilePath
ext) = FilePath -> (FilePath, FilePath)
splitExtension FilePath
file
, Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
name) Bool -> Bool -> Bool
&& FilePath
ext FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
buildInfoExt ]
case [FilePath]
buildInfoFiles of
[] -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
[f :: FilePath
f] -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f)
_ -> FilePath -> IO (Maybe FilePath)
forall a. FilePath -> IO a
die ("Multiple files with extension " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
buildInfoExt)
buildInfoExt :: String
buildInfoExt :: FilePath
buildInfoExt = ".buildinfo"