Skip to content
GitLab
Commit 72547264 authored by Simon Marlow's avatar Simon Marlow
Browse files

Add unique package identifiers (InstalledPackageId) in the package DB 

See commentary at
http://hackage.haskell.org/trac/ghc/wiki/Commentary/Packages
parent 21c5c9c0
Hide whitespace changes
Inline Side-by-side
compiler/ghc.mk
View file @ 72547264
......@@ -464,6 +464,7 @@ $(eval $(call compiler-hs-dependency,PrimOp,$(PRIMOP_BITS)))
ifneq "$(ProjectPatchLevel)" "0"
compiler/stage1/inplace-pkg-config-munged: compiler/stage1/inplace-pkg-config
sed -e 's/^\(version: .*\)\.$(ProjectPatchLevel)$$/\1/' \
-e 's/^\(id: .*\)\.$(ProjectPatchLevel)$$/\1/' \
-e 's/^\(hs-libraries: HSghc-.*\)\.$(ProjectPatchLevel)$$/\1/' \
< $< > $@
"$(compiler_stage1_GHC_PKG)" update --force $(compiler_stage1_GHC_PKG_OPTS) $@
......
compiler/ghci/Linker.lhs
View file @ 72547264
......@@ -51,6 +51,7 @@ import ErrUtils
import SrcLoc
import qualified Maybes
import UniqSet
import FiniteMap
import Constants
import FastString
import Config ( cProjectVersion )
......@@ -973,23 +974,25 @@ linkPackages dflags new_pkgs = do
linkPackages' :: DynFlags -> [PackageId] -> PersistentLinkerState
-> IO PersistentLinkerState
linkPackages' dflags new_pks pls = do
let pkg_map = pkgIdMap (pkgState dflags)
pkgs' <- link pkg_map (pkgs_loaded pls) new_pks
pkgs' <- link (pkgs_loaded pls) new_pks
return $! pls { pkgs_loaded = pkgs' }
where
link :: PackageConfigMap -> [PackageId] -> [PackageId] -> IO [PackageId]
link pkg_map pkgs new_pkgs =
foldM (link_one pkg_map) pkgs new_pkgs
pkg_map = pkgIdMap (pkgState dflags)
ipid_map = installedPackageIdMap (pkgState dflags)
link :: [PackageId] -> [PackageId] -> IO [PackageId]
link pkgs new_pkgs =
foldM link_one pkgs new_pkgs
link_one pkg_map pkgs new_pkg
link_one pkgs new_pkg
| new_pkg `elem` pkgs -- Already linked
= return pkgs
| Just pkg_cfg <- lookupPackage pkg_map new_pkg
= do { -- Link dependents first
pkgs' <- link pkg_map pkgs (map mkPackageId (depends pkg_cfg))
pkgs' <- link pkgs [ Maybes.expectJust "link_one" $
lookupFM ipid_map ipid
| ipid <- depends pkg_cfg ]
-- Now link the package itself
; linkPackage dflags pkg_cfg
; return (new_pkg : pkgs') }
......
compiler/main/DynFlags.hs
View file @ 72547264
......@@ -2058,13 +2058,7 @@ ignorePackage p =
upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
setPackageName :: String -> DynFlags -> DynFlags
setPackageName p
| Nothing <- unpackPackageId pid
= ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
| otherwise
= \s -> s{ thisPackage = pid }
where
pid = stringToPackageId p
setPackageName p s = s{ thisPackage = stringToPackageId p }
-- If we're linking a binary, then only targets that produce object
-- code are allowed (requests for other target types are ignored).
......
compiler/main/PackageConfig.hs
View file @ 72547264
......@@ -7,7 +7,7 @@ module PackageConfig (
-- $package_naming
-- * PackageId
mkPackageId, packageConfigId, unpackPackageId,
mkPackageId, packageConfigId,
-- * The PackageConfig type: information about a package
PackageConfig,
......@@ -28,7 +28,6 @@ import Distribution.ModuleName
import Distribution.Package hiding (PackageId)
import Distribution.Text
import Distribution.Version
import Distribution.Compat.ReadP
-- -----------------------------------------------------------------------------
-- Our PackageConfig type is just InstalledPackageInfo from Cabal. Later we
......@@ -62,15 +61,6 @@ mkPackageId = stringToPackageId . display
packageConfigId :: PackageConfig -> PackageId
packageConfigId = mkPackageId . package
-- | Try and interpret a GHC 'PackageId' as a cabal 'PackageIdentifer'. Returns @Nothing@ if
-- we could not parse it as such an object.
unpackPackageId :: PackageId -> Maybe PackageIdentifier
unpackPackageId p
= case [ pid | (pid,"") <- readP_to_S parse str ] of
[] -> Nothing
(pid:_) -> Just pid
where str = packageIdString p
-- | Turn a 'PackageConfig', which contains GHC 'Module.ModuleName's into a Cabal specific
-- 'InstalledPackageInfo' which contains Cabal 'Distribution.ModuleName.ModuleName's
packageConfigToInstalledPackageInfo :: PackageConfig -> InstalledPackageInfo
......
compiler/main/Packages.lhs
View file @ 72547264
......@@ -42,15 +42,16 @@ import StaticFlags
import Config ( cProjectVersion )
import Name ( Name, nameModule_maybe )
import UniqFM
import FiniteMap
import Module
import Util
import Maybes ( expectJust, MaybeErr(..) )
import Panic
import Outputable
import Maybes
import System.Environment ( getEnv )
import Distribution.InstalledPackageInfo hiding (depends)
import Distribution.Package hiding (depends, PackageId)
import Distribution.InstalledPackageInfo
import Distribution.Package hiding (PackageId,depends)
import FastString
import ErrUtils ( debugTraceMsg, putMsg, Message )
import Exception
......@@ -59,7 +60,7 @@ import System.Directory
import System.FilePath
import Data.Maybe
import Control.Monad
import Data.List
import Data.List as List
-- ---------------------------------------------------------------------------
-- The Package state
......@@ -113,11 +114,13 @@ data PackageState = PackageState {
-- should be in reverse dependency order; that is, a package
-- is always mentioned before the packages it depends on.
moduleToPkgConfAll :: UniqFM [(PackageConfig,Bool)] -- ModuleEnv mapping
moduleToPkgConfAll :: UniqFM [(PackageConfig,Bool)], -- ModuleEnv mapping
-- Derived from pkgIdMap.
-- Maps Module to (pkgconf,exposed), where pkgconf is the
-- PackageConfig for the package containing the module, and
-- exposed is True if the package exposes that module.
installedPackageIdMap :: FiniteMap InstalledPackageId PackageId
}
-- | A PackageConfigMap maps a 'PackageId' to a 'PackageConfig'
......@@ -370,32 +373,27 @@ hideOldPackages dflags pkgs = mapM maybe_hide pkgs
findWiredInPackages
:: DynFlags
-> [PackageConfig] -- database
-> [PackageIdentifier] -- preload packages
-> PackageId -- this package
-> IO ([PackageConfig],
[PackageIdentifier],
PackageId)
-> IO [PackageConfig]
findWiredInPackages dflags pkgs preload this_package = do
findWiredInPackages dflags pkgs = do
--
-- Now we must find our wired-in packages, and rename them to
-- their canonical names (eg. base-1.0 ==> base).
--
let
wired_in_pkgids :: [(PackageId, [String])]
wired_in_pkgids = [ (primPackageId, [""]),
(integerPackageId, [""]),
(basePackageId, [""]),
(rtsPackageId, [""]),
(haskell98PackageId, [""]),
(thPackageId, [""]),
(dphSeqPackageId, [""]),
(dphParPackageId, [""])]
matches :: PackageConfig -> (PackageId, [String]) -> Bool
pc `matches` (pid, suffixes)
= display (pkgName (package pc)) `elem`
(map (packageIdString pid ++) suffixes)
wired_in_pkgids :: [String]
wired_in_pkgids = map packageIdString
[ primPackageId,
integerPackageId,
basePackageId,
rtsPackageId,
haskell98PackageId,
thPackageId,
dphSeqPackageId,
dphParPackageId ]
matches :: PackageConfig -> String -> Bool
pc `matches` pid = display (pkgName (package pc)) == pid
-- find which package corresponds to each wired-in package
-- delete any other packages with the same name
......@@ -407,33 +405,29 @@ findWiredInPackages dflags pkgs preload this_package = do
-- version. To override the default choice, -hide-package
-- could be used to hide newer versions.
--
findWiredInPackage :: [PackageConfig] -> (PackageId, [String])
-> IO (Maybe (PackageIdentifier, PackageId))
findWiredInPackage :: [PackageConfig] -> String
-> IO (Maybe InstalledPackageId)
findWiredInPackage pkgs wired_pkg =
let all_ps = [ p | p <- pkgs, p `matches` wired_pkg ] in
case all_ps of
[] -> notfound
many -> pick (head (sortByVersion many))
where
suffixes = snd wired_pkg
notfound = do
debugTraceMsg dflags 2 $
ptext (sLit "wired-in package ")
<> ppr (fst wired_pkg)
<> (if null suffixes
then empty
else text (show suffixes))
<> text wired_pkg
<> ptext (sLit " not found.")
return Nothing
pick :: InstalledPackageInfo_ ModuleName
-> IO (Maybe (PackageIdentifier, PackageId))
-> IO (Maybe InstalledPackageId)
pick pkg = do
debugTraceMsg dflags 2 $
ptext (sLit "wired-in package ")
<> ppr (fst wired_pkg)
<> text wired_pkg
<> ptext (sLit " mapped to ")
<> text (display (package pkg))
return (Just (package pkg, fst wired_pkg))
return (Just (installedPackageId pkg))
mb_wired_in_ids <- mapM (findWiredInPackage pkgs) wired_in_pkgids
......@@ -454,26 +448,13 @@ findWiredInPackages dflags pkgs preload this_package = do
-}
updateWiredInDependencies pkgs = map upd_pkg pkgs
where upd_pkg p = p{ package = upd_pid (package p),
depends = map upd_pid (depends p) }
upd_pid pid = case filter ((== pid) . fst) wired_in_ids of
[] -> pid
((x, y):_) -> x{ pkgName = PackageName (packageIdString y),
pkgVersion = Version [] [] }
-- pkgs1 = deleteOtherWiredInPackages pkgs
pkgs2 = updateWiredInDependencies pkgs
preload1 = map upd_pid preload
where upd_pkg p
| installedPackageId p `elem` wired_in_ids
= p { package = (package p){ pkgVersion = Version [] [] } }
| otherwise
= p
-- we must return an updated thisPackage, just in case we
-- are actually compiling one of the wired-in packages
Just old_this_pkg = unpackPackageId this_package
new_this_pkg = mkPackageId (upd_pid old_this_pkg)
return (pkgs2, preload1, new_this_pkg)
return $ updateWiredInDependencies pkgs
-- ----------------------------------------------------------------------------
--
......@@ -499,12 +480,12 @@ elimDanglingDeps dflags pkgs ignored = go [] pkgs'
(new_avail, not_avail) -> go (new_avail ++ avail) (map fst not_avail)
depsAvailable :: [PackageConfig] -> PackageConfig
-> Either PackageConfig (PackageConfig, [PackageIdentifier])
-> Either PackageConfig (PackageConfig, [InstalledPackageId])
depsAvailable pkgs_ok pkg
| null dangling = Left pkg
| otherwise = Right (pkg, dangling)
where dangling = filter (`notElem` pids) (depends pkg)
pids = map package pkgs_ok
pids = map installedPackageId pkgs_ok
reportElim (p, deps) =
debugTraceMsg dflags 2 $
......@@ -542,15 +523,14 @@ mkPackageState dflags orig_pkg_db preload0 this_package = do
-- should contain at least rts & base, which is why we pretend that
-- the command line contains -package rts & -package base.
--
let new_preload_packages =
map package (pickPackages pkgs0 [ p | ExposePackage p <- flags ])
let preload1 = map installedPackageId $
pickPackages pkgs0 [ p | ExposePackage p <- flags ]
-- hide packages that are subsumed by later versions
pkgs2 <- hideOldPackages dflags pkgs1
-- sort out which packages are wired in
(pkgs3, preload1, new_this_pkg)
<- findWiredInPackages dflags pkgs2 new_preload_packages this_package
pkgs3 <- findWiredInPackages dflags pkgs2
let ignored = map packageConfigId $
pickPackages pkgs0 [ p | IgnorePackage p <- flags ]
......@@ -558,6 +538,16 @@ mkPackageState dflags orig_pkg_db preload0 this_package = do
let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs
ipid_map = listToFM [ (installedPackageId p, packageConfigId p)
| p <- pkgs ]
lookupIPID ipid@(InstalledPackageId str)
| Just pid <- lookupFM ipid_map ipid = return pid
| otherwise = missingPackageErr str
preload2 <- mapM lookupIPID preload1
let
-- add base & rts to the preload packages
basicLinkedPackages
| dopt Opt_AutoLinkPackages dflags
......@@ -566,19 +556,20 @@ mkPackageState dflags orig_pkg_db preload0 this_package = do
-- but in any case remove the current package from the set of
-- preloaded packages so that base/rts does not end up in the
-- set up preloaded package when we are just building it
preload2 = nub (filter (/= new_this_pkg)
(basicLinkedPackages ++ map mkPackageId preload1))
preload3 = nub $ filter (/= this_package)
$ (basicLinkedPackages ++ preload2)
-- Close the preload packages with their dependencies
dep_preload <- closeDeps pkg_db (zip preload2 (repeat Nothing))
dep_preload <- closeDeps pkg_db ipid_map (zip preload3 (repeat Nothing))
let new_dep_preload = filter (`notElem` preload0) dep_preload
let pstate = PackageState{ preloadPackages = dep_preload,
pkgIdMap = pkg_db,
moduleToPkgConfAll = mkModuleMap pkg_db
moduleToPkgConfAll = mkModuleMap pkg_db,
installedPackageIdMap = ipid_map
}
return (pstate, new_dep_preload, new_this_pkg)
return (pstate, new_dep_preload, this_package)
-- -----------------------------------------------------------------------------
......@@ -697,31 +688,39 @@ getPreloadPackagesAnd dflags pkgids =
let
state = pkgState dflags
pkg_map = pkgIdMap state
ipid_map = installedPackageIdMap state
preload = preloadPackages state
pairs = zip pkgids (repeat Nothing)
in do
all_pkgs <- throwErr (foldM (add_package pkg_map) preload pairs)
all_pkgs <- throwErr (foldM (add_package pkg_map ipid_map) preload pairs)
return (map (getPackageDetails state) all_pkgs)
-- Takes a list of packages, and returns the list with dependencies included,
-- in reverse dependency order (a package appears before those it depends on).
closeDeps :: PackageConfigMap -> [(PackageId, Maybe PackageId)]
-> IO [PackageId]
closeDeps pkg_map ps = throwErr (closeDepsErr pkg_map ps)
closeDeps :: PackageConfigMap
-> FiniteMap InstalledPackageId PackageId
-> [(PackageId, Maybe PackageId)]
-> IO [PackageId]
closeDeps pkg_map ipid_map ps = throwErr (closeDepsErr pkg_map ipid_map ps)
throwErr :: MaybeErr Message a -> IO a
throwErr m = case m of
Failed e -> ghcError (CmdLineError (showSDoc e))
Succeeded r -> return r
closeDepsErr :: PackageConfigMap -> [(PackageId,Maybe PackageId)]
-> MaybeErr Message [PackageId]
closeDepsErr pkg_map ps = foldM (add_package pkg_map) [] ps
closeDepsErr :: PackageConfigMap
-> FiniteMap InstalledPackageId PackageId
-> [(PackageId,Maybe PackageId)]
-> MaybeErr Message [PackageId]
closeDepsErr pkg_map ipid_map ps = foldM (add_package pkg_map ipid_map) [] ps
-- internal helper
add_package :: PackageConfigMap -> [PackageId] -> (PackageId,Maybe PackageId)
-> MaybeErr Message [PackageId]
add_package pkg_db ps (p, mb_parent)
add_package :: PackageConfigMap
-> FiniteMap InstalledPackageId PackageId
-> [PackageId]
-> (PackageId,Maybe PackageId)
-> MaybeErr Message [PackageId]
add_package pkg_db ipid_map ps (p, mb_parent)
| p `elem` ps = return ps -- Check if we've already added this package
| otherwise =
case lookupPackage pkg_db p of
......@@ -729,11 +728,16 @@ add_package pkg_db ps (p, mb_parent)
missingDependencyMsg mb_parent)
Just pkg -> do
-- Add the package's dependents also
let deps = map mkPackageId (depends pkg)
ps' <- foldM (add_package pkg_db) ps (zip deps (repeat (Just p)))
ps' <- foldM add_package_ipid ps (depends pkg)
return (p : ps')
where
add_package_ipid ps ipid@(InstalledPackageId str)
| Just pid <- lookupFM ipid_map ipid
= add_package pkg_db ipid_map ps (pid, Just p)
| otherwise
= Failed (missingPackageMsg str <> missingDependencyMsg mb_parent)
missingPackageErr :: String -> IO [PackageConfig]
missingPackageErr :: String -> IO a
missingPackageErr p = ghcError (CmdLineError (showSDoc (missingPackageMsg p)))
missingPackageMsg :: String -> SDoc
......
compiler/main/ParsePkgConf.y
View file @ 72547264
......@@ -81,8 +81,12 @@ field :: { PackageConfig -> PackageConfig }
_ -> happyError }
}
| VARID '=' CONID STRING { id }
-- another case of license
| VARID '=' CONID STRING
{ \p -> case unpackFS $1 of
"installedPackageId" ->
p{installedPackageId = InstalledPackageId (unpackFS $4)}
_ -> p -- another case of license
}
| VARID '=' strlist
{\p -> case unpackFS $1 of
......@@ -107,7 +111,7 @@ field :: { PackageConfig -> PackageConfig }
_ -> p
}
| VARID '=' pkgidlist
| VARID '=' ipidlist
{% case unpackFS $1 of
"depends" -> return (\p -> p{depends = $3})
_ -> happyError
......@@ -129,13 +133,20 @@ version :: { Version }
{ Version{ versionBranch=$5,
versionTags=map unpackFS $9 } }
pkgidlist :: { [PackageIdentifier] }
: '[' pkgids ']' { $2 }
ipid :: { InstalledPackageId }
: CONID STRING
{% case unpackFS $1 of
"InstalledPackageId" -> return (InstalledPackageId (unpackFS $2))
_ -> happyError
}
ipidlist :: { [InstalledPackageId] }
: '[' ipids ']' { $2 }
-- empty list case is covered by strlist, to avoid conflicts
pkgids :: { [PackageIdentifier] }
: pkgid { [ $1 ] }
| pkgid ',' pkgids { $1 : $3 }
ipids :: { [InstalledPackageId] }
: ipid { [ $1 ] }
| ipid ',' ipids { $1 : $3 }
intlist :: { [Int] }
: '[' ']' { [] }
......
libffi/package.conf.in
View file @ 72547264
name: ffi
version: 1.0
id: builtin:ffi
license: BSD3
maintainer: glasgow-haskell-users@haskell.org
exposed: True
......
rts/package.conf.in
View file @ 72547264
......@@ -5,6 +5,7 @@
name: rts
version: 1.0
id: builtin:rts
license: BSD3
maintainer: glasgow-haskell-users@haskell.org
exposed: True
......@@ -55,7 +56,7 @@ include-dirs: TOP"/includes"
#endif
includes: Stg.h
depends: ffi-1.0
depends: builtin:ffi
hugs-options:
cc-options:
......
utils/ghc-cabal/ghc-cabal.hs
View file @ 72547264
......@@ -25,6 +25,7 @@ import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import Data.Char
main :: IO ()
main = do args <- getArgs
......@@ -208,9 +209,11 @@ generate config_args distdir directory
(Nothing, Nothing) -> return ()
(Just lib, Just clbi) -> do
cwd <- getCurrentDirectory
let ipid = InstalledPackageId (display (packageId pd) ++ "-inplace")
let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir
pd lib lbi clbi
content = Installed.showInstalledPackageInfo installedPkgInfo ++ "\n"
final_ipi = installedPkgInfo{ Installed.installedPackageId = ipid }
content = Installed.showInstalledPackageInfo final_ipi ++ "\n"
writeFileAtomic (distdir </> "inplace-pkg-config") content
_ -> error "Inconsistent lib components; can't happen?"
......@@ -242,16 +245,19 @@ generate config_args distdir directory
-- stricter than gnu ld). Thus we remove the ldOptions for
-- GHC's rts package:
hackRtsPackage index =
case PackageIndex.lookupPackageName index (PackageName "rts") of
[rts] -> PackageIndex.insert rts { Installed.ldOptions = [] } index
case PackageIndex.lookupInstalledPackageByName index (PackageName "rts") of
[rts] -> PackageIndex.addToInstalledPackageIndex rts { Installed.ldOptions = [] } index
_ -> error "No (or multiple) ghc rts package is registered!!"
dep_ids = map (packageId.getLocalPackageInfo lbi) $
externalPackageDeps lbi
let variablePrefix = directory ++ '_':distdir
let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
variablePrefix ++ "_MODULES = " ++ unwords (map display modules),
variablePrefix ++ "_HS_SRC_DIRS = " ++ unwords (hsSourceDirs bi),
variablePrefix ++ "_DEPS = " ++ unwords (map display (externalPackageDeps lbi)),
variablePrefix ++ "_DEP_NAMES = " ++ unwords (map (display . packageName) (externalPackageDeps lbi)),
variablePrefix ++ "_DEPS = " ++ unwords (map display dep_ids),
variablePrefix ++ "_DEP_NAMES = " ++ unwords (map (display . packageName) dep_ids),
variablePrefix ++ "_INCLUDE_DIRS = " ++ unwords (includeDirs bi),
variablePrefix ++ "_INCLUDES = " ++ unwords (includes bi),
variablePrefix ++ "_INSTALL_INCLUDES = " ++ unwords (installIncludes bi),
......
utils/ghc-pkg/Main.hs
View file @ 72547264
{-# OPTIONS -fglasgow-exts -cpp #-}
-----------------------------------------------------------------------------
--
-- (c) The University of Glasgow 2004.
-- (c) The University of Glasgow 2004-2009.
--
-- Package management tool
--
-----------------------------------------------------------------------------
-- TODO:
-- * validate modules
-- * expanding of variables in new-style package conf
-- * version manipulation (checking whether old version exists,
-- hiding old version?)
module Main (main) where
import Version ( version, targetOS, targetARCH )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.ModuleName hiding (main)
import Distribution.InstalledPackageInfo hiding (depends)
import Distribution.InstalledPackageInfo
import Distribution.Compat.ReadP
import Distribution.ParseUtils
import Distribution.Package
import Distribution.Package hiding (depends)
import Distribution.Text
import Distribution.Version
import System.FilePath
......@@ -192,6 +187,11 @@ usageHeader prog = substProg prog $
" all the registered versions will be listed in ascending order.\n" ++
" Accepts the --simple-output flag.\n" ++
"\n" ++
" $p dot\n" ++
" Generate a graph of the package dependencies in a form suitable\n" ++
" for input for the graphviz tools. For example, to generate a PDF" ++
" of the dependency graph: ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf" ++
"\n" ++
" $p find-module {module}\n" ++
" List registered packages exposing module {module} in the global\n" ++
" database, and also the user database if --user is given.\n" ++
......@@ -230,7 +230,7 @@ usageHeader prog = substProg prog $
" entirely. When multiple of these options are given, the rightmost\n"++
" one is used as the database to act upon.\n"++
"\n"++
" Commands that query the package database (list, latest, describe,\n"++
" Commands that query the package database (list, tree, latest, describe,\n"++
" field) operate on the list of databases specified by the flags\n"++
" --user, --global, and --package-conf. If none of these flags are\n"++
" given, the default is --global --user.\n"++
......@@ -310,15 +310,17 @@ runit verbosity cli nonopts = do
pkgid <- readGlobPkgId pkgid_str
hidePackage pkgid verbosity cli force
["list"] -> do
listPackages cli Nothing Nothing
listPackages verbosity cli Nothing Nothing
["list", pkgid_str] ->
case substringCheck pkgid_str of
Nothing -> do pkgid <- readGlobPkgId pkgid_str
listPackages cli (Just (Id pkgid)) Nothing
Just m -> listPackages cli (Just (Substring pkgid_str m)) Nothing
listPackages verbosity cli (Just (Id pkgid)) Nothing
Just m -> listPackages verbosity cli (Just (Substring pkgid_str m)) Nothing
["dot"] -> do
showPackageDot verbosity cli
["find-module", moduleName] -> do
let match = maybe (==moduleName) id (substringCheck moduleName)
listPackages cli Nothing (Just match)
listPackages verbosity cli Nothing (Just match)
["latest", pkgid_str] -> do
pkgid <- readGlobPkgId pkgid_str
latestPackage cli pkgid
......@@ -544,11 +546,6 @@ registerPackage input verbosity my_flags auto_ghci_libs update force = do
when (verbosity >= Normal) $
putStrLn "done."
let unversioned_deps = filter (not . realVersion) (depends pkg)
unless (null unversioned_deps) $
die ("Unversioned dependencies found: " ++
unwords (map display unversioned_deps))
let truncated_stack = dropWhile ((/= to_modify).fst) db_stack
-- truncate the stack for validation, because we don't allow
-- packages lower in the stack to refer to those higher up.
......@@ -616,8 +613,10 @@ modifyPackage fn pkgid verbosity my_flags force = do
-- -----------------------------------------------------------------------------
-- Listing packages
listPackages :: [Flag] -> Maybe PackageArg -> Maybe (String->Bool) -> IO ()
listPackages my_flags mPackageName mModuleName = do
listPackages :: Verbosity -> [Flag] -> Maybe PackageArg
-> Maybe (String->Bool)
-> IO ()
listPackages verbosity my_flags mPackageName mModuleName = do
let simple_output = FlagSimpleOutput `elem` my_flags
(db_stack, _) <- getPkgDatabases False my_flags
let db_stack_filtered -- if a package is given, filter out all other packages
......@@ -642,23 +641,35 @@ listPackages my_flags mPackageName mModuleName = do
match `exposedInPkg` pkg = any match (map display $ exposedModules pkg)
pkg_map = allPackagesInStack db_stack
show_func = if simple_output then show_simple else mapM_ (show_normal pkg_map)
broken = map package (brokenPackages pkg_map)
show_func (reverse db_stack_sorted)
show_func = if simple_output then show_simple else mapM_ show_normal
where show_normal pkg_map (db_name,pkg_confs) =
show_normal (db_name,pkg_confs) =
hPutStrLn stdout (render $
text db_name <> colon $$ nest 4 packages
)