Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

adding options: --package-conf and --no-user-package-conf

These command line options work just like the similar-named GHC flags.
They are useful when working with non-standard package databases.
  • Loading branch information...
commit ad55168265383c2bd0fa2a91dd33da6768eb2b4f 1 parent 92777ed
@takano-akio takano-akio authored
View
8 Browse.hs
@@ -10,7 +10,7 @@ import Types
----------------------------------------------------------------
browseModule :: Options -> String -> IO String
-browseModule opt mdlName = convert opt . format <$> browse mdlName
+browseModule opt mdlName = convert opt . format <$> browse opt mdlName
where
format
| operators opt = formatOps
@@ -22,9 +22,9 @@ browseModule opt mdlName = convert opt . format <$> browse mdlName
| otherwise = '(' : x ++ ")"
formatOps' [] = error "formatOps'"
-browse :: String -> IO [String]
-browse mdlName = withGHC $ do
- initSession0
+browse :: Options -> String -> IO [String]
+browse opt mdlName = withGHC $ do
+ initSession0 opt
maybeNamesToStrings <$> lookupModuleInfo
where
lookupModuleInfo = findModule (mkModuleName mdlName) Nothing >>= getModuleInfo
View
8 Cabal.hs
@@ -15,12 +15,12 @@ import Types
----------------------------------------------------------------
-initializeGHC :: FilePath -> [String] -> Ghc FilePath
-initializeGHC fileName options = do
+initializeGHC :: Options -> FilePath -> [String] -> Ghc FilePath
+initializeGHC opt fileName ghcOptions = do
(owdir,mdirfile) <- getDirs
case mdirfile of
Nothing -> do
- initSession options Nothing
+ initSession opt ghcOptions Nothing
return fileName
Just (cdir,cfile) -> do
midirs <- parseCabalFile cfile
@@ -28,7 +28,7 @@ initializeGHC fileName options = do
let idirs = case midirs of
Nothing -> [cdir,owdir]
Just dirs -> dirs ++ [owdir]
- initSession options (Just idirs)
+ initSession opt ghcOptions (Just idirs)
return (ajustFileName fileName owdir cdir)
----------------------------------------------------------------
View
10 Check.hs
@@ -18,13 +18,13 @@ import Types
----------------------------------------------------------------
checkSyntax :: Options -> String -> IO String
-checkSyntax _ file = unlines <$> check file
+checkSyntax opt file = unlines <$> check opt file
----------------------------------------------------------------
-check :: String -> IO [String]
-check fileName = withGHC $ do
- file <- initializeGHC fileName options
+check :: Options -> String -> IO [String]
+check opt fileName = withGHC $ do
+ file <- initializeGHC opt fileName options
setTargetFile file
ref <- newRef []
loadWithLogger (refLogger ref) LoadAllTargets `gcatch` handleParseError ref
@@ -69,4 +69,4 @@ showSDoc :: SDoc -> String
showSDoc d = map toNull . Pretty.showDocWith PageMode $ d style
where
toNull '\n' = '\0'
- toNull x = x
+ toNull x = x
View
8 GHCMod.hs
@@ -40,6 +40,8 @@ defaultOptions = Options {
convert = toPlain
, hlintOpts = []
, operators = False
+ , packageConfs = []
+ , useUserPackageConf = True
}
argspec :: [OptDescr (Options -> Options)]
@@ -52,6 +54,12 @@ argspec = [ Option "l" ["tolisp"]
, Option "o" ["operators"]
(NoArg (\opts -> opts { operators = True }))
"print operators, too"
+ , Option "" ["package-conf"]
+ (ReqArg (\p opts -> opts { packageConfs = p : packageConfs opts }) "path")
+ "additional package database"
+ , Option "" ["no-user-package-conf"]
+ (NoArg (\opts -> opts{ useUserPackageConf = False }))
+ "do not read the user package database"
]
parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])
View
21 Info.hs
@@ -21,10 +21,10 @@ type ModuleString = String
----------------------------------------------------------------
typeExpr :: Options -> ModuleString -> Expression -> FilePath -> IO String
-typeExpr _ modstr expr file = (++ "\n") <$> typeOf file modstr expr
+typeExpr opt modstr expr file = (++ "\n") <$> typeOf opt file modstr expr
-typeOf :: FilePath -> ModuleString -> Expression -> IO String
-typeOf fileName modstr expr = inModuleContext fileName modstr exprToType
+typeOf :: Options -> FilePath -> ModuleString -> Expression -> IO String
+typeOf opt fileName modstr expr = inModuleContext opt fileName modstr exprToType
where
exprToType = pretty <$> exprType expr
pretty = showSDocForUser neverQualify . pprTypeForUser False
@@ -32,10 +32,10 @@ typeOf fileName modstr expr = inModuleContext fileName modstr exprToType
----------------------------------------------------------------
infoExpr :: Options -> ModuleString -> Expression -> FilePath -> IO String
-infoExpr _ modstr expr file = (++ "\n") <$> info file modstr expr
+infoExpr opt modstr expr file = (++ "\n") <$> info opt file modstr expr
-info :: FilePath -> ModuleString -> FilePath -> IO String
-info fileName modstr expr = inModuleContext fileName modstr exprToInfo
+info :: Options -> FilePath -> ModuleString -> FilePath -> IO String
+info opt fileName modstr expr = inModuleContext opt fileName modstr exprToInfo
where
exprToInfo = infoThing expr
@@ -68,16 +68,17 @@ pprInfo pefas (thing, fixity, insts)
----------------------------------------------------------------
-inModuleContext :: FilePath -> ModuleString -> Ghc String -> IO String
-inModuleContext fileName modstr action = withGHC valid
+inModuleContext
+ :: Options -> FilePath -> ModuleString -> Ghc String -> IO String
+inModuleContext opt fileName modstr action = withGHC valid
where
valid = do
- file <- initializeGHC fileName ["-w"]
+ file <- initializeGHC opt fileName ["-w"]
setTargetFile file
loadWithLogger (\_ -> return ()) LoadAllTargets
mif setContextFromTarget action invalid
invalid = do
- initializeGHC fileName ["-w"]
+ initializeGHC opt fileName ["-w"]
setTargetBuffer
loadWithLogger defaultWarnErrLogger LoadAllTargets
mif setContextFromTarget action (return errorMessage)
View
8 List.hs
@@ -10,11 +10,11 @@ import UniqFM
----------------------------------------------------------------
listModules :: Options -> IO String
-listModules opt = convert opt . nub . sort <$> list
+listModules opt = convert opt . nub . sort <$> list opt
-list :: IO [String]
-list = withGHC $ do
- initSession0
+list :: Options -> IO [String]
+list opt = withGHC $ do
+ initSession0 opt
getExposedModules <$> getSessionDynFlags
where
getExposedModules = map moduleNameString
View
24 Types.hs
@@ -12,6 +12,8 @@ data Options = Options {
convert :: [String] -> String
, hlintOpts :: [String]
, operators :: Bool
+ , packageConfs :: [FilePath]
+ , useUserPackageConf :: Bool
}
withGHC :: (MonadPlus m) => Ghc (m a) -> IO (m a)
@@ -22,15 +24,16 @@ withGHC body = ghandle ignore $ runGhc (Just libdir) body
----------------------------------------------------------------
-initSession0 :: Ghc [PackageId]
-initSession0 = getSessionDynFlags >>= setSessionDynFlags
+initSession0 :: Options -> Ghc [PackageId]
+initSession0 opt = getSessionDynFlags >>=
+ setSessionDynFlags . setPackageConfFlags opt
-initSession :: [String] -> Maybe [FilePath] -> Ghc [PackageId]
-initSession cmdOpts midirs = do
+initSession :: Options -> [String] -> Maybe [FilePath] -> Ghc [PackageId]
+initSession opt cmdOpts midirs = do
dflags <- getSessionDynFlags
let opts = map noLoc cmdOpts
(dflags',_,_) <- parseDynamicFlags dflags opts
- setSessionDynFlags $ setFlags dflags' midirs
+ setSessionDynFlags $ setPackageConfFlags opt $ setFlags dflags' midirs
----------------------------------------------------------------
@@ -46,6 +49,17 @@ setFlags d midirs = maybe d' (\x -> d' { importPaths = x }) midirs
ghcPackage :: PackageFlag
ghcPackage = ExposePackage "ghc"
+setPackageConfFlags :: Options -> DynFlags -> DynFlags
+setPackageConfFlags
+ Options { packageConfs = confs, useUserPackageConf = useUser }
+ flagset@DynFlags { extraPkgConfs = extra, flags = origFlags }
+ = flagset { extraPkgConfs = extra', flags = flags' }
+ where
+ extra' = confs ++ extra
+ flags' = if useUser
+ then origFlags
+ else filter (/=Opt_ReadUserPackageConf) origFlags
+
----------------------------------------------------------------
setTargetFile :: (GhcMonad m) => String -> m ()
Please sign in to comment.
Something went wrong with that request. Please try again.