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 Control.Monad (void)
import Data.Char import Data.Char
import Data.List import Data.List
import Data.Maybe (fromMaybe) import Data.Maybe (catMaybes)
import DataCon (dataConRepType) import DataCon (dataConRepType)
import FastString (mkFastString) import FastString (mkFastString)
import GHC import GHC
@ -26,19 +26,7 @@ browseModule :: Options
-> Cradle -> Cradle
-> ModuleString -- ^ A module name. (e.g. \"Data.List\") -> ModuleString -- ^ A module name. (e.g. \"Data.List\")
-> IO String -> IO String
browseModule opt cradle mdlName = convert opt . format <$> withGHCDummyFile (browse opt cradle mdlName) browseModule opt cradle mdlName = convert opt . sort <$> 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'"
-- | Getting functions, classes, etc from a module. -- | Getting functions, classes, etc from a module.
-- If 'detailed' is 'True', their types are also obtained. -- If 'detailed' is 'True', their types are also obtained.
@ -53,26 +41,42 @@ browse opt cradle mdlName = do
where where
getModule = findModule (mkModuleName mdlName) (mkFastString <$> packageId opt) getModule = findModule (mkModuleName mdlName) (mkFastString <$> packageId opt)
listExports Nothing = return [] listExports Nothing = return []
listExports (Just mdinfo) listExports (Just mdinfo) = processExports opt mdinfo
| detailed opt = processModule mdinfo
| otherwise = return (processExports mdinfo)
processExports :: ModuleInfo -> [String] processExports :: Options -> ModuleInfo -> Ghc [String]
processExports = map getOccString . modInfoExports processExports opt minfo = mapM (showExport opt minfo) $ removeOps $ modInfoExports minfo
processModule :: ModuleInfo -> Ghc [String]
processModule minfo = mapM processName names
where where
names = modInfoExports minfo removeOps
processName :: Name -> Ghc String | operators opt = id
processName nm = do | otherwise = filter (isAlpha . head . getOccString)
tyInfo <- modInfoLookupName minfo nm
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 -- 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 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 :: Name -> Ghc (Maybe TyThing)
inOtherModule nm = getModuleInfo (nameModule nm) >> lookupGlobalName nm 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 :: DynFlags -> TyThing -> Maybe String
showThing dflag (AnId i) = Just $ formatType dflag varType i showThing dflag (AnId i) = Just $ formatType dflag varType i
@ -83,7 +87,7 @@ showThing _ (ATyCon t) = unwords . toList <$> tyType t
showThing _ _ = Nothing showThing _ _ = Nothing
formatType :: NamedThing a => DynFlags -> (a -> Type) -> a -> String 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 :: TyCon -> Maybe String
tyType typ tyType typ

View File

@ -17,6 +17,8 @@ data Options = Options {
, operators :: Bool , operators :: Bool
-- | If 'True', 'browse' also returns types. -- | If 'True', 'browse' also returns types.
, detailed :: Bool , detailed :: Bool
-- | If 'True', 'browse' will return fully qualified name
, qualified :: Bool
-- | Whether or not Template Haskell should be expanded. -- | Whether or not Template Haskell should be expanded.
, expandSplice :: Bool , expandSplice :: Bool
-- | Line separator string. -- | Line separator string.
@ -33,6 +35,7 @@ defaultOptions = Options {
, ghcOpts = [] , ghcOpts = []
, operators = False , operators = False
, detailed = False , detailed = False
, qualified = False
, expandSplice = False , expandSplice = False
, lineSeparator = LineSeparator "\0" , lineSeparator = LineSeparator "\0"
, packageId = Nothing , 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 list" ++ ghcOptHelp ++ "[-l] [-d]\n"
++ "\t ghc-mod lang [-l]\n" ++ "\t ghc-mod lang [-l]\n"
++ "\t ghc-mod flag [-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 check" ++ ghcOptHelp ++ "<HaskellFiles...>\n"
++ "\t ghc-mod expand" ++ ghcOptHelp ++ "<HaskellFiles...>\n" ++ "\t ghc-mod expand" ++ ghcOptHelp ++ "<HaskellFiles...>\n"
++ "\t ghc-mod debug" ++ ghcOptHelp ++ "<HaskellFile>\n" ++ "\t ghc-mod debug" ++ ghcOptHelp ++ "<HaskellFile>\n"
@ -55,6 +55,9 @@ argspec = [ Option "l" ["tolisp"]
, Option "d" ["detailed"] , Option "d" ["detailed"]
(NoArg (\opts -> opts { detailed = True })) (NoArg (\opts -> opts { detailed = True }))
"print detailed info" "print detailed info"
, Option "q" ["qualified"]
(NoArg (\opts -> opts { qualified = True }))
"show qualified names"
, Option "p" ["package"] , Option "p" ["package"]
(ReqArg (\p opts -> opts { packageId = Just p, ghcOpts = ("-package " ++ p) : ghcOpts opts }) "package-id") (ReqArg (\p opts -> opts { packageId = Just p, ghcOpts = ("-package " ++ p) : ghcOpts opts }) "package-id")
"specify package of module" "specify package of module"