cabal-install/src/Distribution/Client/Utils.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE DataKinds #-}
   3 {-# LANGUAGE ScopedTypeVariables #-}
   4
   5 module Distribution.Client.Utils
   6   ( MergeResult (..)
   7   , mergeBy
   8   , duplicates
   9   , duplicatesBy
  10   , readMaybe
  11   , withEnv
  12   , withEnvOverrides
  13   , logDirChange
  14   , withExtraPathEnv
  15   , determineNumJobs
  16   , numberOfProcessors
  17   , removeExistingFile
  18   , withTempFileName
  19   , makeAbsoluteToCwd
  20   , makeRelativeToCwd
  21   , makeRelativeToDir
  22   , makeRelativeToDirS
  23   , makeRelativeCanonical
  24   , filePathToByteString
  25   , byteStringToFilePath
  26   , tryCanonicalizePath
  27   , canonicalizePathNoThrow
  28   , moreRecentFile
  29   , existsAndIsMoreRecentThan
  30   , tryReadAddSourcePackageDesc
  31   , tryReadGenericPackageDesc
  32   , relaxEncodingErrors
  33   , ProgressPhase (..)
  34   , progressMessage
  35   , pvpize
  36   , incVersion
  37   , getCurrentYear
  38   , listFilesRecursive
  39   , listFilesInside
  40   , safeRead
  41   , hasElem
  42   , concatMapM
  43   , occursOnlyOrBefore
  44   , giveRTSWarning
  45   ) where
  46
  47 import Distribution.Client.Compat.Prelude
  48 import Prelude ()
  49
  50 import qualified Control.Exception as Exception
  51   ( finally
  52   )
  53 import qualified Control.Exception.Safe as Safe
  54   ( bracket
  55   )
  56 import Control.Monad
  57   ( zipWithM_
  58   )
  59 import Data.Bits
  60   ( shiftL
  61   , shiftR
  62   , (.|.)
  63   )
  64 import qualified Data.ByteString.Lazy as BS
  65 import Data.List
  66   ( elemIndex
  67   , groupBy
  68   )
  69 import Distribution.Client.Errors
  70 import Distribution.Compat.Environment
  71 import Distribution.Compat.Time (getModTime)
  72 import Distribution.Simple.Setup (Flag (..))
  73 import Distribution.Simple.Utils (dieWithException, findPackageDesc, noticeNoWrap)
  74 import Distribution.Utils.Path
  75   ( CWD
  76   , FileOrDir (..)
  77   , Pkg
  78   , RelativePath
  79   , SymbolicPath
  80   , getSymbolicPath
  81   , makeSymbolicPath
  82   , relativeSymbolicPath
  83   , sameDirectory
  84   , symbolicPathRelative_maybe
  85   )
  86 import Distribution.Version
  87
  88 import System.Directory
  89   ( canonicalizePath
  90   , doesDirectoryExist
  91   , doesFileExist
  92   , getDirectoryContents
  93   , removeFile
  94   )
  95 import qualified System.Directory as Directory
  96 import System.FilePath
  97 import System.IO
  98   ( Handle
  99   , hClose
 100   , hGetEncoding
 101   , hSetEncoding
 102   , openTempFile
 103   )
 104 import System.IO.Unsafe (unsafePerformIO)
 105
 106 import Data.Time (utcToLocalTime)
 107 import Data.Time.Calendar (toGregorian)
 108 import Data.Time.Clock.POSIX (getCurrentTime)
 109 import Data.Time.LocalTime (getCurrentTimeZone, localDay)
 110 import GHC.Conc.Sync (getNumProcessors)
 111 import GHC.IO.Encoding
 112   ( TextEncoding (TextEncoding)
 113   , recover
 114   )
 115 import GHC.IO.Encoding.Failure
 116   ( CodingFailureMode (TransliterateCodingFailure)
 117   , recoverEncode
 118   )
 119 #if defined(mingw32_HOST_OS) || MIN_VERSION_directory(1,2,3)
 120 import qualified System.Directory as Dir
 121 import qualified System.IO.Error as IOError
 122 #endif
 123 import qualified Data.Set as Set
 124 import Distribution.Simple.PackageDescription (readGenericPackageDescription)
 125 import Distribution.Types.GenericPackageDescription (GenericPackageDescription)
 126
 127 -- | Generic merging utility. For sorted input lists this is a full outer join.
 128 mergeBy :: forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
 129 mergeBy cmp = merge
 130   where
 131     merge :: [a] -> [b] -> [MergeResult a b]
 132     merge [] ys = [OnlyInRight y | y <- ys]
 133     merge xs [] = [OnlyInLeft x | x <- xs]
 134     merge (x : xs) (y : ys) =
 135       case x `cmp` y of
 136         GT -> OnlyInRight y : merge (x : xs) ys
 137         EQ -> InBoth x y : merge xs ys
 138         LT -> OnlyInLeft x : merge xs (y : ys)
 139
 140 data MergeResult a b = OnlyInLeft a | InBoth a b | OnlyInRight b
 141
 142 duplicates :: Ord a => [a] -> [[a]]
 143 duplicates = duplicatesBy compare
 144
 145 duplicatesBy :: forall a. (a -> a -> Ordering) -> [a] -> [[a]]
 146 duplicatesBy cmp = filter moreThanOne . groupBy eq . sortBy cmp
 147   where
 148     eq :: a -> a -> Bool
 149     eq a b = case cmp a b of
 150       EQ -> True
 151       _ -> False
 152     moreThanOne (_ : _ : _) = True
 153     moreThanOne _ = False
 154
 155 -- | Like 'removeFile', but does not throw an exception when the file does not
 156 -- exist.
 157 removeExistingFile :: FilePath -> IO ()
 158 removeExistingFile path = do
 159   exists <- doesFileExist path
 160   when exists $
 161     removeFile path
 162
 163 -- | A variant of 'withTempFile' that only gives us the file name, and while
 164 -- it will clean up the file afterwards, it's lenient if the file is
 165 -- moved\/deleted.
 166 withTempFileName
 167   :: FilePath
 168   -> String
 169   -> (FilePath -> IO a)
 170   -> IO a
 171 withTempFileName tmpDir template action =
 172   Safe.bracket
 173     (openTempFile tmpDir template)
 174     (\(name, _) -> removeExistingFile name)
 175     (\(name, h) -> hClose h >> action name)
 176
 177 -- | Executes the action with an environment variable set to some
 178 -- value.
 179 --
 180 -- Warning: This operation is NOT thread-safe, because current
 181 -- environment is a process-global concept.
 182 withEnv :: String -> String -> IO a -> IO a
 183 withEnv k v m = do
 184   mb_old <- lookupEnv k
 185   setEnv k v
 186   m `Exception.finally` setOrUnsetEnv k mb_old
 187
 188 -- | Executes the action with a list of environment variables and
 189 -- corresponding overrides, where
 190 --
 191 -- * @'Just' v@ means \"set the environment variable's value to @v@\".
 192 -- * 'Nothing' means \"unset the environment variable\".
 193 --
 194 -- Warning: This operation is NOT thread-safe, because current
 195 -- environment is a process-global concept.
 196 withEnvOverrides :: [(String, Maybe FilePath)] -> IO a -> IO a
 197 withEnvOverrides overrides m = do
 198   mb_olds <- traverse lookupEnv envVars
 199   traverse_ (uncurry setOrUnsetEnv) overrides
 200   m `Exception.finally` zipWithM_ setOrUnsetEnv envVars mb_olds
 201   where
 202     envVars :: [String]
 203     envVars = map fst overrides
 204
 205 setOrUnsetEnv :: String -> Maybe String -> IO ()
 206 setOrUnsetEnv var Nothing = unsetEnv var
 207 setOrUnsetEnv var (Just val) = setEnv var val
 208
 209 -- | Executes the action, increasing the PATH environment
 210 -- in some way
 211 --
 212 -- Warning: This operation is NOT thread-safe, because the
 213 -- environment variables are a process-global concept.
 214 withExtraPathEnv :: [FilePath] -> IO a -> IO a
 215 withExtraPathEnv paths m = do
 216   oldPathSplit <- getSearchPath
 217   let newPath :: String
 218       newPath = mungePath $ intercalate [searchPathSeparator] (paths ++ oldPathSplit)
 219       oldPath :: String
 220       oldPath = mungePath $ intercalate [searchPathSeparator] oldPathSplit
 221       -- TODO: This is a horrible hack to work around the fact that
 222       -- setEnv can't take empty values as an argument
 223       mungePath p
 224         | p == "" = "/dev/null"
 225         | otherwise = p
 226   setEnv "PATH" newPath
 227   m `Exception.finally` setEnv "PATH" oldPath
 228
 229 -- | Log directory change in 'make' compatible syntax
 230 logDirChange :: (String -> IO ()) -> Maybe FilePath -> IO a -> IO a
 231 logDirChange _ Nothing m = m
 232 logDirChange l (Just d) m = do
 233   l $ "cabal: Entering directory '" ++ d ++ "'\n"
 234   m
 235     `Exception.finally` l ("cabal: Leaving directory '" ++ d ++ "'\n")
 236
 237 -- The number of processors is not going to change during the duration of the
 238 -- program, so unsafePerformIO is safe here.
 239 numberOfProcessors :: Int
 240 numberOfProcessors = unsafePerformIO getNumProcessors
 241
 242 -- | Determine the number of jobs to use given the value of the '-j' flag.
 243 determineNumJobs :: Flag (Maybe Int) -> Int
 244 determineNumJobs numJobsFlag =
 245   case numJobsFlag of
 246     NoFlag -> 1
 247     Flag Nothing -> numberOfProcessors
 248     Flag (Just n) -> n
 249
 250 -- | Given a relative path, make it absolute relative to the current
 251 -- directory. Absolute paths are returned unmodified.
 252 makeAbsoluteToCwd :: FilePath -> IO FilePath
 253 makeAbsoluteToCwd path
 254   | isAbsolute path = return path
 255   | otherwise = do
 256       cwd <- Directory.getCurrentDirectory
 257       return $! cwd </> path
 258
 259 -- | Given a path (relative or absolute), make it relative to the current
 260 -- directory, including using @../..@ if necessary.
 261 makeRelativeToCwd :: FilePath -> IO FilePath
 262 makeRelativeToCwd path =
 263   makeRelativeCanonical <$> canonicalizePath path <*> Directory.getCurrentDirectory
 264
 265 -- | Given a path (relative or absolute), make it relative to the given
 266 -- directory, including using @../..@ if necessary.
 267 makeRelativeToDir :: FilePath -> FilePath -> IO FilePath
 268 makeRelativeToDir path dir =
 269   makeRelativeCanonical <$> canonicalizePath path <*> canonicalizePath dir
 270
 271 -- | makeRelativeToDir for SymbolicPath
 272 makeRelativeToDirS :: Maybe (SymbolicPath CWD (Dir dir)) -> SymbolicPath CWD to -> IO (SymbolicPath dir to)
 273 makeRelativeToDirS Nothing s = makeRelativeToDirS (Just sameDirectory) s
 274 makeRelativeToDirS (Just root) p =
 275   case symbolicPathRelative_maybe p of
 276     -- TODO: Use AbsolutePath
 277     Nothing -> return $ makeSymbolicPath (getSymbolicPath p)
 278     Just rel_path ->
 279       makeSymbolicPath <$> makeRelativeToDir (getSymbolicPath root) (getSymbolicPath rel_path)
 280
 281 -- | Given a canonical absolute path and canonical absolute dir, make the path
 282 -- relative to the directory, including using @../..@ if necessary. Returns
 283 -- the original absolute path if it is not on the same drive as the given dir.
 284 makeRelativeCanonical :: FilePath -> FilePath -> FilePath
 285 makeRelativeCanonical path dir
 286   | takeDrive path /= takeDrive dir = path
 287   | otherwise = go (splitPath path) (splitPath dir)
 288   where
 289     go (p : ps) (d : ds) | p' == d' = go ps ds
 290       where
 291         (p', d') = (dropTrailingPathSeparator p, dropTrailingPathSeparator d)
 292     go [] [] = "./"
 293     go ps ds = joinPath (replicate (length ds) ".." ++ ps)
 294
 295 -- | Convert a 'FilePath' to a lazy 'ByteString'. Each 'Char' is
 296 -- encoded as a little-endian 'Word32'.
 297 filePathToByteString :: FilePath -> BS.ByteString
 298 filePathToByteString p =
 299   BS.pack $ foldr conv [] codepts
 300   where
 301     codepts :: [Word32]
 302     codepts = map (fromIntegral . ord) p
 303
 304     conv :: Word32 -> [Word8] -> [Word8]
 305     conv w32 rest = b0 : b1 : b2 : b3 : rest
 306       where
 307         b0 = fromIntegral $ w32
 308         b1 = fromIntegral $ w32 `shiftR` 8
 309         b2 = fromIntegral $ w32 `shiftR` 16
 310         b3 = fromIntegral $ w32 `shiftR` 24
 311
 312 -- | Reverse operation to 'filePathToByteString'.
 313 byteStringToFilePath :: BS.ByteString -> FilePath
 314 byteStringToFilePath bs
 315   | bslen `mod` 4 /= 0 = unexpected
 316   | otherwise = go 0
 317   where
 318     unexpected = "Distribution.Client.Utils.byteStringToFilePath: unexpected"
 319     bslen = BS.length bs
 320
 321     go i
 322       | i == bslen = []
 323       | otherwise = (chr . fromIntegral $ w32) : go (i + 4)
 324       where
 325         w32 :: Word32
 326         w32 = b0 .|. (b1 `shiftL` 8) .|. (b2 `shiftL` 16) .|. (b3 `shiftL` 24)
 327         b0 = fromIntegral $ BS.index bs i
 328         b1 = fromIntegral $ BS.index bs (i + 1)
 329         b2 = fromIntegral $ BS.index bs (i + 2)
 330         b3 = fromIntegral $ BS.index bs (i + 3)
 331
 332 -- | Workaround for the inconsistent behaviour of 'canonicalizePath'. Always
 333 -- throws an error if the path refers to a non-existent file.
 334 {- FOURMOLU_DISABLE -}
 335 tryCanonicalizePath :: FilePath -> IO FilePath
 336 tryCanonicalizePath path = do
 337   ret <- canonicalizePath path
 338 #if defined(mingw32_HOST_OS) || MIN_VERSION_directory(1,2,3)
 339   exists <- liftM2 (||) (doesFileExist ret) (Dir.doesDirectoryExist ret)
 340   unless exists $
 341     IOError.ioError $ IOError.mkIOError IOError.doesNotExistErrorType "canonicalizePath"
 342                         Nothing (Just ret)
 343 #endif
 344   return ret
 345 {- FOURMOLU_ENABLE -}
 346
 347 -- | A non-throwing wrapper for 'canonicalizePath'. If 'canonicalizePath' throws
 348 -- an exception, returns the path argument unmodified.
 349 canonicalizePathNoThrow :: FilePath -> IO FilePath
 350 canonicalizePathNoThrow path = do
 351   canonicalizePath path `catchIO` (\_ -> return path)
 352
 353 --------------------
 354 -- Modification time
 355
 356 -- | Like Distribution.Simple.Utils.moreRecentFile, but uses getModTime instead
 357 -- of getModificationTime for higher precision. We can't merge the two because
 358 -- Distribution.Client.Time uses MIN_VERSION macros.
 359 moreRecentFile :: FilePath -> FilePath -> IO Bool
 360 moreRecentFile a b = do
 361   exists <- doesFileExist b
 362   if not exists
 363     then return True
 364     else do
 365       tb <- getModTime b
 366       ta <- getModTime a
 367       return (ta > tb)
 368
 369 -- | Like 'moreRecentFile', but also checks that the first file exists.
 370 existsAndIsMoreRecentThan :: FilePath -> FilePath -> IO Bool
 371 existsAndIsMoreRecentThan a b = do
 372   exists <- doesFileExist a
 373   if not exists
 374     then return False
 375     else a `moreRecentFile` b
 376
 377 -- | Sets the handler for encoding errors to one that transliterates invalid
 378 -- characters into one present in the encoding (i.e., \'?\').
 379 -- This is opposed to the default behavior, which is to throw an exception on
 380 -- error. This function will ignore file handles that have a Unicode encoding
 381 -- set. It's a no-op for versions of `base` less than 4.4.
 382 relaxEncodingErrors :: Handle -> IO ()
 383 relaxEncodingErrors handle = do
 384   maybeEncoding <- hGetEncoding handle
 385   case maybeEncoding of
 386     Just (TextEncoding name decoder encoder)
 387       | not ("UTF" `isPrefixOf` name) ->
 388           let relax x = x{recover = recoverEncode TransliterateCodingFailure}
 389            in hSetEncoding handle (TextEncoding name decoder (fmap relax encoder))
 390     _ ->
 391       return ()
 392
 393 -- | Like 'tryFindPackageDesc', but with error specific to add-source deps.
 394 tryReadAddSourcePackageDesc
 395   :: Verbosity
 396   -> FilePath
 397   -> String
 398   -> IO GenericPackageDescription
 399 tryReadAddSourcePackageDesc verbosity depPath err = do
 400   let pkgDir = makeSymbolicPath depPath
 401   pkgDescPath <-
 402     try_find_package_desc verbosity pkgDir $
 403       err
 404         ++ "\n"
 405         ++ "Failed to read cabal file of add-source dependency: "
 406         ++ depPath
 407   readGenericPackageDescription verbosity (Just pkgDir) (relativeSymbolicPath pkgDescPath)
 408
 409 -- | Try to read a @.cabal@ file, in directory @depPath@. Fails if one cannot be
 410 --  found, with @err@ prefixing the error message. This function simply allows
 411 --  us to give a more descriptive error than that provided by @findPackageDesc@.
 412 tryReadGenericPackageDesc
 413   :: Verbosity
 414   -> SymbolicPath CWD (Dir Pkg)
 415   -> String
 416   -> IO GenericPackageDescription
 417 tryReadGenericPackageDesc verbosity pkgDir err = do
 418   pkgDescPath <- try_find_package_desc verbosity pkgDir err
 419   readGenericPackageDescription verbosity (Just pkgDir) (relativeSymbolicPath pkgDescPath)
 420
 421 -- | Internal helper function for 'tryReadAddSourcePackageDesc' and 'tryReadGenericPackageDesc'.
 422 try_find_package_desc
 423   :: Verbosity
 424   -> SymbolicPath CWD (Dir Pkg)
 425   -> String
 426   -> IO (RelativePath Pkg File)
 427 try_find_package_desc verbosity pkgDir err = do
 428   errOrCabalFile <- findPackageDesc (Just pkgDir)
 429   case errOrCabalFile of
 430     Right file -> return file
 431     Left _ -> dieWithException verbosity $ TryFindPackageDescErr err
 432
 433 -- | Phase of building a dependency. Represents current status of package
 434 -- dependency processing. See #4040 for details.
 435 data ProgressPhase
 436   = ProgressDownloading
 437   | ProgressDownloaded
 438   | ProgressStarting
 439   | ProgressBuilding
 440   | ProgressHaddock
 441   | ProgressInstalling
 442   | ProgressCompleted
 443
 444 progressMessage :: Verbosity -> ProgressPhase -> String -> IO ()
 445 progressMessage verbosity phase subject = do
 446   noticeNoWrap verbosity $ phaseStr ++ subject ++ "\n"
 447   where
 448     phaseStr = case phase of
 449       ProgressDownloading ->
 450         "Downloading  "
 451       ProgressDownloaded ->
 452         "Downloaded   "
 453       ProgressStarting ->
 454         "Starting     "
 455       ProgressBuilding ->
 456         "Building     "
 457       ProgressHaddock ->
 458         "Haddock      "
 459       ProgressInstalling ->
 460         "Installing   "
 461       ProgressCompleted ->
 462         "Completed    "
 463
 464 -- | Given a version, return an API-compatible (according to PVP) version range.
 465 --
 466 -- If the boolean argument denotes whether to use a desugared
 467 -- representation (if 'True') or the new-style @^>=@-form (if
 468 -- 'False').
 469 --
 470 -- Example: @pvpize True (mkVersion [0,4,1])@ produces the version range @>= 0.4 && < 0.5@ (which is the
 471 -- same as @0.4.*@).
 472 pvpize :: Bool -> Version -> VersionRange
 473 pvpize False v = majorBoundVersion v
 474 pvpize True v =
 475   orLaterVersion v'
 476     `intersectVersionRanges` earlierVersion (incVersion 1 v')
 477   where
 478     v' = alterVersion (take 2) v
 479
 480 -- | Increment the nth version component (counting from 0).
 481 incVersion :: Int -> Version -> Version
 482 incVersion n = alterVersion (incVersion' n)
 483   where
 484     incVersion' 0 [] = [1]
 485     incVersion' 0 (v : _) = [v + 1]
 486     incVersion' m [] = replicate m 0 ++ [1]
 487     incVersion' m (v : vs) = v : incVersion' (m - 1) vs
 488
 489 -- | Returns the current calendar year.
 490 getCurrentYear :: IO Integer
 491 getCurrentYear = do
 492   u <- getCurrentTime
 493   z <- getCurrentTimeZone
 494   let l = utcToLocalTime z u
 495       (y, _, _) = toGregorian $ localDay l
 496   return y
 497
 498 -- | From System.Directory.Extra
 499 --   https://hackage.haskell.org/package/extra-1.7.9
 500 listFilesInside :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
 501 listFilesInside test dir = ifNotM (test $ dropTrailingPathSeparator dir) (pure []) $ do
 502   (dirs, files) <- partitionM doesDirectoryExist =<< listContents dir
 503   rest <- concatMapM (listFilesInside test) dirs
 504   pure $ files ++ rest
 505
 506 -- | From System.Directory.Extra
 507 --   https://hackage.haskell.org/package/extra-1.7.9
 508 listFilesRecursive :: FilePath -> IO [FilePath]
 509 listFilesRecursive = listFilesInside (const $ pure True)
 510
 511 -- | From System.Directory.Extra
 512 --   https://hackage.haskell.org/package/extra-1.7.9
 513 listContents :: FilePath -> IO [FilePath]
 514 listContents dir = do
 515   xs <- getDirectoryContents dir
 516   pure $ sort [dir </> x | x <- xs, not $ all (== '.') x]
 517
 518 -- | From Control.Monad.Extra
 519 --   https://hackage.haskell.org/package/extra-1.7.9
 520 ifM :: Monad m => m Bool -> m a -> m a -> m a
 521 ifM b t f = do b' <- b; if b' then t else f
 522
 523 -- | 'ifM' with swapped branches:
 524 --   @ifNotM b t f = ifM (not <$> b) t f@
 525 ifNotM :: Monad m => m Bool -> m a -> m a -> m a
 526 ifNotM = flip . ifM
 527
 528 -- | From Control.Monad.Extra
 529 --   https://hackage.haskell.org/package/extra-1.7.9
 530 concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
 531 {-# INLINE concatMapM #-}
 532 concatMapM op = foldr f (pure [])
 533   where
 534     f x xs = do x' <- op x; if null x' then xs else do { xs' <- xs; pure $ x' ++ xs' }
 535
 536 -- | From Control.Monad.Extra
 537 --   https://hackage.haskell.org/package/extra-1.7.9
 538 partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
 539 partitionM _ [] = pure ([], [])
 540 partitionM f (x : xs) = do
 541   res <- f x
 542   (as, bs) <- partitionM f xs
 543   pure ([x | res] ++ as, [x | not res] ++ bs)
 544
 545 safeRead :: Read a => String -> Maybe a
 546 safeRead s
 547   | [(x, "")] <- reads s = Just x
 548   | otherwise = Nothing
 549
 550 -- | @hasElem xs x = elem x xs@ except that @xs@ is turned into a 'Set' first.
 551 --   Use underapplied to speed up subsequent lookups, e.g. @filter (hasElem xs) ys@.
 552 --   Only amortized when used several times!
 553 --
 554 --   Time complexity \(O((n+m) \log(n))\) for \(m\) lookups in a list of length \(n\).
 555 --   (Compare this to 'elem''s \(O(nm)\).)
 556 --
 557 --   This is [Agda.Utils.List.hasElem](https://hackage.haskell.org/package/Agda-2.6.2.2/docs/Agda-Utils-List.html#v:hasElem).
 558 hasElem :: Ord a => [a] -> a -> Bool
 559 hasElem xs = (`Set.member` Set.fromList xs)
 560
 561 -- True if x occurs before y
 562 occursOnlyOrBefore :: Eq a => [a] -> a -> a -> Bool
 563 occursOnlyOrBefore xs x y = case (elemIndex x xs, elemIndex y xs) of
 564   (Just i, Just j) -> i < j
 565   (Just _, _) -> True
 566   _ -> False
 567
 568 giveRTSWarning :: String -> String
 569 giveRTSWarning "run" =
 570   "Your RTS options are applied to cabal, not the "
 571     ++ "executable. Use '--' to separate cabal options from your "
 572     ++ "executable options. For example, use 'cabal run -- +RTS -N "
 573     ++ "to pass the '-N' RTS option to your executable."
 574 giveRTSWarning "test" =
 575   "Some RTS options were found standalone, "
 576     ++ "which affect cabal and not the binary. "
 577     ++ "Please note that +RTS inside the --test-options argument "
 578     ++ "suffices if your goal is to affect the tested binary. "
 579     ++ "For example, use \"cabal test --test-options='+RTS -N'\" "
 580     ++ "to pass the '-N' RTS option to your binary."
 581 giveRTSWarning "bench" =
 582   "Some RTS options were found standalone, "
 583     ++ "which affect cabal and not the binary. Please note "
 584     ++ "that +RTS inside the --benchmark-options argument "
 585     ++ "suffices if your goal is to affect the benchmarked "
 586     ++ "binary. For example, use \"cabal test --benchmark-options="
 587     ++ "'+RTS -N'\" to pass the '-N' RTS option to your binary."
 588 giveRTSWarning _ =
 589   "Your RTS options are applied to cabal, not the "
 590     ++ "binary."