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