Rewrite ghc-mod command line frontend.

Language/Haskell/GhcMod/CabalApi.hs

@@ -31,7 +31,7 @@ import qualified Distribution.PackageDescription as P
 import Distribution.PackageDescription.Configuration (finalizePackageDescription)
 import Distribution.PackageDescription.Parse (readPackageDescription)
 import Distribution.Simple.Compiler (CompilerId(..), CompilerFlavor(..))
-import Distribution.Simple.Program (ghcProgram)
+import Distribution.Simple.Program as C (ghcProgram)
 import Distribution.Simple.Program.Types (programName, programFindVersion)
 import Distribution.System (buildPlatform)
 import Distribution.Text (display)
@@ -155,7 +155,7 @@ getGHCId = CompilerId GHC <$> getGHC
 
 getGHC :: IO Version
 getGHC = do
-    mv <- programFindVersion ghcProgram silent (programName ghcProgram)
+    mv <- programFindVersion C.ghcProgram silent (programName C.ghcProgram)
     case mv of
       -- TODO: MonadError it up
         Nothing -> E.throwIO $ userError "ghc not found"

Language/Haskell/GhcMod/Error.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE TypeFamilies, ScopedTypeVariables #-}
 module Language.Haskell.GhcMod.Error (
     GhcModError(..)
+  , gmeDoc
   , modifyError
   , modifyError'
   , tryFix
@@ -10,6 +11,7 @@ module Language.Haskell.GhcMod.Error (
 
 import Control.Monad.Error (MonadError(..), Error(..))
 import Exception
+import Text.PrettyPrint
 
 data GhcModError = GMENoMsg
                  -- ^ Unknown error
@@ -29,6 +31,20 @@ instance Error GhcModError where
     noMsg = GMENoMsg
     strMsg = GMEString
 
+gmeDoc :: GhcModError -> Doc
+gmeDoc e = case e of
+    GMENoMsg ->
+        text "Unknown error"
+    GMEString msg ->
+        text msg
+    GMECabalConfigure msg ->
+        text "cabal configure failed: " <> gmeDoc msg
+    GMECabalFlags msg ->
+        text "retrieval of the cabal configuration flags failed: " <> gmeDoc msg
+    GMEProcess cmd msg ->
+        text ("launching operating system process `"++unwords cmd++"` failed: ")
+          <> gmeDoc msg
+
 modifyError :: MonadError e m => (e -> e) -> m a -> m a
 modifyError f action = action `catchError` \e -> throwError $ f e
 

Language/Haskell/GhcMod/Find.hs

@@ -31,9 +31,8 @@ import Language.Haskell.GhcMod.Utils
 import Language.Haskell.GhcMod.Types
 import Name (getOccString)
 import System.Directory (doesDirectoryExist, getAppUserDataDirectory, doesFileExist, getModificationTime)
-import System.FilePath ((</>), takeDirectory)
+import System.FilePath ((</>))
 import System.IO
-import System.Environment
 
 #ifndef MIN_VERSION_containers
 #define MIN_VERSION_containers(x,y,z) 1
@@ -93,26 +92,6 @@ lookupSym sym (SymbolDb db) = fromMaybe [] $ M.lookup sym db
 loadSymbolDb :: (IOish m, MonadError GhcModError m) => m SymbolDb
 loadSymbolDb = SymbolDb <$> readSymbolDb
 
--- | Returns the path to the currently running ghc-mod executable. With ghc<7.6
--- this is a guess but >=7.6 uses 'getExecutablePath'.
-ghcModExecutable :: IO FilePath
-#ifndef SPEC
-ghcModExecutable = do
-    dir <- getExecutablePath'
-    return $ dir </> "ghc-mod"
-#else
-ghcModExecutable = do _ <- getExecutablePath' -- get rid of unused warning when
-                                              -- compiling spec
-                      return "dist/build/ghc-mod/ghc-mod"
-#endif
- where
-    getExecutablePath' :: IO FilePath
-# if __GLASGOW_HASKELL__ >= 706
-    getExecutablePath' = takeDirectory <$> getExecutablePath
-# else
-    getExecutablePath' = return ""
-# endif
-
 readSymbolDb :: (IOish m, MonadError GhcModError m) => m (Map Symbol [ModuleString])
 readSymbolDb = do
     ghcMod <- liftIO ghcModExecutable

Language/Haskell/GhcMod/Internal.hs

@@ -16,8 +16,9 @@ module Language.Haskell.GhcMod.Internal (
   , cabalDependPackages
   , cabalSourceDirs
   , cabalAllTargets
-  -- * GHC.Paths
+  -- * Various Paths
   , ghcLibDir
+  , ghcModExecutable
   -- * IO
   , getDynamicFlags
   -- * Targets
@@ -42,6 +43,8 @@ module Language.Haskell.GhcMod.Internal (
   , getCompilerMode
   , setCompilerMode
   , withOptions
+  -- * 'GhcModError'
+  , gmeDoc
   -- * 'GhcMonad' Choice
   , (||>)
   , goNext
@@ -52,11 +55,13 @@ import GHC.Paths (libdir)
 
 import Language.Haskell.GhcMod.CabalApi
 import Language.Haskell.GhcMod.DynFlags
+import Language.Haskell.GhcMod.Error
 import Language.Haskell.GhcMod.GHCChoice
 import Language.Haskell.GhcMod.Logger
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Target
 import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Utils
 
 -- | Obtaining the directory for ghc system libraries.
 ghcLibDir :: FilePath

Language/Haskell/GhcMod/Types.hs

@@ -25,7 +25,12 @@ newtype LineSeparator = LineSeparator String
 
 data Options = Options {
     outputStyle   :: OutputStyle
-  , hlintOpts     :: [String]
+  -- | Line separator string.
+  , lineSeparator :: LineSeparator
+  -- | @ghc@ program name.
+  , ghcProgram    :: FilePath
+  -- | @cabal@ program name.
+  , cabalProgram  :: FilePath
     -- | GHC command line options set on the @ghc-mod@ command line
   , ghcUserOptions:: [GHCOption]
   -- | If 'True', 'browse' also returns operators.
@@ -34,15 +39,17 @@ data Options = Options {
   , detailed      :: Bool
   -- | If 'True', 'browse' will return fully qualified name
   , qualified     :: Bool
-  -- | Line separator string.
-  , lineSeparator :: LineSeparator
+  , hlintOpts     :: [String]
   }
 
+
 -- | A default 'Options'.
 defaultOptions :: Options
 defaultOptions = Options {
     outputStyle   = PlainStyle
   , hlintOpts     = []
+  , ghcProgram    = "ghc"
+  , cabalProgram  = "cabal"
   , ghcUserOptions= []
   , operators     = False
   , detailed      = False

Language/Haskell/GhcMod/Utils.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module Language.Haskell.GhcMod.Utils where
 
 
@@ -6,6 +7,9 @@ import MonadUtils (MonadIO, liftIO)
 import System.Directory (getCurrentDirectory, setCurrentDirectory)
 import System.Exit (ExitCode(..))
 import System.Process (readProcessWithExitCode)
+#ifndef SPEC
+import System.Environment
+#endif
 
 -- dropWhileEnd is not provided prior to base 4.5.0.0.
 dropWhileEnd :: (a -> Bool) -> [a] -> [a]
@@ -42,3 +46,20 @@ withDirectory_ :: (MonadIO m, ExceptionMonad m) => FilePath -> m a -> m a
 withDirectory_ dir action =
     gbracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory)
                 (\_ -> liftIO (setCurrentDirectory dir) >> action)
+
+-- | Returns the path to the currently running ghc-mod executable. With ghc<7.6
+-- this is a guess but >=7.6 uses 'getExecutablePath'.
+ghcModExecutable :: IO FilePath
+#ifndef SPEC
+ghcModExecutable = getExecutable'
+ where
+    getExecutable' :: IO FilePath
+# if __GLASGOW_HASKELL__ >= 706
+    getExecutable' = getExecutablePath
+# else
+    getExecutable' = getProgName
+# endif
+
+#else
+ghcModExecutable = return "dist/build/ghc-mod/ghc-mod"
+#endif