From 2151363dd628b3dad739a1f899dc3becbae5fa41 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Thu, 5 Mar 2015 18:54:39 +0100
Subject: [PATCH] Add back `-d` option to `modules` command

---
 Language/Haskell/GhcMod/Gap.hs     | 21 +++++++++++++++++----
 Language/Haskell/GhcMod/Modules.hs | 21 ++++++++++++++++-----
 src/GHCMod.hs                      | 16 ++++++++++++++--
 3 files changed, 47 insertions(+), 11 deletions(-)

diff --git a/Language/Haskell/GhcMod/Gap.hs b/Language/Haskell/GhcMod/Gap.hs
index eab83d0..f76c7ce 100644
--- a/Language/Haskell/GhcMod/Gap.hs
+++ b/Language/Haskell/GhcMod/Gap.hs
@@ -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
diff --git a/Language/Haskell/GhcMod/Modules.hs b/Language/Haskell/GhcMod/Modules.hs
index 3a2c024..d489138 100644
--- a/Language/Haskell/GhcMod/Modules.hs
+++ b/Language/Haskell/GhcMod/Modules.hs
@@ -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
diff --git a/src/GHCMod.hs b/src/GHCMod.hs
index 5ce05d4..3aa5108 100644
--- a/src/GHCMod.hs
+++ b/src/GHCMod.hs
@@ -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" $