main = do
args <- getArgs
- case getOpt Permute flags args of
+ case getOpt Permute (flags ++ deprecFlags) args of
(cli,_,[]) | FlagHelp `elem` cli -> do
prog <- getProgramName
bye (usageInfo (usageHeader prog) flags)
| FlagAutoGHCiLibs
| FlagDefinedName String String
| FlagSimpleOutput
+ | FlagNamesOnly
deriving Eq
flags :: [OptDescr Flag]
"automatically build libs for GHCi (with register)",
Option ['?'] ["help"] (NoArg FlagHelp)
"display this help and exit",
- Option ['D'] ["define-name"] (ReqArg toDefined "NAME=VALUE")
- "define NAME as VALUE",
Option ['V'] ["version"] (NoArg FlagVersion)
"output version information and exit",
Option [] ["simple-output"] (NoArg FlagSimpleOutput)
- "print output in easy-to-parse format for some commands"
+ "print output in easy-to-parse format for some commands",
+ Option [] ["names-only"] (NoArg FlagNamesOnly)
+ "only print package names, not versions; can only be used with list --simple-output"
]
- where
+
+deprecFlags :: [OptDescr Flag]
+deprecFlags = [
+ Option ['D'] ["define-name"] (ReqArg toDefined "NAME=VALUE")
+ "define NAME as VALUE"
+ ]
+ where
toDefined str =
case break (=='=') str of
(nm,[]) -> FlagDefinedName nm []
pkgid <- readGlobPkgId pkgid_str
hidePackage pkgid cli
["list"] -> do
- listPackages cli Nothing
+ listPackages cli Nothing Nothing
["list", pkgid_str] -> do
pkgid <- readGlobPkgId pkgid_str
- listPackages cli (Just pkgid)
+ listPackages cli (Just pkgid) Nothing
+ ["find-module", moduleName] -> do
+ listPackages cli Nothing (Just moduleName)
["latest", pkgid_str] -> do
pkgid <- readGlobPkgId pkgid_str
latestPackage cli pkgid
expanded <- expandEnvVars s defines force
- pkg0 <- parsePackageInfo expanded defines
+ pkg <- parsePackageInfo expanded defines
putStrLn "done."
- let pkg = resolveDeps db_stack pkg0
validatePackageConfig pkg db_stack auto_ghci_libs update force
let new_details = filter not_this (snd db_to_operate_on) ++ [pkg]
not_this p = package p /= package pkg
-- -----------------------------------------------------------------------------
-- Listing packages
-listPackages :: [Flag] -> Maybe PackageIdentifier -> IO ()
-listPackages flags mPackageName = do
+listPackages :: [Flag] -> Maybe PackageIdentifier -> Maybe String -> IO ()
+listPackages flags mPackageName mModuleName = do
let simple_output = FlagSimpleOutput `elem` flags
db_stack <- getPkgDatabases False flags
let db_stack_filtered -- if a package is given, filter out all other packages
| Just this <- mPackageName =
map (\(conf,pkgs) -> (conf, filter (this `matchesPkg`) pkgs))
db_stack
+ | Just this <- mModuleName = -- packages which expose mModuleName
+ map (\(conf,pkgs) -> (conf, filter (this `exposedInPkg`) pkgs))
+ db_stack
| otherwise = db_stack
db_stack_sorted
where doc = text (showPackageId (package p))
show_simple db_stack = do
- let pkgs = map showPackageId $ sortBy compPkgIdVer $
+ let showPkg = if FlagNamesOnly `elem` flags then pkgName
+ else showPackageId
+ pkgs = map showPkg $ sortBy compPkgIdVer $
map package (concatMap snd db_stack)
when (null pkgs) $ die "no matches"
hPutStrLn stdout $ concat $ intersperse " " pkgs
compPkgIdVer :: PackageIdentifier -> PackageIdentifier -> Ordering
compPkgIdVer p1 p2 = pkgVersion p1 `compare` pkgVersion p2
+exposedInPkg :: String -> InstalledPackageInfo -> Bool
+moduleName `exposedInPkg` pkg = moduleName `elem` exposedModules pkg
+
-- -----------------------------------------------------------------------------
-- Field
mapM_ (putStrLn . fn) (mungePackagePaths top_dir ps)
mungePackagePaths :: String -> [InstalledPackageInfo] -> [InstalledPackageInfo]
--- Replace the string "$topdir" at the beginning of a path
+-- Replace the strings "$topdir" and "$httptopdir" at the beginning of a path
-- with the current topdir (obtained from the -B option).
mungePackagePaths top_dir ps = map munge_pkg ps
where
munge_paths = map munge_path
munge_path p
- | Just p' <- maybePrefixMatch "$topdir" p = top_dir ++ p'
- | otherwise = p
+ | Just p' <- maybePrefixMatch "$topdir" p = top_dir ++ p'
+ | Just p' <- maybePrefixMatch "$httptopdir" p = toHttpPath top_dir ++ p'
+ | otherwise = p
+
+ toHttpPath p = "file:///" ++ p
maybePrefixMatch :: String -> String -> Maybe String
maybePrefixMatch [] rest = Just rest
[] -> die ("invalid package identifier: " ++ str)
_ -> die ("ambiguous package identifier: " ++ str)
-resolveDeps :: PackageDBStack -> InstalledPackageInfo -> InstalledPackageInfo
-resolveDeps db_stack p = updateDeps p
- where
- -- The input package spec is allowed to give a package dependency
- -- without a version number; e.g.
- -- depends: base
- -- Here, we update these dependencies without version numbers to
- -- match the actual versions of the relevant packages installed.
- updateDeps p = p{depends = map resolveDep (depends p)}
-
- resolveDep dep_pkgid
- | realVersion dep_pkgid = dep_pkgid
- | otherwise = lookupDep dep_pkgid
-
- lookupDep dep_pkgid
- = let
- name = pkgName dep_pkgid
- in
- case [ pid | p <- concat (map snd db_stack),
- let pid = package p,
- pkgName pid == name ] of
- (pid:_) -> pid -- Found installed package,
- -- replete with its version
- [] -> dep_pkgid -- No installed package; use
- -- the version-less one
-
checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> IO ()
checkDuplicates db_stack pkg update = do
let
checkDir :: Force -> String -> IO ()
checkDir force d
- | "$topdir" `isPrefixOf` d = return ()
- -- can't check this, because we don't know what $topdir is
+ | "$topdir" `isPrefixOf` d = return ()
+ | "$httptopdir" `isPrefixOf` d = return ()
+ -- can't check these, because we don't know what $(http)topdir is
| otherwise = do
there <- doesDirectoryExist d
when (not there)
doesLibExistIn :: String -> String -> IO Bool
doesLibExistIn lib d
- | "$topdir" `isPrefixOf` d = return True
+ | "$topdir" `isPrefixOf` d = return True
+ | "$httptopdir" `isPrefixOf` d = return True
| otherwise = doesFileExist (d ++ '/':lib)
checkGHCiLib :: [String] -> String -> String -> String -> Bool -> IO ()
defines = [ (nm,val) | OF_DefinedName nm val <- clis ]
case [ c | c <- clis, isAction c ] of
- [ OF_List ] -> listPackages new_flags Nothing
- [ OF_ListLocal ] -> listPackages new_flags Nothing
+ [ OF_List ] -> listPackages new_flags Nothing Nothing
+ [ OF_ListLocal ] -> listPackages new_flags Nothing Nothing
[ OF_Add upd ] ->
registerPackage input_file defines new_flags auto_ghci_libs upd force
[ OF_Remove pkgid_str ] -> do
projects / ghc-hetmet.git / blobdiff