Commit 3410e077 authored by krasimir's avatar krasimir
Browse files

[project @ 2005-01-10 23:48:07 by krasimir]

createDirectoryIfMissing is added to Compat.Directory and is used in ghc-pkg.
The mingw32_HOST_OS is replaced with mingw32_TARGET_OS. I don't know why but
prior the last commit the tool was working with mingw32_HOST_OS fine but not
it isn't. Maybe I miss something. Simon, could you check whether the patch is
fine?
parent 55c60479
......@@ -17,7 +17,8 @@
module Compat.Directory (
getAppUserDataDirectory,
copyFile,
findExecutable
findExecutable,
createDirectoryIfMissing
) where
#if __GLASGOW_HASKELL__ < 603
......@@ -31,7 +32,7 @@ import System.FilePath
import System.IO
import Foreign
import Foreign.C
import System.Directory(doesFileExist, getPermissions, setPermissions)
import System.Directory(doesFileExist, doesDirectoryExist, getPermissions, setPermissions, createDirectory)
#if defined(__GLASGOW_HASKELL__)
import GHC.IOBase ( IOException(..) )
#endif
......@@ -109,3 +110,14 @@ findExecutable binary = do
b <- doesFileExist path
if b then return (Just path)
else search ds
createDirectoryIfMissing :: Bool -- ^ Create its parents too?
-> FilePath -- ^ The path to the directory you want to make
-> IO ()
createDirectoryIfMissing parents file = do
b <- doesDirectoryExist file
case (b,parents, file) of
(_, _, "") -> return ()
(True, _, _) -> return ()
(_, True, _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file))
(_, False, _) -> createDirectory file
......@@ -22,11 +22,11 @@ import Distribution.Compat.ReadP
import Distribution.ParseUtils ( showError )
import Distribution.Package
import Distribution.Version
import Compat.Directory ( getAppUserDataDirectory )
import Compat.Directory ( getAppUserDataDirectory, createDirectoryIfMissing )
import Compat.RawSystem ( rawSystem )
import Control.Exception ( evaluate )
import qualified Control.Exception as Exception
import System.FilePath ( joinFileName, splitFileName )
import System.FilePath ( joinFileName )
import Prelude
......@@ -53,7 +53,7 @@ import System ( getArgs, getProgName,
import System.IO
import Data.List ( isPrefixOf, isSuffixOf, intersperse )
#ifdef mingw32_HOST_OS
#ifdef mingw32_TARGET_OS
import Foreign
#if __GLASGOW_HASKELL__ >= 504
......@@ -261,11 +261,12 @@ getPkgDatabases flags = do
let
subdir = targetARCH ++ '-':targetOS ++ '-':version
user_conf = appdir `joinFileName` subdir `joinFileName` "package.conf"
archdir = appdir `joinFileName` subdir
user_conf = archdir `joinFileName` "package.conf"
b <- doesFileExist user_conf
when (not b) $ do
putStrLn ("Creating user package database in " ++ user_conf)
createParents user_conf
createDirectoryIfMissing True archdir
writeFile user_conf emptyPackageConfig
let
......@@ -895,21 +896,10 @@ dieOrForce force s
| otherwise = die s
-----------------------------------------------------------------------------
-- Create a hierarchy of directories
createParents :: FilePath -> IO ()
createParents dir = do
let parent = directoryOf dir
b <- doesDirectoryExist parent
when (not b) $ do
createParents parent
createDirectory parent
-----------------------------------------
-- Cut and pasted from ghc/compiler/SysTools
#if defined(mingw32_HOST_OS)
#if defined(mingw32_TARGET_OS)
subst a b ls = map (\ x -> if x == a then b else x) ls
unDosifyPath xs = subst '\\' '/' xs
......@@ -934,6 +924,3 @@ foreign import stdcall unsafe "GetModuleFileNameA"
getExecDir :: String -> IO (Maybe String)
getExecDir _ = return Nothing
#endif
directoryOf :: FilePath -> FilePath
directoryOf = fst.splitFileName
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment