Commit 6a9192f6 authored by mnislaih's avatar mnislaih
Browse files

Upgraded to filepath & first steps towards Windows compatibility

parent 4e572d32
......@@ -19,4 +19,4 @@ Executable: cabal-install
Main-Is: CabalInstall.hs
Hs-Source-Dirs: src
Extensions: CPP, OverlappingInstances, TypeSynonymInstances, TemplateHaskell
GHC-options: -idependencies/HTTP-2006.7.7
GHC-options: -idependencies/HTTP-2006.7.7 -idependencies/filepath-1.0
{- |
Module : System.FilePath
Copyright : (c) Neil Mitchell 2005-2007
License : BSD-style (see the file libraries/base/LICENSE)
Maintainer : libraries@haskell.org
Stability : stable
Portability : portable
A library for 'FilePath' manipulations, using Posix or Windows filepaths
depending on the platform.
Both "System.FilePath.Posix" and "System.FilePath.Windows" provide the
same interface. See either for examples and a list of the available
functions.
-}
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
module System.FilePath(module System.FilePath.Windows) where
import System.FilePath.Windows
#else
module System.FilePath(module System.FilePath.Posix) where
import System.FilePath.Posix
#endif
#define MODULE_NAME Posix
#define IS_WINDOWS False
-----------------------------------------------------------------------------
-- |
-- Module : System.FilePath.Posix
-- Copyright : (c) Neil Mitchell 2005-2007
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : stable
-- Portability : portable
--
-- A library for FilePath manipulations, using Posix style paths on
-- all platforms. Importing "System.FilePath" is usually better.
#include "Internal.hs"
#define MODULE_NAME Windows
#define IS_WINDOWS True
-----------------------------------------------------------------------------
-- |
-- Module : System.FilePath.Windows
-- Copyright : (c) Neil Mitchell 2005-2007
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : stable
-- Portability : portable
--
-- A library for FilePath manipulations, using Windows style paths on
-- all platforms. Importing "System.FilePath" is usually better.
#include "Internal.hs"
......@@ -24,27 +24,30 @@ module Network.Hackage.CabalInstall.Config
import Prelude hiding (catch)
import Control.Exception (catch, Exception(IOException))
import Control.Monad.Error (mplus, filterM) -- Using Control.Monad.Error to get the Error instance for IO.
import System.Directory (Permissions (..), getPermissions, createDirectoryIfMissing)
import System.Directory (Permissions (..), getPermissions, createDirectoryIfMissing
,getTemporaryDirectory)
import System.IO.Error (isDoesNotExistError)
import System.IO (hPutStrLn, stderr)
import System.IO.Unsafe
import Distribution.Package (PackageIdentifier)
import Distribution.Version (Dependency)
import Distribution.Compat.FilePath (joinFileName)
import System.FilePath ((</>))
import System.Directory
import Network.Hackage.CabalInstall.Types (ConfigFlags (..), PkgInfo (..))
-- FIXME: should be different on Windows
defaultConfDir :: FilePath
defaultConfDir = "/etc/cabal-install"
defaultConfDir, defaultCacheDir, defaultPkgListDir :: FilePath
-- FIXME: should be different on Windows
defaultCacheDir :: FilePath
defaultCacheDir = "/var/cache/cabal-install"
-- FIXME: should be different on Windows
defaultPkgListDir :: FilePath
defaultPkgListDir = "/var/lib/cabal-install"
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
defaultConfDir = "/" </> "etc" </> "cabal-install" --FIXME
defaultCacheDir = unsafePerformIO getTemporaryDirectory
defaultPkgListDir = unsafePerformIO (getAppUserDataDirectory "cabal-install")
#else
defaultConfDir = "/" </> "etc" </> "cabal-install"
defaultCacheDir = "/" </> "var" </> "cache" </> "cabal-install"
defaultPkgListDir = "/" </> "var" </> "lib" </> "cabal-install"
#endif
pkgListFile :: FilePath
pkgListFile = "pkg.list"
......@@ -58,15 +61,15 @@ packagesDirectoryName = "packages"
-- | Full path to the server list file
servList :: ConfigFlags -> FilePath
servList cfg = configConfDir cfg `joinFileName` servListFile
servList cfg = configConfDir cfg </> servListFile
-- | Full path to the packages directory.
packagesDirectory :: ConfigFlags -> FilePath
packagesDirectory cfg = configCacheDir cfg `joinFileName` packagesDirectoryName
packagesDirectory cfg = configCacheDir cfg </> packagesDirectoryName
-- | Full path to the package list file
pkgList :: ConfigFlags -> FilePath
pkgList cfg = configPkgListDir cfg `joinFileName` pkgListFile
pkgList cfg = configPkgListDir cfg </> pkgListFile
-- |Read the list of known packages from the pkg.list file.
......@@ -101,7 +104,7 @@ isValidConfigDir :: FilePath -> IO Bool
isValidConfigDir path
= do checks <- sequence
[ checkFiles readable [ path
, path `joinFileName` servListFile ]]
, path </> servListFile ]]
return (and checks)
-- |Picks the first valid config directory or throws an exception if none were found.
......
......@@ -25,7 +25,7 @@ import Network.Hackage.CabalInstall.Config (defaultConfDir, defaultCacheDir, def
import qualified Distribution.Simple.Configure as Configure (findProgram, configCompiler)
import Distribution.ParseUtils (showDependency)
import Distribution.Package (showPackageId)
import Distribution.Compat.FilePath (joinFileName)
import System.FilePath ((</>))
import Text.Printf (printf)
import System.IO (openFile, IOMode (..))
......@@ -38,8 +38,8 @@ import Data.Maybe (fromMaybe)
defaultOutputGen :: Int -> IO OutputGen
defaultOutputGen verbose
= do (outch,errch) <- do guard (verbose <= 1)
nullOut <- openFile "/dev/null" AppendMode
nullErr <- openFile "/dev/null" AppendMode
nullOut <- openFile ("/"</>"dev"</>"null") AppendMode
nullErr <- openFile ("/"</>"dev"</>"null") AppendMode
return (Just nullOut, Just nullErr)
`mplus` return (Nothing,Nothing)
return OutputGen
......@@ -92,7 +92,7 @@ findProgramOrDie name p = fmap (fromMaybe (error $ printf "No %s found." name))
localPrefix :: IO FilePath
localPrefix
= do home <- getHomeDirectory
return (home `joinFileName` "usr")
return (home </> "usr")
-- |Compute the local config directory ('~/.cabal-install' on Linux).
localConfigDir :: IO FilePath
......
......@@ -27,6 +27,7 @@ import Network.URI (URI,parseURI,uriScheme,uriPath)
import Network.HTTP (ConnError(..), Request (..), simpleHTTP
, Response(..), RequestMethod (..))
import Control.Exception (bracket)
import Control.Monad (filterM)
import Text.Printf (printf)
import System.Directory (doesFileExist, createDirectoryIfMissing)
......@@ -36,8 +37,9 @@ import Network.Hackage.CabalInstall.Config (packagesDirectory)
import Network.Hackage.CabalInstall.Dependency (filterFetchables, resolveDependencies)
import Distribution.Package (PackageIdentifier(..), showPackageId)
import Distribution.Compat.FilePath (joinFileName, joinFileExt)
import System.FilePath ((</>), (<.>))
import System.Directory (copyFile)
import System.IO (IOMode(..), hPutStr, Handle, hClose, openBinaryFile)
import Text.ParserCombinators.ReadP (readP_to_S)
import Distribution.ParseUtils (parseDependency)
......@@ -65,11 +67,13 @@ downloadURI path uri
case eitherResult of
Left err -> return (Just err)
Right rsp
| rspCode rsp == (2,0,0) -> writeFile path (rspBody rsp) >> return Nothing
| rspCode rsp == (2,0,0) -> withBinaryFile path WriteMode (`hPutStr` rspBody rsp)
>> return Nothing
| otherwise -> return (Just (ErrorMisc ("Invalid HTTP code: " ++ show (rspCode rsp))))
where request = Request uri GET [] ""
downloadFile :: FilePath
-> String
-> IO (Maybe ConnError)
......@@ -97,14 +101,14 @@ downloadIndex cfg serv
Just err -> fail $ printf "Failed to download index '%s'" (show err)
Nothing -> return path
where url = serv ++ "/" ++ "00-index.tar.gz"
path = packagesDirectory cfg `joinFileName` "00-index" `joinFileExt` "tar.gz"
path = packagesDirectory cfg </> "00-index" <.> "tar.gz"
-- |Generate the full path to a given @PackageIdentifer@.
packageFile :: ConfigFlags -> PackageIdentifier -> FilePath
packageFile cfg pkg = packagesDirectory cfg
`joinFileName` pkgName pkg
`joinFileName` showPackageId pkg
`joinFileExt` "tar.gz"
</> pkgName pkg
</> showPackageId pkg
<.> "tar.gz"
-- |Returns @True@ if the package has already been fetched.
isFetched :: ConfigFlags -> PackageIdentifier -> IO Bool
......@@ -140,3 +144,6 @@ fetch cfg pkgs
pkgIsPresent output pkg
return (not fetched)
output = configOutputGen cfg
withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile name mode = bracket (openBinaryFile name mode) hClose
\ No newline at end of file
......@@ -28,7 +28,7 @@ import Network.Hackage.CabalInstall.TarUtils
import Distribution.SetupWrapper (setupWrapper)
import Distribution.Simple.Configure (getInstalledPackages)
import Distribution.Package (showPackageId, PackageIdentifier)
import Distribution.Compat.FilePath (joinFileName, splitFileName)
import System.FilePath ((</>), splitFileName)
import Data.Maybe (fromMaybe, maybeToList)
import Text.Printf (printf, PrintfType)
......@@ -96,11 +96,11 @@ installPkg :: ConfigFlags
installPkg cfg globalArgs (pkg,ops,location)
= do pkgPath <- downloadPkg cfg pkg location
tmp <- getTemporaryDirectory
let tmpDirPath = tmp `joinFileName` printf "TMP%sTMP" (showPackageId pkg)
tmpPkgPath = tmpDirPath `joinFileName` printf "TAR%s.tgz" (showPackageId pkg)
let tmpDirPath = tmp </> printf "TMP%sTMP" (showPackageId pkg)
tmpPkgPath = tmpDirPath </> printf "TAR%s.tgz" (showPackageId pkg)
setup cmd
= let cmdOps = mkPkgOps cfg cmd (globalArgs++ops)
path = tmpDirPath `joinFileName` showPackageId pkg
path = tmpDirPath </> showPackageId pkg
in do message output 3 $ unwords ["setupWrapper", show (cmd:cmdOps), show path]
setupWrapper (cmd:cmdOps) (Just path)
bracket_ (createDirectoryIfMissing True tmpDirPath)
......
......@@ -17,7 +17,7 @@ module Network.Hackage.CabalInstall.TarUtils
, extractTarFile
) where
import Distribution.Compat.FilePath (splitFileName, splitFileExt, breakFilePath)
import System.FilePath
import System.IO (hClose, hGetContents)
import System.Process (runInteractiveProcess, runProcess, waitForProcess)
import System.Exit (ExitCode(..))
......@@ -25,7 +25,6 @@ import Text.Printf (printf)
import Data.List (find, sortBy)
import Data.Maybe (listToMaybe)
-- |List the files in a gzipped tar archive. Throwing an exception on failure.
tarballGetFiles :: FilePath -- ^Path to the 'tar' binary.
-> FilePath -- ^Path to the .tgz archive.
......@@ -74,11 +73,12 @@ Locate all files with a given extension and return the shortest result.
-}
locateFileExt :: [FilePath] -> String -> Maybe FilePath
locateFileExt files fileExt
= let okExts = filter (\f -> let (_,ext) = splitFileExt f
in ext == fileExt) files
= let okExts = filter ((== fileExt) . tailNotNull . takeExtension) files
in (listToMaybe (sortBy sortFn okExts))
where comparing f a b = f a `compare` f b
sortFn = comparing (length.breakFilePath)
sortFn = comparing (length.splitPath)
tailNotNull [] = []
tailNotNull x = tail x
-- |Extract a given archive in the directory where it's placed.
extractTarFile :: FilePath -- ^Path to the 'tar' binary.
......
......@@ -21,7 +21,7 @@ import Network.Hackage.CabalInstall.Fetch (downloadIndex, packagesDirectory)
import Distribution.Package (PackageIdentifier(..), pkgName, showPackageId)
import Distribution.PackageDescription (PackageDescription(..), readPackageDescription)
import Distribution.Compat.FilePath (joinPaths)
import System.FilePath ((</>), joinPath, addExtension)
import Control.Monad (liftM)
import Data.List (isSuffixOf)
......@@ -35,7 +35,7 @@ update cfg =
extractTarFile tarPath indexPath
contents <- tarballGetFiles tarPath indexPath
let packageDir = packagesDirectory cfg
cabalFiles = [ packageDir `joinPaths` path
cabalFiles = [ packageDir </> path
| path <- contents
, ".cabal" `isSuffixOf` path ]
packageDescriptions <-
......@@ -55,7 +55,7 @@ parsePkg server description =
}
pkgURL :: PackageIdentifier -> String -> String
pkgURL identifier base = concat [base, "/", pkgName identifier, "/", showPackageId identifier, ".tar.gz"]
pkgURL identifier base = joinPath [base, pkgName identifier, showPackageId identifier] `addExtension` ".tar.gz"
concatMapM :: (Monad m) => [a] -> (a -> m [b]) -> m [b]
concatMapM amb f = liftM concat (mapM f amb)
......
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