Add exported interface for running build-tools

4 files changed, 71 insertions, 12 deletions

diff --git a/src/CabalHelper/Compiletime/Process.hs b/src/CabalHelper/Compiletime/Process.hs
index 5e9bbbd..948d455 100644
--- a/src/CabalHelper/Compiletime/Process.hs
+++ b/src/CabalHelper/Compiletime/Process.hs
@@ -25,11 +25,14 @@ module CabalHelper.Compiletime.Process
     , module System.Process
     ) where
 
+import Control.Arrow (second)
 import Data.Char
 import Data.List
+import qualified Data.Map.Strict as Map
 import GHC.IO.Exception (IOErrorType(OtherError))
 import System.IO
 import System.IO.Error
+import System.Environment
 import System.Exit
 import System.Process
 
@@ -47,22 +50,41 @@ readProcess' exe args inp = do
 -- | Essentially 'System.Process.callProcess' but returns exit code, has
 -- additional options and logging to stderr when verbosity is enabled.
 callProcessStderr'
-    :: Verbose => Maybe FilePath -> [(String, String)]
+    :: Verbose => Maybe FilePath -> [(String, EnvOverride)]
     -> FilePath -> [String] -> IO ExitCode
 callProcessStderr' mwd env exe args = do
   let cd = case mwd of
              Nothing -> []; Just wd -> [ "cd", formatProcessArg wd++";" ]
-  vLog $ intercalate " " $ cd ++ map formatProcessArg (exe:args)
+  vLog $ intercalate " " $
+    cd ++ map formatProcessArg (map (\(k,v) -> k ++ "=" ++ show v) env ++ exe:args)
+
+  env' <- execEnvOverrides env
   (_, _, _, h) <- createProcess (proc exe args)
     { std_out = UseHandle stderr
-    , env = if env == [] then Nothing else Just env
+    , env = if env == [] then Nothing else Just env'
     , cwd = mwd
     }
   waitForProcess h
 
+execEnvOverride :: EnvOverride -> String -> String
+execEnvOverride (EnvPrepend x) y = x ++ y
+execEnvOverride (EnvAppend  y) x = x ++ y
+execEnvOverride (EnvReplace x) _ = x
+
+execEnvOverrides :: [(String, EnvOverride)] -> IO [(String, String)]
+execEnvOverrides overrides = do
+  envs <- getEnvironment
+  return $ do
+    (k,v) <- envs
+    case Map.lookup k overrides_map of
+      Just os -> return (k, foldr execEnvOverride v os)
+      Nothing -> return (k, v)
+  where
+    overrides_map = Map.fromListWith (++) $ map (second (:[])) overrides
+
 -- | Essentially 'System.Process.callProcess' but with additional options
 -- and logging to stderr when verbosity is enabled.
-callProcessStderr :: Verbose => Maybe FilePath -> [(String, String)]
+callProcessStderr :: Verbose => Maybe FilePath -> [(String, EnvOverride)]
                   -> FilePath -> [String] -> IO ()
 callProcessStderr mwd env exe args = do
   rv <- callProcessStderr' mwd env exe args
diff --git a/src/CabalHelper/Compiletime/Program/CabalInstall.hs b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
index 686743b..cce4364 100644
--- a/src/CabalHelper/Compiletime/Program/CabalInstall.hs
+++ b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, MultiWayIf, TupleSections #-}
+{-# LANGUAGE DataKinds, MultiWayIf, TupleSections, GADTs #-}
 
 -- cabal-helper: Simple interface to Cabal's configuration state
 -- Copyright (C) 2018  Daniel Gröber <cabal-helper@dxld.at>
@@ -312,3 +312,34 @@ cpCompNameToChComponentName cn =
       (CP.CompNameExe name)    -> ChExeName   $ Text.unpack name
       (CP.CompNameTest name)   -> ChTestName  $ Text.unpack name
       (CP.CompNameBench name)  -> ChBenchName $ Text.unpack name
+
+data CabalInstallCommand
+    = CIConfigure
+    | CIBuild
+
+doCabalInstallCmd
+    :: (QueryEnvI c ('Cabal cpt) -> CallProcessWithCwdAndEnv a)
+    -> QueryEnvI c ('Cabal cpt)
+    -> Maybe FilePath -> CabalInstallCommand -> [String] -> IO a
+doCabalInstallCmd procfn qe mcwd cmd args = do
+  case (cmd, projTypeOfQueryEnv qe) of
+    (CIConfigure, SCabal SCV1) ->
+      run "v1-configure" cabalProjArgs cabalUnitArgs []
+    (CIBuild, SCabal SCV1) ->
+      run "v1-build" cabalProjArgs [] []
+    (_, SCabal SCV2) ->
+      run "v2-build" cabalProjArgs cabalUnitArgs []
+  where
+    Programs{..} = qePrograms qe
+    run cmdarg before aftercmd after  = procfn qe mcwd [] cabalProgram $
+      before ++ [cmdarg] ++ aftercmd ++ args ++ after
+
+readCabalInstallCmd
+    :: QueryEnvI c ('Cabal cpt)
+    -> Maybe FilePath -> CabalInstallCommand -> [String] -> IO String
+callCabalInstallCmd
+    :: QueryEnvI c ('Cabal cpt)
+    -> Maybe FilePath -> CabalInstallCommand -> [String] -> IO ()
+
+readCabalInstallCmd = doCabalInstallCmd (\qe -> qeReadProcess qe "")
+callCabalInstallCmd = doCabalInstallCmd qeCallProcess
diff --git a/src/CabalHelper/Compiletime/Program/Stack.hs b/src/CabalHelper/Compiletime/Program/Stack.hs
index 264050a..6f3365f 100644
--- a/src/CabalHelper/Compiletime/Program/Stack.hs
+++ b/src/CabalHelper/Compiletime/Program/Stack.hs
@@ -126,7 +126,7 @@ doStackCmd :: (QueryEnvI c 'Stack -> CallProcessWithCwdAndEnv a)
 doStackCmd procfn qe mcwd args =
   let Programs{..} = qePrograms qe in
   procfn qe mcwd stackEnv stackProgram $
-    stackArgsBefore ++ args ++ stackArgsAfter
+    stackProjArgs ++ args ++ stackUnitArgs
 
 readStackCmd :: QueryEnvI c 'Stack -> Maybe FilePath -> [String] -> IO String
 callStackCmd :: QueryEnvI c 'Stack -> Maybe FilePath -> [String] -> IO ()
diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs
index 619538c..d206cf0 100644
--- a/src/CabalHelper/Compiletime/Types.hs
+++ b/src/CabalHelper/Compiletime/Types.hs
@@ -269,7 +269,7 @@ type ReadProcessWithCwdAndEnv   =
   String -> CallProcessWithCwdAndEnv String
 
 type CallProcessWithCwdAndEnv a =
-  Maybe FilePath -> [(String, String)] -> FilePath -> [String] -> IO a
+  Maybe FilePath -> [(String, EnvOverride)] -> FilePath -> [String] -> IO a
 
 data QueryCache pt = QueryCache
     { qcProjInfo  :: !(Maybe (ProjInfo pt))
@@ -484,14 +484,14 @@ type Progs   = (?progs :: Programs)
 data Programs = Programs
     { cabalProgram    :: !FilePath
       -- ^ The path to the @cabal@ program.
-    , cabalArgsBefore :: ![String]
-    , cabalArgsAfter  :: ![String]
+    , cabalProjArgs   :: ![String]
+    , cabalUnitArgs   :: ![String]
 
     , stackProgram    :: !FilePath
       -- ^ The path to the @stack@ program.
-    , stackArgsBefore :: ![String]
-    , stackArgsAfter  :: ![String]
-    , stackEnv        :: ![(String, String)]
+    , stackProjArgs   :: ![String]
+    , stackUnitArgs   :: ![String]
+    , stackEnv        :: ![(String, EnvOverride)]
       --  ^ TODO: Stack doesn't support passing the compiler as a
       --  commandline option so we meddle with PATH instead. We should
       --  patch that upstream.
@@ -509,6 +509,12 @@ data Programs = Programs
 defaultPrograms :: Programs
 defaultPrograms = Programs "cabal" [] []  "stack" [] [] [] "ghc" "ghc-pkg"
 
+data EnvOverride
+    = EnvPrepend String
+    | EnvAppend String
+    | EnvReplace String
+      deriving (Eq, Ord, Show, Read, Generic, Typeable)
+
 data CompileOptions = CompileOptions
     { oVerbose       :: Bool
     , oCabalPkgDb    :: Maybe PackageDbDir