import Distribution.Package hiding (depends)
import Distribution.Text
import Distribution.Version
-import System.FilePath
+import System.FilePath as FilePath
+import qualified System.FilePath.Posix as FilePath.Posix
import System.Cmd ( rawSystem )
import System.Directory ( getAppUserDataDirectory, createDirectoryIfMissing,
getModificationTime )
import Data.Char ( isSpace, toLower )
import Control.Monad
import System.Directory ( doesDirectoryExist, getDirectoryContents,
- doesFileExist, renameFile, removeFile )
+ doesFileExist, renameFile, removeFile,
+ getCurrentDirectory )
import System.Exit ( exitWith, ExitCode(..) )
import System.Environment ( getArgs, getProgName, getEnv )
import System.IO
-import System.IO.Error (try, isDoesNotExistError)
+import System.IO.Error
import Data.List
import Control.Concurrent
import qualified Data.Binary as Bin
import qualified Data.Binary.Get as Bin
-#if __GLASGOW_HASKELL__ < 612 || defined(mingw32_HOST_OS)
+#if defined(mingw32_HOST_OS)
-- mingw32 needs these for getExecDir, GHC <6.12 needs them for openNewFile
import Foreign
import Foreign.C
#endif
-#if __GLASGOW_HASKELL__ < 612
-import System.Posix.Internals
-import GHC.Handle (fdToHandle)
-#endif
-
#ifdef mingw32_HOST_OS
import GHC.ConsoleHandler
#else
import System.Posix hiding (fdToHandle)
#endif
-import IO ( isPermissionError )
-
#if defined(GLOB)
import System.Process(runInteractiveCommand)
import qualified System.Info(os)
#endif
-#if !defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 611 && !defined(BOOTSTRAPPING)
+#if !defined(mingw32_HOST_OS) && !defined(BOOTSTRAPPING)
import System.Console.Terminfo as Terminfo
#endif
| FlagForce
| FlagForceFiles
| FlagAutoGHCiLibs
+ | FlagExpandEnvVars
| FlagSimpleOutput
| FlagNamesOnly
| FlagIgnoreCase
"ignore missing directories and libraries only",
Option ['g'] ["auto-ghci-libs"] (NoArg FlagAutoGHCiLibs)
"automatically build libs for GHCi (with register)",
+ Option [] ["expand-env-vars"] (NoArg FlagExpandEnvVars)
+ "expand environment variables (${name}-style) in input package descriptions",
Option ['?'] ["help"] (NoArg FlagHelp)
"display this help and exit",
Option ['V'] ["version"] (NoArg FlagVersion)
| FlagForceFiles `elem` cli = ForceFiles
| otherwise = NoForce
auto_ghci_libs = FlagAutoGHCiLibs `elem` cli
+ expand_env_vars= FlagExpandEnvVars `elem` cli
splitFields fields = unfoldr splitComma (',':fields)
where splitComma "" = Nothing
splitComma fs = Just $ break (==',') (tail fs)
["init", filename] ->
initPackageDB filename verbosity cli
["register", filename] ->
- registerPackage filename verbosity cli auto_ghci_libs False force
+ registerPackage filename verbosity cli
+ auto_ghci_libs expand_env_vars False force
["update", filename] ->
- registerPackage filename verbosity cli auto_ghci_libs True force
+ registerPackage filename verbosity cli
+ auto_ghci_libs expand_env_vars True force
["unregister", pkgid_str] -> do
pkgid <- readGlobPkgId pkgid_str
unregisterPackage pkgid verbosity cli force
getPkgDatabases :: Verbosity
-> Bool -- we are modifying, not reading
-> Bool -- read caches, if available
+ -> Bool -- expand vars, like ${pkgroot} and $topdir
-> [Flag]
-> IO (PackageDBStack,
-- the real package DB stack: [global,user] ++
-- is used as the list of package DBs for
-- commands that just read the DB, such as 'list'.
-getPkgDatabases verbosity modify use_cache my_flags = do
+getPkgDatabases verbosity modify use_cache expand_vars my_flags = do
-- first we determine the location of the global package config. On Windows,
-- this is found relative to the ghc-pkg.exe binary, whereas on Unix the
-- location is passed to the binary using the --global-config flag by the
Just path -> return path
fs -> return (last fs)
+ -- The value of the $topdir variable used in some package descriptions
+ -- Note that the way we calculate this is slightly different to how it
+ -- is done in ghc itself. We rely on the convention that the global
+ -- package db lives in ghc's libdir.
+ top_dir <- absolutePath (takeDirectory global_conf)
+
let no_user_db = FlagNoUserDb `elem` my_flags
-- get the location of the user package database, and create it if necessary
-- getAppUserDataDirectory can fail (e.g. if $HOME isn't set)
- e_appdir <- try $ getAppUserDataDirectory "ghc"
+ e_appdir <- tryIO $ getAppUserDataDirectory "ghc"
mb_user_conf <-
if no_user_db then return Nothing else
modify || user_exists = [user_conf, global_conf]
| otherwise = [global_conf]
- e_pkg_path <- try (System.Environment.getEnv "GHC_PACKAGE_PATH")
+ e_pkg_path <- tryIO (System.Environment.getEnv "GHC_PACKAGE_PATH")
let env_stack =
case e_pkg_path of
Left _ -> sys_databases
| null db_flags = Just virt_global_conf
| otherwise = Just (last db_flags)
- db_stack <- mapM (readParseDatabase verbosity mb_user_conf use_cache) final_stack
+ db_stack <- sequence
+ [ do db <- readParseDatabase verbosity mb_user_conf use_cache db_path
+ if expand_vars then mungePackageDBPaths top_dir db else return db
+ | db_path <- final_stack ]
let flag_db_stack = [ db | db_name <- flag_db_names,
db <- db_stack, location db == db_name ]
| Just (user_conf,False) <- mb_user_conf, path == user_conf
= return PackageDB { location = path, packages = [] }
| otherwise
- = do e <- try $ getDirectoryContents path
+ = do e <- tryIO $ getDirectoryContents path
case e of
Left _ -> do
pkgs <- parseMultiPackageConf verbosity path
| otherwise -> do
let cache = path </> cachefilename
tdir <- getModificationTime path
- e_tcache <- try $ getModificationTime cache
+ e_tcache <- tryIO $ getModificationTime cache
case e_tcache of
Left ex -> do
when (verbosity > Normal) $
cachefilename :: FilePath
cachefilename = "package.cache"
+mungePackageDBPaths :: FilePath -> PackageDB -> IO PackageDB
+mungePackageDBPaths top_dir db@PackageDB { packages = pkgs } = do
+ -- It so happens that for both styles of package db ("package.conf"
+ -- files and "package.conf.d" dirs) the pkgroot is the parent directory
+ -- ${pkgroot}/package.conf or ${pkgroot}/package.conf.d/
+ pkgroot <- absolutePath (takeDirectory (location db))
+ return db { packages = map (mungePackagePaths top_dir pkgroot) pkgs }
+
+mungePackagePaths :: FilePath -> FilePath
+ -> InstalledPackageInfo -> InstalledPackageInfo
+-- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec
+-- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
+-- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.
+-- The "pkgroot" is the directory containing the package database.
+--
+-- Also perform a similar substitution for the older GHC-specific
+-- "$topdir" variable. The "topdir" is the location of the ghc
+-- installation (obtained from the -B option).
+mungePackagePaths top_dir pkgroot pkg =
+ pkg {
+ importDirs = munge_paths (importDirs pkg),
+ includeDirs = munge_paths (includeDirs pkg),
+ libraryDirs = munge_paths (libraryDirs pkg),
+ frameworkDirs = munge_paths (frameworkDirs pkg),
+ haddockInterfaces = munge_paths (haddockInterfaces pkg),
+ haddockHTMLs = munge_urls (haddockHTMLs pkg)
+ }
+ where
+ munge_paths = map munge_path
+ munge_urls = map munge_url
+
+ munge_path p
+ | Just p' <- stripVarPrefix "${pkgroot}" sp = pkgroot </> p'
+ | Just p' <- stripVarPrefix "$topdir" sp = top_dir </> p'
+ | otherwise = p
+ where
+ sp = splitPath p
+
+ munge_url p
+ | Just p' <- stripVarPrefix "${pkgrooturl}" sp = toUrlPath pkgroot p'
+ | Just p' <- stripVarPrefix "$httptopdir" sp = toUrlPath top_dir p'
+ | otherwise = p
+ where
+ sp = splitPath p
+
+ toUrlPath r p = "file:///"
+ -- URLs always use posix style '/' separators:
+ ++ FilePath.Posix.joinPath (r : FilePath.splitDirectories p)
+
+ stripVarPrefix var (root:path')
+ | Just [sep] <- stripPrefix var root
+ , isPathSeparator sep
+ = Just (joinPath path')
+
+ stripVarPrefix _ _ = Nothing
+
+
-- -----------------------------------------------------------------------------
-- Creating a new package DB
-> Verbosity
-> [Flag]
-> Bool -- auto_ghci_libs
+ -> Bool -- expand_env_vars
-> Bool -- update
-> Force
-> IO ()
-registerPackage input verbosity my_flags auto_ghci_libs update force = do
+registerPackage input verbosity my_flags auto_ghci_libs expand_env_vars update force = do
(db_stack, Just to_modify, _flag_dbs) <-
- getPkgDatabases verbosity True True my_flags
+ getPkgDatabases verbosity True True False{-expand vars-} my_flags
let
db_to_operate_on = my_head "register" $
filter ((== to_modify).location) db_stack
--
+ when (auto_ghci_libs && verbosity >= Silent) $
+ warn "Warning: --auto-ghci-libs is deprecated and will be removed in GHC 7.4"
+ --
s <-
case input of
"-" -> do
when (verbosity >= Normal) $
putStr "Reading package info from stdin ... "
-#if __GLASGOW_HASKELL__ >= 612
-- fix the encoding to UTF-8, since this is an interchange format
hSetEncoding stdin utf8
-#endif
getContents
f -> do
when (verbosity >= Normal) $
putStr ("Reading package info from " ++ show f ++ " ... ")
readUTF8File f
- expanded <- expandEnvVars s force
+ expanded <- if expand_env_vars then expandEnvVars s force
+ else return s
pkg <- parsePackageInfo expanded
when (verbosity >= Normal) $
putStrLn "done."
+ -- validate the expanded pkg, but register the unexpanded
+ pkgroot <- absolutePath (takeDirectory to_modify)
+ let top_dir = takeDirectory (location (last db_stack))
+ pkg_expanded = mungePackagePaths top_dir pkgroot pkg
+
let truncated_stack = dropWhile ((/= to_modify).location) db_stack
-- truncate the stack for validation, because we don't allow
-- packages lower in the stack to refer to those higher up.
- validatePackageConfig pkg truncated_stack auto_ghci_libs update force
+ validatePackageConfig pkg_expanded truncated_stack auto_ghci_libs update force
let
removes = [ RemovePackage p
| p <- packages db_to_operate_on,
when (verbosity > Normal) $
putStrLn ("writing cache " ++ filename)
writeBinaryFileAtomic filename (map convertPackageInfoOut (packages db))
- `catch` \e ->
+ `catchIO` \e ->
if isPermissionError e
then die (filename ++ ": you don't have permission to modify this file")
else ioError e
-> IO ()
modifyPackage fn pkgid verbosity my_flags force = do
(db_stack, Just _to_modify, _flag_dbs) <-
- getPkgDatabases verbosity True{-modify-} True{-use cache-} my_flags
+ getPkgDatabases verbosity True{-modify-} True{-use cache-} False{-expand vars-} my_flags
(db, ps) <- fmap head $ findPackagesByDB db_stack (Id pkgid)
let
recache :: Verbosity -> [Flag] -> IO ()
recache verbosity my_flags = do
(db_stack, Just to_modify, _flag_dbs) <-
- getPkgDatabases verbosity True{-modify-} False{-no cache-} my_flags
+ getPkgDatabases verbosity True{-modify-} False{-no cache-} False{-expand vars-} my_flags
let
db_to_operate_on = my_head "recache" $
filter ((== to_modify).location) db_stack
listPackages verbosity my_flags mPackageName mModuleName = do
let simple_output = FlagSimpleOutput `elem` my_flags
(db_stack, _, flag_db_stack) <-
- getPkgDatabases verbosity False True{-use cache-} my_flags
+ getPkgDatabases verbosity False True{-use cache-} False{-expand vars-} my_flags
let db_stack_filtered -- if a package is given, filter out all other packages
| Just this <- mPackageName =
if simple_output then show_simple stack else do
-#if defined(mingw32_HOST_OS) || __GLASGOW_HASKELL__ < 611 || defined(BOOTSTRAPPING)
+#if defined(mingw32_HOST_OS) || defined(BOOTSTRAPPING)
mapM_ show_normal stack
#else
let
showPackageDot :: Verbosity -> [Flag] -> IO ()
showPackageDot verbosity myflags = do
(_, _, flag_db_stack) <-
- getPkgDatabases verbosity False True{-use cache-} myflags
+ getPkgDatabases verbosity False True{-use cache-} False{-expand vars-} myflags
let all_pkgs = allPackagesInStack flag_db_stack
ipix = PackageIndex.fromList all_pkgs
latestPackage :: Verbosity -> [Flag] -> PackageIdentifier -> IO ()
latestPackage verbosity my_flags pkgid = do
(_, _, flag_db_stack) <-
- getPkgDatabases verbosity False True{-use cache-} my_flags
+ getPkgDatabases verbosity False True{-use cache-} False{-expand vars-} my_flags
ps <- findPackages flag_db_stack (Id pkgid)
show_pkg (sortBy compPkgIdVer (map sourcePackageId ps))
describePackage :: Verbosity -> [Flag] -> PackageArg -> IO ()
describePackage verbosity my_flags pkgarg = do
(_, _, flag_db_stack) <-
- getPkgDatabases verbosity False True{-use cache-} my_flags
+ getPkgDatabases verbosity False True{-use cache-} True{-expand vars-} my_flags
ps <- findPackages flag_db_stack pkgarg
doDump ps
dumpPackages :: Verbosity -> [Flag] -> IO ()
dumpPackages verbosity my_flags = do
(_, _, flag_db_stack) <-
- getPkgDatabases verbosity False True{-use cache-} my_flags
+ getPkgDatabases verbosity False True{-use cache-} False{-expand vars-} my_flags
doDump (allPackagesInStack flag_db_stack)
doDump :: [InstalledPackageInfo] -> IO ()
doDump pkgs = do
-#if __GLASGOW_HASKELL__ >= 612
-- fix the encoding to UTF-8, since this is an interchange format
hSetEncoding stdout utf8
-#endif
mapM_ putStrLn . intersperse "---" . map showInstalledPackageInfo $ pkgs
-- PackageId is can have globVersion for the version
describeField :: Verbosity -> [Flag] -> PackageArg -> [String] -> IO ()
describeField verbosity my_flags pkgarg fields = do
(_, _, flag_db_stack) <-
- getPkgDatabases verbosity False True{-use cache-} my_flags
+ getPkgDatabases verbosity False True{-use cache-} True{-expand vars-} my_flags
fns <- toFields fields
ps <- findPackages flag_db_stack pkgarg
- let top_dir = takeDirectory (location (last flag_db_stack))
- mapM_ (selectFields fns) (mungePackagePaths top_dir ps)
+ mapM_ (selectFields fns) ps
where toFields [] = return []
toFields (f:fs) = case toField f of
Nothing -> die ("unknown field: " ++ f)
return (fn:fns)
selectFields fns info = mapM_ (\fn->putStrLn (fn info)) fns
-mungePackagePaths :: String -> [InstalledPackageInfo] -> [InstalledPackageInfo]
--- Replace the strings "$topdir" and "$httptopdir" at the beginning of a path
--- with the current topdir (obtained from the -B option).
-mungePackagePaths top_dir ps = map munge_pkg ps
- where
- munge_pkg p = p{ importDirs = munge_paths (importDirs p),
- includeDirs = munge_paths (includeDirs p),
- libraryDirs = munge_paths (libraryDirs p),
- frameworkDirs = munge_paths (frameworkDirs p),
- haddockInterfaces = munge_paths (haddockInterfaces p),
- haddockHTMLs = munge_paths (haddockHTMLs p)
- }
-
- munge_paths = map munge_path
-
- munge_path p
- | Just p' <- maybePrefixMatch "$topdir" p = top_dir ++ p'
- | Just p' <- maybePrefixMatch "$httptopdir" p = toHttpPath top_dir ++ p'
- | otherwise = p
-
- toHttpPath p = "file:///" ++ p
-
-maybePrefixMatch :: String -> String -> Maybe String
-maybePrefixMatch [] rest = Just rest
-maybePrefixMatch (_:_) [] = Nothing
-maybePrefixMatch (p:pat) (r:rest)
- | p == r = maybePrefixMatch pat rest
- | otherwise = Nothing
-
toField :: String -> Maybe (InstalledPackageInfo -> String)
-- backwards compatibility:
toField "import_dirs" = Just $ strList . importDirs
checkConsistency :: Verbosity -> [Flag] -> IO ()
checkConsistency verbosity my_flags = do
- (db_stack, _, _) <- getPkgDatabases verbosity True True{-use cache-} my_flags
+ (db_stack, _, _) <-
+ getPkgDatabases verbosity True True{-use cache-} True{-expand vars-} my_flags
-- check behaves like modify for the purposes of deciding which
-- databases to use, because ordering is important.
$ map (show . convertPackageInfoOut) ipis
fileContents = "[" ++ shown ++ "\n]"
writeFileUtf8Atomic filename fileContents
- `catch` \e ->
+ `catchIO` \e ->
if isPermissionError e
then die (filename ++ ": you don't have permission to modify this file")
else ioError e
"Package " ++ display pkgid ++
" overlaps with: " ++ unwords (map display dups)
-
-checkDir :: Bool -> String -> String -> Validate ()
+checkDir :: Bool -> String -> FilePath -> Validate ()
checkDir warn_only thisfield d
- | "$topdir" `isPrefixOf` d = return ()
- | "$httptopdir" `isPrefixOf` d = return ()
- -- can't check these, because we don't know what $(http)topdir is
+ -- Note: we don't check for $topdir/${pkgroot} here. We relies on these
+ -- variables having been expanded already, see mungePackagePaths.
+
| isRelative d = verror ForceFiles $
thisfield ++ ": " ++ d ++ " is a relative path"
-- relative paths don't make any sense; #4134
case m of
Nothing -> verror ForceFiles ("cannot find " ++ batch_lib_file ++
" on library path")
- Just dir -> liftIO $ checkGHCiLib dirs dir batch_lib_file lib auto_ghci_libs
+ Just dir -> liftIO $ checkGHCiLib dir batch_lib_file lib auto_ghci_libs
doesFileExistOnPath :: String -> [FilePath] -> IO (Maybe FilePath)
doesFileExistOnPath file path = go path
when (isNothing m) $
verror ForceFiles ("file " ++ file ++ " is missing")
-checkGHCiLib :: [String] -> String -> String -> String -> Bool -> IO ()
-checkGHCiLib dirs batch_lib_dir batch_lib_file lib auto_build
+checkGHCiLib :: String -> String -> String -> Bool -> IO ()
+checkGHCiLib batch_lib_dir batch_lib_file lib auto_build
| auto_build = autoBuildGHCiLib batch_lib_dir batch_lib_file ghci_lib_file
- | otherwise = do
- m <- doesFileExistOnPath ghci_lib_file dirs
- when (isNothing m && ghci_lib_file /= "HSrts.o") $
- warn ("warning: can't find GHCi lib " ++ ghci_lib_file)
+ | otherwise = return ()
where
ghci_lib_file = lib <.> "o"
return (concat mms)
searchDir path prefix = do
- fs <- getDirectoryEntries path `catch` \_ -> return []
+ fs <- getDirectoryEntries path `catchIO` \_ -> return []
searchEntries path prefix fs
searchEntries path prefix [] = return []
= go str (c:acc)
lookupEnvVar :: String -> IO String
+ lookupEnvVar "pkgroot" = return "${pkgroot}" -- these two are special,
+ lookupEnvVar "pkgrooturl" = return "${pkgrooturl}" -- we don't expand them
lookupEnvVar nm =
- catch (System.Environment.getEnv nm)
+ catchIO (System.Environment.getEnv nm)
(\ _ -> do dieOrForceAll force ("Unable to expand variable " ++
show nm)
return "")
removeCmdSuffix = return . Just . initN (length cmd) . unDosifyPath
getExecPath :: IO (Maybe String)
-getExecPath =
- allocaArray len $ \buf -> do
- ret <- getModuleFileName nullPtr buf len
- if ret == 0 then return Nothing
- else liftM Just $ peekCString buf
- where len = 2048 -- Plenty, PATH_MAX is 512 under Win32.
-
-foreign import stdcall unsafe "GetModuleFileNameA"
- getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
-
+getExecPath = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
+ where
+ try_size size = allocaArray (fromIntegral size) $ \buf -> do
+ ret <- c_GetModuleFileName nullPtr buf size
+ case ret of
+ 0 -> return Nothing
+ _ | ret < size -> fmap Just $ peekCWString buf
+ | otherwise -> try_size (size * 2)
+
+foreign import stdcall unsafe "windows.h GetModuleFileNameW"
+ c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
#else
getLibDir :: IO (Maybe String)
getLibDir = return Nothing
#if mingw32_HOST_OS || mingw32_TARGET_OS
throwIOIO :: Exception.IOException -> IO a
throwIOIO = Exception.throwIO
+#endif
catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
catchIO = Exception.catch
-#endif
catchError :: IO a -> (String -> IO a) -> IO a
catchError io handler = io `Exception.catch` handler'
where handler' (Exception.ErrorCall err) = handler err
+tryIO :: IO a -> IO (Either Exception.IOException a)
+tryIO = Exception.try
writeBinaryFileAtomic :: Bin.Binary a => FilePath -> a -> IO ()
writeBinaryFileAtomic targetFile obj =
writeFileUtf8Atomic :: FilePath -> String -> IO ()
writeFileUtf8Atomic targetFile content =
withFileAtomic targetFile $ \h -> do
-#if __GLASGOW_HASKELL__ >= 612
hSetEncoding h utf8
-#endif
hPutStr h content
-- copied from Cabal's Distribution.Simple.Utils, except that we want
openNewFile :: FilePath -> String -> IO (FilePath, Handle)
openNewFile dir template = do
-#if __GLASGOW_HASKELL__ >= 612
-- this was added to System.IO in 6.12.1
-- we must use this version because the version below opens the file
-- in binary mode.
openTempFileWithDefaultPermissions dir template
-#else
- -- Ugh, this is a copy/paste of code from the base library, but
- -- if uses 666 rather than 600 for the permissions.
- pid <- c_getpid
- findTempName pid
- where
- -- We split off the last extension, so we can use .foo.ext files
- -- for temporary files (hidden on Unix OSes). Unfortunately we're
- -- below filepath in the hierarchy here.
- (prefix,suffix) =
- case break (== '.') $ reverse template of
- -- First case: template contains no '.'s. Just re-reverse it.
- (rev_suffix, "") -> (reverse rev_suffix, "")
- -- Second case: template contains at least one '.'. Strip the
- -- dot from the prefix and prepend it to the suffix (if we don't
- -- do this, the unique number will get added after the '.' and
- -- thus be part of the extension, which is wrong.)
- (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)
- -- Otherwise, something is wrong, because (break (== '.')) should
- -- always return a pair with either the empty string or a string
- -- beginning with '.' as the second component.
- _ -> error "bug in System.IO.openTempFile"
-
- oflags = rw_flags .|. o_EXCL
-
- withFilePath = withCString
-
- findTempName x = do
- fd <- withFilePath filepath $ \ f ->
- c_open f oflags 0o666
- if fd < 0
- then do
- errno <- getErrno
- if errno == eEXIST
- then findTempName (x+1)
- else ioError (errnoToIOError "openNewBinaryFile" errno Nothing (Just dir))
- else do
- -- XXX We want to tell fdToHandle what the filepath is,
- -- as any exceptions etc will only be able to report the
- -- fd currently
- h <-
- fdToHandle fd
- `Exception.onException` c_close fd
- return (filepath, h)
- where
- filename = prefix ++ show x ++ suffix
- filepath = dir `combine` filename
-
--- XXX Copied from GHC.Handle
-std_flags, output_flags, rw_flags :: CInt
-std_flags = o_NONBLOCK .|. o_NOCTTY
-output_flags = std_flags .|. o_CREAT
-rw_flags = output_flags .|. o_RDWR
-#endif /* GLASGOW_HASKELL < 612 */
-- | The function splits the given string to substrings
-- using 'isSearchPathSeparator'.
readUTF8File :: FilePath -> IO String
readUTF8File file = do
h <- openFile file ReadMode
-#if __GLASGOW_HASKELL__ >= 612
-- fix the encoding to UTF-8
hSetEncoding h utf8
-#endif
hGetContents h
-- removeFileSave doesn't throw an exceptions, if the file is already deleted
removeFileSafe :: FilePath -> IO ()
removeFileSafe fn =
- removeFile fn `catch` \ e ->
+ removeFile fn `catchIO` \ e ->
when (not $ isDoesNotExistError e) $ ioError e
+
+absolutePath :: FilePath -> IO FilePath
+absolutePath path = return . normalise . (</> path) =<< getCurrentDirectory
projects / ghc-hetmet.git / blobdiff