{-# LANGUAGE 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
, hasElem
) 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 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.Conc.Sync ( getNumProcessors )
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
import qualified Data.Set as Set
mergeBy :: forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy :: forall a b. (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 = [ forall a b. b -> MergeResult a b
OnlyInRight b
y | b
y <- [b]
ys]
merge [a]
xs [] = [ 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 -> forall a b. b -> MergeResult a b
OnlyInRight b
y forall a. a -> [a] -> [a]
: [a] -> [b] -> [MergeResult a b]
merge (a
xforall a. a -> [a] -> [a]
:[a]
xs) [b]
ys
Ordering
EQ -> forall a b. a -> b -> MergeResult a b
InBoth a
x b
y forall a. a -> [a] -> [a]
: [a] -> [b] -> [MergeResult a b]
merge [a]
xs [b]
ys
Ordering
LT -> forall a b. a -> MergeResult a b
OnlyInLeft a
x forall a. a -> [a] -> [a]
: [a] -> [b] -> [MergeResult a b]
merge [a]
xs (b
yforall a. a -> [a] -> [a]
:[b]
ys)
data MergeResult a b = OnlyInLeft a | InBoth a b | OnlyInRight b
duplicates :: Ord a => [a] -> [[a]]
duplicates :: forall a. Ord a => [a] -> [[a]]
duplicates = forall a. (a -> a -> Ordering) -> [a] -> [[a]]
duplicatesBy forall a. Ord a => a -> a -> Ordering
compare
duplicatesBy :: forall a. (a -> a -> Ordering) -> [a] -> [[a]]
duplicatesBy :: forall a. (a -> a -> Ordering) -> [a] -> [[a]]
duplicatesBy a -> a -> Ordering
cmp = forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. [a] -> Bool
moreThanOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy a -> a -> Bool
eq forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$
FilePath -> IO ()
removeFile FilePath
path
withTempFileName :: FilePath
-> String
-> (FilePath -> IO a) -> IO a
withTempFileName :: forall a. FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempFileName FilePath
tmpDir FilePath
template FilePath -> IO a
action =
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 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 :: forall a. 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 forall a b. IO a -> IO b -> IO a
`Exception.finally` FilePath -> IO ()
setCurrentDirectory FilePath
old
withEnv :: String -> String -> IO a -> IO a
withEnv :: forall a. 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 forall a b. IO a -> IO b -> IO a
`Exception.finally` FilePath -> Maybe FilePath -> IO ()
setOrUnsetEnv FilePath
k Maybe FilePath
mb_old
withEnvOverrides :: [(String, Maybe FilePath)] -> IO a -> IO a
withEnvOverrides :: forall a. [(FilePath, Maybe FilePath)] -> IO a -> IO a
withEnvOverrides [(FilePath, Maybe FilePath)]
overrides IO a
m = do
[Maybe FilePath]
mb_olds <- 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
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> Maybe FilePath -> IO ()
setOrUnsetEnv) [(FilePath, Maybe FilePath)]
overrides
IO a
m forall a b. IO a -> IO b -> IO a
`Exception.finally` forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ FilePath -> Maybe FilePath -> IO ()
setOrUnsetEnv [FilePath]
envVars [Maybe FilePath]
mb_olds
where
envVars :: [String]
envVars :: [FilePath]
envVars = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(FilePath, Maybe FilePath)]
overrides
setOrUnsetEnv :: String -> Maybe String -> IO ()
setOrUnsetEnv :: FilePath -> Maybe FilePath -> IO ()
setOrUnsetEnv FilePath
var Maybe FilePath
Nothing = FilePath -> IO ()
unsetEnv FilePath
var
setOrUnsetEnv 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 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] ([FilePath]
paths forall a. [a] -> [a] -> [a]
++ [FilePath]
oldPathSplit)
oldPath :: String
oldPath :: FilePath
oldPath = FilePath -> FilePath
mungePath forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] [FilePath]
oldPathSplit
mungePath :: FilePath -> FilePath
mungePath FilePath
p | FilePath
p 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 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 :: forall a. (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 forall a b. (a -> b) -> a -> b
$ FilePath
"cabal: Entering directory '" forall a. [a] -> [a] -> [a]
++ FilePath
d forall a. [a] -> [a] -> [a]
++ FilePath
"'\n"
IO a
m forall a b. IO a -> IO b -> IO a
`Exception.finally`
(FilePath -> IO ()
l forall a b. (a -> b) -> a -> b
$ FilePath
"cabal: Leaving directory '" forall a. [a] -> [a] -> [a]
++ FilePath
d forall a. [a] -> [a] -> [a]
++ FilePath
"'\n")
numberOfProcessors :: Int
numberOfProcessors :: Int
numberOfProcessors = forall a. IO a -> a
unsafePerformIO IO Int
getNumProcessors
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 = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
| Bool
otherwise = do FilePath
cwd <- IO FilePath
getCurrentDirectory
forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
canonicalizePath FilePath
path 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
canonicalizePath FilePath
path 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 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' 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 (forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
ds) FilePath
".." forall a. [a] -> [a] -> [a]
++ [FilePath]
ps)
filePathToByteString :: FilePath -> BS.ByteString
filePathToByteString :: FilePath -> ByteString
filePathToByteString FilePath
p =
[Word8] -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral 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
b0forall a. a -> [a] -> [a]
:Word8
b1forall a. a -> [a] -> [a]
:Word8
b2forall a. a -> [a] -> [a]
:Word8
b3forall a. a -> [a] -> [a]
:[Word8]
rest
where
b0 :: Word8
b0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w32
b1 :: Word8
b1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w32 forall a. Bits a => a -> Int -> a
`shiftR` Int
8
b2 :: Word8
b2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w32 forall a. Bits a => a -> Int -> a
`shiftR` Int
16
b3 :: Word8
b3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w32 forall a. Bits a => a -> Int -> a
`shiftR` Int
24
byteStringToFilePath :: BS.ByteString -> FilePath
byteStringToFilePath :: ByteString -> FilePath
byteStringToFilePath ByteString
bs | Int64
bslen forall a. Integral a => a -> a -> a
`mod` Int64
4 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 forall a. Eq a => a -> a -> Bool
== Int64
bslen = []
| Bool
otherwise = (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w32) forall a. a -> [a] -> [a]
: Int64 -> FilePath
go (Int64
iforall a. Num a => a -> a -> a
+Int64
4)
where
w32 :: Word32
w32 :: Word32
w32 = Word32
b0 forall a. Bits a => a -> a -> a
.|. (Word32
b1 forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|. (Word32
b2 forall a. Bits a => a -> Int -> a
`shiftL` Int
16) forall a. Bits a => a -> a -> a
.|. (Word32
b3 forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
b0 :: Word32
b0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Int64 -> Word8
BS.index ByteString
bs Int64
i
b1 :: Word32
b1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Int64 -> Word8
BS.index ByteString
bs (Int64
i forall a. Num a => a -> a -> a
+ Int64
1)
b2 :: Word32
b2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Int64 -> Word8
BS.index ByteString
bs (Int64
i forall a. Num a => a -> a -> a
+ Int64
2)
b3 :: Word32
b3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Int64 -> Word8
BS.index ByteString
bs (Int64
i 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 <- 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)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$
forall a. IOError -> IO a
IOError.ioError forall a b. (a -> b) -> a -> b
$ IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOError
IOError.mkIOError IOErrorType
IOError.doesNotExistErrorType FilePath
"canonicalizePath"
forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just FilePath
ret)
#endif
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 forall a. IO a -> (IOError -> IO a) -> IO a
`catchIO` (\IOError
_ -> 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 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
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime
ta 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 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" 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 (forall dstate estate.
FilePath
-> IO (TextDecoder dstate)
-> IO (TextEncoder estate)
-> TextEncoding
TextEncoding FilePath
name IO (TextDecoder dstate)
decoder (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {state}.
BufferCodec Char Word8 state -> BufferCodec Char Word8 state
relax IO (TextEncoder estate)
encoder))
Maybe TextEncoding
_ ->
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 forall a b. (a -> b) -> a -> b
$
FilePath
err forall a. [a] -> [a] -> [a]
++ FilePath
"\n" forall a. [a] -> [a] -> [a]
++ FilePath
"Failed to read cabal file of add-source dependency: "
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 -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
file
Left 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right FilePath
s)
Maybe FilePath
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (FilePath
"Couldn't find file-opener program `" forall a. Semigroup a => a -> a -> a
<> FilePath
name 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (FilePath
"Couldn't determine file-opener program for " forall a. Semigroup a => a -> a -> a
<> 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 forall a b. (a -> b) -> a -> b
$ FilePath
phaseStr forall a. [a] -> [a] -> [a]
++ FilePath
subject 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 (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 (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
vforall a. Num a => a -> a -> a
+a
1]
incVersion' Int
m [] = forall a. Int -> a -> [a]
replicate Int
m a
0 forall a. [a] -> [a] -> [a]
++ [a
1]
incVersion' Int
m (a
v:[a]
vs) = a
v forall a. a -> [a] -> [a]
: Int -> [a] -> [a]
incVersion' (Int
mforall 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 forall a b. (a -> b) -> a -> b
$ LocalTime -> Day
localDay LocalTime
l
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 = forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifNotM (FilePath -> IO Bool
test forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
dropTrailingPathSeparator FilePath
dir) (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) forall a b. (a -> b) -> a -> b
$ do
([FilePath]
dirs,[FilePath]
files) <- forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM FilePath -> IO Bool
doesDirectoryExist forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listContents FilePath
dir
[FilePath]
rest <- 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
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [FilePath]
files forall a. [a] -> [a] -> [a]
++ [FilePath]
rest
listFilesRecursive :: FilePath -> IO [FilePath]
listFilesRecursive :: FilePath -> IO [FilePath]
listFilesRecursive = (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
listFilesInside (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort [FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
x | FilePath
x <- [FilePath]
xs, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Char
'.') FilePath
x]
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: forall (m :: * -> *) a. Monad m => 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
ifNotM :: Monad m => m Bool -> m a -> m a -> m a
ifNotM :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifNotM = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
{-# INLINE concatMapM #-}
concatMapM :: forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM a -> m [b]
op = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> m [b] -> m [b]
f (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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
x' then m [b]
xs else do [b]
xs' <- m [b]
xs; forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [b]
x' forall a. [a] -> [a] -> [a]
++ [b]
xs'
partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
partitionM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
_ [] = 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) <- forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
f [a]
xs
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a
x | Bool
res]forall a. [a] -> [a] -> [a]
++[a]
as, [a
x | Bool -> Bool
not Bool
res]forall a. [a] -> [a] -> [a]
++[a]
bs)
safeRead :: Read a => String -> Maybe a
safeRead :: forall a. Read a => FilePath -> Maybe a
safeRead FilePath
s
| [(a
x, FilePath
"")] <- forall a. Read a => ReadS a
reads FilePath
s = forall a. a -> Maybe a
Just a
x
| Bool
otherwise = forall a. Maybe a
Nothing
hasElem :: Ord a => [a] -> a -> Bool
hasElem :: forall a. Ord a => [a] -> a -> Bool
hasElem [a]
xs = (forall a. Ord a => a -> Set a -> Bool
`Set.member` forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs)