Merge pull request #6552 from phadej/prelude-io

Remove WithCallStack IO type alias

Author: phadej

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,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

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

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

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

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.<>)

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

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.

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
 

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

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

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)

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) =

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 ]