{-# LANGUAGE ForeignFunctionInterface, CPP #-}

module Distribution.Client.Utils ( MergeResult(..)
                                 , mergeBy, duplicates, duplicatesBy
                                 , readMaybe
                                 , inDir, withEnv, withEnvOverrides
                                 , logDirChange, withExtraPathEnv
                                 , determineNumJobs, numberOfProcessors
                                 , removeExistingFile
                                 , withTempFileName
                                 , makeAbsoluteToCwd
                                 , makeRelativeToCwd, makeRelativeToDir
                                 , makeRelativeCanonical
                                 , filePathToByteString
                                 , byteStringToFilePath, tryCanonicalizePath
                                 , canonicalizePathNoThrow
                                 , moreRecentFile, existsAndIsMoreRecentThan
                                 , tryFindAddSourcePackageDesc
                                 , tryFindPackageDesc
                                 , relaxEncodingErrors
                                 , ProgressPhase (..)
                                 , progressMessage
                                 , cabalInstallVersion)
       where

import Prelude ()
import Distribution.Client.Compat.Prelude

import Distribution.Compat.Environment
import Distribution.Compat.Time        ( getModTime )
import Distribution.Simple.Setup       ( Flag(..) )
import Distribution.Version
import Distribution.Simple.Utils       ( die', findPackageDesc, noticeNoWrap )
import qualified Data.ByteString.Lazy as BS
import Data.Bits
         ( (.|.), shiftL, shiftR )
import System.FilePath
import Control.Monad
         ( zipWithM_ )
import Data.List
         ( groupBy )
import Foreign.C.Types ( CInt(..) )
import qualified Control.Exception as Exception
         ( finally, bracket )
import System.Directory
         ( canonicalizePath, doesFileExist, getCurrentDirectory
         , removeFile, setCurrentDirectory )
import System.IO
         ( Handle, hClose, openTempFile
         , hGetEncoding, hSetEncoding
         )
import System.IO.Unsafe ( unsafePerformIO )

import GHC.IO.Encoding
         ( recover, TextEncoding(TextEncoding) )
import GHC.IO.Encoding.Failure
         ( recoverEncode, CodingFailureMode(TransliterateCodingFailure) )

#if defined(mingw32_HOST_OS) || MIN_VERSION_directory(1,2,3)
import qualified System.Directory as Dir
import qualified System.IO.Error as IOError
#endif

#ifndef __DOCTEST__
import qualified Paths_cabal_install (version)
#endif

-- | Generic merging utility. For sorted input lists this is a full outer join.
--
mergeBy :: (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy :: (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy a -> b -> Ordering
cmp = [a] -> [b] -> [MergeResult a b]
merge
  where
    merge :: [a] -> [b] -> [MergeResult a b]
merge []     [b]
ys     = [ b -> MergeResult a b
forall a b. b -> MergeResult a b
OnlyInRight b
y | b
y <- [b]
ys]
    merge [a]
xs     []     = [ a -> MergeResult a b
forall a b. a -> MergeResult a b
OnlyInLeft  a
x | a
x <- [a]
xs]
    merge (a
x:[a]
xs) (b
y:[b]
ys) =
      case a
x a -> b -> Ordering
`cmp` b
y of
        Ordering
GT -> b -> MergeResult a b
forall a b. b -> MergeResult a b
OnlyInRight   b
y MergeResult a b -> [MergeResult a b] -> [MergeResult a b]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [MergeResult a b]
merge (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [b]
ys
        Ordering
EQ -> a -> b -> MergeResult a b
forall a b. a -> b -> MergeResult a b
InBoth      a
x b
y MergeResult a b -> [MergeResult a b] -> [MergeResult a b]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [MergeResult a b]
merge [a]
xs     [b]
ys
        Ordering
LT -> a -> MergeResult a b
forall a b. a -> MergeResult a b
OnlyInLeft  a
x   MergeResult a b -> [MergeResult a b] -> [MergeResult a b]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [MergeResult a b]
merge [a]
xs  (b
yb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
ys)

data MergeResult a b = OnlyInLeft a | InBoth a b | OnlyInRight b

duplicates :: Ord a => [a] -> [[a]]
duplicates :: [a] -> [[a]]
duplicates = (a -> a -> Ordering) -> [a] -> [[a]]
forall a. (a -> a -> Ordering) -> [a] -> [[a]]
duplicatesBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

duplicatesBy :: (a -> a -> Ordering) -> [a] -> [[a]]
duplicatesBy :: (a -> a -> Ordering) -> [a] -> [[a]]
duplicatesBy a -> a -> Ordering
cmp = ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter [a] -> Bool
forall a. [a] -> Bool
moreThanOne ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy a -> a -> Bool
eq ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
cmp
  where
    eq :: a -> a -> Bool
eq a
a a
b = case a -> a -> Ordering
cmp a
a a
b of
               Ordering
EQ -> Bool
True
               Ordering
_  -> Bool
False
    moreThanOne :: [a] -> Bool
moreThanOne (a
_:a
_:[a]
_) = Bool
True
    moreThanOne [a]
_       = Bool
False

-- | Like 'removeFile', but does not throw an exception when the file does not
-- exist.
removeExistingFile :: FilePath -> IO ()
removeExistingFile :: FilePath -> IO ()
removeExistingFile FilePath
path = do
  Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
path
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath -> IO ()
removeFile FilePath
path

-- | A variant of 'withTempFile' that only gives us the file name, and while
-- it will clean up the file afterwards, it's lenient if the file is
-- moved\/deleted.
--
withTempFileName :: FilePath
                 -> String
                 -> (FilePath -> IO a) -> IO a
withTempFileName :: FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempFileName FilePath
tmpDir FilePath
template FilePath -> 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)
    (\(FilePath
name, Handle
_) -> FilePath -> IO ()
removeExistingFile FilePath
name)
    (\(FilePath
name, Handle
h) -> Handle -> IO ()
hClose Handle
h IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO a
action FilePath
name)

-- | Executes the action in the specified directory.
--
-- Warning: This operation is NOT thread-safe, because current
-- working directory is a process-global concept.
inDir :: Maybe FilePath -> IO a -> IO a
inDir :: Maybe FilePath -> IO a -> IO a
inDir Maybe FilePath
Nothing IO a
m = IO a
m
inDir (Just FilePath
d) IO a
m = do
  FilePath
old <- IO FilePath
getCurrentDirectory
  FilePath -> IO ()
setCurrentDirectory FilePath
d
  IO a
m IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`Exception.finally` FilePath -> IO ()
setCurrentDirectory FilePath
old

-- | Executes the action with an environment variable set to some
-- value.
--
-- Warning: This operation is NOT thread-safe, because current
-- environment is a process-global concept.
withEnv :: String -> String -> IO a -> IO a
withEnv :: FilePath -> FilePath -> IO a -> IO a
withEnv FilePath
k FilePath
v IO a
m = do
  Maybe FilePath
mb_old <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
k
  FilePath -> FilePath -> IO ()
setEnv FilePath
k FilePath
v
  IO a
m IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`Exception.finally` (case Maybe FilePath
mb_old of
    Maybe FilePath
Nothing -> FilePath -> IO ()
unsetEnv FilePath
k
    Just FilePath
old -> FilePath -> FilePath -> IO ()
setEnv FilePath
k FilePath
old)

-- | Executes the action with a list of environment variables and
-- corresponding overrides, where
--
-- * @'Just' v@ means \"set the environment variable's value to @v@\".
-- * 'Nothing' means \"unset the environment variable\".
--
-- Warning: This operation is NOT thread-safe, because current
-- environment is a process-global concept.
withEnvOverrides :: [(String, Maybe FilePath)] -> IO a -> IO a
withEnvOverrides :: [(FilePath, Maybe FilePath)] -> IO a -> IO a
withEnvOverrides [(FilePath, Maybe FilePath)]
overrides IO a
m = do
  [Maybe FilePath]
mb_olds <- (FilePath -> IO (Maybe FilePath))
-> [FilePath] -> IO [Maybe FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO (Maybe FilePath)
lookupEnv [FilePath]
envVars
  ((FilePath, Maybe FilePath) -> IO ())
-> [(FilePath, Maybe FilePath)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((FilePath -> Maybe FilePath -> IO ())
-> (FilePath, Maybe FilePath) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> Maybe FilePath -> IO ()
update) [(FilePath, Maybe FilePath)]
overrides
  IO a
m IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`Exception.finally` (FilePath -> Maybe FilePath -> IO ())
-> [FilePath] -> [Maybe FilePath] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ FilePath -> Maybe FilePath -> IO ()
update [FilePath]
envVars [Maybe FilePath]
mb_olds
   where
    envVars :: [String]
    envVars :: [FilePath]
envVars = ((FilePath, Maybe FilePath) -> FilePath)
-> [(FilePath, Maybe FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Maybe FilePath) -> FilePath
forall a b. (a, b) -> a
fst [(FilePath, Maybe FilePath)]
overrides

    update :: String -> Maybe FilePath -> IO ()
    update :: FilePath -> Maybe FilePath -> IO ()
update FilePath
var Maybe FilePath
Nothing    = FilePath -> IO ()
unsetEnv FilePath
var
    update FilePath
var (Just FilePath
val) = FilePath -> FilePath -> IO ()
setEnv FilePath
var FilePath
val

-- | Executes the action, increasing the PATH environment
-- in some way
--
-- Warning: This operation is NOT thread-safe, because the
-- environment variables are a process-global concept.
withExtraPathEnv :: [FilePath] -> IO a -> IO a
withExtraPathEnv :: [FilePath] -> IO a -> IO a
withExtraPathEnv [FilePath]
paths IO a
m = do
  [FilePath]
oldPathSplit <- IO [FilePath]
getSearchPath
  let newPath :: FilePath
newPath = FilePath -> FilePath
mungePath (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] ([FilePath]
paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
oldPathSplit)
      oldPath :: FilePath
oldPath = FilePath -> FilePath
mungePath (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] [FilePath]
oldPathSplit
      -- TODO: This is a horrible hack to work around the fact that
      -- setEnv can't take empty values as an argument
      mungePath :: FilePath -> FilePath
mungePath FilePath
p | FilePath
p FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
""   = FilePath
"/dev/null"
                  | Bool
otherwise = FilePath
p
  FilePath -> FilePath -> IO ()
setEnv FilePath
"PATH" FilePath
newPath
  IO a
m IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`Exception.finally` FilePath -> FilePath -> IO ()
setEnv FilePath
"PATH" FilePath
oldPath

-- | Log directory change in 'make' compatible syntax
logDirChange :: (String -> IO ()) -> Maybe FilePath -> IO a -> IO a
logDirChange :: (FilePath -> IO ()) -> Maybe FilePath -> IO a -> IO a
logDirChange FilePath -> IO ()
_ Maybe FilePath
Nothing IO a
m = IO a
m
logDirChange FilePath -> IO ()
l (Just FilePath
d) IO a
m = do
  FilePath -> IO ()
l (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"cabal: Entering directory '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
d FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'\n"
  IO a
m IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`Exception.finally`
    (FilePath -> IO ()
l (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"cabal: Leaving directory '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
d FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'\n")

foreign import ccall "getNumberOfProcessors" c_getNumberOfProcessors :: IO CInt

-- The number of processors is not going to change during the duration of the
-- program, so unsafePerformIO is safe here.
numberOfProcessors :: Int
numberOfProcessors :: Int
numberOfProcessors = CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ IO CInt -> CInt
forall a. IO a -> a
unsafePerformIO IO CInt
c_getNumberOfProcessors

-- | Determine the number of jobs to use given the value of the '-j' flag.
determineNumJobs :: Flag (Maybe Int) -> Int
determineNumJobs :: Flag (Maybe Int) -> Int
determineNumJobs Flag (Maybe Int)
numJobsFlag =
  case Flag (Maybe Int)
numJobsFlag of
    Flag (Maybe Int)
NoFlag        -> Int
1
    Flag Maybe Int
Nothing  -> Int
numberOfProcessors
    Flag (Just Int
n) -> Int
n

-- | Given a relative path, make it absolute relative to the current
-- directory. Absolute paths are returned unmodified.
makeAbsoluteToCwd :: FilePath -> IO FilePath
makeAbsoluteToCwd :: FilePath -> IO FilePath
makeAbsoluteToCwd FilePath
path | FilePath -> Bool
isAbsolute FilePath
path = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
                       | Bool
otherwise       = do FilePath
cwd <- IO FilePath
getCurrentDirectory
                                              FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$! FilePath
cwd FilePath -> FilePath -> FilePath
</> FilePath
path

-- | Given a path (relative or absolute), make it relative to the current
-- directory, including using @../..@ if necessary.
makeRelativeToCwd :: FilePath -> IO FilePath
makeRelativeToCwd :: FilePath -> IO FilePath
makeRelativeToCwd FilePath
path =
    FilePath -> FilePath -> FilePath
makeRelativeCanonical (FilePath -> FilePath -> FilePath)
-> IO FilePath -> IO (FilePath -> FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
canonicalizePath FilePath
path IO (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO FilePath
getCurrentDirectory

-- | Given a path (relative or absolute), make it relative to the given
-- directory, including using @../..@ if necessary.
makeRelativeToDir :: FilePath -> FilePath -> IO FilePath
makeRelativeToDir :: FilePath -> FilePath -> IO FilePath
makeRelativeToDir FilePath
path FilePath
dir =
    FilePath -> FilePath -> FilePath
makeRelativeCanonical (FilePath -> FilePath -> FilePath)
-> IO FilePath -> IO (FilePath -> FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
canonicalizePath FilePath
path IO (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO FilePath
canonicalizePath FilePath
dir

-- | Given a canonical absolute path and canonical absolute dir, make the path
-- relative to the directory, including using @../..@ if necessary. Returns
-- the original absolute path if it is not on the same drive as the given dir.
makeRelativeCanonical :: FilePath -> FilePath -> FilePath
makeRelativeCanonical :: FilePath -> FilePath -> FilePath
makeRelativeCanonical FilePath
path FilePath
dir
  | FilePath -> FilePath
takeDrive FilePath
path FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath -> FilePath
takeDrive FilePath
dir = FilePath
path
  | Bool
otherwise                       = [FilePath] -> [FilePath] -> FilePath
go (FilePath -> [FilePath]
splitPath FilePath
path) (FilePath -> [FilePath]
splitPath FilePath
dir)
  where
    go :: [FilePath] -> [FilePath] -> FilePath
go (FilePath
p:[FilePath]
ps) (FilePath
d:[FilePath]
ds) | FilePath
p FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
d = [FilePath] -> [FilePath] -> FilePath
go [FilePath]
ps [FilePath]
ds
    go    []     []           = FilePath
"./"
    go    [FilePath]
ps     [FilePath]
ds           = [FilePath] -> FilePath
joinPath (Int -> FilePath -> [FilePath]
forall a. Int -> a -> [a]
replicate ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
ds) FilePath
".." [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
ps)

-- | Convert a 'FilePath' to a lazy 'ByteString'. Each 'Char' is
-- encoded as a little-endian 'Word32'.
filePathToByteString :: FilePath -> BS.ByteString
filePathToByteString :: FilePath -> ByteString
filePathToByteString FilePath
p =
  [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word32 -> [Word8] -> [Word8]) -> [Word8] -> [Word32] -> [Word8]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word32 -> [Word8] -> [Word8]
conv [] [Word32]
codepts
  where
    codepts :: [Word32]
    codepts :: [Word32]
codepts = (Char -> Word32) -> FilePath -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> (Char -> Int) -> Char -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) FilePath
p

    conv :: Word32 -> [Word8] -> [Word8]
    conv :: Word32 -> [Word8] -> [Word8]
conv Word32
w32 [Word8]
rest = Word8
b0Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:Word8
b1Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:Word8
b2Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:Word8
b3Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:[Word8]
rest
      where
        b0 :: Word8
b0 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
w32
        b1 :: Word8
b1 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
w32 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8
        b2 :: Word8
b2 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
w32 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16
        b3 :: Word8
b3 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
w32 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24

-- | Reverse operation to 'filePathToByteString'.
byteStringToFilePath :: BS.ByteString -> FilePath
byteStringToFilePath :: ByteString -> FilePath
byteStringToFilePath ByteString
bs | Int64
bslen Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
4 Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
0 = FilePath
unexpected
                        | Bool
otherwise = Int64 -> FilePath
go Int64
0
  where
    unexpected :: FilePath
unexpected = FilePath
"Distribution.Client.Utils.byteStringToFilePath: unexpected"
    bslen :: Int64
bslen = ByteString -> Int64
BS.length ByteString
bs

    go :: Int64 -> FilePath
go Int64
i | Int64
i Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
bslen = []
         | Bool
otherwise = (Int -> Char
chr (Int -> Char) -> (Word32 -> Int) -> Word32 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Char) -> Word32 -> Char
forall a b. (a -> b) -> a -> b
$ Word32
w32) Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: Int64 -> FilePath
go (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
4)
      where
        w32 :: Word32
        w32 :: Word32
w32 = Word32
b0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
b1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
b2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
b3 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
        b0 :: Word32
b0 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> Word8 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> Word8
BS.index ByteString
bs Int64
i
        b1 :: Word32
b1 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> Word8 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> Word8
BS.index ByteString
bs (Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1)
        b2 :: Word32
b2 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> Word8 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> Word8
BS.index ByteString
bs (Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2)
        b3 :: Word32
b3 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> Word8 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> Word8
BS.index ByteString
bs (Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
3)

-- | Workaround for the inconsistent behaviour of 'canonicalizePath'. Always
-- throws an error if the path refers to a non-existent file.
tryCanonicalizePath :: FilePath -> IO FilePath
tryCanonicalizePath :: FilePath -> IO FilePath
tryCanonicalizePath FilePath
path = do
  FilePath
ret <- FilePath -> IO FilePath
canonicalizePath FilePath
path
#if defined(mingw32_HOST_OS) || MIN_VERSION_directory(1,2,3)
  Bool
exists <- (Bool -> Bool -> Bool) -> IO Bool -> IO Bool -> IO Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(||) (FilePath -> IO Bool
doesFileExist FilePath
ret) (FilePath -> IO Bool
Dir.doesDirectoryExist FilePath
ret)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOError -> IO ()
forall a. IOError -> IO a
IOError.ioError (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOError
IOError.mkIOError IOErrorType
IOError.doesNotExistErrorType FilePath
"canonicalizePath"
                        Maybe Handle
forall a. Maybe a
Nothing (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
ret)
#endif
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
ret

-- | A non-throwing wrapper for 'canonicalizePath'. If 'canonicalizePath' throws
-- an exception, returns the path argument unmodified.
canonicalizePathNoThrow :: FilePath -> IO FilePath
canonicalizePathNoThrow :: FilePath -> IO FilePath
canonicalizePathNoThrow FilePath
path = do
  FilePath -> IO FilePath
canonicalizePath FilePath
path IO FilePath -> (IOError -> IO FilePath) -> IO FilePath
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIO` (\IOError
_ -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path)

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

-- | Like Distribution.Simple.Utils.moreRecentFile, but uses getModTime instead
-- of getModificationTime for higher precision. We can't merge the two because
-- Distribution.Client.Time uses MIN_VERSION macros.
moreRecentFile :: FilePath -> FilePath -> IO Bool
moreRecentFile :: FilePath -> FilePath -> IO Bool
moreRecentFile FilePath
a 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 ModTime
tb <- FilePath -> IO ModTime
getModTime FilePath
b
            ModTime
ta <- FilePath -> IO ModTime
getModTime FilePath
a
            Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime
ta ModTime -> ModTime -> Bool
forall a. Ord a => a -> a -> Bool
> ModTime
tb)

-- | Like 'moreRecentFile', but also checks that the first file exists.
existsAndIsMoreRecentThan :: FilePath -> FilePath -> IO Bool
existsAndIsMoreRecentThan :: FilePath -> FilePath -> IO Bool
existsAndIsMoreRecentThan FilePath
a 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

-- | Sets the handler for encoding errors to one that transliterates invalid
-- characters into one present in the encoding (i.e., \'?\').
-- This is opposed to the default behavior, which is to throw an exception on
-- error. This function will ignore file handles that have a Unicode encoding
-- set. It's a no-op for versions of `base` less than 4.4.
relaxEncodingErrors :: Handle -> IO ()
relaxEncodingErrors :: Handle -> IO ()
relaxEncodingErrors Handle
handle = do
  Maybe TextEncoding
maybeEncoding <- Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
handle
  case Maybe TextEncoding
maybeEncoding of
    Just (TextEncoding FilePath
name IO (TextDecoder dstate)
decoder IO (TextEncoder estate)
encoder) | Bool -> Bool
not (FilePath
"UTF" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
name) ->
      let relax :: BufferCodec Char Word8 state -> BufferCodec Char Word8 state
relax BufferCodec Char Word8 state
x = BufferCodec Char Word8 state
x { recover :: Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
recover = CodingFailureMode
-> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
recoverEncode CodingFailureMode
TransliterateCodingFailure }
      in Handle -> TextEncoding -> IO ()
hSetEncoding Handle
handle (FilePath
-> IO (TextDecoder dstate)
-> IO (TextEncoder estate)
-> TextEncoding
forall dstate estate.
FilePath
-> IO (TextDecoder dstate)
-> IO (TextEncoder estate)
-> TextEncoding
TextEncoding FilePath
name IO (TextDecoder dstate)
decoder ((TextEncoder estate -> TextEncoder estate)
-> IO (TextEncoder estate) -> IO (TextEncoder estate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEncoder estate -> TextEncoder estate
forall state.
BufferCodec Char Word8 state -> BufferCodec Char Word8 state
relax IO (TextEncoder estate)
encoder))
    Maybe TextEncoding
_ ->
      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- |Like 'tryFindPackageDesc', but with error specific to add-source deps.
tryFindAddSourcePackageDesc :: Verbosity -> FilePath -> String -> IO FilePath
tryFindAddSourcePackageDesc :: Verbosity -> FilePath -> FilePath -> IO FilePath
tryFindAddSourcePackageDesc Verbosity
verbosity FilePath
depPath FilePath
err = Verbosity -> FilePath -> FilePath -> IO FilePath
tryFindPackageDesc Verbosity
verbosity FilePath
depPath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$
    FilePath
err FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"Failed to read cabal file of add-source dependency: "
    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
depPath

-- |Try to find a @.cabal@ file, in directory @depPath@. Fails if one cannot be
-- found, with @err@ prefixing the error message. This function simply allows
-- us to give a more descriptive error than that provided by @findPackageDesc@.
tryFindPackageDesc :: Verbosity -> FilePath -> String -> IO FilePath
tryFindPackageDesc :: Verbosity -> FilePath -> FilePath -> IO FilePath
tryFindPackageDesc Verbosity
verbosity FilePath
depPath FilePath
err = do
    Either FilePath FilePath
errOrCabalFile <- FilePath -> IO (Either FilePath FilePath)
findPackageDesc FilePath
depPath
    case Either FilePath FilePath
errOrCabalFile of
        Right FilePath
file -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
file
        Left FilePath
_ -> Verbosity -> FilePath -> IO FilePath
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity FilePath
err

-- | Phase of building a dependency. Represents current status of package
-- dependency processing. See #4040 for details.
data ProgressPhase
    = ProgressDownloading
    | ProgressDownloaded
    | ProgressStarting
    | ProgressBuilding
    | ProgressHaddock
    | ProgressInstalling
    | ProgressCompleted

progressMessage :: Verbosity -> ProgressPhase -> String -> IO ()
progressMessage :: Verbosity -> ProgressPhase -> FilePath -> IO ()
progressMessage Verbosity
verbosity ProgressPhase
phase FilePath
subject = do
    Verbosity -> FilePath -> IO ()
noticeNoWrap Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
phaseStr FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
subject FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
  where
    phaseStr :: FilePath
phaseStr = case ProgressPhase
phase of
        ProgressPhase
ProgressDownloading -> FilePath
"Downloading  "
        ProgressPhase
ProgressDownloaded  -> FilePath
"Downloaded   "
        ProgressPhase
ProgressStarting    -> FilePath
"Starting     "
        ProgressPhase
ProgressBuilding    -> FilePath
"Building     "
        ProgressPhase
ProgressHaddock     -> FilePath
"Haddock      "
        ProgressPhase
ProgressInstalling  -> FilePath
"Installing   "
        ProgressPhase
ProgressCompleted   -> FilePath
"Completed    "

cabalInstallVersion :: Version
#ifdef __DOCTEST__
cabalInstallVersion = mkVersion [3,3]
#else
cabalInstallVersion :: Version
cabalInstallVersion = Version -> Version
mkVersion' Version
Paths_cabal_install.version
#endif