+
+ expanded <- expandEnvVars s defines force
+
+ pkg0 <- parsePackageInfo expanded defines force
+ putStrLn "done."
+
+ let pkg = resolveDeps db_stack pkg0
+ overlaps <- validatePackageConfig pkg db_stack auto_ghci_libs update force
+ new_details <- updatePackageDB db_stack overlaps (snd db_to_operate_on) pkg
+ savePackageConfig db_filename
+ maybeRestoreOldConfig db_filename $
+ writeNewConfig db_filename new_details
+
+parsePackageInfo
+ :: String
+ -> [(String,String)]
+ -> Bool
+ -> IO InstalledPackageInfo
+parsePackageInfo str defines force =
+ case parseInstalledPackageInfo str of
+ ParseOk _warns ok -> return ok
+ ParseFailed err -> die (showError err)
+
+-- -----------------------------------------------------------------------------
+-- Exposing, Hiding, Unregistering are all similar
+
+exposePackage :: PackageIdentifier -> [Flag] -> IO ()
+exposePackage = modifyPackage (\p -> [p{exposed=True}])
+
+hidePackage :: PackageIdentifier -> [Flag] -> IO ()
+hidePackage = modifyPackage (\p -> [p{exposed=False}])
+
+unregisterPackage :: PackageIdentifier -> [Flag] -> IO ()
+unregisterPackage = modifyPackage (\p -> [])
+
+modifyPackage
+ :: (InstalledPackageInfo -> [InstalledPackageInfo])
+ -> PackageIdentifier
+ -> [Flag]
+ -> IO ()
+modifyPackage fn pkgid flags = do
+ db_stack <- getPkgDatabases True{-modify-} flags
+ let ((db_name, pkgs) : _) = db_stack
+ checkConfigAccess db_name
+ ps <- findPackages [(db_name,pkgs)] pkgid
+ let pids = map package ps
+ savePackageConfig db_name
+ let new_config = concat (map modify pkgs)
+ modify pkg
+ | package pkg `elem` pids = fn pkg
+ | otherwise = [pkg]
+ maybeRestoreOldConfig db_name $
+ writeNewConfig db_name new_config
+
+-- -----------------------------------------------------------------------------
+-- Listing packages
+
+listPackages :: [Flag] -> Maybe PackageIdentifier -> IO ()
+listPackages flags mPackageName = 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
+ | otherwise = db_stack
+
+ db_stack_sorted
+ = [ (db, sort_pkgs pkgs) | (db,pkgs) <- db_stack_filtered ]
+ where sort_pkgs = sortBy cmpPkgIds
+ cmpPkgIds pkg1 pkg2 =
+ case pkgName p1 `compare` pkgName p2 of
+ LT -> LT
+ GT -> GT
+ EQ -> pkgVersion p1 `compare` pkgVersion p2
+ where (p1,p2) = (package pkg1, package pkg2)
+
+ show_func = if simple_output then show_easy else mapM_ show_regular
+
+ show_func (reverse db_stack_sorted)
+
+ where show_regular (db_name,pkg_confs) =
+ hPutStrLn stdout (render $
+ text (db_name ++ ":") $$ nest 4 packages
+ )
+ where packages = fsep (punctuate comma (map pp_pkg pkg_confs))
+ pp_pkg p
+ | exposed p = doc
+ | otherwise = parens doc
+ where doc = text (showPackageId (package p))
+
+ show_easy db_stack = do
+ let pkgs = map showPackageId $ sortBy compPkgIdVer $
+ map package (concatMap snd db_stack)
+ when (null pkgs) $ die "no matches"
+ hPutStrLn stdout $ concat $ intersperse " " pkgs
+
+-- -----------------------------------------------------------------------------
+-- Prints the highest (hidden or exposed) version of a package
+
+latestPackage :: [Flag] -> PackageIdentifier -> IO ()
+latestPackage flags pkgid = do
+ db_stack <- getPkgDatabases False flags
+ ps <- findPackages db_stack pkgid
+ show_pkg (sortBy compPkgIdVer (map package ps))
+ where
+ show_pkg [] = die "no matches"
+ show_pkg pids = hPutStrLn stdout (showPackageId (last pids))
+
+-- -----------------------------------------------------------------------------
+-- Describe
+
+describePackage :: [Flag] -> PackageIdentifier -> IO ()
+describePackage flags pkgid = do
+ db_stack <- getPkgDatabases False flags
+ ps <- findPackages db_stack pkgid
+ mapM_ (putStrLn . showInstalledPackageInfo) ps
+
+-- PackageId is can have globVersion for the version
+findPackages :: PackageDBStack -> PackageIdentifier -> IO [InstalledPackageInfo]
+findPackages db_stack pkgid
+ = case [ p | p <- all_pkgs, pkgid `matchesPkg` p ] of
+ [] -> die ("cannot find package " ++ showPackageId pkgid)
+ ps -> return ps
+ where
+ all_pkgs = concat (map snd db_stack)
+
+matches :: PackageIdentifier -> PackageIdentifier -> Bool
+pid `matches` pid'
+ = (pkgName pid == pkgName pid')
+ && (pkgVersion pid == pkgVersion pid' || not (realVersion pid))
+
+matchesPkg :: PackageIdentifier -> InstalledPackageInfo -> Bool
+pid `matchesPkg` pkg = pid `matches` package pkg
+
+compPkgIdVer :: PackageIdentifier -> PackageIdentifier -> Ordering
+compPkgIdVer p1 p2 = pkgVersion p1 `compare` pkgVersion p2
+
+-- -----------------------------------------------------------------------------
+-- Field
+
+describeField :: [Flag] -> PackageIdentifier -> String -> IO ()
+describeField flags pkgid field = do
+ db_stack <- getPkgDatabases False flags
+ case toField field of
+ Nothing -> die ("unknown field: " ++ field)
+ Just fn -> do
+ ps <- findPackages db_stack pkgid
+ mapM_ (putStrLn.fn) ps
+
+toField :: String -> Maybe (InstalledPackageInfo -> String)
+-- backwards compatibility:
+toField "import_dirs" = Just $ strList . importDirs
+toField "source_dirs" = Just $ strList . importDirs
+toField "library_dirs" = Just $ strList . libraryDirs
+toField "hs_libraries" = Just $ strList . hsLibraries
+toField "extra_libraries" = Just $ strList . extraLibraries
+toField "include_dirs" = Just $ strList . includeDirs
+toField "c_includes" = Just $ strList . includes
+toField "package_deps" = Just $ strList . map showPackageId. depends
+toField "extra_cc_opts" = Just $ strList . ccOptions
+toField "extra_ld_opts" = Just $ strList . ldOptions
+toField "framework_dirs" = Just $ strList . frameworkDirs
+toField "extra_frameworks"= Just $ strList . frameworks
+toField s = showInstalledPackageInfoField s
+
+strList :: [String] -> String
+strList = show
+
+-- -----------------------------------------------------------------------------
+-- Manipulating package.conf files