Add back `-d` option to `modules` command

This commit is contained in:
Daniel Gröber 2015-03-05 18:54:39 +01:00
parent eb5d0fc867
commit 2151363dd6
3 changed files with 47 additions and 11 deletions

View File

@ -38,6 +38,7 @@ module Language.Haskell.GhcMod.Gap (
, occName
, listVisibleModuleNames
, listVisibleModules
, lookupModulePackageInAllPackages
, Language.Haskell.GhcMod.Gap.isSynTyCon
, parseModuleHeader
) where
@ -89,20 +90,18 @@ import RdrName (rdrNameOcc)
#if __GLASGOW_HASKELL__ < 710
import UniqFM (eltsUFM)
import Packages (exposedModules, exposed, pkgIdMap)
import PackageConfig (PackageConfig, packageConfigId)
import Module
#endif
#if __GLASGOW_HASKELL__ >= 704
import qualified Data.IntSet as I (IntSet, empty)
#endif
import Bag
import Lexer as L
import Parser
import SrcLoc
import Packages
----------------------------------------------------------------
----------------------------------------------------------------
@ -476,6 +475,20 @@ listVisibleModuleNames :: DynFlags -> [ModuleName]
listVisibleModuleNames = allExposedModules
#endif
lookupModulePackageInAllPackages ::
DynFlags -> ModuleName -> [String]
lookupModulePackageInAllPackages df mn =
#if __GLASGOW_HASKELL__ >= 710
unpackSPId . sourcePackageId . snd <$> lookupModuleInAllPackages df mn
where
unpackSPId (SourcePackageId fs) = unpackFS fs
#else
unpackPId . sourcePackageId . fst <$> lookupModuleInAllPackages df mn
where
unpackPId pid = packageIdString $ mkPackageId pid
-- n ++ "-" ++ showVersion v
#endif
listVisibleModules :: DynFlags -> [GHC.Module]
listVisibleModules df = let
#if __GLASGOW_HASKELL__ >= 710

View File

@ -1,15 +1,26 @@
module Language.Haskell.GhcMod.Modules (modules) where
import qualified GHC as G
import Control.Arrow
import Data.List
import Language.Haskell.GhcMod.Convert
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Monad
import Language.Haskell.GhcMod.Gap (listVisibleModuleNames)
import Module (moduleNameString)
import Language.Haskell.GhcMod.Gap ( listVisibleModuleNames
, lookupModulePackageInAllPackages
)
import qualified GHC as G
----------------------------------------------------------------
-- | Listing installed modules.
modules :: (IOish m, GmEnv m) => m String
modules = do
dflags <- runGmPkgGhc G.getSessionDynFlags
convert' $ map moduleNameString $ listVisibleModuleNames dflags
Options { detailed } <- options
df <- runGmPkgGhc G.getSessionDynFlags
let mns = listVisibleModuleNames df
pmnss = map (first moduleNameString) $ zip mns (modulePkg df `map` mns)
convert' $ nub [ if detailed then pkg ++ " " ++ mn else mn
| (mn, pkgs) <- pmnss, pkg <- pkgs ]
where
modulePkg df = lookupModulePackageInAllPackages df

View File

@ -88,6 +88,9 @@ ghcModUsage =
\\n\
\ - list [FLAGS...] | modules [FLAGS...]\n\
\ List all visible modules.\n\
\ Flags:\n\
\ -d\n\
\ Print package modules belong to.\n\
\\n\
\ - lang\n\
\ List all known GHC language extensions.\n\
@ -558,7 +561,8 @@ modulesCmd, languagesCmd, flagsCmd, browseCmd, checkSyntaxCmd, expandTemplateCmd
findSymbolCmd, lintCmd, rootInfoCmd, pkgDocCmd, dumpSymbolCmd, bootCmd
:: IOish m => [String] -> GhcModT m String
modulesCmd = withParseCmd' "modules" [] $ \[] -> modules
modulesCmd = withParseCmd' "modules" s $ \[] -> modules
where s = modulesArgSpec
languagesCmd = withParseCmd' "lang" [] $ \[] -> languages
flagsCmd = withParseCmd' "flag" [] $ \[] -> flags
debugInfoCmd = withParseCmd' "debug" [] $ \[] -> debugInfo
@ -571,7 +575,7 @@ findSymbolCmd = withParseCmd' "find" [] $ \[sym] -> findSymbol sym
pkgDocCmd = withParseCmd' "doc" [] $ \[mdl] -> pkgDoc mdl
lintCmd = withParseCmd' "lint" s $ \[file] -> lint file
where s = hlintArgSpec
browseCmd = withParseCmd s $ \mdls -> concat <$> browse `mapM` mdls
browseCmd = withParseCmd s $ \mdls -> concat <$> browse `mapM` mdls
where s = browseArgSpec
checkSyntaxCmd = withParseCmd [] $ checkAction checkSyntax
expandTemplateCmd = withParseCmd [] $ checkAction expandTemplate
@ -601,6 +605,14 @@ locAction' _ action [f,_,line,col,expr] = action f (read line) (read col) expr
locAction' _ action [f, line,col,expr] = action f (read line) (read col) expr
locAction' cmd _ _ = throw $ InvalidCommandLine (Left cmd)
modulesArgSpec :: [OptDescr (Options -> Options)]
modulesArgSpec =
[ option "d" ["detailed"] "Print package modules belong to." $
NoArg $ \o -> o { detailed = True }
]
hlintArgSpec :: [OptDescr (Options -> Options)]
hlintArgSpec =
[ option "h" ["hlintOpt"] "Option to be passed to hlint" $