Commit c2f73685 authored by simonmar's avatar simonmar
Browse files

Register almost working

parent 9969677b
......@@ -45,7 +45,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.InstalledPackageInfo (
InstalledPackageInfo(..),
emptyInstalledPackageInfo
emptyInstalledPackageInfo,
) where
import Distribution.Misc(License(..), Dependency, Opt)
......
......@@ -51,6 +51,7 @@ module Distribution.Simple.Configure (writePersistBuildConfig,
import Distribution.Setup(ConfigFlags,CompilerFlavor(..), Compiler(..))
import Distribution.Package(PackageDescription(..))
import Distribution.Simple.Utils
import Distribution.Package ( PackageIdentifier )
import System.IO hiding (catch)
import System.Exit
......@@ -66,8 +67,17 @@ import HUnit
-- |Data cached after configuration step.
data LocalBuildInfo = LocalBuildInfo {
prefix :: String,
compiler :: Compiler
prefix :: String,
-- ^ The installation directory (eg. @/usr/local@, or
-- @C:/Program Files/foo-1.2@ on Windows.
compiler :: Compiler,
-- ^ The compiler we're building with
packageDeps :: [PackageIdentifier]
-- ^ Which packages we depend on, *exactly*, The
-- 'PackageDescription' specifies a set of build dependencies
-- that must be satisfied in terms of version ranges. This
-- field fixes those dependencies to the specific versions
-- available on this machine for this compiler.
}
deriving (Show, Read, Eq)
......@@ -79,7 +89,7 @@ getPersistBuildConfig = do
str <- readFile localBuildInfoFile
let bi = read str
evaluate bi `catch` \e ->
die "error reading .setup-config; perhaps run ./Setup.lhs configure?"
die "error reading .setup-config; run ./Setup.lhs configure?\n"
return bi
writePersistBuildConfig :: LocalBuildInfo -> IO ()
......@@ -107,7 +117,7 @@ configure pkg_descr (maybe_hc_flavor, maybe_hc_path, maybe_prefix)
message $ "Using compiler flavor: " ++ (show f')
message $ "Using compiler: " ++ p'
message $ "Using package tool: " ++ pkg
return LocalBuildInfo{prefix=prefix, compiler=compiler}
return LocalBuildInfo{prefix=prefix, compiler=compiler, packageDeps=[]}
system_default_prefix PackageDescription{package=package} =
#ifdef mingw32_TARGET_OS
......@@ -194,6 +204,6 @@ hunitTests = do
"finding ghc, etc on simonMar's machine" ~: "failed" ~:
(LocalBuildInfo "/usr" (Compiler GHC
simonMarGHCLoc
(simonMarGHCLoc ++ "-pkg")))
(simonMarGHCLoc ++ "-pkg")) [])
~=? simonMarGHC]]
#endif
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.GHCPackageConfig
-- Copyright : (c) The University of Glasgow 2004
--
-- Maintainer : libraries@haskell.org
-- Stability : alpha
-- Portability : portable
--
-- Explanation: <FIX>
-- WHERE DOES THIS MODULE FIT IN AT A HIGH-LEVEL <FIX>
module Distribution.Simple.GHCPackageConfig (
GHCPackageConfig(..),
mkGHCPackageConfig,
defaultGHCPackageConfig,
showGHCPackageConfig
) where
import Distribution.Package
import Distribution.Simple.Configure
import Distribution.Simple.Install
import Text.PrettyPrint.HughesPJ
-- -----------------------------------------------------------------------------
-- GHC 6.2 PackageConfig type
-- Until GHC supports the InstalledPackageInfo type above, we use its
-- existing PackagConfig type.
mkGHCPackageConfig :: PackageDescription -> LocalBuildInfo -> GHCPackageConfig
mkGHCPackageConfig pkg_descr lbi
= defaultGHCPackageConfig {
name = pkg_name,
auto = True,
import_dirs = [mkImportDir pkg_descr lbi],
hs_libraries = [pkg_name],
extra_libraries = extraLibs pkg_descr,
include_dirs = includeDirs pkg_descr,
c_includes = includes pkg_descr,
package_deps = map showPackageId (packageDeps lbi)
}
where
pkg_name = showPackageId (package pkg_descr)
data GHCPackageConfig
= GHCPackage {
name :: String,
auto :: Bool,
import_dirs :: [String],
source_dirs :: [String],
library_dirs :: [String],
hs_libraries :: [String],
extra_libraries :: [String],
include_dirs :: [String],
c_includes :: [String],
package_deps :: [String],
extra_ghc_opts :: [String],
extra_cc_opts :: [String],
extra_ld_opts :: [String],
framework_dirs :: [String], -- ignored everywhere but on Darwin/MacOS X
extra_frameworks:: [String] -- ignored everywhere but on Darwin/MacOS X
}
defaultGHCPackageConfig
= GHCPackage {
name = error "defaultPackage",
auto = False,
import_dirs = [],
source_dirs = [],
library_dirs = [],
hs_libraries = [],
extra_libraries = [],
include_dirs = [],
c_includes = [],
package_deps = [],
extra_ghc_opts = [],
extra_cc_opts = [],
extra_ld_opts = [],
framework_dirs = [],
extra_frameworks= []
}
-- ---------------------------------------------------------------------------
-- Pretty printing package info
showGHCPackageConfig :: GHCPackageConfig -> String
showGHCPackageConfig pkg = render $
text "Package" $$ nest 3 (braces (
sep (punctuate comma [
text "name = " <> text (show (name pkg)),
text "auto = " <> text (show (auto pkg)),
dumpField "import_dirs" (import_dirs pkg),
dumpField "source_dirs" (source_dirs pkg),
dumpField "library_dirs" (library_dirs pkg),
dumpField "hs_libraries" (hs_libraries pkg),
dumpField "extra_libraries" (extra_libraries pkg),
dumpField "include_dirs" (include_dirs pkg),
dumpField "c_includes" (c_includes pkg),
dumpField "package_deps" (package_deps pkg),
dumpField "extra_ghc_opts" (extra_ghc_opts pkg),
dumpField "extra_cc_opts" (extra_cc_opts pkg),
dumpField "extra_ld_opts" (extra_ld_opts pkg),
dumpField "framework_dirs" (framework_dirs pkg),
dumpField "extra_frameworks"(extra_frameworks pkg)
])))
dumpField :: String -> [String] -> Doc
dumpField name val = hang (text name <+> equals) 2 (dumpFieldContents val)
dumpFieldContents :: [String] -> Doc
dumpFieldContents val = brackets (sep (punctuate comma (map (text . show) val)))
{-# OPTIONS -cpp #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.Install
......@@ -42,11 +43,12 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.Simple.Install (
install
install,
mkImportDir
) where
import Distribution.Package(PackageDescription)
import Distribution.Simple.Configure(LocalBuildInfo)
import Distribution.Package
import Distribution.Simple.Configure(LocalBuildInfo(..))
import Distribution.Simple.Utils(setupMessage)
import System.Exit
......@@ -56,3 +58,17 @@ install pkg_descr localbuildinfo = do
setupMessage "Installing" pkg_descr
exitWith (ExitFailure 1)
-- -----------------------------------------------------------------------------
-- Installation policies
mkImportDir :: PackageDescription -> LocalBuildInfo -> FilePath
mkImportDir pkg_descr lbi =
#ifdef mingw32_TARGET_OS
prefix lbi ++ '/':pkg_name
#else
prefix lbi ++ "/lib/" ++ pkg_name
#endif
where
pkg_name = showPackageId (package pkg_descr)
......@@ -46,20 +46,45 @@ module Distribution.Simple.Register (
unregister,
) where
import Distribution.Simple.Configure(LocalBuildInfo)
import Distribution.Package(PackageDescription)
import Distribution.Simple.Configure
import Distribution.Setup
import Distribution.Package
import Distribution.InstalledPackageInfo(InstalledPackageInfo)
import Distribution.Simple.Utils(setupMessage)
import Distribution.Simple.Utils
import Distribution.Simple.GHCPackageConfig
import System.IO
import System.Exit
import Control.Monad
-- -----------------------------------------------------------------------------
-- Registration
register :: PackageDescription -> LocalBuildInfo -> IO ()
register pkg_descr lbi = do
setupMessage "Registering" pkg_descr
exitWith (ExitFailure 1)
when (compilerFlavor (compiler lbi) /= GHC) $
die ("only registering with GHC is implemented")
let pkg_config = mkGHCPackageConfig pkg_descr lbi
writeFile installedPkgConfigFile (showGHCPackageConfig pkg_config)
rawSystemExit (compilerPkgTool (compiler lbi))
["--add-package", "--input-file="++installedPkgConfigFile]
installedPkgConfigFile = "installed-pkg-config"
-- -----------------------------------------------------------------------------
-- Unregistration
unregister :: PackageDescription -> LocalBuildInfo -> IO ()
unregister pkg_descr lbi = do
setupMessage "Unregistering" pkg_descr
exitWith (ExitFailure 1)
when (compilerFlavor (compiler lbi) /= GHC) $
die ("only unregistering with GHC is implemented")
rawSystemExit (compilerPkgTool (compiler lbi))
["--remove-package=" ++ showPackageId (package pkg_descr)]
......@@ -62,6 +62,9 @@ import System.Cmd
import System.Environment
import System.Directory
-- -----------------------------------------------------------------------------
-- Pathname-related utils
-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy.ext")
splitFilenameDir :: String -> (String,String)
splitFilenameDir str
......@@ -91,13 +94,6 @@ isPathSeparator ch =
ch == '/'
#endif
setupMessage :: String -> PackageDescription -> IO ()
setupMessage msg pkg_descr =
putStrLn (msg ++ ' ':showPackageId (package pkg_descr) ++ "...")
die :: String -> IO a
die msg = do hPutStr stderr msg; exitWith (ExitFailure 1)
-- ToDo: add cacheing?
findBinary :: String -> IO (Maybe FilePath)
findBinary binary = do
......@@ -121,6 +117,16 @@ parsePath path = split pathSep path
pathSep = ':'
#endif
-- -----------------------------------------------------------------------------
-- Utils for setup
setupMessage :: String -> PackageDescription -> IO ()
setupMessage msg pkg_descr =
putStrLn (msg ++ ' ':showPackageId (package pkg_descr) ++ "...")
die :: String -> IO a
die msg = do hPutStr stderr msg; exitWith (ExitFailure 1)
-- -----------------------------------------------------------------------------
-- rawSystem variants
......
module A where
a = 42 :: Int
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