diff --git a/Cabal/Distribution/Compat/CopyFile.hs b/Cabal/Distribution/Compat/CopyFile.hs index 341975c7f60..449181c19b9 100644 --- a/Cabal/Distribution/Compat/CopyFile.hs +++ b/Cabal/Distribution/Compat/CopyFile.hs @@ -69,16 +69,16 @@ import System.IO import qualified System.Win32.File as Win32 ( copyFile ) #endif /* mingw32_HOST_OS */ -copyOrdinaryFile, copyExecutableFile :: FilePath -> FilePath -> NoCallStackIO () +copyOrdinaryFile, copyExecutableFile :: FilePath -> FilePath -> IO () copyOrdinaryFile src dest = copyFile src dest >> setFileOrdinary dest copyExecutableFile src dest = copyFile src dest >> setFileExecutable dest -setFileOrdinary, setFileExecutable, setDirOrdinary :: FilePath -> NoCallStackIO () +setFileOrdinary, setFileExecutable, setDirOrdinary :: FilePath -> IO () #ifndef mingw32_HOST_OS setFileOrdinary path = setFileMode path 0o644 -- file perms -rw-r--r-- setFileExecutable path = setFileMode path 0o755 -- file perms -rwxr-xr-x -setFileMode :: FilePath -> FileMode -> NoCallStackIO () +setFileMode :: FilePath -> FileMode -> IO () setFileMode name m = withFilePath name $ \s -> do throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m) @@ -91,7 +91,7 @@ setDirOrdinary = setFileExecutable -- | Copies a file to a new destination. -- Often you should use `copyFileChanged` instead. -copyFile :: FilePath -> FilePath -> NoCallStackIO () +copyFile :: FilePath -> FilePath -> IO () copyFile fromFPath toFPath = copy `catchIO` (\ioe -> throwIO (ioeSetLocation ioe "copyFile")) @@ -229,7 +229,7 @@ emptyToCurDir path = path -- | Like `copyFile`, but does not touch the target if source and destination -- are already byte-identical. This is recommended as it is useful for -- time-stamp based recompilation avoidance. -copyFileChanged :: FilePath -> FilePath -> NoCallStackIO () +copyFileChanged :: FilePath -> FilePath -> IO () copyFileChanged src dest = do equal <- filesEqual src dest unless equal $ copyFile src dest @@ -237,7 +237,7 @@ copyFileChanged src dest = do -- | Checks if two files are byte-identical. -- Returns False if either of the files do not exist or if files -- are of different size. -filesEqual :: FilePath -> FilePath -> NoCallStackIO Bool +filesEqual :: FilePath -> FilePath -> IO Bool filesEqual f1 f2 = do ex1 <- doesFileExist f1 ex2 <- doesFileExist f2 diff --git a/Cabal/Distribution/Compat/CreatePipe.hs b/Cabal/Distribution/Compat/CreatePipe.hs index b9e3267be36..e72e5ccc795 100644 --- a/Cabal/Distribution/Compat/CreatePipe.hs +++ b/Cabal/Distribution/Compat/CreatePipe.hs @@ -44,7 +44,7 @@ createPipe = do hSetEncoding writeh localeEncoding return (readh, writeh)) `onException` (close readfd >> close writefd) where - fdToHandle :: CInt -> IOMode -> NoCallStackIO Handle + fdToHandle :: CInt -> IOMode -> IO Handle fdToHandle fd mode = do (fd', deviceType) <- mkFD fd mode (Just (Stream, 0, 0)) False False mkHandleFromFD fd' deviceType "" mode False Nothing diff --git a/Cabal/Distribution/Compat/Environment.hs b/Cabal/Distribution/Compat/Environment.hs index 220d0228dce..2c9b4f0d993 100644 --- a/Cabal/Distribution/Compat/Environment.hs +++ b/Cabal/Distribution/Compat/Environment.hs @@ -38,7 +38,7 @@ import Foreign.C.Error (throwErrnoIfMinus1_) import System.Posix.Internals ( withFilePath ) #endif /* mingw32_HOST_OS */ -getEnvironment :: NoCallStackIO [(String, String)] +getEnvironment :: IO [(String, String)] #ifdef mingw32_HOST_OS -- On Windows, the names of environment variables are case-insensitive, but are -- often given in mixed-case (e.g. "PATH" is "Path"), so we have to normalise diff --git a/Cabal/Distribution/Compat/GetShortPathName.hs b/Cabal/Distribution/Compat/GetShortPathName.hs index eebad98f947..baf402c326b 100644 --- a/Cabal/Distribution/Compat/GetShortPathName.hs +++ b/Cabal/Distribution/Compat/GetShortPathName.hs @@ -40,7 +40,7 @@ foreign import WINAPI unsafe "windows.h GetShortPathNameW" -- will always return the required buffer size for a -- specified lpszLongPath. -- -getShortPathName :: FilePath -> NoCallStackIO FilePath +getShortPathName :: FilePath -> IO FilePath getShortPathName path = Win32.withTString path $ \c_path -> do c_len <- Win32.failIfZero "GetShortPathName #1 failed!" $ @@ -53,7 +53,7 @@ getShortPathName path = #else -getShortPathName :: FilePath -> NoCallStackIO FilePath +getShortPathName :: FilePath -> IO FilePath getShortPathName path = return path #endif diff --git a/Cabal/Distribution/Compat/Prelude.hs b/Cabal/Distribution/Compat/Prelude.hs index 0cca7db309a..d13db626706 100644 --- a/Cabal/Distribution/Compat/Prelude.hs +++ b/Cabal/Distribution/Compat/Prelude.hs @@ -44,7 +44,6 @@ module Distribution.Compat.Prelude ( IsString (..), -- * Some types - IO, NoCallStackIO, Map, Set, Identity (..), @@ -106,7 +105,7 @@ module Distribution.Compat.Prelude ( ) where -- We also could hide few partial function import Prelude as BasePrelude hiding - ( IO, mapM, mapM_, sequence, null, length, foldr, any, all, head, tail, last, init + ( mapM, mapM_, sequence, null, length, foldr, any, all, head, tail, last, init -- partial functions , read , foldr1, foldl1 @@ -165,14 +164,8 @@ import Text.Read (readMaybe) import qualified Text.PrettyPrint as Disp -import qualified Prelude as OrigPrelude -import Distribution.Compat.Stack - import Distribution.Utils.Structured (Structured) -type IO a = WithCallStack (OrigPrelude.IO a) -type NoCallStackIO a = OrigPrelude.IO a - -- | New name for 'Text.PrettyPrint.<>' (<<>>) :: Disp.Doc -> Disp.Doc -> Disp.Doc (<<>>) = (Disp.<>) diff --git a/Cabal/Distribution/Compat/Time.hs b/Cabal/Distribution/Compat/Time.hs index 53645de6efb..ef73b4fc8a1 100644 --- a/Cabal/Distribution/Compat/Time.hs +++ b/Cabal/Distribution/Compat/Time.hs @@ -72,7 +72,7 @@ instance Read ModTime where -- -- This is a modified version of the code originally written for Shake by Neil -- Mitchell. See module Development.Shake.FileInfo. -getModTime :: FilePath -> NoCallStackIO ModTime +getModTime :: FilePath -> IO ModTime #if defined mingw32_HOST_OS @@ -110,7 +110,7 @@ getModTime path = allocaBytes size_WIN32_FILE_ATTRIBUTE_DATA $ \info -> do foreign import CALLCONV "windows.h GetFileAttributesExW" c_getFileAttributesEx :: LPCTSTR -> Int32 -> LPVOID -> Prelude.IO BOOL -getFileAttributesEx :: String -> LPVOID -> NoCallStackIO BOOL +getFileAttributesEx :: String -> LPVOID -> IO BOOL getFileAttributesEx path lpFileInformation = withTString path $ \c_path -> c_getFileAttributesEx c_path getFileExInfoStandard lpFileInformation @@ -154,14 +154,14 @@ posixTimeToModTime p = ModTime $ (ceiling $ p * 1e7) -- 100 ns precision + (secToUnixEpoch * windowsTick) -- | Return age of given file in days. -getFileAge :: FilePath -> NoCallStackIO Double +getFileAge :: FilePath -> IO Double getFileAge file = do t0 <- getModificationTime file t1 <- getCurrentTime return $ realToFrac (t1 `diffUTCTime` t0) / realToFrac posixDayLength -- | Return the current time as 'ModTime'. -getCurTime :: NoCallStackIO ModTime +getCurTime :: IO ModTime getCurTime = posixTimeToModTime `fmap` getPOSIXTime -- Uses 'gettimeofday'. -- | Based on code written by Neil Mitchell for Shake. See diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs index 25f65224a1a..ea87359b392 100644 --- a/Cabal/Distribution/PackageDescription/Check.hs +++ b/Cabal/Distribution/PackageDescription/Check.hs @@ -1886,7 +1886,7 @@ checkDevelopmentOnlyFlags pkg = -- | Sanity check things that requires IO. It looks at the files in the -- package and expects to find the package unpacked in at the given file path. -- -checkPackageFiles :: Verbosity -> PackageDescription -> FilePath -> NoCallStackIO [PackageCheck] +checkPackageFiles :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck] checkPackageFiles verbosity pkg root = do contentChecks <- checkPackageContent checkFilesIO pkg preDistributionChecks <- checkPackageFilesPreDistribution verbosity pkg root @@ -2202,7 +2202,7 @@ checkTarPath path -- check these on the server; these checks only make sense in the development -- and package-creation environment. Hence we can use IO, rather than needing -- to pass a 'CheckPackageContentOps' dictionary around. -checkPackageFilesPreDistribution :: Verbosity -> PackageDescription -> FilePath -> NoCallStackIO [PackageCheck] +checkPackageFilesPreDistribution :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck] -- Note: this really shouldn't return any 'Inexcusable' warnings, -- because that will make us say that Hackage would reject the package. -- But, because Hackage doesn't run these tests, that will be a lie! @@ -2212,7 +2212,7 @@ checkPackageFilesPreDistribution = checkGlobFiles checkGlobFiles :: Verbosity -> PackageDescription -> FilePath - -> NoCallStackIO [PackageCheck] + -> IO [PackageCheck] checkGlobFiles verbosity pkg root = fmap concat $ for allGlobs $ \(field, dir, glob) -> -- Note: we just skip over parse errors here; they're reported elsewhere. diff --git a/Cabal/Distribution/PackageDescription/PrettyPrint.hs b/Cabal/Distribution/PackageDescription/PrettyPrint.hs index aed448bcbaa..e7b1f9b687f 100644 --- a/Cabal/Distribution/PackageDescription/PrettyPrint.hs +++ b/Cabal/Distribution/PackageDescription/PrettyPrint.hs @@ -57,7 +57,7 @@ import Text.PrettyPrint (Doc, char, hsep, parens, text, (<+>)) import qualified Data.ByteString.Lazy.Char8 as BS.Char8 -- | Writes a .cabal file from a generic package description -writeGenericPackageDescription :: FilePath -> GenericPackageDescription -> NoCallStackIO () +writeGenericPackageDescription :: FilePath -> GenericPackageDescription -> IO () writeGenericPackageDescription fpath pkg = writeUTF8File fpath (showGenericPackageDescription pkg) -- | Writes a generic package description to a string @@ -192,7 +192,7 @@ ppIfCondition :: Condition ConfVar -> [PrettyField ()] -> PrettyField () ppIfCondition c = PrettySection () "if" [ppCondition c] -- | @since 2.0.0.2 -writePackageDescription :: FilePath -> PackageDescription -> NoCallStackIO () +writePackageDescription :: FilePath -> PackageDescription -> IO () writePackageDescription fpath pkg = writeUTF8File fpath (showPackageDescription pkg) --TODO: make this use section syntax @@ -225,7 +225,7 @@ pdToGpd pd = GenericPackageDescription mkCondTree' f x = (f x, CondNode x [] []) -- | @since 2.0.0.2 -writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> NoCallStackIO () +writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> IO () writeHookedBuildInfo fpath = writeFileAtomic fpath . BS.Char8.pack . showHookedBuildInfo diff --git a/Cabal/Distribution/PackageDescription/Quirks.hs b/Cabal/Distribution/PackageDescription/Quirks.hs index de9e5b8abfe..a546c190de1 100644 --- a/Cabal/Distribution/PackageDescription/Quirks.hs +++ b/Cabal/Distribution/PackageDescription/Quirks.hs @@ -256,7 +256,7 @@ patches = Map.fromList mk a b c d = ((a, b), (c, d)) -- | Helper to create entries in patches -_makePatchKey :: FilePath -> (BS.ByteString -> BS.ByteString) -> NoCallStackIO () +_makePatchKey :: FilePath -> (BS.ByteString -> BS.ByteString) -> IO () _makePatchKey fp transform = do contents <- BS.readFile fp let output = transform contents diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs index d6e221f323d..22c775fc6f7 100644 --- a/Cabal/Distribution/Simple.hs +++ b/Cabal/Distribution/Simple.hs @@ -606,7 +606,7 @@ clean pkg_descr flags = do traverse_ (writePersistBuildConfig distPref) maybeConfig where - removeFileOrDirectory :: FilePath -> NoCallStackIO () + removeFileOrDirectory :: FilePath -> IO () removeFileOrDirectory fname = do isDir <- doesDirectoryExist fname isFile <- doesFileExist fname @@ -740,11 +740,13 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do let configureFile' = intercalate "/" $ splitDirectories configureFile for_ badAutoconfCharacters $ \(c, cname) -> when (c `elem` dropDrive configureFile') $ - warn verbosity $ - "The path to the './configure' script, '" ++ configureFile' - ++ "', contains the character '" ++ [c] ++ "' (" ++ cname ++ ")." - ++ " This may cause the script to fail with an obscure error, or for" - ++ " building the package to fail later." + warn verbosity $ concat + [ "The path to the './configure' script, '", configureFile' + , "', contains the character '", [c], "' (", cname, ")." + , " This may cause the script to fail with an obscure error, or for" + , " building the package to fail later." + ] + let extraPath = fromNubList $ configProgramPathExtra flags let cflagsEnv = maybe (unwords ccFlags) (++ (" " ++ unwords ccFlags)) $ lookup "CFLAGS" env @@ -766,40 +768,40 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do (programInvocation (sh {programOverrideEnv = overEnv}) args') { progInvokeCwd = Just (buildDir lbi) } Nothing -> die' verbosity notFoundMsg - where args = configureArgs backwardsCompatHack flags - badAutoconfCharacters = - [ (' ', "space") - , ('\t', "tab") - , ('\n', "newline") - , ('\0', "null") - , ('"', "double quote") - , ('#', "hash") - , ('$', "dollar sign") - , ('&', "ampersand") - , ('\'', "single quote") - , ('(', "left bracket") - , (')', "right bracket") - , ('*', "star") - , (';', "semicolon") - , ('<', "less-than sign") - , ('=', "equals sign") - , ('>', "greater-than sign") - , ('?', "question mark") - , ('[', "left square bracket") - , ('\\', "backslash") - , ('`', "backtick") - , ('|', "pipe") - ] - notFoundMsg = "The package has a './configure' script. " ++ "If you are on Windows, This requires a " ++ "Unix compatibility toolchain such as MinGW+MSYS or Cygwin. " ++ "If you are not on Windows, ensure that an 'sh' command " ++ "is discoverable in your path." +badAutoconfCharacters :: [(Char, String)] +badAutoconfCharacters = + [ (' ', "space") + , ('\t', "tab") + , ('\n', "newline") + , ('\0', "null") + , ('"', "double quote") + , ('#', "hash") + , ('$', "dollar sign") + , ('&', "ampersand") + , ('\'', "single quote") + , ('(', "left bracket") + , (')', "right bracket") + , ('*', "star") + , (';', "semicolon") + , ('<', "less-than sign") + , ('=', "equals sign") + , ('>', "greater-than sign") + , ('?', "question mark") + , ('[', "left square bracket") + , ('\\', "backslash") + , ('`', "backtick") + , ('|', "pipe") + ] + getHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo getHookedBuildInfo verbosity build_dir = do maybe_infoFile <- findHookedPackageDesc verbosity build_dir diff --git a/Cabal/Distribution/Simple/BuildTarget.hs b/Cabal/Distribution/Simple/BuildTarget.hs index 0b97bdbbb0d..0f0c81085ee 100644 --- a/Cabal/Distribution/Simple/BuildTarget.hs +++ b/Cabal/Distribution/Simple/BuildTarget.hs @@ -154,7 +154,7 @@ readBuildTargets verbosity pkg targetStrs = do return btargets -checkTargetExistsAsFile :: UserBuildTarget -> NoCallStackIO (UserBuildTarget, Bool) +checkTargetExistsAsFile :: UserBuildTarget -> IO (UserBuildTarget, Bool) checkTargetExistsAsFile t = do fexists <- existsAsFile (fileComponentOfTarget t) return (t, fexists) diff --git a/Cabal/Distribution/Simple/Compiler.hs b/Cabal/Distribution/Simple/Compiler.hs index fd0e05af8bd..03e6b1e25cc 100644 --- a/Cabal/Distribution/Simple/Compiler.hs +++ b/Cabal/Distribution/Simple/Compiler.hs @@ -206,10 +206,10 @@ registrationPackageDB dbs = case safeLast dbs of -- | Make package paths absolute -absolutePackageDBPaths :: PackageDBStack -> NoCallStackIO PackageDBStack +absolutePackageDBPaths :: PackageDBStack -> IO PackageDBStack absolutePackageDBPaths = traverse absolutePackageDBPath -absolutePackageDBPath :: PackageDB -> NoCallStackIO PackageDB +absolutePackageDBPath :: PackageDB -> IO PackageDB absolutePackageDBPath GlobalPackageDB = return GlobalPackageDB absolutePackageDBPath UserPackageDB = return UserPackageDB absolutePackageDBPath (SpecificPackageDB db) = diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index af74f13c02b..8abdc6485b2 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -253,7 +253,7 @@ maybeGetPersistBuildConfig = -- 'localBuildInfoFile'. writePersistBuildConfig :: FilePath -- ^ The @dist@ directory path. -> LocalBuildInfo -- ^ The 'LocalBuildInfo' to write. - -> NoCallStackIO () + -> IO () writePersistBuildConfig distPref lbi = do createDirectoryIfMissing False distPref writeFileAtomic (localBuildInfoFile distPref) $ @@ -298,7 +298,7 @@ showHeader pkgId = BLC8.unwords -- | Check that localBuildInfoFile is up-to-date with respect to the -- .cabal file. -checkPersistBuildConfigOutdated :: FilePath -> FilePath -> NoCallStackIO Bool +checkPersistBuildConfigOutdated :: FilePath -> FilePath -> IO Bool checkPersistBuildConfigOutdated distPref pkg_descr_file = pkg_descr_file `moreRecentFile` localBuildInfoFile distPref @@ -316,7 +316,7 @@ localBuildInfoFile distPref = distPref "setup-config" -- \"CABAL_BUILDDIR\" environment variable, or the default prefix. findDistPref :: FilePath -- ^ default \"dist\" prefix -> Setup.Flag FilePath -- ^ override \"dist\" prefix - -> NoCallStackIO FilePath + -> IO FilePath findDistPref defDistPref overrideDistPref = do envDistPref <- liftM parseEnvDistPref (lookupEnv "CABAL_BUILDDIR") return $ fromFlagOrDefault defDistPref (mappend envDistPref overrideDistPref) @@ -333,7 +333,7 @@ findDistPref defDistPref overrideDistPref = do -- set. (The @*DistPref@ flags are always set to a definite value before -- invoking 'UserHooks'.) findDistPrefOrDefault :: Setup.Flag FilePath -- ^ override \"dist\" prefix - -> NoCallStackIO FilePath + -> IO FilePath findDistPrefOrDefault = findDistPref defaultDistPref -- |Perform the \"@.\/setup configure@\" action. @@ -1660,7 +1660,7 @@ configurePkgconfigPackages verbosity pkg_descr progdb enabled addPkgConfigBIBench = addPkgConfigBI benchmarkBuildInfo $ \bench bi -> bench { benchmarkBuildInfo = bi } - pkgconfigBuildInfo :: [PkgconfigDependency] -> NoCallStackIO BuildInfo + pkgconfigBuildInfo :: [PkgconfigDependency] -> IO BuildInfo pkgconfigBuildInfo [] = return mempty pkgconfigBuildInfo pkgdeps = do let pkgs = nub [ prettyShow pkg | PkgconfigDependency pkg _ <- pkgdeps ] diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index abad0b2bb52..4bb31148d5b 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -385,7 +385,7 @@ getGlobalPackageDB verbosity ghcProg = -- | Return the 'FilePath' to the per-user GHC package database. getUserPackageDB - :: Verbosity -> ConfiguredProgram -> Platform -> NoCallStackIO FilePath + :: Verbosity -> ConfiguredProgram -> Platform -> IO FilePath getUserPackageDB _verbosity ghcProg platform = do -- It's rather annoying that we have to reconstruct this, because ghc -- hides this information from us otherwise. But for certain use cases @@ -1684,7 +1684,7 @@ extractRtsInfo lbi = -- | Returns True if the modification date of the given source file is newer than -- the object file we last compiled for it, or if no object file exists yet. -checkNeedsRecompilation :: FilePath -> GhcOptions -> NoCallStackIO Bool +checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool checkNeedsRecompilation filename opts = filename `moreRecentFile` oname where oname = getObjectFileName filename opts @@ -1700,7 +1700,7 @@ getObjectFileName filename opts = oname -- Calculates relative RPATHs when 'relocatable' is set. getRPaths :: LocalBuildInfo -> ComponentLocalBuildInfo -- ^ Component we are building - -> NoCallStackIO (NubListR FilePath) + -> IO (NubListR FilePath) getRPaths lbi clbi | supportRPaths hostOS = do libraryPaths <- depLibraryPaths False (relocatable lbi) lbi clbi let hostPref = case hostOS of diff --git a/Cabal/Distribution/Simple/GHC/Internal.hs b/Cabal/Distribution/Simple/GHC/Internal.hs index aa1b791a67f..243524ce246 100644 --- a/Cabal/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/Distribution/Simple/GHC/Internal.hs @@ -176,7 +176,7 @@ configureToolchain _implInfo ghcProg ghcInfo = | (flags', ""):_ <- reads flags -> flags' | otherwise -> tokenizeQuotedWords flags - configureGcc :: Verbosity -> ConfiguredProgram -> NoCallStackIO ConfiguredProgram + configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram configureGcc _v gccProg = do return gccProg { programDefaultArgs = programDefaultArgs gccProg @@ -216,7 +216,7 @@ configureToolchain _implInfo ghcProg ghcInfo = else return ldProg getLanguages :: Verbosity -> GhcImplInfo -> ConfiguredProgram - -> NoCallStackIO [(Language, String)] + -> IO [(Language, String)] getLanguages _ implInfo _ -- TODO: should be using --supported-languages rather than hard coding | supportsHaskell2010 implInfo = return [(Haskell98, "-XHaskell98") @@ -507,7 +507,7 @@ ghcLookupProperty prop comp = -- Module_split directory for each module. getHaskellObjects :: GhcImplInfo -> Library -> LocalBuildInfo -> ComponentLocalBuildInfo - -> FilePath -> String -> Bool -> NoCallStackIO [FilePath] + -> FilePath -> String -> Bool -> IO [FilePath] getHaskellObjects _implInfo lib lbi clbi pref wanted_obj_ext allow_split_objs | splitObjs lbi && allow_split_objs = do let splitSuffix = "_" ++ wanted_obj_ext ++ "_split" @@ -563,7 +563,7 @@ checkPackageDbEnvVar verbosity compilerName packagePathEnvVar = do mcsPP <- lookupEnv "CABAL_SANDBOX_PACKAGE_PATH" unless (mPP == mcsPP) abort where - lookupEnv :: String -> NoCallStackIO (Maybe String) + lookupEnv :: String -> IO (Maybe String) lookupEnv name = (Just `fmap` getEnv name) `catchIO` const (return Nothing) abort = @@ -652,7 +652,7 @@ writeGhcEnvironmentFile :: FilePath -- ^ directory in which to put it -> Platform -- ^ the GHC target platform -> Version -- ^ the GHC version -> [GhcEnvironmentFileEntry] -- ^ the content - -> NoCallStackIO FilePath + -> IO FilePath writeGhcEnvironmentFile directory platform ghcversion entries = do writeFileAtomic envfile . BS.pack . renderGhcEnvironmentFile $ entries return envfile diff --git a/Cabal/Distribution/Simple/GHCJS.hs b/Cabal/Distribution/Simple/GHCJS.hs index 4ad5bb18cf0..6a6e9fb2408 100644 --- a/Cabal/Distribution/Simple/GHCJS.hs +++ b/Cabal/Distribution/Simple/GHCJS.hs @@ -296,7 +296,7 @@ getGlobalPackageDB verbosity ghcProg = getProgramOutput verbosity ghcProg ["--print-global-package-db"] -- | Return the 'FilePath' to the per-user GHC package database. -getUserPackageDB :: Verbosity -> ConfiguredProgram -> Platform -> NoCallStackIO FilePath +getUserPackageDB :: Verbosity -> ConfiguredProgram -> Platform -> IO FilePath getUserPackageDB _verbosity ghcjsProg platform = do -- It's rather annoying that we have to reconstruct this, because ghc -- hides this information from us otherwise. But for certain use cases @@ -1464,7 +1464,7 @@ extractRtsInfo lbi = -- | Returns True if the modification date of the given source file is newer than -- the object file we last compiled for it, or if no object file exists yet. -checkNeedsRecompilation :: FilePath -> GhcOptions -> NoCallStackIO Bool +checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool checkNeedsRecompilation filename opts = filename `moreRecentFile` oname where oname = getObjectFileName filename opts @@ -1480,7 +1480,7 @@ getObjectFileName filename opts = oname -- Calculates relative RPATHs when 'relocatable' is set. getRPaths :: LocalBuildInfo -> ComponentLocalBuildInfo -- ^ Component we are building - -> NoCallStackIO (NubListR FilePath) + -> IO (NubListR FilePath) getRPaths lbi clbi | supportRPaths hostOS = do libraryPaths <- depLibraryPaths False (relocatable lbi) lbi clbi let hostPref = case hostOS of diff --git a/Cabal/Distribution/Simple/Haddock.hs b/Cabal/Distribution/Simple/Haddock.hs index 41040e21f3b..7ad7d41c2e8 100644 --- a/Cabal/Distribution/Simple/Haddock.hs +++ b/Cabal/Distribution/Simple/Haddock.hs @@ -702,7 +702,7 @@ renderPureArgs version comp platform args = concat -- HTML paths, and an optional warning for packages with missing documentation. haddockPackagePaths :: [InstalledPackageInfo] -> Maybe (InstalledPackageInfo -> FilePath) - -> NoCallStackIO ([( FilePath -- path to interface + -> IO ([( FilePath -- path to interface -- file , Maybe FilePath -- url to html diff --git a/Cabal/Distribution/Simple/InstallDirs.hs b/Cabal/Distribution/Simple/InstallDirs.hs index da405c6d750..739b87d58c9 100644 --- a/Cabal/Distribution/Simple/InstallDirs.hs +++ b/Cabal/Distribution/Simple/InstallDirs.hs @@ -465,7 +465,7 @@ instance Read PathTemplate where -- --------------------------------------------------------------------------- -- Internal utilities -getWindowsProgramFilesDir :: NoCallStackIO FilePath +getWindowsProgramFilesDir :: IO FilePath getWindowsProgramFilesDir = do #ifdef mingw32_HOST_OS m <- shGetFolderPath csidl_PROGRAM_FILES @@ -475,7 +475,7 @@ getWindowsProgramFilesDir = do return (fromMaybe "C:\\Program Files" m) #ifdef mingw32_HOST_OS -shGetFolderPath :: CInt -> NoCallStackIO (Maybe FilePath) +shGetFolderPath :: CInt -> IO (Maybe FilePath) shGetFolderPath n = allocaArray long_path_size $ \pPath -> do r <- c_SHGetFolderPath nullPtr n nullPtr 0 pPath diff --git a/Cabal/Distribution/Simple/LocalBuildInfo.hs b/Cabal/Distribution/Simple/LocalBuildInfo.hs index 9cc88e51140..992b5eba74f 100644 --- a/Cabal/Distribution/Simple/LocalBuildInfo.hs +++ b/Cabal/Distribution/Simple/LocalBuildInfo.hs @@ -190,7 +190,7 @@ depLibraryPaths :: Bool -- ^ Building for inplace? -> Bool -- ^ Generate prefix-relative library paths -> LocalBuildInfo -> ComponentLocalBuildInfo -- ^ Component that is being built - -> NoCallStackIO [FilePath] + -> IO [FilePath] depLibraryPaths inplace relative lbi clbi = do let pkgDescr = localPkgDescr lbi installDirs = absoluteComponentInstallDirs pkgDescr lbi (componentUnitId clbi) NoCopyDest diff --git a/Cabal/Distribution/Simple/Program/Find.hs b/Cabal/Distribution/Simple/Program/Find.hs index e3ab562e689..1e8497e1e1a 100644 --- a/Cabal/Distribution/Simple/Program/Find.hs +++ b/Cabal/Distribution/Simple/Program/Find.hs @@ -97,7 +97,7 @@ findProgramOnSearchPath verbosity searchpath prog = do where alltried = concat (reverse (notfoundat : tried)) - tryPathElem :: ProgramSearchPathEntry -> NoCallStackIO (Maybe FilePath, [FilePath]) + tryPathElem :: ProgramSearchPathEntry -> IO (Maybe FilePath, [FilePath]) tryPathElem (ProgramSearchPathDir dir) = findFirstExe [ dir prog <.> ext | ext <- exeExtensions ] @@ -122,7 +122,7 @@ findProgramOnSearchPath verbosity searchpath prog = do dirs <- getSystemSearchPath findFirstExe [ dir prog <.> ext | dir <- dirs, ext <- exeExtensions ] - findFirstExe :: [FilePath] -> NoCallStackIO (Maybe FilePath, [FilePath]) + findFirstExe :: [FilePath] -> IO (Maybe FilePath, [FilePath]) findFirstExe = go [] where go fs' [] = return (Nothing, reverse fs') @@ -144,7 +144,7 @@ findProgramOnSearchPath verbosity searchpath prog = do -- | Interpret a 'ProgramSearchPath' to construct a new @$PATH@ env var. -- Note that this is close but not perfect because on Windows the search -- algorithm looks at more than just the @%PATH%@. -programSearchPathAsPATHVar :: ProgramSearchPath -> NoCallStackIO String +programSearchPathAsPATHVar :: ProgramSearchPath -> IO String programSearchPathAsPATHVar searchpath = do ess <- traverse getEntries searchpath return (intercalate [searchPathSeparator] (concat ess)) @@ -157,7 +157,7 @@ programSearchPathAsPATHVar searchpath = do -- | Get the system search path. On Unix systems this is just the @$PATH@ env -- var, but on windows it's a bit more complicated. -- -getSystemSearchPath :: NoCallStackIO [FilePath] +getSystemSearchPath :: IO [FilePath] getSystemSearchPath = fmap nub $ do #if defined(mingw32_HOST_OS) processdir <- takeDirectory `fmap` Win32.getModuleFileName Win32.nullHANDLE @@ -179,7 +179,7 @@ getSystemSearchPath = fmap nub $ do #endif #endif -findExecutable :: FilePath -> NoCallStackIO (Maybe FilePath) +findExecutable :: FilePath -> IO (Maybe FilePath) #ifdef HAVE_directory_121 findExecutable = Directory.findExecutable #else diff --git a/Cabal/Distribution/Simple/Program/Run.hs b/Cabal/Distribution/Simple/Program/Run.hs index df07db0d386..ce782f098e5 100644 --- a/Cabal/Distribution/Simple/Program/Run.hs +++ b/Cabal/Distribution/Simple/Program/Run.hs @@ -198,7 +198,7 @@ getProgramInvocationIODataAndErrors where input = encodeToIOData encoding <$> minputStr -getExtraPathEnv :: [(String, Maybe String)] -> [FilePath] -> NoCallStackIO [(String, Maybe String)] +getExtraPathEnv :: [(String, Maybe String)] -> [FilePath] -> IO [(String, Maybe String)] getExtraPathEnv _ [] = return [] getExtraPathEnv env extras = do mb_path <- case lookup "PATH" env of @@ -215,7 +215,7 @@ getExtraPathEnv env extras = do -- precedence. -- getEffectiveEnvironment :: [(String, Maybe String)] - -> NoCallStackIO (Maybe [(String, String)]) + -> IO (Maybe [(String, String)]) getEffectiveEnvironment [] = return Nothing getEffectiveEnvironment overrides = fmap (Just . Map.toList . apply overrides . Map.fromList) getEnvironment diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index 2c0bf61ac9e..ea6237d3445 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -300,7 +300,7 @@ createPackageDB verbosity comp progdb preferCompat dbPath = "Distribution.Simple.Register.createPackageDB: " ++ "not implemented for this compiler" -doesPackageDBExist :: FilePath -> NoCallStackIO Bool +doesPackageDBExist :: FilePath -> IO Bool doesPackageDBExist dbPath = do -- currently one impl for all compiler flavours, but could change if needed dir_exists <- doesDirectoryExist dbPath @@ -308,7 +308,7 @@ doesPackageDBExist dbPath = do then return True else doesFileExist dbPath -deletePackageDB :: FilePath -> NoCallStackIO () +deletePackageDB :: FilePath -> IO () deletePackageDB dbPath = do -- currently one impl for all compiler flavours, but could change if needed dir_exists <- doesDirectoryExist dbPath diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index d971600494b..c047b9aaa16 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -348,7 +348,7 @@ instance Eq ConfigFlags where where equal f = on (==) f a b -configAbsolutePaths :: ConfigFlags -> NoCallStackIO ConfigFlags +configAbsolutePaths :: ConfigFlags -> IO ConfigFlags configAbsolutePaths f = (\v -> f { configPackageDBs = v }) `liftM` traverse (maybe (return Nothing) (liftM Just . absolutePackageDBPath)) diff --git a/Cabal/Distribution/Simple/SrcDist.hs b/Cabal/Distribution/Simple/SrcDist.hs index 6bc637df670..dbdf62424be 100644 --- a/Cabal/Distribution/Simple/SrcDist.hs +++ b/Cabal/Distribution/Simple/SrcDist.hs @@ -278,7 +278,7 @@ prepareTree verbosity pkg_descr0 mb_lbi targetDir pps = do pkg_descr = filterAutogenModules pkg_descr0 -- | Find the setup script file, if it exists. -findSetupFile :: FilePath -> NoCallStackIO (Maybe FilePath) +findSetupFile :: FilePath -> IO (Maybe FilePath) findSetupFile targetDir = do hsExists <- doesFileExist setupHs lhsExists <- doesFileExist setupLhs @@ -292,7 +292,7 @@ findSetupFile targetDir = do setupLhs = targetDir "Setup.lhs" -- | Create a default setup script in the target directory, if it doesn't exist. -maybeCreateDefaultSetupScript :: FilePath -> NoCallStackIO () +maybeCreateDefaultSetupScript :: FilePath -> IO () maybeCreateDefaultSetupScript targetDir = do mSetupFile <- findSetupFile targetDir case mSetupFile of diff --git a/Cabal/Distribution/Simple/Test/LibV09.hs b/Cabal/Distribution/Simple/Test/LibV09.hs index 35dc367c85e..cd9d0dc19c3 100644 --- a/Cabal/Distribution/Simple/Test/LibV09.hs +++ b/Cabal/Distribution/Simple/Test/LibV09.hs @@ -203,7 +203,7 @@ writeSimpleTestStub :: PD.TestSuite -- ^ library 'TestSuite' for which a stub -- is being created -> FilePath -- ^ path to directory where stub source -- should be located - -> NoCallStackIO () + -> IO () writeSimpleTestStub t dir = do createDirectoryIfMissing True dir let filename = dir stubFilePath t @@ -233,7 +233,7 @@ stubMain tests = do setCurrentDirectory dir stubWriteLog f n results where - errHandler :: CE.SomeException -> NoCallStackIO TestLogs + errHandler :: CE.SomeException -> IO TestLogs errHandler e = case CE.fromException e of Just CE.UserInterrupt -> CE.throwIO e _ -> return $ TestLog { testName = "Cabal test suite exception", @@ -274,7 +274,7 @@ stubRunTests tests = do -- | From a test stub, write the 'TestSuiteLog' to temporary file for the calling -- Cabal process to read. -stubWriteLog :: FilePath -> UnqualComponentName -> TestLogs -> NoCallStackIO () +stubWriteLog :: FilePath -> UnqualComponentName -> TestLogs -> IO () stubWriteLog f n logs = do let testLog = TestSuiteLog { testSuiteName = n, testLogs = logs, logFile = f } writeFile (logFile testLog) $ show testLog diff --git a/Cabal/Distribution/Simple/UHC.hs b/Cabal/Distribution/Simple/UHC.hs index 903458adb86..b155b4816cf 100644 --- a/Cabal/Distribution/Simple/UHC.hs +++ b/Cabal/Distribution/Simple/UHC.hs @@ -122,7 +122,7 @@ getGlobalPackageDir verbosity progdb = do where trimEnd = reverse . dropWhile isSpace . reverse -getUserPackageDir :: NoCallStackIO FilePath +getUserPackageDir :: IO FilePath getUserPackageDir = do homeDir <- getHomeDirectory return $ homeDir ".cabal" "lib" -- TODO: determine in some other way @@ -151,7 +151,7 @@ installedPkgConfig = "installed-pkg-config" -- | Check if a certain dir contains a valid package. Currently, we are -- looking only for the presence of an installed package configuration. -- TODO: Actually make use of the information provided in the file. -isPkgDir :: String -> String -> String -> NoCallStackIO Bool +isPkgDir :: String -> String -> String -> IO Bool isPkgDir _ _ ('.' : _) = return False -- ignore files starting with a . isPkgDir c dir xs = do let candidate = dir uhcPackageDir xs c diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs index ccc35f5a997..d6e8384f11a 100644 --- a/Cabal/Distribution/Simple/Utils.hs +++ b/Cabal/Distribution/Simple/Utils.hs @@ -382,15 +382,15 @@ topHandlerWith cont prog = do ] where -- Let async exceptions rise to the top for the default top-handler - rethrowAsyncExceptions :: Exception.AsyncException -> NoCallStackIO a + rethrowAsyncExceptions :: Exception.AsyncException -> IO a rethrowAsyncExceptions a = throwIO a -- ExitCode gets thrown asynchronously too, and we don't want to print it - rethrowExitStatus :: ExitCode -> NoCallStackIO a + rethrowExitStatus :: ExitCode -> IO a rethrowExitStatus = throwIO -- Print all other exceptions - handle :: Exception.SomeException -> NoCallStackIO a + handle :: Exception.SomeException -> IO a handle se = do hFlush stdout pname <- getProgName @@ -537,7 +537,7 @@ chattyTry desc action = -- | Run an IO computation, returning @e@ if it raises a "file -- does not exist" error. -handleDoesNotExist :: a -> NoCallStackIO a -> NoCallStackIO a +handleDoesNotExist :: a -> IO a -> IO a handleDoesNotExist e = Exception.handleJust (\ioe -> if isDoesNotExistError ioe then Just ioe else Nothing) @@ -867,13 +867,13 @@ rawSystemStdInOut verbosity path args mcwd menv input _ = withFrozenCallStack $ return (out, err, exitcode) where - reportOutputIOError :: Either Exception.SomeException a -> NoCallStackIO a + reportOutputIOError :: Either Exception.SomeException a -> IO a reportOutputIOError (Right x) = return x reportOutputIOError (Left exc) = case fromException exc of Just ioe -> throwIO (ioeSetFileName ioe ("output of " ++ path)) Nothing -> throwIO exc - ignoreSigPipe :: NoCallStackIO () -> NoCallStackIO () + ignoreSigPipe :: IO () -> IO () ignoreSigPipe = Exception.handle $ \e -> case e of GHC.IOError { GHC.ioe_type = GHC.ResourceVanished, GHC.ioe_errno = Just ioe } | Errno ioe == ePIPE -> return () @@ -960,7 +960,7 @@ findFileEx verbosity searchPath fileName = findFileWithExtension :: [String] -> [FilePath] -> FilePath - -> NoCallStackIO (Maybe FilePath) + -> IO (Maybe FilePath) findFileWithExtension extensions searchPath baseName = findFirstFile id [ path baseName <.> ext @@ -970,7 +970,7 @@ findFileWithExtension extensions searchPath baseName = findAllFilesWithExtension :: [String] -> [FilePath] -> FilePath - -> NoCallStackIO [FilePath] + -> IO [FilePath] findAllFilesWithExtension extensions searchPath basename = findAllFiles id [ path basename <.> ext @@ -983,14 +983,14 @@ findAllFilesWithExtension extensions searchPath basename = findFileWithExtension' :: [String] -> [FilePath] -> FilePath - -> NoCallStackIO (Maybe (FilePath, FilePath)) + -> IO (Maybe (FilePath, FilePath)) findFileWithExtension' extensions searchPath baseName = findFirstFile (uncurry ()) [ (path, baseName <.> ext) | path <- nub searchPath , ext <- nub extensions ] -findFirstFile :: (a -> FilePath) -> [a] -> NoCallStackIO (Maybe a) +findFirstFile :: (a -> FilePath) -> [a] -> IO (Maybe a) findFirstFile file = findFirst where findFirst [] = return Nothing findFirst (x:xs) = do exists <- doesFileExist (file x) @@ -998,7 +998,7 @@ findFirstFile file = findFirst then return (Just x) else findFirst xs -findAllFiles :: (a -> FilePath) -> [a] -> NoCallStackIO [a] +findAllFiles :: (a -> FilePath) -> [a] -> IO [a] findAllFiles file = filterM (doesFileExist . file) @@ -1084,7 +1084,7 @@ getDirectoryContentsRecursive topdir = recurseDirectories [""] -- Environment variables -- | Is this directory in the system search path? -isInSearchPath :: FilePath -> NoCallStackIO Bool +isInSearchPath :: FilePath -> IO Bool isInSearchPath path = fmap (elem path) getSearchPath addLibraryPath :: OS @@ -1114,7 +1114,7 @@ addLibraryPath os paths = addEnv -- The expected use case is when the second file is generated using the first. -- In this use case, if the result is True then the second file is out of date. -- -moreRecentFile :: FilePath -> FilePath -> NoCallStackIO Bool +moreRecentFile :: FilePath -> FilePath -> IO Bool moreRecentFile a b = do exists <- doesFileExist b if not exists @@ -1124,7 +1124,7 @@ moreRecentFile a b = do return (ta > tb) -- | Like 'moreRecentFile', but also checks that the first file exists. -existsAndIsMoreRecentThan :: FilePath -> FilePath -> NoCallStackIO Bool +existsAndIsMoreRecentThan :: FilePath -> FilePath -> IO Bool existsAndIsMoreRecentThan a b = do exists <- doesFileExist a if not exists @@ -1302,7 +1302,7 @@ copyDirectoryRecursive verbosity srcDir destDir = withFrozenCallStack $ do -- File permissions -- | Like 'doesFileExist', but also checks that the file is executable. -doesExecutableExist :: FilePath -> NoCallStackIO Bool +doesExecutableExist :: FilePath -> IO Bool doesExecutableExist f = do exists <- doesFileExist f if exists @@ -1454,7 +1454,7 @@ defaultPackageDesc verbosity = tryFindPackageDesc verbosity currentDir -- |Find a package description file in the given directory. Looks for -- @.cabal@ files. findPackageDesc :: FilePath -- ^Where to look - -> NoCallStackIO (Either String FilePath) -- ^.cabal + -> IO (Either String FilePath) -- ^.cabal findPackageDesc dir = do files <- getDirectoryContents dir -- to make sure we do not mistake a ~/.cabal/ dir for a .cabal diff --git a/Cabal/Distribution/Utils/Generic.hs b/Cabal/Distribution/Utils/Generic.hs index e0e72cec51f..496fe9b01ee 100644 --- a/Cabal/Distribution/Utils/Generic.hs +++ b/Cabal/Distribution/Utils/Generic.hs @@ -143,7 +143,7 @@ wrapLine width = wrap 0 [] -- The file is read lazily but if it is not fully consumed by the action then -- the remaining input is truncated and the file is closed. -- -withFileContents :: FilePath -> (String -> NoCallStackIO a) -> NoCallStackIO a +withFileContents :: FilePath -> (String -> IO a) -> IO a withFileContents name action = withFile name ReadMode (\hnd -> hGetContents hnd >>= action) @@ -156,7 +156,7 @@ withFileContents name action = -- On windows it is not possible to delete a file that is open by a process. -- This case will give an IO exception but the atomic property is not affected. -- -writeFileAtomic :: FilePath -> BS.ByteString -> NoCallStackIO () +writeFileAtomic :: FilePath -> BS.ByteString -> IO () writeFileAtomic targetPath content = do let (targetDir, targetFile) = splitFileName targetPath Exception.bracketOnError @@ -247,7 +247,7 @@ ignoreBOM string = string -- -- Reads lazily using ordinary 'readFile'. -- -readUTF8File :: FilePath -> NoCallStackIO String +readUTF8File :: FilePath -> IO String readUTF8File f = (ignoreBOM . fromUTF8LBS) <$> BS.readFile f -- | Reads a UTF8 encoded text file as a Unicode String @@ -263,7 +263,7 @@ withUTF8FileContents name action = -- -- Uses 'writeFileAtomic', so provides the same guarantees. -- -writeUTF8File :: FilePath -> String -> NoCallStackIO () +writeUTF8File :: FilePath -> String -> IO () writeUTF8File path = writeFileAtomic path . BS.pack . encodeStringUtf8 -- | Fix different systems silly line ending conventions diff --git a/Cabal/Distribution/Utils/LogProgress.hs b/Cabal/Distribution/Utils/LogProgress.hs index 5ee2de833a0..9a2dced9392 100644 --- a/Cabal/Distribution/Utils/LogProgress.hs +++ b/Cabal/Distribution/Utils/LogProgress.hs @@ -44,7 +44,7 @@ instance Monad LogProgress where -- | Run 'LogProgress', outputting traces according to 'Verbosity', -- 'die' if there is an error. -runLogProgress :: Verbosity -> LogProgress a -> NoCallStackIO a +runLogProgress :: Verbosity -> LogProgress a -> IO a runLogProgress verbosity (LogProgress m) = foldProgress step_fn fail_fn return (m env) where @@ -52,11 +52,11 @@ runLogProgress verbosity (LogProgress m) = le_verbosity = verbosity, le_context = [] } - step_fn :: LogMsg -> NoCallStackIO a -> NoCallStackIO a + step_fn :: LogMsg -> IO a -> IO a step_fn doc go = do putStrLn (render doc) go - fail_fn :: Doc -> NoCallStackIO a + fail_fn :: Doc -> IO a fail_fn doc = do dieNoWrap verbosity (render doc) diff --git a/cabal-install/Distribution/Client/Compat/Prelude.hs b/cabal-install/Distribution/Client/Compat/Prelude.hs index 421bdee82ec..2846f888ff9 100644 --- a/cabal-install/Distribution/Client/Compat/Prelude.hs +++ b/cabal-install/Distribution/Client/Compat/Prelude.hs @@ -12,9 +12,7 @@ -- module Distribution.Client.Compat.Prelude ( module Distribution.Compat.Prelude.Internal - , Prelude.IO ) where -import Prelude (IO) -import Distribution.Compat.Prelude.Internal hiding (IO) +import Distribution.Compat.Prelude.Internal import Distribution.Client.Compat.Orphans ()