aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/Distribution/Helper.hs17
-rw-r--r--src/CabalHelper/Compiletime/Program/CabalInstall.hs14
-rw-r--r--src/CabalHelper/Compiletime/Program/GHC.hs18
-rw-r--r--src/CabalHelper/Compiletime/Program/Stack.hs6
-rw-r--r--src/CabalHelper/Compiletime/Types.hs19
-rw-r--r--tests/CompileTest.hs1
-rw-r--r--tests/GhcSession.hs21
7 files changed, 38 insertions, 58 deletions
diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs
index c7689f9..c269a5c 100644
--- a/lib/Distribution/Helper.hs
+++ b/lib/Distribution/Helper.hs
@@ -60,7 +60,6 @@ module Distribution.Helper (
, mkQueryEnv
, qeReadProcess
, qePrograms
- , qeCompPrograms
, qeProjLoc
, qeDistDir
@@ -78,8 +77,6 @@ module Distribution.Helper (
-- * Programs
, Programs(..)
, defaultPrograms
- , CompPrograms(..)
- , defaultCompPrograms
-- * Query result types
, ChComponentInfo(..)
@@ -206,7 +203,6 @@ mkQueryEnv projloc distdir = do
-- something
callProcessStderr mcwd exe args
, qePrograms = defaultPrograms
- , qeCompPrograms = defaultCompPrograms
, qeProjLoc = projloc
, qeDistDir = distdir
, qeCacheRef = cr
@@ -613,15 +609,14 @@ withVerbosity act = do
withProgs
:: Verbose => ProjInfoImpl pt -> QueryEnvI c pt -> (Env => IO a) -> IO a
withProgs impl QueryEnv{..} f = do
- cprogs <- guessCompProgramPaths $ case impl of
+ progs <- guessCompProgramPaths $ case impl of
ProjInfoStack projPaths ->
- Stack.patchCompPrograms projPaths qeCompPrograms
- _ -> qeCompPrograms
- let ?cprogs = cprogs in
- let ?progs = qePrograms in f
+ Stack.patchCompPrograms projPaths qePrograms
+ _ -> qePrograms
+ let ?progs = progs in f
where
-- | Determine ghc-pkg path from ghc path
- guessCompProgramPaths :: Verbose => CompPrograms -> IO CompPrograms
+ guessCompProgramPaths :: Verbose => Programs -> IO Programs
guessCompProgramPaths progs
| same ghcProgram progs dprogs = return progs
guessCompProgramPaths progs = do
@@ -648,7 +643,7 @@ withProgs impl QueryEnv{..} f = do
}
same f o o' = f o == f o'
- dprogs = defaultCompPrograms
+ dprogs = defaultPrograms
newtype Helper pt
= Helper { runHelper :: Unit pt -> [String] -> IO [Maybe ChResponse] }
diff --git a/src/CabalHelper/Compiletime/Program/CabalInstall.hs b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
index 4411bc3..2af1cdc 100644
--- a/src/CabalHelper/Compiletime/Program/CabalInstall.hs
+++ b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
@@ -180,7 +180,7 @@ compileSetupHs (GhcVersion ghcVer) db srcdir = do
file = srcdir </> "Setup"
- callProcessStderr (Just srcdir) (ghcProgram ?cprogs) $ concat
+ callProcessStderr (Just srcdir) (ghcProgram ?progs) $ concat
[ [ "--make"
, "-package-conf", db
]
@@ -193,11 +193,11 @@ compileSetupHs (GhcVersion ghcVer) db srcdir = do
cabalWithGHCProgOpts :: Progs => [String]
cabalWithGHCProgOpts = concat
- [ [ "--with-ghc=" ++ ghcProgram ?cprogs ]
+ [ [ "--with-ghc=" ++ ghcProgram ?progs ]
-- Only pass ghc-pkg if it was actually set otherwise we
-- might break cabal's guessing logic
- , if ghcPkgProgram ?cprogs /= ghcPkgProgram defaultCompPrograms
- then [ "--with-ghc-pkg=" ++ ghcPkgProgram ?cprogs ]
+ , if ghcPkgProgram ?progs /= ghcPkgProgram defaultPrograms
+ then [ "--with-ghc-pkg=" ++ ghcPkgProgram ?progs ]
else []
]
@@ -238,9 +238,9 @@ installCabalLibV2 _ghcVer cv (PackageEnvFile env_file) = do
cabalV2WithGHCProgOpts :: Progs => [String]
cabalV2WithGHCProgOpts = concat
- [ [ "--with-compiler=" ++ ghcProgram ?cprogs ]
- , if ghcPkgProgram ?cprogs /= ghcPkgProgram defaultCompPrograms
- then [ "--with-hc-pkg=" ++ ghcPkgProgram ?cprogs ]
+ [ [ "--with-compiler=" ++ ghcProgram ?progs ]
+ , if ghcPkgProgram ?progs /= ghcPkgProgram defaultPrograms
+ then [ "--with-hc-pkg=" ++ ghcPkgProgram ?progs ]
else []
]
diff --git a/src/CabalHelper/Compiletime/Program/GHC.hs b/src/CabalHelper/Compiletime/Program/GHC.hs
index 547911f..e45d921 100644
--- a/src/CabalHelper/Compiletime/Program/GHC.hs
+++ b/src/CabalHelper/Compiletime/Program/GHC.hs
@@ -66,25 +66,25 @@ newtype GhcVersion = GhcVersion { unGhcVersion :: Version }
showGhcVersion :: GhcVersion -> String
showGhcVersion (GhcVersion v) = showVersion v
-ghcVersion :: (Verbose, CProgs) => IO GhcVersion
+ghcVersion :: (Verbose, Progs) => IO GhcVersion
ghcVersion = GhcVersion .
- parseVer . trim <$> readProcess' (ghcProgram ?cprogs) ["--numeric-version"] ""
+ parseVer . trim <$> readProcess' (ghcProgram ?progs) ["--numeric-version"] ""
-ghcPkgVersion :: (Verbose, CProgs) => IO Version
+ghcPkgVersion :: (Verbose, Progs) => IO Version
ghcPkgVersion =
parseVer . trim . dropWhile (not . isDigit)
- <$> readProcess' (ghcPkgProgram ?cprogs) ["--version"] ""
+ <$> readProcess' (ghcPkgProgram ?progs) ["--version"] ""
-createPkgDb :: (Verbose, CProgs) => UnpackedCabalVersion -> IO PackageDbDir
+createPkgDb :: (Verbose, Progs) => UnpackedCabalVersion -> IO PackageDbDir
createPkgDb cabalVer = do
db@(PackageDbDir db_path)
<- getPrivateCabalPkgDb $ unpackedToResolvedCabalVersion cabalVer
exists <- doesDirectoryExist db_path
when (not exists) $
- callProcessStderr Nothing (ghcPkgProgram ?cprogs) ["init", db_path]
+ callProcessStderr Nothing (ghcPkgProgram ?progs) ["init", db_path]
return db
-getPrivateCabalPkgDb :: (Verbose, CProgs) => ResolvedCabalVersion -> IO PackageDbDir
+getPrivateCabalPkgDb :: (Verbose, Progs) => ResolvedCabalVersion -> IO PackageDbDir
getPrivateCabalPkgDb cabalVer = do
appdir <- appCacheDir
ghcVer <- ghcVersion
@@ -113,7 +113,7 @@ listCabalVersions mdb = do
let mdbopt = ("--package-conf="++) <$> mdb_path
args = ["list", "--simple-output", "Cabal"] ++ maybeToList mdbopt
catMaybes . map (fmap snd . parsePkgId) . words
- <$> readProcess' (ghcPkgProgram ?cprogs) args ""
+ <$> readProcess' (ghcPkgProgram ?progs) args ""
_ -> mzero
cabalVersionExistsInPkgDb
@@ -136,7 +136,7 @@ cabalVersionExistsInPkgDb cabalVer db@(PackageDbDir db_path) = do
invokeGhc :: Env => GhcInvocation -> IO (Either ExitCode FilePath)
invokeGhc GhcInvocation {..} = do
- rv <- callProcessStderr' Nothing (ghcProgram ?cprogs) $ concat
+ rv <- callProcessStderr' Nothing (ghcProgram ?progs) $ concat
[ [ "-outputdir", giOutDir
, "-o", giOutput
]
diff --git a/src/CabalHelper/Compiletime/Program/Stack.hs b/src/CabalHelper/Compiletime/Program/Stack.hs
index 353e8f1..3cdf87b 100644
--- a/src/CabalHelper/Compiletime/Program/Stack.hs
+++ b/src/CabalHelper/Compiletime/Program/Stack.hs
@@ -127,6 +127,6 @@ callStackCmd :: QueryEnvI c 'Stack -> Maybe FilePath -> [String] -> IO ()
readStackCmd = doStackCmd (\qe -> qeReadProcess qe "")
callStackCmd = doStackCmd qeCallProcess
-patchCompPrograms :: StackProjPaths -> CompPrograms -> CompPrograms
-patchCompPrograms StackProjPaths{sppCompExe} cprogs =
- cprogs { ghcProgram = sppCompExe }
+patchCompPrograms :: StackProjPaths -> Programs -> Programs
+patchCompPrograms StackProjPaths{sppCompExe} progs =
+ progs { ghcProgram = sppCompExe }
diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs
index e79c812..1f3bd3d 100644
--- a/src/CabalHelper/Compiletime/Types.hs
+++ b/src/CabalHelper/Compiletime/Types.hs
@@ -241,9 +241,6 @@ data QueryEnvI c (pt :: ProjType) = QueryEnv
, qePrograms :: !Programs
-- ^ Field accessor for 'QueryEnv'.
- , qeCompPrograms :: !CompPrograms
- -- ^ Field accessor for 'QueryEnv'.
-
, qeProjLoc :: !(ProjLoc pt)
-- ^ Field accessor for 'QueryEnv'. Defines path to the project directory,
-- i.e. a directory containing a @cabal.project@ file
@@ -460,11 +457,9 @@ data StackProjPaths = StackProjPaths
-- Beware: GHC 8.0.2 doesn't like these being recursively defined for some
-- reason so just keep them unrolled.
type Verbose = (?verbose :: Word -> Bool)
-type Env = ( ?cprogs :: CompPrograms
- , ?progs :: Programs
+type Env = ( ?progs :: Programs
, ?verbose :: Word -> Bool)
-type Progs = (?cprogs :: CompPrograms, ?progs :: Programs)
-type CProgs = (?cprogs :: CompPrograms)
+type Progs = (?progs :: Programs)
-- | Configurable paths to various programs we use.
data Programs = Programs
@@ -477,11 +472,8 @@ data Programs = Programs
-- ^ The path to the @stack@ program.
, stackArgsBefore :: ![String]
, stackArgsAfter :: ![String]
- } deriving (Eq, Ord, Show, Read, Generic, Typeable)
--- | Configurable paths to programs only used during helper compilation.
-data CompPrograms = CompPrograms
- { ghcProgram :: !FilePath
+ , ghcProgram :: !FilePath
-- ^ The path to the @ghc@ program.
, ghcPkgProgram :: !FilePath
@@ -492,10 +484,7 @@ data CompPrograms = CompPrograms
-- | By default all programs use their unqualified names, i.e. they will be
-- searched for on @PATH@.
defaultPrograms :: Programs
-defaultPrograms = Programs "cabal" [] [] "stack" [] []
-
-defaultCompPrograms :: CompPrograms
-defaultCompPrograms = CompPrograms "ghc" "ghc-pkg"
+defaultPrograms = Programs "cabal" [] [] "stack" [] [] "ghc" "ghc-pkg"
data CompileOptions = CompileOptions
{ oVerbose :: Bool
diff --git a/tests/CompileTest.hs b/tests/CompileTest.hs
index 2df6c2d..1c76787 100644
--- a/tests/CompileTest.hs
+++ b/tests/CompileTest.hs
@@ -62,7 +62,6 @@ createHOME = do
main :: IO ()
main = do
let ?progs = defaultPrograms
- let ?cprogs = defaultCompPrograms
let ?opts = defaultCompileOptions { oVerbose = True }
let ?verbose = \level -> case level of 1 -> True; _ -> False
diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs
index a25c3f7..52eba4e 100644
--- a/tests/GhcSession.hs
+++ b/tests/GhcSession.hs
@@ -60,28 +60,28 @@ testConfigToTestSpec (TC loc _ _ _) pt =
let (topdir, projdir, cabal_file) = testLocPath loc in
"- " ++ intercalate ":" [topdir, projdir, cabal_file, show pt]
-type ModProgs = (Programs -> Programs, CompPrograms -> CompPrograms)
+type ModProgs = (Programs -> Programs)
options :: [OptDescr ModProgs]
options =
[ GetOpt.Option [] ["with-cabal"]
- (ReqArg (\arg -> (\p -> p { cabalProgram = arg }, id)) "PROG")
+ (ReqArg (\arg -> \p -> p { cabalProgram = arg }) "PROG")
"name or path of 'cabal' executable"
, GetOpt.Option [] ["with-stack"]
- (ReqArg (\arg -> (\p -> p { stackProgram = arg }, id)) "PROG")
+ (ReqArg (\arg -> \p -> p { stackProgram = arg }) "PROG")
"name or path of 'stack' executable"
, GetOpt.Option [] ["with-ghc"]
- (ReqArg (\arg -> (id, \cp -> cp { ghcProgram = arg })) "PROG")
+ (ReqArg (\arg -> \cp -> cp { ghcProgram = arg }) "PROG")
"name or path of 'ghc' executable"
, GetOpt.Option [] ["with-ghc-pkg"]
- (ReqArg (\arg -> (id, \cp -> cp { ghcPkgProgram = arg })) "PROG")
+ (ReqArg (\arg -> \cp -> cp { ghcPkgProgram = arg }) "PROG")
"name or path of 'ghc-pkg' executable"
]
testOpts :: [String] -> IO (ModProgs, [String])
testOpts args =
case getOpt Permute options args of
- (o,n,[] ) -> return (foldl (\(b, d) (a, c) -> (a . b, c . d)) (id, id) o, n)
+ (o,n,[] ) -> return (foldl (flip (.)) id o, n)
(_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
where header = "Usage: ghc-session [OPTION..] [TEST_SPEC..]"
@@ -93,8 +93,7 @@ main = do
let withEnv :: (Env => a) -> a
withEnv action =
let ?verbose = const False
- ?progs = (fst modProgs) defaultPrograms
- ?cprogs = (snd modProgs) defaultCompPrograms
+ ?progs = modProgs defaultPrograms
in action
GhcVersion g_ver <- withEnv ghcVersion
@@ -317,10 +316,8 @@ test modProgs (psdImpl -> ProjSetupImpl{..}) topdir tmpdir projdir cabal_file
(psiProjLoc (CabalFile cabal_file) projdir)
(psiDistDir projdir)
- let qe = qe' { qePrograms = (fst modProgs) (qePrograms qe')
- , qeCompPrograms = (snd modProgs) (qeCompPrograms qe')
- }
- progs = qePrograms qe
+ let progs = modProgs (qePrograms qe')
+ qe = qe' { qePrograms = progs }
psiSdist progs topdir tmpdir
psiConfigure progs projdir
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-24 18:11:43 +0000