Reorganize module namespace

- Remove Language.Haskell prefix from all modules
- Move 'GHCMod.*' to 'GhcMod.Exe'
- Move 'GhcModExe' to 'GhcMod.Exe'

GhcMod/Exe/Debug.hs

@@ -0,0 +1,182 @@
+module GhcMod.Exe.Debug (debugInfo, rootInfo, componentInfo) where
+
+import Control.Arrow (first)
+import Control.Applicative
+import Control.Monad
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Data.Char
+import Data.Maybe
+import Data.Version
+import Data.List.Split
+import System.Directory
+
+import GhcMod.Exe.Internal
+import GhcMod.Cradle
+import GhcMod.Monad
+import GhcMod.Output
+import GhcMod.Pretty
+import GhcMod.Stack
+import GhcMod.Target
+import GhcMod.Types
+import GhcMod.Utils
+
+import Paths_ghc_mod (version)
+
+import Config (cProjectVersion)
+import Pretty
+
+----------------------------------------------------------------
+
+-- | Obtaining debug information.
+debugInfo :: IOish m => GhcModT m String
+debugInfo = do
+    Options {..} <- options
+    Cradle {..} <- cradle
+
+    [ghcPath, ghcPkgPath] <- liftIO $
+        case cradleProject of
+          StackProject se ->
+              catMaybes <$> sequence [getStackGhcPath se, getStackGhcPkgPath se]
+          _ ->
+              return ["ghc", "ghc-pkg"]
+
+    cabal <-
+        case cradleProject of
+          CabalProject -> cabalDebug ghcPkgPath
+          StackProject {} -> (++) <$> stackPaths <*> cabalDebug ghcPkgPath
+          _ -> return []
+
+    pkgOpts <- packageGhcOptions
+
+    readProc <- gmReadProcess
+
+    ghcVersion <- liftIO $
+        dropWhileEnd isSpace <$> readProc ghcPath ["--numeric-version"] ""
+
+    return $ unlines $
+      [ "Version:              ghc-mod-" ++ showVersion version
+      , "Library GHC Version:  " ++ cProjectVersion
+      , "System GHC Version:   " ++ ghcVersion
+      , "Root directory:       " ++ cradleRootDir
+      , "Current directory:    " ++ cradleCurrentDir
+      , "GHC Package flags:\n"   ++ renderGm (nest 4 $
+              fsep $ map text pkgOpts)
+      , "GHC System libraries: " ++ ghcLibDir
+      ] ++ cabal
+
+stackPaths :: IOish m => GhcModT m [String]
+stackPaths = do
+    Cradle { cradleProject = StackProject senv } <- cradle
+    ghc <- getStackGhcPath senv
+    ghcPkg <- getStackGhcPkgPath senv
+    return $
+         [ "Stack ghc executable:    " ++ show ghc
+         , "Stack ghc-pkg executable:" ++ show ghcPkg
+         ]
+
+cabalDebug :: IOish m => FilePath -> GhcModT m [String]
+cabalDebug ghcPkgPath = do
+    Cradle {..} <- cradle
+    mcs <- cabalResolvedComponents
+    let entrypoints = Map.map gmcEntrypoints mcs
+        graphs      = Map.map gmcHomeModuleGraph mcs
+        opts        = Map.map gmcGhcOpts mcs
+        srcOpts     = Map.map gmcGhcSrcOpts mcs
+
+    readProc <- gmReadProcess
+    cabalExists <- liftIO $ (/=Nothing) <$> findExecutable "cabal"
+
+    cabalInstVersion <-
+        if cabalExists
+          then liftIO $
+            dropWhileEnd isSpace <$> readProc "cabal" ["--numeric-version"] ""
+          else return ""
+
+    packages <- liftIO $ readProc ghcPkgPath ["list", "--simple-output"] ""
+    let cabalPackages = filter ((== ["Cabal"]) . take 1 . splitOn "-") $ splitWhen isSpace packages
+
+    return $
+         [ "cabal-install Version: "    ++ cabalInstVersion
+         , "Cabal Library Versions:\n"  ++ renderGm (nest 4 $
+              fsep $ map text cabalPackages)
+         , "Cabal file:            "    ++ show cradleCabalFile
+         , "Project:               " ++ show cradleProject
+         , "Cabal entrypoints:\n"       ++ renderGm (nest 4 $
+              mapDoc gmComponentNameDoc smpDoc entrypoints)
+         , "Cabal components:\n"        ++ renderGm (nest 4 $
+              mapDoc gmComponentNameDoc graphDoc graphs)
+         , "GHC Cabal options:\n"       ++ renderGm (nest 4 $
+              mapDoc gmComponentNameDoc (fsep . map text) opts)
+         , "GHC search path options:\n" ++ renderGm (nest 4 $
+              mapDoc gmComponentNameDoc (fsep . map text) srcOpts)
+         ]
+
+componentInfo :: IOish m => [String] -> GhcModT m String
+componentInfo ts = do
+    -- TODO: most of this is copypasta of targetGhcOptions. Factor out more
+    -- useful function from there.
+    crdl <- cradle
+    sefnmn <- Set.fromList `liftM` mapM guessModuleFile ts
+    mcs <- cabalResolvedComponents
+    let
+        mdlcs = moduleComponents mcs `zipMap` Set.toList sefnmn
+        candidates = findCandidates $ map snd mdlcs
+        cn = pickComponent candidates
+    opts <- targetGhcOptions crdl sefnmn
+
+    return $ unlines $
+         [ "Matching Components:\n"     ++ renderGm (nest 4 $
+              alistDoc (either text mnDoc) (setDoc gmComponentNameDoc) mdlcs)
+         , "Picked Component:\n"        ++ renderGm (nest 4 $
+              gmComponentNameDoc cn)
+         , "GHC Cabal options:\n"       ++ renderGm (nest 4 $ fsep $ map text opts)
+         ]
+ where
+   zipMap f l = l `zip` (f `map` l)
+
+guessModuleFile :: MonadIO m => String -> m (Either FilePath ModuleName)
+guessModuleFile m
+  | (isUpper . head .&&. (all $ all $ isAlphaNum .||. (=='.')) . splitOn ".") m =
+      return $ Right $ mkModuleName m
+ where
+   infixr 1 .||.
+   infixr 2 .&&.
+   (.||.) = liftA2 (||)
+   (.&&.) = liftA2 (&&)
+
+guessModuleFile str = Left `liftM` liftIO (canonFilePath str)
+
+graphDoc :: GmModuleGraph -> Doc
+graphDoc GmModuleGraph{..} =
+    mapDoc mpDoc smpDoc' gmgGraph
+ where
+   smpDoc' smp = vcat $ map mpDoc' $ Set.toList smp
+   mpDoc' = text . moduleNameString . mpModule
+
+setDoc :: (a -> Doc) -> Set.Set a -> Doc
+setDoc f s = vcat $ map f $ Set.toList s
+
+smpDoc :: Set.Set ModulePath -> Doc
+smpDoc smp = setDoc mpDoc smp
+
+mpDoc :: ModulePath -> Doc
+mpDoc (ModulePath mn fn) = text (moduleNameString mn) <+> parens (text fn)
+
+mnDoc :: ModuleName -> Doc
+mnDoc mn = text (moduleNameString mn)
+
+alistDoc :: Ord k => (k -> Doc) -> (a -> Doc) -> [(k, a)] -> Doc
+alistDoc fk fa alist = mapDoc fk fa (Map.fromList alist)
+
+mapDoc :: (k -> Doc) -> (a -> Doc) -> Map.Map k a -> Doc
+mapDoc kd ad m = vcat $
+    map (uncurry ($+$)) $ map (first kd) $ Map.toList $ Map.map (nest 4 . ad) m
+----------------------------------------------------------------
+
+-- | Obtaining root information.
+rootInfo :: forall m. (IOish m, GmOut m, GmEnv m) => m String
+rootInfo = do
+    crdl <- findCradleNoLog =<< (optPrograms <$> options)
+    liftIO $ cleanupCradle crdl
+    return $ cradleRootDir crdl ++ "\n"