module Compat.Directory (
getAppUserDataDirectory,
copyFile,
- findExecutable
+ findExecutable,
+ createDirectoryIfMissing
) where
#if __GLASGOW_HASKELL__ < 603
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
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
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
import System.IO
import Data.List ( isPrefixOf, isSuffixOf, intersperse )
-#ifdef mingw32_HOST_OS
+#ifdef mingw32_TARGET_OS
import Foreign
#if __GLASGOW_HASKELL__ >= 504
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
| 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
getExecDir :: String -> IO (Maybe String)
getExecDir _ = return Nothing
#endif
-
-directoryOf :: FilePath -> FilePath
-directoryOf = fst.splitFileName