aboutsummaryrefslogtreecommitdiff
path: root/src/CabalHelper
diff options
context:
space:
mode:
Diffstat (limited to 'src/CabalHelper')
-rw-r--r--src/CabalHelper/Compiletime/Process.hs30
-rw-r--r--src/CabalHelper/Compiletime/Program/CabalInstall.hs33
-rw-r--r--src/CabalHelper/Compiletime/Program/Stack.hs2
-rw-r--r--src/CabalHelper/Compiletime/Types.hs18
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 05:56:38 +0000