-main = do args <- getArgs
- case args of
- pref : ghcpkg : args' ->
- let verbosity = case args' of
- [] -> normal
- ['-':'v':v] ->
- let m = case v of
- "" -> Nothing
- _ -> Just v
- in flagToVerbosity m
- _ -> error ("Bad arguments: " ++ show args)
- in doit pref ghcpkg verbosity
- _ ->
- error "Missing arguments"
+main
+ = do args <- getArgs
+ case args of
+ "register" : "--inplace" :args' ->
+ let verbosity = mkVerbosity args'
+ in doRegisterInplace verbosity
+ "install" : ghcpkg : ghcpkgconf : destdir : topdir :
+ iprefix : ibindir : ilibdir : ilibexecdir : idynlibdir :
+ idatadir : idocdir : ihtmldir : ihaddockdir :
+ args' ->
+ let verbosity = mkVerbosity args'
+ in doInstall verbosity ghcpkg ghcpkgconf destdir topdir
+ iprefix ibindir ilibdir ilibexecdir idynlibdir idatadir
+ idocdir ihtmldir ihaddockdir
+ _ ->
+ error ("Bad arguments: " ++ show args)
+
+mkVerbosity :: [String] -> Verbosity
+mkVerbosity [] = normal
+mkVerbosity ['-':'v':v] = readEOrFail flagToVerbosity v
+mkVerbosity args = error ("Bad arguments: " ++ show args)
+
+doRegisterInplace :: Verbosity -> IO ()
+doRegisterInplace verbosity =
+ do lbi <- getConfig verbosity
+ let registerFlags = defaultRegisterFlags { regInPlace = toFlag True }
+ pd = localPkgDescr lbi
+ pd_reg = if pkgName (package pd) == "ghc-prim"
+ then case library pd of
+ Just lib ->
+ let ems = "GHC.Prim" : exposedModules lib
+ lib' = lib { exposedModules = ems }
+ in pd { library = Just lib' }
+ Nothing ->
+ error "Expected a library, but none found"
+ else pd
+ (regHook simpleUserHooks) pd_reg lbi simpleUserHooks registerFlags
+ return ()