Configure cabal-helper to use the new 'runGhcCmd' API

Author: fendor

src/Ide/Cradle.hs

@@ -5,6 +5,7 @@
 
 module Ide.Cradle where
 
+import           Control.Applicative (optional)
 import           Control.Exception
 import           Data.Foldable (toList)
 import           Data.Function ((&))
@@ -21,7 +22,8 @@ import           Distribution.Helper (Package, projectPackages, pUnits,
                                       unChModuleName, Ex(..), ProjLoc(..),
                                       QueryEnv, mkQueryEnv, runQuery,
                                       Unit, unitInfo, uiComponents,
-                                      ChEntrypoint(..), UnitInfo(..))
+                                      ChEntrypoint(..), UnitInfo(..),
+                                      qePrograms, ghcProgram)
 import           Distribution.Helper.Discover (findProjects, getDefaultDistDir)
 import           Ide.Logger
 import           HIE.Bios as Bios
@@ -31,7 +33,7 @@ import qualified HIE.Bios.Types as Bios
 import           System.Directory (getCurrentDirectory, canonicalizePath, findExecutable)
 import           System.Exit
 import           System.FilePath
-import           System.Process (readCreateProcessWithExitCode, shell, CreateProcess(..))
+import           System.Process (readCreateProcessWithExitCode, shell, CreateProcess(..), proc)
 
 
 -- ---------------------------------------------------------------------
@@ -470,7 +472,7 @@ cabalHelperCradle file = do
                                           , componentRoot = cwd
                                           , componentDependencies = []
                                           }
-                                , runGhcCmd = \_ -> pure CradleNone
+                                , runGhcCmd = \args -> readProcessWithCwd cwd "ghc" args ""
                                 }
                }
     Just (Ex proj) -> do
@@ -519,7 +521,9 @@ cabalHelperCradle file = do
                                         realPackage
                                         normalisedPackageLocation
                                         fp
-                                    , runGhcCmd = \_ -> pure CradleNone
+                                    , runGhcCmd = \args -> do
+                                        let programs = qePrograms env
+                                        readProcessWithCwd normalisedPackageLocation (ghcProgram programs) args ""
                                     }
                    }
 
@@ -908,3 +912,14 @@ cradleDisplay cradle = fromString result
   name = Bios.actionName (Bios.cradleOptsProg cradle)
 
 -- ---------------------------------------------------------------------
+-- | Wrapper around 'readCreateProcess' that sets the working directory
+readProcessWithCwd :: FilePath -> FilePath -> [String] -> String -> IO (CradleLoadResult String)
+readProcessWithCwd dir cmd args stdi = do
+  let createProc = (proc cmd args) { cwd = Just dir }
+  mResult <- optional $ readCreateProcessWithExitCode createProc stdi
+  case mResult of
+    Just (ExitSuccess, stdo, _) -> pure $ CradleSuccess stdo
+    Just (exitCode, stdo, stde) -> pure $ CradleFail $
+      CradleError [] exitCode ["Error when calling " <> cmd <> " " <> unwords args, stdo, stde]
+    Nothing -> pure $ CradleFail $
+      CradleError [] ExitSuccess ["Couldn't execute " <> cmd <> " " <> unwords args]