1 -----------------------------------------------------------------------------
2 -- $Id: Main.hs,v 1.2 2001/03/16 10:04:31 simonmar Exp $
4 -- Package management tool
5 -----------------------------------------------------------------------------
11 #ifdef __GLASGOW_HASKELL__
12 import qualified Exception
21 default_pkgconf = clibdir ++ "/package.conf"
26 case getOpt Permute flags args of
27 (clis,[],[]) -> runit clis
28 (_,_,errors) -> die (concat errors ++
29 usageInfo usageHeader flags)
31 data Flag = Config String | List | Add | Remove String
32 isConfig (Config _) = True
35 usageHeader = "ghc-pkg [OPTION...]"
38 Option ['f'] ["config-file"] (ReqArg Config "FILE")
39 "Use the specified package config file",
40 Option ['l'] ["list-packages"] (NoArg List)
41 "List the currently installed packages",
42 Option ['a'] ["add-package"] (NoArg Add)
44 Option ['r'] ["remove-package"] (ReqArg Remove "NAME")
45 "Remove an installed package"
50 case [ f | Config f <- clis ] of
51 [] -> return default_pkgconf
53 _ -> die (usageInfo usageHeader flags)
55 s <- readFile conf_file
56 let details = read s :: [PackageConfig]
57 eval_catch details (\_ -> die "parse error in package config file")
59 case [ c | c <- clis, not (isConfig c) ] of
60 [ List ] -> listPackages details
61 [ Add ] -> addPackage details conf_file
62 [ Remove p ] -> removePackage details conf_file p
63 _ -> die (usageInfo usageHeader flags)
66 listPackages :: [PackageConfig] -> IO ()
67 listPackages details = do
68 hPutStr stdout (listPkgs details)
72 addPackage :: [PackageConfig] -> FilePath -> IO ()
73 addPackage details pkgconf = do
74 checkConfigAccess pkgconf
75 hPutStr stdout "Reading package info from stdin... "
77 let new_pkg = read s :: PackageConfig
78 eval_catch new_pkg (\_ -> die "parse error in package info")
79 hPutStrLn stdout "done."
80 if (name new_pkg `elem` map name details)
81 then die ("package `" ++ name new_pkg ++ "' already installed")
83 savePackageConfig pkgconf
84 maybeRestoreOldConfig pkgconf $ do
85 writeNewConfig pkgconf (details ++ [new_pkg])
88 removePackage :: [PackageConfig] -> FilePath -> String -> IO ()
89 removePackage details pkgconf pkg = do
90 checkConfigAccess pkgconf
91 if (pkg `notElem` map name details)
92 then die ("package `" ++ pkg ++ "' not installed")
94 savePackageConfig pkgconf
95 maybeRestoreOldConfig pkgconf $ do
96 writeNewConfig pkgconf (filter ((/= pkg) . name) details)
99 checkConfigAccess :: FilePath -> IO ()
100 checkConfigAccess pkgconf = do
101 access <- getPermissions pkgconf
102 when (not (writable access))
103 (die "you don't have permission to modify the package configuration file")
105 maybeRestoreOldConfig :: String -> IO () -> IO ()
106 maybeRestoreOldConfig conf_file io
107 = my_catch io (\e -> do
108 hPutStr stdout "\nWARNING: an error was encountered while the new \n\
109 \configuration was being written. Attempting to \n\
110 \restore the old configuration... "
111 renameFile (conf_file ++ ".old") conf_file
112 hPutStrLn stdout "done."
116 writeNewConfig :: String -> [PackageConfig] -> IO ()
117 writeNewConfig conf_file details = do
118 hPutStr stdout "Writing new package config file... "
119 h <- openFile conf_file WriteMode
120 hPutStr h (dumpPackages details )
122 hPutStrLn stdout "done."
124 savePackageConfig :: String -> IO ()
125 savePackageConfig conf_file = do
126 hPutStr stdout "Saving old package config file... "
127 -- mv rather than cp because we've already done an hGetContents
128 -- on this file so we won't be able to open it for writing
129 -- unless we move the old one out of the way...
130 renameFile conf_file (conf_file ++ ".old")
131 hPutStrLn stdout "done."
133 -----------------------------------------------------------------------------
135 die :: String -> IO a
136 die s = do { hPutStrLn stderr s; exitWith (ExitFailure 1) }
138 -----------------------------------------------------------------------------
141 #ifndef __GLASGOW_HASKELL__
143 eval_catch a h = a `seq` return ()
149 my_throw = Exception.throw
150 #if __GLASGOW_HASKELL__ > 408
151 eval_catch = Exception.catch . Exception.evaluate
152 my_catch = Exception.catch
154 eval_catch = Exception.catchAll
155 my_catch = Exception.catchAllIO