Refactoring to use cabal-helper-wrapper

This turned out to be quite involved but save for this huge commit it's
actually quite awesome and squashes quite a few bugs and nasty
problems (hopefully). Most importantly we now have native cabal
component support without the user having to do anything to get it!

To do this we traverse imports starting from each component's
entrypoints (library modules or Main source file for executables) and
use this information to find which component's options each module will
build with. Under the assumption that these modules have to build with
every component they're used in we can now just pick one.

Quite a few internal assumptions have been invalidated by this
change. Most importantly the runGhcModT* family of cuntions now change
the current working directory to `cradleRootDir`.

Language/Haskell/GhcMod/Utils.hs

@@ -15,28 +15,28 @@
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 {-# LANGUAGE CPP #-}
-module Language.Haskell.GhcMod.Utils where
+module Language.Haskell.GhcMod.Utils (
+    module Language.Haskell.GhcMod.Utils
+  , module Utils
+  , readProcess
+  ) where
 
 import Control.Arrow
-import Control.Applicative ((<$>))
+import Control.Applicative
 import Data.Char
 import Language.Haskell.GhcMod.Error
-import MonadUtils (MonadIO, liftIO)
+import Exception
 import System.Directory (getCurrentDirectory, setCurrentDirectory, doesFileExist)
-import System.Exit (ExitCode(..))
-import System.Process (readProcessWithExitCode)
+import System.Process (readProcess)
 import System.Directory (getTemporaryDirectory)
-import System.FilePath (splitDrive, pathSeparators, (</>))
+import System.FilePath (splitDrive, takeDirectory, takeFileName, pathSeparators,
+                        (</>))
 import System.IO.Temp (createTempDirectory)
-#ifndef SPEC
-import Paths_ghc_mod (getLibexecDir)
 import System.Environment
-import System.FilePath (takeDirectory)
-#else
--- When compiling test suite
-import Data.IORef
-import System.IO.Unsafe
-#endif
+import Text.Printf
+
+import Paths_ghc_mod (getLibexecDir)
+import Utils
 
 -- dropWhileEnd is not provided prior to base 4.5.0.0.
 dropWhileEnd :: (a -> Bool) -> [a] -> [a]
@@ -54,21 +54,6 @@ extractParens str = extractParens' str 0
        | s `elem` "}])" = s : extractParens' ss (level-1)
        | otherwise = s : extractParens' ss level
 
-readProcess' :: (MonadIO m, GmError m)
-             => String
-             -> [String]
-             -> m String
-readProcess' cmd opts = do
-  (rv,output,err) <- liftIO (readProcessWithExitCode cmd opts "")
-      `modifyError'` GMEProcess ([cmd] ++ opts)
-  case rv of
-    ExitFailure val -> do
-        throwError $ GMEProcess ([cmd] ++ opts) $ strMsg $
-          cmd ++ " " ++ unwords opts ++ " (exit " ++ show val ++ ")"
-              ++ "\n" ++ err
-    ExitSuccess ->
-        return output
-
 withDirectory_ :: (MonadIO m, ExceptionMonad m) => FilePath -> m a -> m a
 withDirectory_ dir action =
     gbracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory)
@@ -91,42 +76,85 @@ newTempDir :: FilePath -> IO FilePath
 newTempDir dir =
     flip createTempDirectory (uniqTempDirName dir) =<< getTemporaryDirectory
 
-mightExist :: FilePath -> IO (Maybe FilePath)
-mightExist f = do
-  exists <- doesFileExist f
-  return $ if exists then (Just f) else (Nothing)
+whenM :: IO Bool -> IO () -> IO ()
+whenM mb ma = mb >>= flip when ma
 
 -- | 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"
- where
-    getExecutablePath' :: IO FilePath
-# if __GLASGOW_HASKELL__ >= 706
-    getExecutablePath' = takeDirectory <$> getExecutablePath
-# else
-    getExecutablePath' = return ""
-# endif
+    dir <- takeDirectory <$> getExecutablePath'
+    return $ (if dir == "." then "" else dir) </> "ghc-mod"
 #else
 ghcModExecutable = fmap (</> "dist/build/ghc-mod/ghc-mod") getCurrentDirectory
 #endif
 
-#ifdef SPEC
--- Ugly workaround :'( but I can't think of any other way of doing this
--- the test suite changes the cwd often so I can't use relative paths :/
-specRootDir :: IORef FilePath
-specRootDir = unsafePerformIO $ newIORef undefined
-{-# NOINLINE specRootDir #-}
-#endif
-
 findLibexecExe :: String -> IO FilePath
-#ifndef SPEC
-findLibexecExe "cabal-helper" = (fmap (</> "cabal-helper")) getLibexecDir
-#else
-findLibexecExe "cabal-helper" =
-    (</> "dist/build/cabal-helper/cabal-helper") <$> (readIORef specRootDir)
-#endif
+findLibexecExe "cabal-helper-wrapper" = do
+    libexecdir <- getLibexecDir
+    let exeName = "cabal-helper-wrapper"
+        exe = libexecdir </> exeName
+
+    exists <- doesFileExist exe
+
+    if exists
+       then return exe
+       else do
+         mdir <- tryFindGhcModTreeDataDir
+         case mdir of
+           Nothing ->
+               error $ libexecNotExitsError exeName libexecdir
+           Just dir ->
+               return $ dir </> "dist" </> "build" </> exeName </> exeName
 findLibexecExe exe = error $ "findLibexecExe: Unknown executable: " ++ exe
+
+libexecNotExitsError :: String -> FilePath -> String
+libexecNotExitsError exe dir = printf
+ ( "Could not find $libexecdir/%s\n"
+ ++"\n"
+ ++"If you are a developer set the environment variable `ghc_mod_libexecdir'\n"
+ ++"to override $libexecdir[1] the following will work in the ghc-mod tree:\n"
+ ++"\n"
+ ++"    $ export ghc_mod_libexecdir=$PWD/dist/build/%s\n"
+ ++"\n"
+ ++"[1]: %s\n"
+ ++"\n"
+ ++"If you don't know what I'm talking about something went wrong with your\n"
+ ++"installation. Please report this problem here:\n"
+ ++"\n"
+ ++"    https://github.com/kazu-yamamoto/ghc-mod/issues") exe exe dir
+
+tryFindGhcModTreeLibexecDir :: IO (Maybe FilePath)
+tryFindGhcModTreeLibexecDir  = do
+  exe <- getExecutablePath
+  dir <- case takeFileName exe of
+    "ghc" -> do -- we're probably in ghci; try CWD
+        getCurrentDirectory
+    _ ->
+        return $ (!!4) $ iterate takeDirectory exe
+  exists <- doesFileExist $ dir </> "ghc-mod.cabal"
+  return $ if exists
+             then Just dir
+             else Nothing
+
+tryFindGhcModTreeDataDir :: IO (Maybe FilePath)
+tryFindGhcModTreeDataDir  = do
+  dir <- (!!4) . iterate takeDirectory <$> getExecutablePath'
+  exists <- doesFileExist $ dir </> "ghc-mod.cabal"
+  return $ if exists
+             then Just dir
+             else Nothing
+
+readLibExecProcess' :: (MonadIO m, ExceptionMonad m)
+                    => String -> [String] -> m String
+readLibExecProcess' cmd args = do
+  exe <- liftIO $ findLibexecExe cmd
+  liftIO $ readProcess exe args ""
+
+getExecutablePath' :: IO FilePath
+#if __GLASGOW_HASKELL__ >= 706
+getExecutablePath' = getExecutablePath
+#else
+getExecutablePath' = getProgName
+#endif