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