+-- Making changes to a package database
+
+data DBOp = RemovePackage InstalledPackageInfo
+ | AddPackage InstalledPackageInfo
+ | ModifyPackage InstalledPackageInfo
+
+changeDB :: Verbosity -> [DBOp] -> PackageDB -> IO ()
+changeDB verbosity cmds db = do
+ let db' = updateInternalDB db cmds
+ isfile <- doesFileExist (location db)
+ if isfile
+ then writeNewConfig verbosity (location db') (packages db')
+ else do
+ createDirectoryIfMissing True (location db)
+ changeDBDir verbosity cmds db'
+
+updateInternalDB :: PackageDB -> [DBOp] -> PackageDB
+updateInternalDB db cmds = db{ packages = foldl do_cmd (packages db) cmds }
+ where
+ do_cmd pkgs (RemovePackage p) =
+ filter ((/= installedPackageId p) . installedPackageId) pkgs
+ do_cmd pkgs (AddPackage p) = p : pkgs
+ do_cmd pkgs (ModifyPackage p) =
+ do_cmd (do_cmd pkgs (RemovePackage p)) (AddPackage p)
+
+
+changeDBDir :: Verbosity -> [DBOp] -> PackageDB -> IO ()
+changeDBDir verbosity cmds db = do
+ mapM_ do_cmd cmds
+ updateDBCache verbosity db
+ where
+ do_cmd (RemovePackage p) = do
+ let file = location db </> display (installedPackageId p) <.> "conf"
+ when (verbosity > Normal) $ putStrLn ("removing " ++ file)
+ removeFile file
+ do_cmd (AddPackage p) = do
+ let file = location db </> display (installedPackageId p) <.> "conf"
+ when (verbosity > Normal) $ putStrLn ("writing " ++ file)
+ writeFileAtomic file (showInstalledPackageInfo p)
+ do_cmd (ModifyPackage p) =
+ do_cmd (AddPackage p)
+
+updateDBCache :: Verbosity -> PackageDB -> IO ()
+updateDBCache verbosity db = do
+ let filename = location db </> cachefilename
+ when (verbosity > Normal) $
+ putStrLn ("writing cache " ++ filename)
+ writeBinPackageDB filename (map convertPackageInfoOut (packages db))
+ `catch` \e ->
+ if isPermissionError e
+ then die (filename ++ ": you don't have permission to modify this file")
+ else ioError e
+
+-- -----------------------------------------------------------------------------