Commit a10ae8e3 authored by bjorn@bringert.net's avatar bjorn@bringert.net
Browse files

Added a config file. Removed the old serv.list file. Added dinstall directory...

Added a config file. Removed the old serv.list file. Added dinstall directory command line arguments.
parent b204fbeb
......@@ -16,7 +16,6 @@ Build-depends: base, mtl, network, regex-compat,
Cabal>=1.3,
HTTP >= 3000.0 && < 3000.1,
zlib >= 0.3
data-files: serv.list
Extra-Source-Files: copyright README
Executable: cabal-install
......@@ -27,7 +26,6 @@ Other-Modules:
Network.Hackage.CabalInstall.BuildDep
Network.Hackage.CabalInstall.Clean
Network.Hackage.CabalInstall.Config
Network.Hackage.CabalInstall.Configure
Network.Hackage.CabalInstall.Dependency
Network.Hackage.CabalInstall.Fetch
Network.Hackage.CabalInstall.Info
......
[("hackage.haskell.org", "http://hackage.haskell.org/packages/archive")]
......@@ -15,7 +15,7 @@ module Network.Hackage.CabalInstall.BuildDep where
import Network.Hackage.CabalInstall.Dependency (getPackages, getBuildDeps
, listInstalledPackages
, depToUnresolvedDep, resolveDependenciesAux)
import Network.Hackage.CabalInstall.Install (install, installPkg)
import Network.Hackage.CabalInstall.Install (install, installPackages)
import Network.Hackage.CabalInstall.Types (ConfigFlags (..), UnresolvedDependency)
import Distribution.PackageDescription (readPackageDescription, buildDepends,
......@@ -30,7 +30,7 @@ buildDep cfg globalArgs deps
= do ipkgs <- listInstalledPackages cfg
apkgs <- fmap getPackages (fmap (getBuildDeps ipkgs)
(resolveDependenciesAux cfg ipkgs deps))
mapM_ (installPkg cfg globalArgs) apkgs
installPackages cfg globalArgs apkgs
-- | Takes the path to a .cabal file, and installs the build-dependencies listed there.
-- FIXME: what if the package uses hooks which modify the build-dependencies?
......
......@@ -15,12 +15,13 @@ module Network.Hackage.CabalInstall.Config
, repoCacheDir
, packageFile
, packageDir
, getDefaultConfigDir
, getLocalConfigDir
, getLocalCacheDir
, getKnownServers
, getKnownPackages
, selectValidConfigDir
, pkgURL
, defaultConfigFile
, loadConfig
, programConfiguration
, findCompiler
) where
import Prelude hiding (catch)
......@@ -28,18 +29,27 @@ import Control.Exception (catch, Exception(IOException),evaluate)
import Control.Monad.Error (mplus, filterM) -- Using Control.Monad.Error to get the Error instance for IO.
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Char (isAlphaNum, toLower)
import Data.List (intersperse)
import Data.Maybe (mapMaybe)
import Data.Maybe (mapMaybe, fromMaybe)
import System.Directory (Permissions (..), getPermissions, createDirectoryIfMissing
,getTemporaryDirectory)
import System.IO.Error (isDoesNotExistError)
import System.IO (hPutStrLn, stderr)
import System.IO.Unsafe
import Text.PrettyPrint.HughesPJ (text)
import Distribution.Compat.ReadP (ReadP, char, munch1, readS_to_P)
import Distribution.Compiler (CompilerFlavor(..), defaultCompilerFlavor)
import Distribution.Package (PackageIdentifier(..), showPackageId)
import Distribution.PackageDescription (GenericPackageDescription(..)
, PackageDescription(..)
, parsePackageDescription, ParseResult(..))
import Distribution.ParseUtils (FieldDescr, simpleField, listField)
import Distribution.Simple.Compiler (Compiler)
import qualified Distribution.Simple.Configure as Configure (configCompiler)
import Distribution.Simple.InstallDirs (InstallDirTemplates(..), defaultInstallDirs)
import Distribution.Simple.Program (ProgramConfiguration, defaultProgramConfiguration)
import Distribution.Version (Dependency, showVersion)
import Distribution.Verbosity
import System.FilePath ((</>), takeExtension, (<.>))
......@@ -47,36 +57,37 @@ import System.Directory
import Network.Hackage.CabalInstall.Tar (readTarArchive, tarFileName)
import Network.Hackage.CabalInstall.Types (ConfigFlags (..), OutputGen(..), PkgInfo (..), Repo(..))
import Network.Hackage.CabalInstall.Utils
-- FIXME: remove imports below, only for defaultOutputGen
import Paths_cabal_install (getDataDir)
import Control.Monad (guard, mplus, when)
-- |Compute the global config directory
-- (eg '/usr/local/share/cabal-install-0.3.0/' on Linux).
getDefaultConfigDir :: IO FilePath
getDefaultConfigDir = getDataDir
import Network.Hackage.CabalInstall.Types (ConfigFlags (..), OutputGen (..)
, ResolvedPackage (..))
import qualified Distribution.Simple.Configure as Configure (configCompiler)
import Distribution.Simple.Program
import Distribution.ParseUtils (showDependency)
import Distribution.Package (showPackageId)
import Distribution.Version (VersionRange(..))
import Distribution.Verbosity
import System.FilePath ((</>))
import Text.Printf (printf)
import System.IO (openFile, IOMode (..))
import System.Directory (doesFileExist, getHomeDirectory, getAppUserDataDirectory)
import Data.Maybe (fromMaybe)
-- |Compute the local config directory ('~/.cabal-install' on Linux).
getLocalConfigDir :: IO FilePath
getLocalConfigDir
= getAppUserDataDirectory "cabal-install"
getLocalCacheDir :: IO FilePath
getLocalCacheDir = getLocalConfigDir
pkgListFile :: FilePath
pkgListFile = "pkg.list"
servListFile :: FilePath
servListFile = "serv.list"
-- |Name of the packages directory.
packagesDirectoryName :: FilePath
packagesDirectoryName = "packages"
-- | Full path to the server list file
servList :: ConfigFlags -> FilePath
servList cfg = configConfDir cfg </> servListFile
-- | Full path to the packages directory.
packagesDirectory :: ConfigFlags -> FilePath
packagesDirectory cfg = configCacheDir cfg </> packagesDirectoryName
......@@ -101,7 +112,7 @@ packageDir cfg pkg repo = repoCacheDir cfg repo
getKnownPackages :: ConfigFlags -> IO [PkgInfo]
getKnownPackages cfg
= fmap concat $ mapM (readRepoIndex cfg) $ configServers cfg
= fmap concat $ mapM (readRepoIndex cfg) $ configRepos cfg
readRepoIndex :: ConfigFlags -> Repo -> IO [PkgInfo]
readRepoIndex cfg repo =
......@@ -128,41 +139,172 @@ parseRepoIndex repo s =
_ -> error $ "Couldn't read cabal file " ++ show (tarFileName hdr)
else fail "Not a .cabal file"
getKnownServers :: ConfigFlags -> IO [Repo]
getKnownServers cfg
= (evaluate =<< fmap readRepos (readFile (servList cfg)))
`catch` \e -> case e of
IOException ioe | isDoesNotExistError ioe ->
return defaultServs
_ -> hPutStrLn stderr ("Failed to read server list: " ++ (show e) ++ ". Using hackage.haskell.org.") >> return defaultServs
where defaultServs = [ Repo "hackage.haskell.org" "http://hackage.haskell.org/packages/archive" ]
readRepos :: String -> [Repo]
readRepos = map (\ (n,u) -> Repo { repoName = n, repoURL = u }) . read
-- |Confirms validity of a config directory by checking the permissions for the package-list file,
-- server-list file and downloaded packages directory.
isValidConfigDir :: FilePath -> IO Bool
isValidConfigDir path
= do checks <- sequence
[ checkFiles readable [ path ]]
-- , path </> servListFile ]]
return (and checks)
-- |Picks the first valid config directory or throws an exception if none were found.
selectValidConfigDir :: [FilePath] -> IO FilePath
selectValidConfigDir paths
= do valids <- filterM isValidConfigDir paths
case valids of
[] -> error "No valid config dir found!"
(x:_) -> return x
checkFiles :: (Permissions -> Bool) -> [FilePath] -> IO Bool
checkFiles check
= worker True
where worker r [] = return r
worker r (x:xs)
= do permissions <- getPermissions x
if check permissions
then worker r xs
else return False
`mplus` worker False xs
{-|
Structure with default responses to various events.
-}
defaultOutputGen :: Verbosity -> IO OutputGen
defaultOutputGen verbosity
= do (outch,errch) <- do guard (verbosity <= normal)
nullOut <- openFile ("/"</>"dev"</>"null") AppendMode
nullErr <- openFile ("/"</>"dev"</>"null") AppendMode
return (Just nullOut, Just nullErr)
`mplus` return (Nothing,Nothing)
return OutputGen
{ prepareInstall = \_pkgs -> return ()
, pkgIsPresent = printf "'%s' is present.\n" . showPackageId
, downloadingPkg = printf "Downloading '%s'...\n" . showPackageId
, executingCmd = \cmd args
-> when (verbosity > silent) $ printf "Executing: '%s %s'\n" cmd (unwords args)
, cmdFailed = \cmd args errno
-> error (printf "Command failed: '%s %s'. Errno: %d\n" cmd (unwords args) errno)
, buildingPkg = printf "Building '%s'\n" . showPackageId
, stepConfigPkg = const (printf " Configuring...\n")
, stepBuildPkg = const (printf " Building...\n")
, stepInstallPkg = const (printf " Installing...\n")
, stepFinishedPkg= const (printf " Done.\n")
, noSetupScript = const (error "Couldn't find a setup script in the tarball.")
, noCabalFile = const (error "Couldn't find a .cabal file in the tarball")
, gettingPkgList = \serv ->
when (verbosity > silent) (printf "Downloading package list from server '%s'\n" serv)
, showPackageInfo = showPkgInfo
, showOtherPackageInfo = showOtherPkg
, cmdStdout = outch
, cmdStderr = errch
, message = \v s -> when (verbosity >= v) (putStrLn s)
}
where showOtherPkg mbPkg dep
= do printf " Package: '%s'\n" (show $ showDependency dep)
case mbPkg of
Nothing -> printf " Not available!\n\n"
Just pkg -> do printf " Using: %s\n" (showPackageId pkg)
printf " Installed: Yes\n\n"
showPkgInfo mbPath installed ops dep (pkg,repo,deps)
= do printf " Package: '%s'\n" (show $ showDependency dep)
printf " Using: %s\n" (showPackageId pkg)
printf " Installed: %s\n" (if installed then "Yes" else "No")
printf " Depends: %s\n" (showDeps deps)
printf " Options: %s\n" (unwords ops)
printf " Location: %s\n" (pkgURL pkg repo)
printf " Local: %s\n\n" (fromMaybe "*Not downloaded" mbPath)
showDeps = show . map showDep
showDep dep = show (showDependency (fulfilling dep))
-- | Generate the URL of the tarball for a given package.
pkgURL :: PackageIdentifier -> Repo -> String
pkgURL pkg repo = joinWith "/" [repoURL repo, pkgName pkg, showVersion (pkgVersion pkg), showPackageId pkg]
++ ".tar.gz"
where joinWith tok = concat . intersperse tok
--
-- * Compiler and programs
--
-- FIXME: should look at config
programConfiguration :: ConfigFlags -> IO ProgramConfiguration
programConfiguration cfg = return defaultProgramConfiguration
findCompiler :: ConfigFlags -> IO (Compiler, ProgramConfiguration)
findCompiler cfg =
do conf <- programConfiguration cfg
Configure.configCompiler
(Just (configCompiler cfg))
Nothing Nothing conf (configVerbose cfg)
--
-- * Default config
--
defaultConfigDir :: IO FilePath
defaultConfigDir = getAppUserDataDirectory "cabal"
defaultConfigFile :: IO FilePath
defaultConfigFile = do dir <- defaultConfigDir
return $ dir </> "config"
defaultCacheDir :: IO FilePath
defaultCacheDir = defaultConfigDir
defaultCompiler :: CompilerFlavor
defaultCompiler = fromMaybe GHC defaultCompilerFlavor
defaultConfigFlags :: IO ConfigFlags
defaultConfigFlags =
do installDirs <- defaultInstallDirs defaultCompiler True
cacheDir <- defaultCacheDir
outputGen <- defaultOutputGen normal -- FIXME: get rid of OutputGen
return $ ConfigFlags
{ configCompiler = defaultCompiler
, configInstallDirs = installDirs
, configCacheDir = cacheDir
, configRepos = [Repo "hackage.haskell.org" "http://hackage.haskell.org/packages/archive"]
, configOutputGen = outputGen
, configVerbose = normal
, configUserInstall = True
}
--
-- * Config file reading
--
loadConfig :: FilePath -> IO ConfigFlags
loadConfig configFile =
do defaultConf <- defaultConfigFlags
minp <- readFileIfExists configFile
case minp of
Nothing -> do hPutStrLn stderr $ "Config file " ++ configFile ++ " not found."
-- FIXME: write config file with defaults
return defaultConf
Just inp -> case parseBasicStanza configFieldDescrs defaultConf inp of
ParseOk ws dummyConf ->
do mapM_ (hPutStrLn stderr . ("Config file warning: " ++)) ws
-- There is a data dependency within the config file.
-- The default installation paths depend on the compiler.
-- Hence we need to do two passes through the config file.
installDirs <- defaultInstallDirs (configCompiler dummyConf) True
let conf = defaultConf { configInstallDirs = installDirs }
case parseBasicStanza configFieldDescrs conf inp of
ParseOk _ conf' -> return conf'
ParseFailed err ->
fail $ "Error parsing config file " ++ configFile ++ ": " ++ showPError err
configFieldDescrs :: [FieldDescr ConfigFlags]
configFieldDescrs =
[ simpleField "compiler"
(text . show) parseCompilerFlavor
configCompiler (\c cfg -> cfg { configCompiler = c })
, listField "repos"
(text . showRepo) parseRepo
configRepos (\rs cfg -> cfg { configRepos = rs })
, simpleField "prefix"
(text . show) (readS_to_P reads)
(prefixDirTemplate . configInstallDirs) (\d -> setInstallDir (\ds -> ds { prefixDirTemplate = d }))
]
setInstallDir :: (InstallDirTemplates -> InstallDirTemplates) -> ConfigFlags -> ConfigFlags
setInstallDir f cfg = cfg { configInstallDirs = f (configInstallDirs cfg) }
parseCompilerFlavor :: ReadP r CompilerFlavor
parseCompilerFlavor =
do s <- munch1 isAlphaNum
return $ case map toLower s of
"ghc" -> GHC
"nhc" -> NHC
"hugs" -> Hugs
"hbc" -> HBC
"helium" -> Helium
"jhc" -> JHC
_ -> OtherCompiler s
showRepo :: Repo -> String
showRepo repo = repoName repo ++ ":" ++ repoURL repo
parseRepo :: ReadP r Repo
parseRepo = do name <- munch1 (\c -> isAlphaNum c || c `elem` "_-.")
char ':'
url <- munch1 (const True)
return $ Repo { repoName = name, repoURL = url }
-----------------------------------------------------------------------------
-- |
-- Module : Network.Hackage.CabalInstall.Configure
-- Copyright : (c) David Himmelstrup 2005
-- License : BSD-like
--
-- Maintainer : lemmih@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Functions used to generate ConfigFlags.
-----------------------------------------------------------------------------
module Network.Hackage.CabalInstall.Configure
( defaultOutputGen
, mkConfigFlags
) where
import Control.Monad (guard, mplus, when)
import Network.Hackage.CabalInstall.Types (ConfigFlags (..), OutputGen (..)
, TempFlags (..), ResolvedPackage (..))
import Network.Hackage.CabalInstall.Config
(getDefaultConfigDir, getLocalConfigDir, getLocalCacheDir,
getKnownServers, selectValidConfigDir)
import Network.Hackage.CabalInstall.Fetch (pkgURL)
import qualified Distribution.Simple.Configure as Configure (configCompiler)
import Distribution.Simple.Program
import Distribution.ParseUtils (showDependency)
import Distribution.Package (showPackageId)
import Distribution.Version (VersionRange(..))
import Distribution.Verbosity
import System.FilePath ((</>))
import Text.Printf (printf)
import System.IO (openFile, IOMode (..))
import System.Directory (doesFileExist, getHomeDirectory, getAppUserDataDirectory)
import Data.Maybe (fromMaybe)
{-|
Structure with default responses to various events.
-}
defaultOutputGen :: Verbosity -> IO OutputGen
defaultOutputGen verbosity
= do (outch,errch) <- do guard (verbosity <= normal)
nullOut <- openFile ("/"</>"dev"</>"null") AppendMode
nullErr <- openFile ("/"</>"dev"</>"null") AppendMode
return (Just nullOut, Just nullErr)
`mplus` return (Nothing,Nothing)
return OutputGen
{ prepareInstall = \_pkgs -> return ()
, pkgIsPresent = printf "'%s' is present.\n" . showPackageId
, downloadingPkg = printf "Downloading '%s'...\n" . showPackageId
, executingCmd = \cmd args
-> when (verbosity > silent) $ printf "Executing: '%s %s'\n" cmd (unwords args)
, cmdFailed = \cmd args errno
-> error (printf "Command failed: '%s %s'. Errno: %d\n" cmd (unwords args) errno)
, buildingPkg = printf "Building '%s'\n" . showPackageId
, stepConfigPkg = const (printf " Configuring...\n")
, stepBuildPkg = const (printf " Building...\n")
, stepInstallPkg = const (printf " Installing...\n")
, stepFinishedPkg= const (printf " Done.\n")
, noSetupScript = const (error "Couldn't find a setup script in the tarball.")
, noCabalFile = const (error "Couldn't find a .cabal file in the tarball")
, gettingPkgList = \serv ->
when (verbosity > silent) (printf "Downloading package list from server '%s'\n" serv)
, showPackageInfo = showPkgInfo
, showOtherPackageInfo = showOtherPkg
, cmdStdout = outch
, cmdStderr = errch
, message = \v s -> when (verbosity >= v) (putStrLn s)
}
where showOtherPkg mbPkg dep
= do printf " Package: '%s'\n" (show $ showDependency dep)
case mbPkg of
Nothing -> printf " Not available!\n\n"
Just pkg -> do printf " Using: %s\n" (showPackageId pkg)
printf " Installed: Yes\n\n"
showPkgInfo mbPath installed ops dep (pkg,repo,deps)
= do printf " Package: '%s'\n" (show $ showDependency dep)
printf " Using: %s\n" (showPackageId pkg)
printf " Installed: %s\n" (if installed then "Yes" else "No")
printf " Depends: %s\n" (showDeps deps)
printf " Options: %s\n" (unwords ops)
printf " Location: %s\n" (pkgURL pkg repo)
printf " Local: %s\n\n" (fromMaybe "*Not downloaded" mbPath)
showDeps = show . map showDep
showDep dep = show (showDependency (fulfilling dep))
-- |Compute the default prefix when doing a local install ('~/usr' on Linux).
localPrefix :: IO FilePath
localPrefix
= do home <- getHomeDirectory
return (home </> "usr")
{-|
Give concrete answers to questions like:
* where to find \'runhaskell\'.
* where to find \'tar\'.
* which compiler to use.
* which config-directory to use.
-}
mkConfigFlags :: TempFlags -> IO ConfigFlags
mkConfigFlags cfg
= do let verbosity = tempVerbose cfg
conf = userMaybeSpecifyPath "tar" (tempTarPath cfg) $
defaultProgramConfiguration
(tarProg, conf') <- requireProgram verbosity tarProgram AnyVersion conf
(comp, conf'') <- Configure.configCompiler (tempHcFlavor cfg) (tempHcPath cfg) (tempHcPkg cfg) conf' verbosity
let userIns = tempUserIns cfg
prefix <- if userIns
then fmap Just (maybe localPrefix return (tempPrefix cfg))
else return Nothing
defaultConfigDir <- getDefaultConfigDir
localConfigDir <- getLocalConfigDir
localCacheDir <- getLocalCacheDir
confDir <- selectValidConfigDir ( maybe id (:) (tempConfDir cfg)
[localConfigDir, defaultConfigDir] )
let cacheDir = fromMaybe localCacheDir (tempCacheDir cfg)
when (verbosity > normal) $ do
printf "Using config dir: %s\n" confDir
printf "Using cache dir: %s\n" cacheDir
outputGen <- defaultOutputGen (tempVerbose cfg)
let config = ConfigFlags
{ configCompiler = comp
, configPrograms = conf''
, configConfDir = confDir
, configCacheDir = cacheDir
, configPrefix = prefix
, configServers = []
, configTarPath = programPath tarProg
, configOutputGen = outputGen
, configVerbose = tempVerbose cfg
-- , configUpgradeDeps = tempUpgradeDeps cfg
, configUserIns = userIns
}
knownServers <- getKnownServers config
return (config{ configServers = knownServers})
runhaskellProgram :: Program
runhaskellProgram = simpleProgram "runhaskell"
......@@ -34,7 +34,8 @@ import Distribution.PackageDescription
, finalizePackageDescription)
import Distribution.ParseUtils (showDependency)
import Distribution.Simple.Configure (getInstalledPackages)
import Distribution.Simple.Compiler (PackageDB(..), showCompilerId, compilerVersion)
import Distribution.Simple.Compiler (PackageDB(..), Compiler, showCompilerId, compilerVersion)
import Distribution.Simple.Program (defaultProgramConfiguration)
import Data.Char (toLower)
import Data.List (nub, maximumBy, isPrefixOf)
......@@ -42,7 +43,7 @@ import Data.Maybe (mapMaybe)
import Control.Monad (guard)
import qualified System.Info (arch,os)
import Network.Hackage.CabalInstall.Config (getKnownPackages)
import Network.Hackage.CabalInstall.Config (getKnownPackages, findCompiler)
import Network.Hackage.CabalInstall.Types ( ResolvedPackage(..), UnresolvedDependency(..)
, ConfigFlags (..), PkgInfo (..), ResolvedDependency(..), Repo(..))
import Text.Printf (printf)
......@@ -140,18 +141,18 @@ isInstalled :: [PackageIdentifier] -- ^Installed packages.
isInstalled ps dep = any (fulfillDependency dep) ps
getDependency :: ConfigFlags
getDependency :: Compiler
-> [PackageIdentifier]
-> [PkgInfo]
-> UnresolvedDependency -> ResolvedPackage
getDependency cfg installed available (UnresolvedDependency { dependency=dep, depOptions=opts})
getDependency comp installed available (UnresolvedDependency { dependency=dep, depOptions=opts})
= ResolvedPackage { fulfilling = dep
, resolvedData = fmap pkgData (getLatestPkg available dep)
, pkgOptions = opts }
where pkgData p = ( package d
, pkgRepo p
, map (getDependency cfg installed available . depToUnresolvedDep) (buildDepends d))
where d = finalizePackage cfg installed available (configurationsFlags opts) p
, map (getDependency comp installed available . depToUnresolvedDep) (buildDepends d))
where d = finalizePackage comp installed available (configurationsFlags opts) p
configurationsFlags :: [String] -> [(String, Bool)]
configurationsFlags opts =
......@@ -181,13 +182,13 @@ filterFetchables = mapMaybe worker
where worker dep = do (pkg,repo,_) <- resolvedData dep
return (pkg,repo)
finalizePackage :: ConfigFlags
finalizePackage :: Compiler
-> [PackageIdentifier] -- ^ All installed packages
-> [PkgInfo] -- ^ All available packages
-> [(String,Bool)] -- ^ Configurations flags
-> PkgInfo
-> PackageDescription
finalizePackage cfg installed available flags desc
finalizePackage comp installed available flags desc
= case e of
Left missing -> error $ "Can't resolve dependencies: " ++ show missing
Right (d,flags) -> d
......@@ -197,7 +198,7 @@ finalizePackage cfg installed available flags desc
(Just $ nub $ installed ++ map (package . packageDescription . pkgDesc) available)
System.Info.os
System.Info.arch
(showCompilerId (configCompiler cfg), compilerVersion (configCompiler cfg))
(showCompilerId comp, compilerVersion comp)
(pkgDesc desc)
-- |Resolve some dependencies from the known packages while filtering out installed packages.
......@@ -207,10 +208,11 @@ resolveDependenciesAux :: ConfigFlags
-> [UnresolvedDependency] -- ^Dependencies in need of resolution.
-> IO [ResolvedPackage]
resolveDependenciesAux cfg ps deps
= do installed <- listInstalledPackages cfg
= do (comp,_) <- findCompiler cfg
installed <- listInstalledPackages cfg
knownPkgs <- getKnownPackages cfg