{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, 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
, findOpenProgramLocation
, relaxEncodingErrors
, ProgressPhase (..)
, progressMessage
, pvpize
, incVersion
, getCurrentYear
, listFilesRecursive
, listFilesInside
, safeRead
) 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 Distribution.System ( Platform (..), OS(..))
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 )
import qualified Control.Exception.Safe as Safe
( bracket )
import System.Directory
( canonicalizePath, doesFileExist, findExecutable, getCurrentDirectory
, removeFile, setCurrentDirectory, getDirectoryContents, doesDirectoryExist )
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) )
import Data.Time.Clock.POSIX (getCurrentTime)
import Data.Time.LocalTime (getCurrentTimeZone, localDay)
import Data.Time (utcToLocalTime)
import Data.Time.Calendar (toGregorian)
#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
mergeBy :: forall a b. (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 :: [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 :: forall a. (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 -> 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
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
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 (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
Safe.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)
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
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)
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
withExtraPathEnv :: [FilePath] -> IO a -> IO a
[FilePath]
paths IO a
m = do
[FilePath]
oldPathSplit <- IO [FilePath]
getSearchPath
let newPath :: String
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 :: String
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
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
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
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
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
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
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
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
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
where (FilePath
p', FilePath
d') = (FilePath -> FilePath
dropTrailingPathSeparator FilePath
p, FilePath -> FilePath
dropTrailingPathSeparator FilePath
d)
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)
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
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)
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
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)
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)
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
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 ()
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
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
findOpenProgramLocation :: Platform -> IO (Either String FilePath)
findOpenProgramLocation :: Platform -> IO (Either FilePath FilePath)
findOpenProgramLocation (Platform Arch
_ OS
os) =
let
locate :: FilePath -> IO (Either FilePath FilePath)
locate FilePath
name = do
Maybe FilePath
exe <- FilePath -> IO (Maybe FilePath)
findExecutable FilePath
name
case Maybe FilePath
exe of
Just FilePath
s -> Either FilePath FilePath -> IO (Either FilePath FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right FilePath
s)
Maybe FilePath
Nothing -> Either FilePath FilePath -> IO (Either FilePath FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left (FilePath
"Couldn't find file-opener program `" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"`"))
xdg :: IO (Either FilePath FilePath)
xdg = FilePath -> IO (Either FilePath FilePath)
locate FilePath
"xdg-open"
in case OS
os of
OS
Windows -> Either FilePath FilePath -> IO (Either FilePath FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right FilePath
"start")
OS
OSX -> FilePath -> IO (Either FilePath FilePath)
locate FilePath
"open"
OS
Linux -> IO (Either FilePath FilePath)
xdg
OS
FreeBSD -> IO (Either FilePath FilePath)
xdg
OS
OpenBSD -> IO (Either FilePath FilePath)
xdg
OS
NetBSD -> IO (Either FilePath FilePath)
xdg
OS
DragonFly -> IO (Either FilePath FilePath)
xdg
OS
_ -> Either FilePath FilePath -> IO (Either FilePath FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left (FilePath
"Couldn't determine file-opener program for " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> OS -> FilePath
forall a. Show a => a -> FilePath
show OS
os))
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 "
pvpize :: Bool -> Version -> VersionRange
pvpize :: Bool -> Version -> VersionRange
pvpize Bool
False Version
v = Version -> VersionRange
majorBoundVersion Version
v
pvpize Bool
True Version
v = Version -> VersionRange
orLaterVersion Version
v'
VersionRange -> VersionRange -> VersionRange
`intersectVersionRanges`
Version -> VersionRange
earlierVersion (Int -> Version -> Version
incVersion Int
1 Version
v')
where v' :: Version
v' = ([Int] -> [Int]) -> Version -> Version
alterVersion (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
2) Version
v
incVersion :: Int -> Version -> Version
incVersion :: Int -> Version -> Version
incVersion Int
n = ([Int] -> [Int]) -> Version -> Version
alterVersion (Int -> [Int] -> [Int]
forall a. Num a => Int -> [a] -> [a]
incVersion' Int
n)
where
incVersion' :: Int -> [a] -> [a]
incVersion' Int
0 [] = [a
1]
incVersion' Int
0 (a
v:[a]
_) = [a
va -> a -> a
forall a. Num a => a -> a -> a
+a
1]
incVersion' Int
m [] = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
m a
0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
1]
incVersion' Int
m (a
v:[a]
vs) = a
v a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a] -> [a]
incVersion' (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
vs
getCurrentYear :: IO Integer
getCurrentYear :: IO Integer
getCurrentYear = do
UTCTime
u <- IO UTCTime
getCurrentTime
TimeZone
z <- IO TimeZone
getCurrentTimeZone
let l :: LocalTime
l = TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
z UTCTime
u
(Integer
y, Int
_, Int
_) = Day -> (Integer, Int, Int)
toGregorian (Day -> (Integer, Int, Int)) -> Day -> (Integer, Int, Int)
forall a b. (a -> b) -> a -> b
$ LocalTime -> Day
localDay LocalTime
l
Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
y
listFilesInside :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
listFilesInside :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
listFilesInside FilePath -> IO Bool
test FilePath
dir = IO Bool -> IO [FilePath] -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (IO Bool -> IO Bool
forall (m :: * -> *). Functor m => m Bool -> m Bool
notM (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
test (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
dropTrailingPathSeparator FilePath
dir) ([FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ do
([FilePath]
dirs,[FilePath]
files) <- (FilePath -> IO Bool) -> [FilePath] -> IO ([FilePath], [FilePath])
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM FilePath -> IO Bool
doesDirectoryExist ([FilePath] -> IO ([FilePath], [FilePath]))
-> IO [FilePath] -> IO ([FilePath], [FilePath])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listContents FilePath
dir
[FilePath]
rest <- (FilePath -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM ((FilePath -> IO Bool) -> FilePath -> IO [FilePath]
listFilesInside FilePath -> IO Bool
test) [FilePath]
dirs
[FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
files [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
rest
listFilesRecursive :: FilePath -> IO [FilePath]
listFilesRecursive :: FilePath -> IO [FilePath]
listFilesRecursive = (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
listFilesInside (IO Bool -> FilePath -> IO Bool
forall a b. a -> b -> a
const (IO Bool -> FilePath -> IO Bool) -> IO Bool -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
listContents :: FilePath -> IO [FilePath]
listContents :: FilePath -> IO [FilePath]
listContents FilePath
dir = do
[FilePath]
xs <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
[FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
x | FilePath
x <- [FilePath]
xs, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') FilePath
x]
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: m Bool -> m a -> m a -> m a
ifM m Bool
b m a
t m a
f = do Bool
b' <- m Bool
b; if Bool
b' then m a
t else m a
f
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
{-# INLINE concatMapM #-}
concatMapM :: (a -> m [b]) -> [a] -> m [b]
concatMapM a -> m [b]
op = (a -> m [b] -> m [b]) -> m [b] -> [a] -> m [b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> m [b] -> m [b]
f ([b] -> m [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
where f :: a -> m [b] -> m [b]
f a
x m [b]
xs = do [b]
x' <- a -> m [b]
op a
x; if [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
x' then m [b]
xs else do [b]
xs' <- m [b]
xs; [b] -> m [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([b] -> m [b]) -> [b] -> m [b]
forall a b. (a -> b) -> a -> b
$ [b]
x' [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ [b]
xs'
partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
partitionM :: (a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
_ [] = ([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
partitionM a -> m Bool
f (a
x:[a]
xs) = do
Bool
res <- a -> m Bool
f a
x
([a]
as,[a]
bs) <- (a -> m Bool) -> [a] -> m ([a], [a])
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
f [a]
xs
([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a
x | Bool
res][a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
as, [a
x | Bool -> Bool
not Bool
res][a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
bs)
notM :: Functor m => m Bool -> m Bool
notM :: m Bool -> m Bool
notM = (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not
safeRead :: Read a => String -> Maybe a
safeRead :: FilePath -> Maybe a
safeRead FilePath
s
| [(a
x, FilePath
"")] <- ReadS a
forall a. Read a => ReadS a
reads FilePath
s = a -> Maybe a
forall a. a -> Maybe a
Just a
x
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing