Added -q option to list fully qualified names with browse command

This commit is contained in:
mvoidex 2013-11-17 22:31:47 +04:00
parent d4505041a9
commit 444dd225e1
3 changed files with 40 additions and 30 deletions

View File

@ -4,7 +4,7 @@ import Control.Applicative
import Control.Monad (void)
import Data.Char
import Data.List
import Data.Maybe (fromMaybe)
import Data.Maybe (catMaybes)
import DataCon (dataConRepType)
import FastString (mkFastString)
import GHC
@ -26,19 +26,7 @@ browseModule :: Options
-> Cradle
-> ModuleString -- ^ A module name. (e.g. \"Data.List\")
-> IO String
browseModule opt cradle mdlName = convert opt . format <$> withGHCDummyFile (browse opt cradle mdlName)
where
format
| operators opt = formatOps
| otherwise = removeOps
removeOps = sort . filter (isAlpha.head)
formatOps = sort . map formatOps'
formatOps' x@(s:_)
| isAlpha s = x
| otherwise = "(" ++ name ++ ")" ++ tail_
where
(name, tail_) = break isSpace x
formatOps' [] = error "formatOps'"
browseModule opt cradle mdlName = convert opt . sort <$> withGHCDummyFile (browse opt cradle mdlName)
-- | Getting functions, classes, etc from a module.
-- If 'detailed' is 'True', their types are also obtained.
@ -53,26 +41,42 @@ browse opt cradle mdlName = do
where
getModule = findModule (mkModuleName mdlName) (mkFastString <$> packageId opt)
listExports Nothing = return []
listExports (Just mdinfo)
| detailed opt = processModule mdinfo
| otherwise = return (processExports mdinfo)
listExports (Just mdinfo) = processExports opt mdinfo
processExports :: ModuleInfo -> [String]
processExports = map getOccString . modInfoExports
processModule :: ModuleInfo -> Ghc [String]
processModule minfo = mapM processName names
processExports :: Options -> ModuleInfo -> Ghc [String]
processExports opt minfo = mapM (showExport opt minfo) $ removeOps $ modInfoExports minfo
where
names = modInfoExports minfo
processName :: Name -> Ghc String
processName nm = do
tyInfo <- modInfoLookupName minfo nm
removeOps
| operators opt = id
| otherwise = filter (isAlpha . head . getOccString)
showExport :: Options -> ModuleInfo -> Name -> Ghc String
showExport opt minfo e = do
mtype' <- mtype
return $ concat $ catMaybes [mqualified, Just $ formatOp $ getOccString e, mtype']
where
mqualified
| qualified opt = Just $ moduleNameString (moduleName $ nameModule e) ++ "."
| otherwise = Nothing
mtype
| detailed opt = do
tyInfo <- modInfoLookupName minfo e
-- If nothing found, load dependent module and lookup global
tyResult <- maybe (inOtherModule nm) (return . Just) tyInfo
tyResult <- maybe (inOtherModule e) (return . Just) tyInfo
dflag <- getSessionDynFlags
return $ fromMaybe (getOccString nm) (tyResult >>= showThing dflag)
return $ do
typeName <- tyResult >>= showThing dflag
(" :: " ++ typeName) `justIf` detailed opt
| otherwise = return Nothing
formatOp nm@(n:_)
| isAlpha n = nm
| otherwise = "(" ++ nm ++ ")"
formatOp "" = error "formatOp"
inOtherModule :: Name -> Ghc (Maybe TyThing)
inOtherModule nm = getModuleInfo (nameModule nm) >> lookupGlobalName nm
justIf :: a -> Bool -> Maybe a
justIf x True = Just x
justIf _ False = Nothing
showThing :: DynFlags -> TyThing -> Maybe String
showThing dflag (AnId i) = Just $ formatType dflag varType i
@ -83,7 +87,7 @@ showThing _ (ATyCon t) = unwords . toList <$> tyType t
showThing _ _ = Nothing
formatType :: NamedThing a => DynFlags -> (a -> Type) -> a -> String
formatType dflag f x = getOccString x ++ " :: " ++ showOutputable dflag (removeForAlls $ f x)
formatType dflag f x = showOutputable dflag (removeForAlls $ f x)
tyType :: TyCon -> Maybe String
tyType typ

View File

@ -17,6 +17,8 @@ data Options = Options {
, operators :: Bool
-- | If 'True', 'browse' also returns types.
, detailed :: Bool
-- | If 'True', 'browse' will return fully qualified name
, qualified :: Bool
-- | Whether or not Template Haskell should be expanded.
, expandSplice :: Bool
-- | Line separator string.
@ -33,6 +35,7 @@ defaultOptions = Options {
, ghcOpts = []
, operators = False
, detailed = False
, qualified = False
, expandSplice = False
, lineSeparator = LineSeparator "\0"
, packageId = Nothing

View File

@ -27,7 +27,7 @@ usage = "ghc-mod version " ++ showVersion version ++ "\n"
++ "\t ghc-mod list" ++ ghcOptHelp ++ "[-l] [-d]\n"
++ "\t ghc-mod lang [-l]\n"
++ "\t ghc-mod flag [-l]\n"
++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] [-d] [-p package] <module> [<module> ...]\n"
++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] [-d] [-q] [-p package] <module> [<module> ...]\n"
++ "\t ghc-mod check" ++ ghcOptHelp ++ "<HaskellFiles...>\n"
++ "\t ghc-mod expand" ++ ghcOptHelp ++ "<HaskellFiles...>\n"
++ "\t ghc-mod debug" ++ ghcOptHelp ++ "<HaskellFile>\n"
@ -55,6 +55,9 @@ argspec = [ Option "l" ["tolisp"]
, Option "d" ["detailed"]
(NoArg (\opts -> opts { detailed = True }))
"print detailed info"
, Option "q" ["qualified"]
(NoArg (\opts -> opts { qualified = True }))
"show qualified names"
, Option "p" ["package"]
(ReqArg (\p opts -> opts { packageId = Just p, ghcOpts = ("-package " ++ p) : ghcOpts opts }) "package-id")
"specify package of module"