From 444dd225e1179085703fc61f9446ef7ed018ea00 Mon Sep 17 00:00:00 2001 From: mvoidex Date: Sun, 17 Nov 2013 22:31:47 +0400 Subject: [PATCH] Added -q option to list fully qualified names with browse command --- Language/Haskell/GhcMod/Browse.hs | 62 ++++++++++++++++--------------- Language/Haskell/GhcMod/Types.hs | 3 ++ src/GHCMod.hs | 5 ++- 3 files changed, 40 insertions(+), 30 deletions(-) diff --git a/Language/Haskell/GhcMod/Browse.hs b/Language/Haskell/GhcMod/Browse.hs index 2b515f9..8550e64 100644 --- a/Language/Haskell/GhcMod/Browse.hs +++ b/Language/Haskell/GhcMod/Browse.hs @@ -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 diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index 10b4602..4912c2f 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -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 diff --git a/src/GHCMod.hs b/src/GHCMod.hs index c49feba..39b07a4 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -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] [ ...]\n" + ++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] [-d] [-q] [-p package] [ ...]\n" ++ "\t ghc-mod check" ++ ghcOptHelp ++ "\n" ++ "\t ghc-mod expand" ++ ghcOptHelp ++ "\n" ++ "\t ghc-mod debug" ++ ghcOptHelp ++ "\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"