Skip to content

Remove WithCallStack IO type alias #6552

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Feb 23, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 6 additions & 6 deletions Cabal/Distribution/Compat/CopyFile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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"))
Expand Down Expand Up @@ -229,15 +229,15 @@ 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

-- | 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
Expand Down
2 changes: 1 addition & 1 deletion Cabal/Distribution/Compat/CreatePipe.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion Cabal/Distribution/Compat/Environment.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions Cabal/Distribution/Compat/GetShortPathName.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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!" $
Expand All @@ -53,7 +53,7 @@ getShortPathName path =

#else

getShortPathName :: FilePath -> NoCallStackIO FilePath
getShortPathName :: FilePath -> IO FilePath
getShortPathName path = return path

#endif
9 changes: 1 addition & 8 deletions Cabal/Distribution/Compat/Prelude.hs
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,6 @@ module Distribution.Compat.Prelude (
IsString (..),

-- * Some types
IO, NoCallStackIO,
Map,
Set,
Identity (..),
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.<>)
Expand Down
8 changes: 4 additions & 4 deletions Cabal/Distribution/Compat/Time.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions Cabal/Distribution/PackageDescription/Check.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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!
Expand All @@ -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.
Expand Down
6 changes: 3 additions & 3 deletions Cabal/Distribution/PackageDescription/PrettyPrint.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion Cabal/Distribution/PackageDescription/Quirks.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
64 changes: 33 additions & 31 deletions Cabal/Distribution/Simple.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion Cabal/Distribution/Simple/BuildTarget.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
4 changes: 2 additions & 2 deletions Cabal/Distribution/Simple/Compiler.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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) =
Expand Down
10 changes: 5 additions & 5 deletions Cabal/Distribution/Simple/Configure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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) $
Expand Down Expand Up @@ -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

Expand All @@ -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)
Expand All @@ -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.
Expand Down Expand Up @@ -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 ]
Expand Down
Loading