Cleanup and some fixes

Language/Haskell/GhcMod.hs

@@ -34,6 +34,7 @@ module Language.Haskell.GhcMod (
   , check
   , checkSyntax
   , debugInfo
+  , componentInfo
   , expandTemplate
   , info
   , lint
@@ -58,7 +59,6 @@ module Language.Haskell.GhcMod (
 import Language.Haskell.GhcMod.Boot
 import Language.Haskell.GhcMod.Browse
 import Language.Haskell.GhcMod.CaseSplit
-import Language.Haskell.GhcMod.CabalHelper
 import Language.Haskell.GhcMod.Check
 import Language.Haskell.GhcMod.Cradle
 import Language.Haskell.GhcMod.Debug
@@ -73,4 +73,3 @@ import Language.Haskell.GhcMod.Modules
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.PkgDoc
 import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Target

Language/Haskell/GhcMod/CabalHelper.hs

@@ -14,6 +14,7 @@
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
+{-# LANGUAGE CPP #-}
 module Language.Haskell.GhcMod.CabalHelper (
     getComponents
   , getGhcPkgOptions
@@ -33,6 +34,8 @@ import Language.Haskell.GhcMod.World
 import Language.Haskell.GhcMod.PathsAndFiles
 import System.FilePath
 
+import Paths_ghc_mod as GhcMod
+
 -- | Only package related GHC options, sufficient for things that don't need to
 -- access home modules
 getGhcPkgOptions :: (MonadIO m, GmEnv m) => m [(ChComponentName, [GHCOption])]
@@ -87,6 +90,7 @@ cabalHelperCache = Cached {
                 , a == a'
                 ]
 
+
 withCabal :: (MonadIO m, GmEnv m) => m a -> m a
 withCabal action = do
     crdl <- cradle

Language/Haskell/GhcMod/Debug.hs

@@ -1,9 +1,10 @@
-module Language.Haskell.GhcMod.Debug (debugInfo, rootInfo) where
+module Language.Haskell.GhcMod.Debug (debugInfo, rootInfo, componentInfo) where
 
 import Control.Arrow (first)
 import Control.Applicative ((<$>))
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import Data.Char
 import Text.PrettyPrint
 import Language.Haskell.GhcMod.Convert
 import Language.Haskell.GhcMod.Monad
@@ -35,8 +36,8 @@ debugInfo = do
 
 cabalDebug :: IOish m => GhcModT m [String]
 cabalDebug = do
-    Cradle {..} <- cradle
-    mcs <- resolveGmComponents Nothing =<< getComponents
+    crdl@Cradle {..} <- cradle
+    mcs <- resolveGmComponents Nothing =<< mapM (resolveEntrypoint crdl) =<< getComponents
     let entrypoints = Map.map gmcEntrypoints mcs
         graphs      = Map.map gmcHomeModuleGraph mcs
         opts        = Map.map gmcGhcOpts mcs
@@ -54,6 +55,20 @@ cabalDebug = do
               mapDoc gmComponentNameDoc (fsep . map text) srcOpts)
          ]
 
+componentInfo :: IOish m => [String] -> GhcModT m String
+componentInfo ts = do
+    crdl <- cradle
+    opts <- targetGhcOptions crdl $ Set.fromList $ map guessModuleFile ts
+
+    return $ unlines $
+         [ "GHC Cabal options:\n"       ++ render (nest 4 $ fsep $ map text opts)
+         ]
+
+guessModuleFile :: String -> Either FilePath ModuleName
+guessModuleFile mn@(h:r)
+    | isUpper h && all isAlphaNum r = Right $ mkModuleName mn
+guessModuleFile str = Left str
+
 graphDoc :: GmModuleGraph -> Doc
 graphDoc GmModuleGraph{..} =
     mapDoc mpDoc' smpDoc' gmgGraph

Language/Haskell/GhcMod/HomeModuleGraph.hs

@@ -216,7 +216,7 @@ updateHomeModuleGraph' env smp0 = do
           Left errs -> do
             -- TODO: Remember these and present them as proper errors if this is
             -- the file the user is looking at.
-            gmLog GmWarning "preprocess'" $ vcat $ map strDoc errs
+            gmLog GmWarning ("preprocess' " ++ show fn) $ vcat $ map strDoc errs
             return Nothing
 
    imports :: ModulePath -> String -> DynFlags -> MaybeT m (Set ModulePath)

Language/Haskell/GhcMod/Logging.hs

@@ -14,6 +14,8 @@
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module Language.Haskell.GhcMod.Logging (
     module Language.Haskell.GhcMod.Logging
   , module Language.Haskell.GhcMod.Pretty
@@ -22,7 +24,9 @@ module Language.Haskell.GhcMod.Logging (
   , module Data.Monoid
   ) where
 
+import Control.Applicative hiding (empty)
 import Control.Monad
+import Control.Monad.Trans.Class
 import Data.List
 import Data.Char
 import Data.Monoid (mempty, mappend, mconcat, (<>))
@@ -57,9 +61,20 @@ gmLog level loc' doc = do
 
   let loc | loc' == "" = empty
           | otherwise = text loc'
-      msg = gmRenderDoc $ (gmLogLevelDoc level <+> loc) <+>: doc
+      msg = gmRenderDoc $ (gmLogLevelDoc level <+>: loc) <+>: doc
       msg' = dropWhileEnd isSpace msg
 
   when (Just level <= level') $
        liftIO $ hPutStrLn stderr msg'
   gmlJournal (GhcModLog Nothing [(level, render loc, msg)])
+
+newtype LogDiscardT m a = LogDiscardT { runLogDiscard :: m a }
+    deriving (Functor, Applicative, Monad)
+
+instance MonadTrans LogDiscardT where
+    lift = LogDiscardT
+
+instance Monad m => GmLog (LogDiscardT m) where
+    gmlJournal = const $ return ()
+    gmlHistory = return mempty
+    gmlClear = return ()

Language/Haskell/GhcMod/Monad/Types.hs

@@ -27,14 +27,14 @@ module Language.Haskell.GhcMod.Monad.Types (
   , LightGhc(..)
   , GmGhc
   , IOish
-  -- ** Environment, state and logging
+  -- * Environment, state and logging
   , GhcModEnv(..)
   , GhcModState(..)
   , defaultGhcModState
   , GmGhcSession(..)
   , GmComponent(..)
   , CompilerMode(..)
-  -- ** Accessing 'GhcModEnv', 'GhcModState' and 'GhcModLog'
+  -- * Accessing 'GhcModEnv', 'GhcModState' and 'GhcModLog'
   , GmLogLevel(..)
   , GhcModLog(..)
   , GhcModError(..)
@@ -46,7 +46,7 @@ module Language.Haskell.GhcMod.Monad.Types (
   , withOptions
   , getCompilerMode
   , setCompilerMode
-  -- ** Re-exporting convenient stuff
+  -- * Re-exporting convenient stuff
   , MonadIO
   , liftIO
   ) where