Commit 64532b8c authored by Oleg Grenrus's avatar Oleg Grenrus

Remove WithCallStack IO type alias

parent 6c64494e
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......@@ -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.<>)
......
......@@ -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
......
......@@ -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.
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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) =
......
......@@ -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 ]
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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))
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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]