cabal-helper 1.0.0.0 → 1.1.0.0

raw patch · 29 files changed

+527/−326 lines, 29 filesdep −cabal-helperdep −ghc-pathsdep ~Cabaldep ~cabal-plandep ~clockPVP ok

version bump matches the API change (PVP)

Dependencies removed: cabal-helper, ghc-paths

Dependency ranges changed: Cabal, cabal-plan, clock, ghc, template-haskell, temporary

API changes (from Hackage documentation)

Files

• cabal-helper.cabal +47/−28
• lib/Distribution/Helper.hs +109/−84
• src/CabalHelper/Compiletime/Cabal.hs +19/−54
• src/CabalHelper/Compiletime/CompPrograms.hs +12/−7
• src/CabalHelper/Compiletime/Compile.hs +12/−10
• src/CabalHelper/Compiletime/Data.hs +15/−5
• src/CabalHelper/Compiletime/Process.hs +13/−16
• src/CabalHelper/Compiletime/Program/CabalInstall.hs +33/−30
• src/CabalHelper/Compiletime/Program/GHC.hs +17/−6
• src/CabalHelper/Compiletime/Program/Stack.hs +1/−1
• src/CabalHelper/Compiletime/Types.hs +12/−11
• src/CabalHelper/Compiletime/Types/Cabal.hs +59/−0
• src/CabalHelper/Runtime/Compat.hs +12/−1
• src/CabalHelper/Runtime/HelperMain.hs +2/−11
• tests/CompileTest.hs +14/−7
• tests/GhcSession.hs +52/−54
• tests/TestOptions.hs +33/−0
• tests/cabal-versions +3/−0
• tests/custom-setup/Lib.hs +8/−0
• tests/custom-setup/Setup.hs +2/−0
• tests/custom-setup/custom-setup.cabal +13/−0
• tests/custom-setup/packages.list +1/−0
• tests/custom-setup/stack.yaml +3/−0
• tests/src-repo/Exe.hs +5/−0
• tests/src-repo/Setup.hs +2/−0
• tests/src-repo/cabal.project +7/−0
• tests/src-repo/packages.list +1/−0
• tests/src-repo/src-repo.cabal +19/−0
• tests/stack-resolvers +1/−1

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                cabal-helper-version:             1.0.0.0+version:             1.1.0.0 synopsis:  Give Haskell development tools access to Cabal project environment description:@@ -39,6 +39,11 @@                      tests/fliblib/stack.yaml                      tests/fliblib/lib/*.hs +                     tests/custom-setup/*.hs+                     tests/custom-setup/*.cabal+                     tests/custom-setup/packages.list+                     tests/custom-setup/stack.yaml+                      tests/bkpregex/*.hs                      tests/bkpregex/*.cabal                      tests/bkpregex/packages.list@@ -49,6 +54,11 @@                      tests/bkpregex/regex-types/Regex/*.hs                      tests/bkpregex/str-impls/Str/*.hs +                     tests/src-repo/*.hs+                     tests/src-repo/*.cabal+                     tests/src-repo/packages.list+                     tests/src-repo/cabal.project+                      tests/multipkg/packages.list                      tests/multipkg/pkg-oot/*.cabal                      tests/multipkg/pkg-oot/*.hs@@ -83,10 +93,10 @@  common build-deps   build-depends:       base             < 5    && >= 4.9.1.0-                     , Cabal            < 3.1  && >= 3.0+                     , Cabal            < 3.4  && >= 3.0                                      || < 2.5  && >= 2.0                                      || < 1.26 && >= 1.24.2.0-                     , cabal-plan       < 0.6  && >= 0.5.0.0+                     , cabal-plan       < 0.7  && >= 0.5.0.0                      , clock            < 0.8  && >= 0.7.2                      , containers       < 1    && >= 0.5.7.1                      , bytestring       < 0.11 && >= 0.10.8.1@@ -98,24 +108,26 @@                      , semigroupoids    < 5.4  && >= 5.2                      , SHA              < 1.7  && >= 1.6.4.4                      , text             < 1.3  && >= 1.0.0.0-                     , template-haskell < 2.15 && >= 2.11.1.0+                     , template-haskell < 2.17 && >= 2.11.1.0                      , temporary        < 1.3  && >= 1.2.1-                     , time             < 1.9  && >= 1.6.0.1+                     , time             < 1.10 && >= 1.6.0.1                      , transformers     < 0.6  && >= 0.5.2.0                      , utf8-string      < 1.1  && >= 1.0.1.1   if os(windows)     build-depends:     Win32            < 2.9  && >= 2.5.4.1+                     , Cabal            >= 3.0.1+                       --^ Need fix for dropExeExtension (haskell/cabal#6287)   else     build-depends:     unix             < 2.8  && >= 2.7.2.1   build-depends:       unix-compat      < 0.6  && >= 0.4.3.1    if flag(dev)-    ghc-options:       -Wall+    ghc-options:       -Wall -fwarn-incomplete-uni-patterns  -library c-h-internal+common c-h-internal   import:             build-deps, extensions-  exposed-modules:+  other-modules:                        CabalHelper.Compiletime.Cabal                        CabalHelper.Compiletime.CompPrograms                        CabalHelper.Compiletime.Compat.Environment@@ -130,6 +142,7 @@                        CabalHelper.Compiletime.Program.GHC                        CabalHelper.Compiletime.Sandbox                        CabalHelper.Compiletime.Types+                       CabalHelper.Compiletime.Types.Cabal                        CabalHelper.Compiletime.Types.RelativePath                        CabalHelper.Runtime.Compat                        CabalHelper.Runtime.HelperMain@@ -139,7 +152,7 @@                        Paths_cabal_helper   autogen-modules:                        Paths_cabal_helper-  exposed-modules:+  other-modules:                        Symlink   if os(windows)     hs-source-dirs:    os/win@@ -147,8 +160,19 @@     hs-source-dirs:    os/posix   hs-source-dirs:      src +common c-h-lib+  import:             build-deps, extensions, c-h-internal+  other-modules:+                       Distribution.Helper+                       Distribution.Helper.Discover+  other-modules:+                       Paths_cabal_helper+  autogen-modules:+                       Paths_cabal_helper+  hs-source-dirs:      lib+ library-  import:              build-deps, extensions+  import:              build-deps, extensions, c-h-internal   exposed-modules:     Distribution.Helper                        Distribution.Helper.Discover   other-modules:@@ -156,44 +180,39 @@   autogen-modules:                        Paths_cabal_helper   hs-source-dirs:      lib-  build-depends:       c-h-internal  test-suite compile-test-  import:              build-deps, extensions+  import:              build-deps, extensions, c-h-internal   type:                exitcode-stdio-1.0   main-is:             CompileTest.hs+  other-modules:       TestOptions   hs-source-dirs:      tests-  ghc-options:         -Wall-  build-depends:       c-h-internal+  ghc-options:         -Wall -fwarn-incomplete-uni-patterns  test-suite programs-test-  import:              build-deps, extensions+  import:              build-deps, extensions, c-h-internal   type:                exitcode-stdio-1.0   main-is:             ProgramsTest.hs   hs-source-dirs:      tests-  ghc-options:         -Wall-  build-depends:       c-h-internal-                     , pretty-show+  ghc-options:         -Wall -fwarn-incomplete-uni-patterns+  build-depends:       pretty-show  test-suite ghc-session-  import:              build-deps, extensions+  import:              build-deps, extensions, c-h-lib   type:                exitcode-stdio-1.0   main-is:             GhcSession.hs+  other-modules:       TestOptions   hs-source-dirs:      tests-  ghc-options:         -Wall-  build-depends:       ghc              < 8.7  && >= 8.0.2-                     , ghc-paths        < 0.2  && >= 0.1.0.9+  ghc-options:         -Wall -fwarn-incomplete-uni-patterns+  build-depends:       ghc              < 8.11  && >= 8.0.2                      , pretty-show      < 1.9  && >= 1.8.1-                     , cabal-helper-                     , c-h-internal  test-suite examples-  import:              build-deps, extensions+  import:              build-deps, extensions, c-h-lib   type:                exitcode-stdio-1.0   main-is:             Examples.hs   hs-source-dirs:      tests-  ghc-options:         -Wall-  build-depends:       cabal-helper+  ghc-options:         -Wall -fwarn-incomplete-uni-patterns  executable cabal-helper-main   default-language:    Haskell2010@@ -214,7 +233,7 @@   else     buildable:         False -  ghc-options:         -Wall -fno-warn-unused-imports+  ghc-options:         -Wall -fno-warn-unused-imports -fwarn-incomplete-uni-patterns   build-depends:       base             < 5    && >= 4.9.1.0                      , Cabal                      , containers

@@ -147,6 +147,7 @@ import CabalHelper.Compiletime.Process import CabalHelper.Compiletime.Sandbox import CabalHelper.Compiletime.Types+import CabalHelper.Compiletime.Types.Cabal import CabalHelper.Compiletime.Types.RelativePath import CabalHelper.Shared.InterfaceTypes import CabalHelper.Shared.Common@@ -281,19 +282,25 @@     package_yaml_path = pSourceDir  </> "package.yaml"     setup_config_path = distdirv1 </> "setup-config" +-- | Get a random unit from the project. Sometimes we need to get info we+-- can only get after configuring _any_ unit but we do assume that this+-- info is uniform across units.+someUnit :: ProjInfo pt -> Unit pt+someUnit proj_info =+    NonEmpty.head $ pUnits $+    NonEmpty.head $ piPackages proj_info  -- | The version of GHC the project is configured to use for compilation. compilerVersion :: Query pt (String, Version) compilerVersion = Query $ \qe ->   getProjInfo qe >>= \proj_info ->-    let someUnit = NonEmpty.head $ pUnits $-                   NonEmpty.head $ piPackages proj_info in+    let unit = someUnit proj_info in     --  ^ ASSUMPTION: Here we assume the compiler version is uniform across all     --  units so we just pick any one.     case piImpl proj_info of-      ProjInfoV1 {} -> uiCompilerId <$> getUnitInfo qe someUnit+      ProjInfoV1 {} -> uiCompilerId <$> getUnitInfo qe unit       ProjInfoV2 { piV2CompilerId } -> return piV2CompilerId-      ProjInfoStack {} -> uiCompilerId <$> getUnitInfo qe someUnit+      ProjInfoStack {} -> uiCompilerId <$> getUnitInfo qe unit  -- | All local packages currently active in a project\'s build plan. projectPackages :: Query pt (NonEmpty (Package pt))@@ -409,6 +416,25 @@         readProjInfo qe proj_conf mtime pre_info     } ++-- | Get the cabal version we need to build for this project.+getCabalLibVersion :: QueryEnv pt -> Reconfigured pt -> ProjInfo pt -> IO CabalVersion+getCabalLibVersion _ _ ProjInfo{piImpl=ProjInfoV1 {piV1CabalVersion}} =+  return piV1CabalVersion+getCabalLibVersion qe reconf proj_info = do+  unit <- case reconf of+    AlreadyReconfigured unit ->+        return unit+    Haven'tReconfigured -> do+        let unit = someUnit proj_info+        reconfigureUnit qe unit+        return unit+  let DistDirLib distdir = uDistDir $ unit+  hdr <- readSetupConfigHeader $ distdir </> "setup-config"+  let ("Cabal", cabalVer) = uhSetupId hdr+  return $ CabalVersion cabalVer++ getUnitInfo :: QueryEnv pt -> Unit pt -> IO UnitInfo getUnitInfo qe@QueryEnv{..} unit@Unit{uDistDir} = do   pre_info <- getPreInfo qe@@ -426,8 +452,9 @@     , cKeyValid = (==)      , cRegen = \mtimes -> do-        reconfigureUnit qe unit-        helper <- getHelper pre_info proj_info qe+        reconf <- reconfigureUnit qe unit+        cabal_ver <- getCabalLibVersion qe reconf proj_info+        helper <- getHelper qe pre_info proj_info cabal_ver         readUnitInfo helper unit mtimes     } @@ -456,8 +483,11 @@ shallowReconfigureProject qe = do   buildProjectTarget qe Nothing DryRun -reconfigureUnit :: QueryEnvI c pt -> Unit pt -> IO ()-reconfigureUnit qe u = buildProjectTarget qe (Just u) OnlyCfg+data Reconfigured pt = AlreadyReconfigured (Unit pt) | Haven'tReconfigured+reconfigureUnit :: QueryEnvI c pt -> Unit pt -> IO (Reconfigured pt)+reconfigureUnit qe u = do+  buildProjectTarget qe (Just u) OnlyCfg+  return (AlreadyReconfigured u)  buildUnits :: [Unit pt] -> Query pt () buildUnits units = Query $ \qe -> do@@ -488,6 +518,8 @@       cmd <- return $ case stage of         DryRun | SCV1 <- cpt ->           CabalInstall.CIConfigure+          -- TODO: in v1 we configure twice because we do configure for+          -- DryRun and OnlyCfg.         OnlyCfg ->           CabalInstall.CIConfigure         _ ->@@ -502,7 +534,7 @@               Just Unit{uImpl} -> concat                 [ if uiV2OnlyDependencies uImpl                     then ["--only-dependencies"] else []-                , uiV2Components uImpl+                , map snd $ filter ((/= ChSetupHsName) . fst) $ uiV2Components uImpl                 ]             case qeProjLoc of               ProjLocV2File {plCabalProjectFile} ->@@ -537,43 +569,39 @@  readProjInfo     :: QueryEnvI c pt -> ProjConf pt -> ProjConfModTimes -> PreInfo pt -> IO (ProjInfo pt)-readProjInfo qe pc pcm pi = withVerbosity $ do+readProjInfo qe pc pcm _pi = withVerbosity $ do   let projloc = qeProjLoc qe   case (qeDistDir qe, pc) of     (DistDirCabal SCV1 distdir, ProjConfV1{pcV1CabalFile}) -> do       setup_config_path <- canonicalizePath (distdir </> "setup-config")-      mhdr <- readSetupConfigHeader setup_config_path-      case mhdr of-        Just hdr@(UnitHeader (pkg_name_bs, _pkg_ver) ("Cabal", hdrCabalVersion) _compId) -> do-          let-            v3_0_0_0 = makeVersion [3,0,0,0]-            pkg_name-              | hdrCabalVersion >= v3_0_0_0 = BSU.toString pkg_name_bs-              | otherwise = BS8.unpack pkg_name_bs-            pkg = Package-              { pPackageName = pkg_name-              , pSourceDir = plCabalProjectDir projloc-              , pCabalFile = CabalFile pcV1CabalFile-              , pFlags = []-              , pUnits = (:|[]) Unit-                { uUnitId = UnitId pkg_name-                , uPackage = pkg { pUnits = () }-                , uDistDir = DistDirLib distdir-                , uImpl = UnitImplV1-                }-              }-            piImpl = ProjInfoV1 { piV1SetupHeader = hdr }-          return ProjInfo-            { piCabalVersion = hdrCabalVersion-            , piProjConfModTimes = pcm-            , piPackages = pkg :| []-            , piImpl+      hdr@(UnitHeader (pkg_name_bs, _pkg_ver) ("Cabal", hdrCabalVersion) _)+          <- readSetupConfigHeader setup_config_path+      let+        v3_0_0_0 = makeVersion [3,0,0,0]+        pkg_name+          | hdrCabalVersion >= v3_0_0_0 = BSU.toString pkg_name_bs+          | otherwise = BS8.unpack pkg_name_bs+        pkg = Package+          { pPackageName = pkg_name+          , pSourceDir = plCabalProjectDir projloc+          , pCabalFile = CabalFile pcV1CabalFile+          , pFlags = []+          , pUnits = (:|[]) Unit+            { uUnitId = UnitId pkg_name+            , uPackage = pkg { pUnits = () }+            , uDistDir = DistDirLib distdir+            , uImpl = UnitImplV1             }-        Just UnitHeader {uhSetupId=(setup_name, _)} ->-          panicIO $ printf "Unknown Setup package-id in setup-config header '%s': '%s'"-                      (BS8.unpack setup_name) setup_config_path-        Nothing ->-          panicIO $ printf "Could not read '%s' header" setup_config_path+          }+        piImpl = ProjInfoV1+          { piV1SetupHeader = hdr+          , piV1CabalVersion = CabalVersion hdrCabalVersion+          }+      return ProjInfo+        { piProjConfModTimes = pcm+        , piPackages = pkg :| []+        , piImpl+        }      (DistDirCabal SCV2 distdirv2, _) -> do       let plan_path = distdirv2 </> "cache" </> "plan.json"@@ -590,8 +618,7 @@        Just pkgs <- NonEmpty.nonEmpty <$> CabalInstall.planPackages plan       return ProjInfo-        { piCabalVersion = makeDataVersion pjCabalLibVersion-        , piProjConfModTimes = pcm+        { piProjConfModTimes = pcm         , piPackages = NonEmpty.sortWith pPackageName pkgs         , piImpl = ProjInfoV2           { piV2Plan = plan@@ -602,33 +629,26 @@     (DistDirStack{}, _) -> do       Just cabal_files <- NonEmpty.nonEmpty <$> Stack.listPackageCabalFiles qe       pkgs <- mapM (Stack.getPackage qe) cabal_files-      Just (cabalVer:_) <- runMaybeT $-        let ?progs = qePrograms qe in-        let PreInfoStack {piStackProjPaths} = pi in-        GHC.listCabalVersions (Just (sppGlobalPkgDb piStackProjPaths))-        --  ^ See [Note Stack Cabal Version]       return ProjInfo-        { piCabalVersion = cabalVer-        , piProjConfModTimes = pcm+        { piProjConfModTimes = pcm         , piPackages = NonEmpty.sortWith pPackageName pkgs         , piImpl = ProjInfoStack         } --- [Note Stack Cabal Version]------ Stack just uses ghc-pkg on the global-pkg-db to determine the--- appropriate Cabal version for a resolver when building, see--- Stack.Setup.pathsFromCompiler(cabalPkgVer). We do essentially the same--- thing here.------ The code for building Setup.hs is in Stack.Build.Execute and the version--- of cabal is set in withSingleContext.withCabal.getPackageArgs.------ Note there is some special casing going on (see 'depsMinusCabal'), they--- use the packages from the snapshot pkg-db except Cabal which comes from--- the global pkg-db.- readUnitInfo :: Helper pt -> Unit pt -> UnitModTimes -> IO UnitInfo+readUnitInfo helper u@Unit{uImpl=ui@UnitImplV2{uiV2Components}} umt+    | ChSetupHsName `elem` map fst uiV2Components = do+        let unit' = u {+          uImpl = ui+            { uiV2Components = filter ((/= ChSetupHsName) . fst) uiV2Components+            }+          }+        -- TODO: Add a synthetic UnitInfo for the setup executable. Cabal+        -- doesn't allow building it via a target on the cmdline and it+        -- doesn't really exist as far as setup-config is concerned but+        -- plan.json has the dependency versions for custom-setup so we+        -- should be able to represet that as a UnitInfo.+        readUnitInfo helper unit' umt readUnitInfo helper unit@Unit {uUnitId=uiUnitId} uiModTimes = do     res <- runHelper helper unit            [ "package-id"@@ -698,7 +718,8 @@ prepare = Query $ \qe -> do   pre_info <- getPreInfo qe   proj_info <- getProjInfo qe-  void $ getHelper pre_info proj_info qe+  cabal_ver <- getCabalLibVersion qe Haven'tReconfigured proj_info+  void $ getHelper qe pre_info proj_info cabal_ver  -- | Create @cabal_macros.h@, @Paths_\<pkg\>.hs@ and other generated files -- in the usual place. See 'Distribution.Simple.Build.initialBuildSteps'.@@ -709,7 +730,8 @@ writeAutogenFiles unit = Query $ \qe -> do   pre_info <- getPreInfo qe   proj_info <- getProjInfo qe-  helper <- getHelper pre_info proj_info qe+  cabal_ver <- getCabalLibVersion qe Haven'tReconfigured proj_info+  helper <- getHelper qe pre_info proj_info cabal_ver   void $ runHelper helper unit ["write-autogen-files"]  -- | Get the path to the sandbox package-db in a project@@ -766,19 +788,19 @@ newtype Helper pt   = Helper { runHelper :: Unit pt -> [String] -> IO [Maybe ChResponse] } -getHelper :: PreInfo pt -> ProjInfo pt -> QueryEnvI c pt -> IO (Helper pt)-getHelper _pre_info ProjInfo{piCabalVersion} qe@QueryEnv{..}-  | piCabalVersion == bultinCabalVersion = return $ Helper $+getHelper :: QueryEnvI c pt -> PreInfo pt -> ProjInfo pt -> CabalVersion -> IO (Helper pt)+getHelper qe@QueryEnv{..} _pre_info _proj_info cabal_ver+  | cabal_ver == bultinCabalVersion = return $ Helper $       \Unit{ uDistDir=DistDirLib distdir            , uPackage=Package{pCabalFile=CabalFile cabal_file}            } args ->         let pt = dispHelperProjectType (projTypeOfQueryEnv qe) in         helper_main $ cabal_file : distdir : pt : args-getHelper pre_info proj_info qe@QueryEnv{..} = do+getHelper qe@QueryEnv{..} pre_info proj_info cabal_ver = do   withVerbosity $ do     let ?progs = qePrograms     t0 <- Clock.getTime Monotonic-    eexe <- compileHelper $ mkCompHelperEnv qeProjLoc qeDistDir pre_info proj_info+    eexe <- compileHelper $ mkCompHelperEnv qeProjLoc qeDistDir pre_info proj_info cabal_ver     t1 <- Clock.getTime Monotonic     let dt = (/10^9) $ fromInteger $ Clock.toNanoSecs $ Clock.diffTimeSpec t0 t1         dt :: Float@@ -805,18 +827,20 @@     -> DistDir pt     -> PreInfo pt     -> ProjInfo pt+    -> CabalVersion     -> CompHelperEnv mkCompHelperEnv   projloc   (DistDirCabal SCV1 distdir)   PreInfoCabal-  ProjInfo{piCabalVersion}+  ProjInfo {}+  cabal_ver   = CompHelperEnv-    { cheCabalVer = CabalVersion piCabalVersion+    { cheCabalVer = cabal_ver     , cheProjDir  = plCabalProjectDir projloc     , cheProjLocalCacheDir = distdir-    , chePkgDb    = Nothing-    , chePlanJson = Nothing+    , chePkgDb    = []+    , chePjUnits = Nothing     , cheDistV2 = Nothing     } mkCompHelperEnv@@ -824,30 +848,31 @@   (DistDirCabal SCV2 distdir)   PreInfoCabal   ProjInfo{piImpl=ProjInfoV2{piV2Plan=plan}}+  cabal_ver   = CompHelperEnv {..}   where     cheProjDir  = plCabalProjectDir projloc-    cheCabalVer = CabalVersion $ makeDataVersion pjCabalLibVersion+    cheCabalVer = cabal_ver     cheProjLocalCacheDir = distdir </> "cache"-    chePkgDb    = Nothing-    chePlanJson = Just plan+    chePkgDb    = []+    chePjUnits  = Just $ pjUnits plan     cheDistV2   = Just distdir-    PlanJson {pjCabalLibVersion=Ver pjCabalLibVersion } = plan mkCompHelperEnv   (ProjLocStackYaml stack_yaml)   (DistDirStack mworkdir)   PreInfoStack     { piStackProjPaths=StackProjPaths-      { sppGlobalPkgDb }+      { sppGlobalPkgDb, sppSnapPkgDb, sppLocalPkgDb }     }-  ProjInfo { piCabalVersion }+  ProjInfo {}+  cabal_ver   = let workdir = fromMaybe ".stack-work" $ unRelativePath <$> mworkdir in     let projdir = takeDirectory stack_yaml in     CompHelperEnv-    { cheCabalVer = CabalVersion $ piCabalVersion+    { cheCabalVer = cabal_ver     , cheProjDir  = projdir     , cheProjLocalCacheDir = projdir </> workdir-    , chePkgDb    = Just sppGlobalPkgDb-    , chePlanJson = Nothing+    , chePkgDb    = [sppGlobalPkgDb, sppSnapPkgDb, sppLocalPkgDb]+    , chePjUnits = Nothing     , cheDistV2 = Nothing     }

@@ -15,7 +15,8 @@ License     : Apache-2.0 -} -{-# LANGUAGE DeriveFunctor, ViewPatterns, OverloadedStrings, CPP #-}+{-# LANGUAGE DeriveFunctor, ViewPatterns, OverloadedStrings #-}+{-# LANGUAGE CPP #-} -- for VERSION_Cabal  module CabalHelper.Compiletime.Cabal where @@ -38,43 +39,10 @@ import qualified Data.ByteString.Char8 as BS8  import CabalHelper.Compiletime.Types+import CabalHelper.Compiletime.Types.Cabal import CabalHelper.Compiletime.Process import CabalHelper.Shared.Common (replace, parseVer, parseVerMay, parsePkgIdBS, panicIO) -type UnpackedCabalVersion = CabalVersion' (CommitId, CabalSourceDir)-type ResolvedCabalVersion = CabalVersion' CommitId-type CabalVersion = CabalVersion' ()--unpackedToResolvedCabalVersion :: UnpackedCabalVersion -> ResolvedCabalVersion-unpackedToResolvedCabalVersion (CabalHEAD (commit, _)) = CabalHEAD commit-unpackedToResolvedCabalVersion (CabalVersion ver) = CabalVersion ver---- | Cabal library version we're compiling the helper exe against.-data CabalVersion' a-    = CabalHEAD a-    | CabalVersion { cvVersion :: Version }-      deriving (Eq, Ord, Functor)--newtype CommitId = CommitId { unCommitId :: String }--showUnpackedCabalVersion :: UnpackedCabalVersion -> String-showUnpackedCabalVersion (CabalHEAD (commitid, _)) =-  "HEAD-" ++ unCommitId commitid-showUnpackedCabalVersion CabalVersion {cvVersion} =-  showVersion cvVersion--showResolvedCabalVersion :: ResolvedCabalVersion -> String-showResolvedCabalVersion (CabalHEAD commitid) =-  "HEAD-" ++ unCommitId commitid-showResolvedCabalVersion CabalVersion {cvVersion} =-  showVersion cvVersion--showCabalVersion :: CabalVersion -> String-showCabalVersion (CabalHEAD ()) =-  "HEAD"-showCabalVersion CabalVersion {cvVersion} =-  showVersion cvVersion- data CabalPatchDescription = CabalPatchDescription   { cpdVersions      :: [Version]   , cpdUnpackVariant :: UnpackCabalVariant@@ -165,8 +133,6 @@   (commit, csdir) <- unpackCabalHEAD tmpdir   return $ CabalHEAD (commit, csdir) -data UnpackCabalVariant = Pristine | LatestRevision-newtype CabalSourceDir = CabalSourceDir { unCabalSourceDir :: FilePath } unpackCabalHackage     :: (Verbose, Progs)     => Version@@ -196,24 +162,14 @@       { cwd = Just dir } ""   let ut = posixSecondsToUTCTime $ fromInteger (read ts)       (y,m,d) = toGregorian $ utctDay ut-      sec = round $ utctDayTime ut-      datecode =-        read $ show y ++ printf "%02d" m ++ printf "%02d" d ++ printf "%05d" sec-      sec :: Int; datecode :: Int+      sec = round $ utctDayTime ut; sec :: Int+      datecode = makeVersion [1000, fromInteger y, m, d, sec]   let cabal_file = tmpdir </> "Cabal/Cabal.cabal"   cf0 <- readFile cabal_file-  let Just cf1 = replaceVersionDecl (setVersion datecode) cf0+  let Just cf1 = replaceVersionDecl (const (Just datecode)) cf0   writeFile (cabal_file<.>"tmp") cf1   renameFile (cabal_file<.>"tmp") cabal_file   return (CommitId commit, CabalSourceDir $ tmpdir </> "Cabal")-  where-    -- If the released version of cabal has 4 components but we use only three-    -- theirs will always be larger than this one here. That's not really-    -- critical though.-    setVersion i (versionBranch -> mj:mi:_:_:[]) =-        Just $ makeVersion $ mj:mi:[i]-    setVersion _ v =-        error $ "unpackCabalHEAD.setVersion: Wrong version format" ++ show v  -- | Replace the version declaration in a cabal file replaceVersionDecl :: (Version -> Maybe Version) -> String -> Maybe String@@ -265,12 +221,21 @@ complainIfNoCabalFile pkgdir Nothing =   panicIO $ "No cabal file found in package-dir: '"++pkgdir++"'" -bultinCabalVersion :: Version-bultinCabalVersion = parseVer VERSION_Cabal+bultinCabalVersion :: CabalVersion+bultinCabalVersion = CabalVersion $ parseVer VERSION_Cabal -readSetupConfigHeader :: FilePath -> IO (Maybe UnitHeader)+readSetupConfigHeader :: FilePath -> IO UnitHeader readSetupConfigHeader file = bracket (openFile file ReadMode) hClose $ \h -> do-  parseSetupHeader <$> BS.hGetLine h+  mhdr <- parseSetupHeader <$> BS.hGetLine h+  case mhdr of+    Just hdr@(UnitHeader _PkgId ("Cabal", _hdrCabalVersion) _compId) -> do+      return hdr+    Just UnitHeader {uhSetupId=(setup_name, _)} -> panicIO $+      printf "Unknown Setup package-id in setup-config header '%s': '%s'"+        (BS8.unpack setup_name) file+    Nothing -> panicIO $+      printf "Could not read '%s' header" file+  parseSetupHeader :: BS.ByteString -> Maybe UnitHeader parseSetupHeader header = case BS8.words header of

@@ -2,6 +2,7 @@  module CabalHelper.Compiletime.CompPrograms where +import Control.Monad (when) import Data.List import Data.Maybe import System.Directory@@ -10,6 +11,7 @@  import CabalHelper.Compiletime.Types import CabalHelper.Compiletime.Cabal (getCabalVerbosity)+import CabalHelper.Shared.Common (panicIO) import Symlink (createSymbolicLink)  import Distribution.Simple.GHC as GHC (configure)@@ -80,20 +82,23 @@   -- being able to pass executable paths straight through to stack but   -- currently there is no option to let us do that.   withSystemTempDirectory "cabal-helper-symlinks" $ \bindir -> do-  createProgSymlink bindir $ ghcProgram progs-  createProgSymlink bindir $ ghcPkgProgram progs-  createProgSymlink bindir $ haddockProgram progs+  createProgSymlink True bindir $ ghcProgram progs+  createProgSymlink True bindir $ ghcPkgProgram progs+  createProgSymlink False bindir $ haddockProgram progs   return $ progs     { stackEnv =         [("PATH", EnvPrepend $ bindir ++ [searchPathSeparator])] ++         stackEnv progs     } -createProgSymlink :: FilePath -> FilePath -> IO ()-createProgSymlink bindir target+createProgSymlink :: Bool -> FilePath -> FilePath -> IO ()+createProgSymlink required bindir target   | [exe] <- splitPath target = do-    Just exe_path <- findExecutable exe-    createSymbolicLink exe_path (bindir </> takeFileName target)+    mb_exe_path <- findExecutable exe+    case mb_exe_path of+      Just exe_path -> createSymbolicLink exe_path (bindir </> takeFileName target)+      Nothing -> when required $ panicIO $ "Error trying to create symlink to '" ++ target ++ "': "+                                        ++ "'" ++ exe ++ "'" ++ " executable not found."   | otherwise = do     cwd <- getCurrentDirectory     createSymbolicLink (cwd </> target) (bindir </> takeFileName target)

@@ -21,7 +21,7 @@  import qualified Cabal.Plan as CP import Cabal.Plan-  ( PlanJson(..), PkgId(..), PkgName(..), Ver(..), uPId)+  ( PkgId(..), PkgName(..), Ver(..), uPId) import Control.Applicative import Control.Arrow import Control.Exception as E@@ -30,6 +30,7 @@ import Control.Monad.IO.Class import Data.Char import Data.List+import Data.Map.Strict (Map) import Data.Maybe import Data.String import Data.Version@@ -58,6 +59,7 @@ import CabalHelper.Compiletime.Sandbox     ( getSandboxPkgDb ) import CabalHelper.Compiletime.Types+import CabalHelper.Compiletime.Types.Cabal  import CabalHelper.Shared.Common @@ -90,10 +92,10 @@ type CompHelperEnv = CompHelperEnv' CabalVersion data CompHelperEnv' cv = CompHelperEnv   { cheCabalVer :: !cv-  , chePkgDb    :: !(Maybe PackageDbDir)+  , chePkgDb    :: ![PackageDbDir]   -- ^ A package-db where we are guaranteed to find Cabal-`cheCabalVer`.   , cheProjDir  :: !FilePath-  , chePlanJson :: !(Maybe PlanJson)+  , chePjUnits  :: !(Maybe (Map CP.UnitId CP.Unit))   , cheDistV2   :: !(Maybe FilePath)   , cheProjLocalCacheDir :: FilePath   }@@ -119,7 +121,7 @@     CabalVersion cabalVerPlain -> do       runMaybeT $ msum $ map (\f -> f ghcVer cabalVerPlain) $         case chePkgDb of-          Nothing ->+          [] ->             [ compileWithCabalV2Inplace             , compileWithCabalV2GhcEnv             , compileCabalSource@@ -127,8 +129,8 @@             , compileGlobal             , compileWithCabalInPrivatePkgDb             ]-          Just db ->-            [ ((.).(.)) liftIO (compilePkgDb db)+          dbs ->+            [ ((.).(.)) liftIO (compilePkgDbs dbs)             ]   appdir <- appCacheDir   let cp@CompPaths {compExePath} = compPaths appdir cheProjLocalCacheDir comp@@ -148,11 +150,11 @@  -- for relaxed deps: find (sameMajorVersionAs cheCabalVer) . reverse . sort -   compilePkgDb db _ghcVer cabalVer  = return $+   compilePkgDbs dbs _ghcVer cabalVer = return $        (,)          (pure ())          CompileWithCabalPackage-           { compPackageSource = GPSPackageDBs [db]+           { compPackageSource = GPSPackageDBs dbs            , compCabalVersion  = CabalVersion cabalVer            , compProductTarget = CPSProject            }@@ -184,8 +186,8 @@    compileWithCabalV2Inplace ghcVer cabalVer = do        -- TODO: Test coverage! Neither compile-test nor ghc-session test out        -- this code path-       PlanJson {pjUnits} <- maybe mzero pure chePlanJson-       distdir_newstyle   <- maybe mzero pure cheDistV2+       pjUnits <- maybe mzero pure chePjUnits+       distdir_newstyle <- maybe mzero pure cheDistV2        let cabal_pkgid =              PkgId (PkgName (Text.pack "Cabal")) (Ver $ versionBranch cabalVer)            mcabal_unit = listToMaybe $

@@ -9,8 +9,7 @@ -- --     http://www.apache.org/licenses/LICENSE-2.0 -{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}-{-# OPTIONS_GHC -fforce-recomp #-}+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, CPP #-}  {-| Module      : CabalHelper.Compiletime.Data@@ -30,6 +29,7 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy.UTF8 as LUTF8 import Language.Haskell.TH+import Language.Haskell.TH.Syntax (addDependentFile) import System.Directory import System.FilePath import System.IO.Temp@@ -86,15 +86,25 @@         , ("Shared/InterfaceTypes.hs")         ]   in do-    contents <- mapM (\lf -> runIO (LBS.readFile lf)) $ map snd files+    contents <- forM (map snd files) $ \lf -> do+      addDependentFile lf+      runIO (LBS.readFile lf)     let hashes = map (bytestringDigest . sha256) contents     let top_hash = showDigest $ sha256 $ LBS.concat hashes +    let exprWrapper =+#if MIN_VERSION_template_haskell(2,16,0)+          Just+#else+          id+#endif++     thfiles <- forM (map fst files `zip` contents) $ \(f, xs) -> do-      return $ TupE [LitE (StringL f), LitE (StringL (LUTF8.toString xs))]+      return $ TupE [exprWrapper (LitE (StringL f)), exprWrapper (LitE (StringL (LUTF8.toString xs)))]  -    return $ TupE [LitE (StringL top_hash), ListE thfiles]+    return $ TupE [exprWrapper (LitE (StringL top_hash)), exprWrapper (ListE thfiles)]    ) 

@@ -20,9 +20,9 @@     , module System.Process     ) where -import Control.Arrow (second) import Data.Char import Data.List+import Data.Maybe import qualified Data.Map.Strict as Map import GHC.IO.Exception (IOErrorType(OtherError)) import System.IO@@ -42,7 +42,7 @@                   -> FilePath -> [String] -> String -> IO String readProcessStderr mcwd env exe args inp = do   logProcessCall mcwd env exe args-  env' <- execEnvOverrides env+  env' <- execEnvOverrides env <$> getEnvironment   outp <- readCreateProcess (proc exe args)     { cwd = mcwd     , env = if env == [] then Nothing else Just env'@@ -57,7 +57,7 @@     -> FilePath -> [String] -> IO ExitCode callProcessStderr' mcwd env exe args = do   logProcessCall mcwd env exe args-  env' <- execEnvOverrides env+  env' <- execEnvOverrides env <$> getEnvironment   (_, _, _, h) <- createProcess (proc exe args)     { std_out = UseHandle stderr     , env = if env == [] then Nothing else Just env'@@ -74,21 +74,18 @@     cd = case mcwd of       Nothing -> []; Just cwd -> [ "cd", formatProcessArg cwd++";" ] -execEnvOverride :: EnvOverride -> String -> String-execEnvOverride (EnvPrepend x) y = x ++ y-execEnvOverride (EnvAppend  y) x = x ++ y-execEnvOverride (EnvReplace x) _ = x+execEnvOverride :: EnvOverride -> String -> Maybe String+execEnvOverride (EnvPrepend x) y = Just (x ++ y)+execEnvOverride (EnvAppend  y) x = Just (x ++ y)+execEnvOverride (EnvSet x)     _ = Just x+execEnvOverride  EnvUnset      _ = Nothing -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)+execEnvOverrides+    :: [(String, EnvOverride)] -> [(String, String)] -> [(String, String)]+execEnvOverrides overrides env =+    Map.toList $ foldl f (Map.fromList env) overrides   where-    overrides_map = Map.fromListWith (++) $ map (second (:[])) overrides+    f em (k, o) = Map.alter (execEnvOverride o . fromMaybe "") k em  -- | Essentially 'System.Process.callProcess' but with additional options -- and logging to stderr when verbosity is enabled.

@@ -35,7 +35,6 @@ import Text.Printf import Text.Read -import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Text as Text@@ -44,13 +43,15 @@ import CabalHelper.Compiletime.Types import CabalHelper.Compiletime.Program.GHC   ( GhcVersion(..), createPkgDb )+import CabalHelper.Compiletime.Types.Cabal+  ( CabalSourceDir(..), UnpackedCabalVersion, CabalVersion'(..) ) import CabalHelper.Compiletime.Cabal-  ( CabalSourceDir(..), UnpackedCabalVersion, CabalVersion'(..), unpackCabalV1 )+  ( unpackCabalV1 ) import CabalHelper.Compiletime.Process import CabalHelper.Shared.InterfaceTypes   ( ChComponentName(..), ChLibraryName(..) ) import CabalHelper.Shared.Common-  ( parseVer, trim, appCacheDir, panicIO )+  ( parseVer, trim, appCacheDir )  newtype CabalInstallVersion = CabalInstallVersion { cabalInstallVer :: Version } @@ -215,8 +216,7 @@     installingMessage cv     (target, cwd) <- case cv of       CabalVersion cabalVer -> do-        tmp <- getTemporaryDirectory-        return $ ("Cabal-"++showVersion cabalVer, tmp)+        return $ ("Cabal-"++showVersion cabalVer, "/")       CabalHEAD (_commitid, CabalSourceDir srcdir) -> do         return (".", srcdir)     CabalInstallVersion {..} <- cabalInstallVersion@@ -251,33 +251,34 @@  planPackages :: CP.PlanJson -> IO [Package ('Cabal 'CV2)] planPackages plan = do-    fmap Map.elems $-      mapM mkPackage $-      groupByMap $ Map.elems $-      Map.filter ((==CP.UnitTypeLocal) . CP.uType) $+    sequence $+      Map.elems $+      Map.mapWithKey mkPackage $+      Map.mapMaybe packagesWithSourceDir $+      groupByMap $+      Map.elems $       CP.pjUnits plan   where     groupByMap = Map.fromListWith (<>) . map (CP.uPId &&& (:|[])) -    mkPackage :: NonEmpty CP.Unit -> IO (Package ('Cabal 'CV2))-    mkPackage units@(unit :| _) =+    packagesWithSourceDir units@(unit :| _) =       case unit of-       CP.Unit-        { uPkgSrc=Just (CP.LocalUnpackedPackage pkgdir)-        } -> do-          cabal_file <- Cabal.complainIfNoCabalFile pkgdir =<< Cabal.findCabalFile pkgdir-          let pkg = Package-                { pPackageName =-                    let CP.PkgId (CP.PkgName pkg_name) _ = CP.uPId unit-                    in Text.unpack pkg_name-                , pSourceDir = pkgdir-                , pCabalFile = CabalFile cabal_file-                , pFlags = []-                , pUnits = fmap (\u -> fixBackpackUnit u $ mkUnit pkg { pUnits = () } u) units-                }-          return pkg-       _ -> panicIO "planPackages.mkPackage: Got non-unpacked package src!"+        CP.Unit { uPkgSrc=Just (CP.LocalUnpackedPackage pkgdir) }+          -> Just (pkgdir, units)+        _ -> Nothing +    mkPackage :: CP.PkgId -> (FilePath, NonEmpty CP.Unit) -> IO (Package ('Cabal 'CV2))+    mkPackage (CP.PkgId (CP.PkgName pkg_name) _) (pkgdir, units) = do+      cabal_file <- Cabal.complainIfNoCabalFile pkgdir =<< Cabal.findCabalFile pkgdir+      let pkg = Package+            { pPackageName = Text.unpack pkg_name+            , pSourceDir = pkgdir+            , pCabalFile = CabalFile cabal_file+            , pFlags = []+            , pUnits = fmap (\u -> fixBackpackUnit u $ mkUnit pkg { pUnits = () } u) units+            }+      return pkg+     takeBackpackIndefUnitId :: CP.Unit -> Maybe CP.UnitId     takeBackpackIndefUnitId CP.Unit {uId=CP.UnitId uid}       | Text.any (=='+') uid = Just $ CP.UnitId $ Text.takeWhile (/='+') uid@@ -299,16 +300,18 @@       | otherwise =         ch_unit -    unitTargets :: CP.Unit -> [String]+    unitTargets :: CP.Unit -> [(ChComponentName, String)]     unitTargets CP.Unit {uComps, uPId=CP.PkgId pkg_name _} =-      map (Text.unpack . (((coerce pkg_name) <> ":") <>) . CP.dispCompNameTarget pkg_name) $-      Map.keys uComps+      [ (cpCompNameToChComponentName comp, Text.unpack target)+      | comp <- Map.keys uComps+      , let comp_str = CP.dispCompNameTarget pkg_name comp+      , let target = ((coerce pkg_name) <> ":") <> comp_str+      ]      mkUnit :: Package' () -> CP.Unit -> Unit ('Cabal 'CV2)     mkUnit pkg u@CP.Unit       { uDistDir=Just distdirv1       , uComps=comps-      , uPId=CP.PkgId pkg_name _       , uId       } =         Unit

@@ -31,7 +31,7 @@ import CabalHelper.Shared.Common   (parseVer, trim, appCacheDir, parsePkgId) import CabalHelper.Compiletime.Types-import CabalHelper.Compiletime.Cabal+import CabalHelper.Compiletime.Types.Cabal   ( ResolvedCabalVersion, showResolvedCabalVersion, UnpackedCabalVersion   , unpackedToResolvedCabalVersion, CabalVersion'(..) ) import CabalHelper.Compiletime.Process@@ -64,6 +64,10 @@ ghcVersion = GhcVersion .   parseVer . trim <$> readProcess' (ghcProgram ?progs) ["--numeric-version"] "" +ghcLibdir :: (Verbose, Progs) => IO FilePath+ghcLibdir = do+  trim <$> readProcess' (ghcProgram ?progs) ["--print-libdir"] ""+ ghcPkgVersion :: (Verbose, Progs) => IO Version ghcPkgVersion =   parseVer . trim . dropWhile (not . isDigit)@@ -130,9 +134,16 @@  invokeGhc :: Env => GhcInvocation -> IO (Either ExitCode FilePath) invokeGhc GhcInvocation {..} = do-    rv <- callProcessStderr' (Just "/") [] (ghcProgram ?progs) $ concat-      [ [ "-outputdir", giOutDir-        , "-o", giOutput+    giOutDirAbs <- makeAbsolute giOutDir+    giOutputAbs <- makeAbsolute giOutput+    giIncludeDirsAbs <- mapM makeAbsolute giIncludeDirs+    giInputsAbs <- mapM makeAbsolute giInputs+    -- We unset some interferring envvars here for stack, see:+    -- https://github.com/DanielG/cabal-helper/issues/78#issuecomment-557860898+    let eos = [("GHC_ENVIRONMENT", EnvUnset), ("GHC_PACKAGE_PATH", EnvUnset)]+    rv <- callProcessStderr' (Just "/") eos (ghcProgram ?progs) $ concat+      [ [ "-outputdir", giOutDirAbs+        , "-o", giOutputAbs         ]       , map ("-optP"++) giCPPOptions       , if giHideAllPackages then ["-hide-all-packages"] else []@@ -144,10 +155,10 @@             , packageFlags             ]           GPSPackageEnv env -> [ "-package-env=" ++ unPackageEnvFile env ]-      , map ("-i"++) $ nub $ "" : giIncludeDirs+      , map ("-i"++) $ nub $ "" : giIncludeDirsAbs       , giWarningFlags       , ["--make"]-      , giInputs+      , giInputsAbs       ]     return $       case rv of

@@ -85,7 +85,7 @@     workdirArg qe ++ [ "path", "--stack-yaml="++stack_yaml ]   return $ \k -> let Just x = lookup k $ map split $ lines out in x   where-    split l = let (key, ' ' : val) = span (not . isSpace) l in (key, val)+    split l = let (key, val) = break isSpace l in (key, dropWhile isSpace val)  listPackageCabalFiles :: QueryEnvI c 'Stack -> IO [CabalFile] listPackageCabalFiles qe@QueryEnv{qeProjLoc}

@@ -30,6 +30,7 @@ import System.FilePath (takeDirectory) import System.Posix.Types import CabalHelper.Compiletime.Types.RelativePath+import CabalHelper.Compiletime.Types.Cabal import CabalHelper.Shared.InterfaceTypes  import Data.List.NonEmpty (NonEmpty)@@ -347,8 +348,7 @@   UnitImplV1 :: UnitImpl ('Cabal 'CV1)    UnitImplV2 ::-    { uiV2ComponentNames :: ![ChComponentName]-    , uiV2Components     :: ![String]+    { uiV2Components       :: ![(ChComponentName, String)]     , uiV2OnlyDependencies :: !Bool     } -> UnitImpl ('Cabal 'CV2) @@ -365,7 +365,7 @@ -- of helper invocations for clients that don't need to know the entire project -- structure. uComponentName :: Unit pt -> Maybe ChComponentName-uComponentName Unit { uImpl=UnitImplV2 { uiV2ComponentNames=[comp] } } =+uComponentName Unit { uImpl=UnitImplV2 { uiV2Components=[(comp, _)] } } =     Just comp uComponentName _ =     Nothing@@ -456,8 +456,7 @@  -- | Project-scope information cache. data ProjInfo pt = ProjInfo-  { piCabalVersion     :: !Version-  , piPackages         :: !(NonEmpty (Package pt))+  { piPackages         :: !(NonEmpty (Package pt))   , piImpl             :: !(ProjInfoImpl pt)   , piProjConfModTimes :: !ProjConfModTimes   -- ^ Key for cache invalidation. When this is not equal to the return@@ -466,13 +465,14 @@  data ProjInfoImpl pt where   ProjInfoV1 ::-    { piV1SetupHeader :: !UnitHeader+    { piV1SetupHeader  :: !UnitHeader+    , piV1CabalVersion :: !CabalVersion     } -> ProjInfoImpl ('Cabal 'CV1)    ProjInfoV2 ::-    { piV2Plan        :: !PlanJson-    , piV2PlanModTime :: !EpochTime-    , piV2CompilerId  :: !(String, Version)+    { piV2Plan         :: !PlanJson+    , piV2PlanModTime  :: !EpochTime+    , piV2CompilerId   :: !(String, Version)     } -> ProjInfoImpl ('Cabal 'CV2)    ProjInfoStack :: ProjInfoImpl 'Stack@@ -570,9 +570,10 @@   Programs "cabal" [] []  "stack" [] [] [] "ghc" "ghc-pkg" "haddock"  data EnvOverride-    = EnvPrepend String+    = EnvUnset+    | EnvSet String     | EnvAppend String-    | EnvReplace String+    | EnvPrepend String       deriving (Eq, Ord, Show, Read, Generic, Typeable)  data CompileOptions = CompileOptions

@@ -0,0 +1,59 @@+-- cabal-helper: Simple interface to Cabal's configuration state+-- Copyright (C) 2020  Daniel Gröber <cabal-helper@dxld.at>+--+-- SPDX-License-Identifier: Apache-2.0+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0++{-|+Module      : CabalHelper.Compiletime.Types.Cabal+License     : Apache-2.0+-}++{-# LANGUAGE DeriveFunctor #-}++module CabalHelper.Compiletime.Types.Cabal where++import Data.Version++-- | Cabal library version we're compiling the helper exe against.+data CabalVersion' a+    = CabalHEAD a+    | CabalVersion { cvVersion :: Version }+      deriving (Eq, Ord, Functor)++newtype CommitId = CommitId { unCommitId :: String }++type UnpackedCabalVersion = CabalVersion' (CommitId, CabalSourceDir)+type ResolvedCabalVersion = CabalVersion' CommitId+type CabalVersion = CabalVersion' ()++data UnpackCabalVariant = Pristine | LatestRevision+newtype CabalSourceDir = CabalSourceDir { unCabalSourceDir :: FilePath }+++unpackedToResolvedCabalVersion :: UnpackedCabalVersion -> ResolvedCabalVersion+unpackedToResolvedCabalVersion (CabalHEAD (commit, _)) = CabalHEAD commit+unpackedToResolvedCabalVersion (CabalVersion ver) = CabalVersion ver++showUnpackedCabalVersion :: UnpackedCabalVersion -> String+showUnpackedCabalVersion (CabalHEAD (commitid, _)) =+  "HEAD-" ++ unCommitId commitid+showUnpackedCabalVersion CabalVersion {cvVersion} =+  showVersion cvVersion++showResolvedCabalVersion :: ResolvedCabalVersion -> String+showResolvedCabalVersion (CabalHEAD commitid) =+  "HEAD-" ++ unCommitId commitid+showResolvedCabalVersion CabalVersion {cvVersion} =+  showVersion cvVersion++showCabalVersion :: CabalVersion -> String+showCabalVersion (CabalHEAD ()) =+  "HEAD"+showCabalVersion CabalVersion {cvVersion} =+  showVersion cvVersion

@@ -25,6 +25,7 @@     , componentNameFromComponent     , componentOutDir     , internalPackageDBPath+    , unFlagAssignment     ) where  import System.FilePath@@ -124,10 +125,16 @@ import qualified Distribution.InstalledPackageInfo as Installed #endif -#if CH_MIN_VERSION_Cabal(2,2,0)+#if CH_MIN_VERSION_Cabal(3,2,0)+import Distribution.Types.Flag+  ( unFlagAssignment+  )+#elif CH_MIN_VERSION_Cabal(2,2,0) import Distribution.Types.GenericPackageDescription   ( unFlagAssignment   )+#else+#define NOP_UN_FLAG_ASSIGNMENT 1 #endif  #if CH_MIN_VERSION_Cabal(2,5,0)@@ -225,4 +232,8 @@ internalPackageDBPath :: LocalBuildInfo -> FilePath -> FilePath internalPackageDBPath lbi distPref =   distPref </> "package.conf.inplace"+#endif++#ifdef NOP_UN_FLAG_ASSIGNMENT+unFlagAssignment = id #endif

@@ -193,12 +193,6 @@ import qualified Distribution.InstalledPackageInfo as Installed #endif -#if CH_MIN_VERSION_Cabal(2,2,0)-import Distribution.Types.GenericPackageDescription-  ( unFlagAssignment-  )-#endif- import Control.Applicative ((<$>), (<*>), ZipList(..)) import Control.Arrow (first, second, (&&&)) import Control.Monad@@ -227,7 +221,7 @@   hPutStr stderr $ "Usage: " ++ prog ++ " " ++ usageMsg  where    usageMsg = ""-     ++"PROJ_DIR DIST_DIR (v1|v2)\n"+     ++"CABAL_FILE DIST_DIR (v1|v2)\n"      ++"  ( version\n"      ++"  | flags\n"      ++"  | config-flags\n"@@ -301,11 +295,8 @@     "config-flags":[] -> do       return $ Just $ ChResponseFlags $ sort $         map (first unFlagName)-#if CH_MIN_VERSION_Cabal(2,2,0)-          $ unFlagAssignment $ configConfigurationsFlags-#else+          $ unFlagAssignment           $ configConfigurationsFlags-#endif           $ configFlags lbi      "non-default-config-flags":[] -> do

@@ -36,8 +36,11 @@ import CabalHelper.Compiletime.Compile import CabalHelper.Compiletime.Program.GHC import CabalHelper.Compiletime.Types+import CabalHelper.Compiletime.Types.Cabal import CabalHelper.Shared.Common +import TestOptions+ withinRange'CH :: Version -> VersionRange -> Bool withinRange'CH v r =     withinRange (fromDataVersion v) r@@ -61,11 +64,12 @@  main :: IO () main = do-  let ?progs = defaultPrograms+  (modProgs, args) <- testOpts =<< getArgs++  let ?progs = modProgs defaultPrograms   let ?opts = defaultCompileOptions { oVerbose = True }   let ?verbose = \level -> case level of 1 -> True; _ -> False -  args <- getArgs   case args of     "list-versions":[] -> do         mapM_ print =<< relevantCabalVersions =<< ghcVersion@@ -97,7 +101,8 @@       <- map parseVer . lines <$> readFile "tests/cabal-versions"   let     constraint :: VersionRange-    Just constraint =+    constraint =+        fromMaybe (error $ "No cabal version constraint found for " ++ show ghc_ver) $         fmap snd $         find (and . (zipWith (==) `on` versionBranch) ghc_ver . fst) $         constraint_table@@ -112,6 +117,8 @@             , ("8.2",   ">= 1.24.2.0      ")             , ("8.4",   ">= 2.0.0.2       ")             , ("8.6",   ">= 2.0.0.2       ")+            , ("8.8",   ">= 3.0.0.0       ")+            , ("8.10",  ">= 3.2.0.0       ")             ]   return $ reverse $ map (flip withinRange'CH constraint &&& id) cabal_versions @@ -135,7 +142,7 @@           { cheCabalVer = icv           , chePkgDb = db           , cheProjDir = tmpdir-          , chePlanJson = Nothing+          , chePjUnits = Nothing           , cheDistV2 = Just $ tmpdir </> "dist-newstyle"           , cheProjLocalCacheDir =               tmpdir </> "dist-newstyle" </> "cache"@@ -148,11 +155,11 @@         mcabalVersions <- runMaybeT $ listCabalVersions (Just db)         case mcabalVersions of           Just [hdver] ->-            return $ che0 (CabalVersion hdver) (Just db)+            return $ che0 (CabalVersion hdver) [db]           _ ->-            return $ che0 (CabalHEAD ()) Nothing+            return $ che0 (CabalHEAD ()) []       (CabalVersion ver) ->-        return $ che0 (CabalVersion ver) Nothing+        return $ che0 (CabalVersion ver) []      compileHelper che 

@@ -2,15 +2,14 @@   DataKinds, ExistentialQuantification, PolyKinds, ViewPatterns,   DeriveFunctor, MonoLocalBinds, GADTs, MultiWayIf #-} -{-| This test ensures we can get a GHC API session up and running in a variety of-  project environments.+{-| This test ensures we can get a GHC API session up and running in a+  variety of project environments. -}  module Main where  import GHC import Config-import GHC.Paths (libdir) import Outputable import DynFlags @@ -22,7 +21,6 @@ import Data.Version import Data.Bifunctor import qualified Data.Map as Map-import System.Console.GetOpt as GetOpt import System.Environment (getArgs) import System.Exit import System.FilePath ((</>), (<.>), makeRelative, takeDirectory)@@ -39,10 +37,12 @@ import CabalHelper.Compiletime.Types (Env) import CabalHelper.Compiletime.Process (readProcess, callProcessStderr) import CabalHelper.Compiletime.Program.GHC-  (GhcVersion(..), ghcVersion)+  (GhcVersion(..), ghcVersion, ghcLibdir) import CabalHelper.Compiletime.Program.CabalInstall   (CabalInstallVersion(..), cabalInstallVersion) +import TestOptions+ data TestConfig = TC   { location        :: TestLocation   , cabalLowerBound :: Version@@ -60,35 +60,10 @@   let (topdir, projdir, cabal_file) = testLocPath loc in   "- " ++ intercalate ":" [topdir, projdir, cabal_file, show pt] -type ModProgs = (Programs -> Programs)--options :: [OptDescr ModProgs]-options =-    [ GetOpt.Option [] ["with-cabal"]-        (ReqArg (\arg -> \p -> p { cabalProgram = arg }) "PROG")-        "name or path of 'cabal' executable"-    , GetOpt.Option [] ["with-stack"]-        (ReqArg (\arg -> \p -> p { stackProgram = arg }) "PROG")-        "name or path of 'stack' executable"-    , GetOpt.Option [] ["with-ghc"]-        (ReqArg (\arg -> \cp -> cp { ghcProgram = arg }) "PROG")-        "name or path of 'ghc' executable"-    , GetOpt.Option [] ["with-ghc-pkg"]-        (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 (flip (.)) id o, n)-      (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))-  where header = "Usage: ghc-session [OPTION..] [TEST_SPEC..]"- main :: IO () main = do   (modProgs, args) <- testOpts =<< getArgs---  topdir <- getCurrentDirectory+  topdir <- getCurrentDirectory    let withEnv :: (Env => a) -> a       withEnv action =@@ -132,7 +107,7 @@       proj_impls =         -- V2 is sorted before the others here so helper compilation always         -- uses v2-build caching!-        [ (Cabal CV2, newBuildProjSetup)+        [ (Cabal CV2, newBuildProjSetup topdir)         , (Cabal CV1, oldBuildProjSetup)         , (Stack, stackProjSetup g_ver)         ]@@ -151,12 +126,31 @@       -- fucking awesome store cache to keep CI times down.       --       -- TODO: Better test coverage for helper compilation with the other two!-      [ TC (TN "exelib")    (parseVer "1.10") (parseVer "0")   []-      , TC (TN "exeintlib") (parseVer "2.0")  (parseVer "0")   []-      , TC (TN "fliblib")   (parseVer "2.0")  (parseVer "0")   []-      , TC (TN "bkpregex")  (parseVer "2.0")  (parseVer "8.1") [Cabal CV2, Cabal CV1]+      [ TC (TN "exelib")       (parseVer "1.10") (parseVer "0")   []+      , TC (TN "exeintlib")    (parseVer "2.0")  (parseVer "0")   []+      , TC (TN "fliblib")      (parseVer "2.0")  (parseVer "0")   []+      , TC (TN "custom-setup") (parseVer "1.24") (parseVer "0")   [Cabal CV2, Stack]+      --  ^ Custom setup has issues in v1. Specifically we can get into the+      --  situation where v1-configure --with-ghc=... will pick one Cabal+      --  lib version but then v1-build (without --with-ghc) will pick+      --  another because the system ghc has different packages available+      --  than the --with-ghc one.+      --+      -- At this point a setup recompile happens and hell breaks loose+      -- because setup-config is mismatched. The reason we can't just pass+      -- --with-ghc to v1-build to fix this is that it will actually ignore+      -- it as far as setup compilation is concerned while v1-configure+      -- will pick it up.+      --+      -- We could fuck around with $PATH in the v1-build case too but I+      -- really don't think that many people use v1 still and with+      -- built-type:custom no less.+      --+      -- See haskell/cabal#6749+      , TC (TN "bkpregex")     (parseVer "2.0")  (parseVer "8.1") [Cabal CV2, Cabal CV1]+      , TC (TN "src-repo")     (parseVer "2.4")  (parseVer "0")   [Cabal CV2]       , let multipkg_loc = TF "tests/multipkg/" "proj/" "proj/proj.cabal" in-        TC  multipkg_loc    (parseVer "1.10") (parseVer "0")   [Cabal CV2, Stack]+        TC  multipkg_loc       (parseVer "1.10") (parseVer "0")   [Cabal CV2, Stack]       --            min Cabal lib ver -^    min GHC ver -^       ] @@ -253,7 +247,7 @@   (topdir, projdir_rel, cabal_file) = testLocPath test_loc in do   c_ver <- f_c_ver pt   first SkipReason $ do-  if| Stack <- pt, Left (SkipReason msg) <- stackCheckCompat s_ver g_ver ->+  if| Stack <- pt, Left (SkipReason msg) <- stackCheckCompat s_ver ->       Left $ msg     | ci_ver < parseVer "1.24" ->       Left $ "cabal-install-" ++ showVersion ci_ver ++ " is too old"@@ -319,6 +313,8 @@     let progs = modProgs (qePrograms qe')         qe = qe' { qePrograms = progs } +    ghc_libdir <- let ?progs = progs; ?verbose = const False in ghcLibdir+     psiSdist progs topdir tmpdir      cs <- concat <$> runQuery (allUnits (Map.elems . uiComponents)) qe@@ -342,7 +338,7 @@         putStrLn sopts          hFlush stdout-        tr <- compileModule pkgdir ciEntrypoints ciSourceDirs opts'+        tr <- compileModule ghc_libdir pkgdir ciEntrypoints ciSourceDirs opts'         return $ tr ciComponentName   where     formatArg x@@ -354,9 +350,9 @@   writeFile (dir </> "cabal.project") "packages: .\n"  compileModule-    :: FilePath -> ChEntrypoint -> [FilePath] -> [String]+    :: FilePath -> FilePath -> ChEntrypoint -> [FilePath] -> [String]     -> IO (ChComponentName -> FilePath -> String -> String -> TestResult)-compileModule pkgdir ep srcdirs opts = do+compileModule ghc_libdir pkgdir ep srcdirs opts = do     cwd_before <- getCurrentDirectory     setCurrentDirectory pkgdir     flip E.finally (setCurrentDirectory cwd_before) $ do@@ -366,7 +362,7 @@     E.handle (\(ec :: ExitCode) -> print ec >> return (TestResult False)) $ do      defaultErrorHandler defaultFatalMessager defaultFlushOut $ do-    runGhc (Just libdir) $ do+    runGhc (Just ghc_libdir) $ do     let printGhcEx e = GHC.printException e >> return (TestResult False)     handleSourceError printGhcEx $ do @@ -451,8 +447,9 @@     , psiQEmod     = id     } -newBuildProjSetup :: ProjSetup0-newBuildProjSetup = ProjSetupDescr "cabal-v2" $ Right $ Ex $ ProjSetupImpl+newBuildProjSetup :: FilePath -> ProjSetup0+newBuildProjSetup topdir+  = ProjSetupDescr "cabal-v2" $ Right $ Ex $ ProjSetupImpl     { psiProjType  = SCabal SCV2     , psiDistDir   = \dir  -> DistDirCabal SCV2 (dir </> "dist-newstyle")     , psiProjLoc   = \_cabal_file projdir -> ProjLocV2File (projdir </> "cabal.project") projdir@@ -463,7 +460,7 @@         copyMuliPackageProject progs srcdir destdir $ \pkgsrc pkgdest -> do           exists <- doesFileExist (pkgsrc </> "cabal.project")           if exists then-            copyFile (pkgsrc </> "cabal.project") (pkgdest </> "cabal.project")+            writeFile (pkgdest </> "cabal.project") =<< replaceStrings [("${topdir}", topdir)] <$> readFile (pkgsrc </> "cabal.project")           else             addCabalProject pkgdest     , psiQEmod     = id@@ -529,15 +526,15 @@     :: (?progs :: Programs)     => Version -> Version -> Either SkipReason (IO Version) stackBuiltinCabalVersion s_ver g_ver = do-    _ <- stackCheckCompat s_ver g_ver+    _ <- stackCheckCompat s_ver     res <- lookupStackResolver g_ver     return $ parseVer . trim <$> readProcess (stackProgram ?progs)         [ "--resolver="++res, "--system-ghc", "exec", "--"-        , "ghc-pkg", "--simple-output", "field", "Cabal", "version"+        , "ghc-pkg", "--simple-output", "--global", "field", "Cabal", "version"         ] "" -stackCheckCompat :: Version -> Version -> Either SkipReason ()-stackCheckCompat s_ver g_ver =+stackCheckCompat :: Version -> Either SkipReason ()+stackCheckCompat s_ver =   if| s_ver < parseVer "1.9.4" ->         Left $ SkipReason $ "stack-" ++ showVersion s_ver ++ " is too old"     | otherwise ->@@ -548,16 +545,17 @@     parseVer . trim <$> readProcess (cabalProgram ?progs)         ["act-as-setup", "--", "--numeric-version"] "" -normalizeOutputWithVars :: [(String, String)] -> String -> String-normalizeOutputWithVars ts str =+normalizeOutputWithVars = replaceStrings+replaceStrings :: [(String, String)] -> String -> String+replaceStrings ts str =   case filter (isJust . fst) $ map (first (flip stripPrefix str)) ts of-    (Just rest, replacemnet) : _ ->-        replacemnet ++ normalizeOutputWithVars ts rest+    (Just rest, replacement) : _ ->+        replacement ++ replaceStrings ts rest     _ -> cont   where     cont =       case str of-        s:ss -> s : normalizeOutputWithVars ts ss+        s:ss -> s : replaceStrings ts ss         [] -> [] -- --------------------------------------------------------------------- -- | Create and use a temporary directory in the system standard temporary directory.

@@ -0,0 +1,33 @@+module TestOptions+    ( ModProgs+    , testOpts+    ) where++import System.Console.GetOpt as GetOpt++import CabalHelper.Compiletime.Types++type ModProgs = (Programs -> Programs)++options :: [OptDescr ModProgs]+options =+    [ GetOpt.Option [] ["with-cabal"]+        (ReqArg (\arg -> \p -> p { cabalProgram = arg }) "PROG")+        "name or path of 'cabal' executable"+    , GetOpt.Option [] ["with-stack"]+        (ReqArg (\arg -> \p -> p { stackProgram = arg }) "PROG")+        "name or path of 'stack' executable"+    , GetOpt.Option [] ["with-ghc"]+        (ReqArg (\arg -> \cp -> cp { ghcProgram = arg }) "PROG")+        "name or path of 'ghc' executable"+    , GetOpt.Option [] ["with-ghc-pkg"]+        (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 (flip (.)) id o, n)+      (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))+  where header = "Usage: ghc-session [OPTION..] [TEST_SPEC..]"

@@ -56,3 +56,6 @@ 2.4.0.1 2.4.1.0 3.0.0.0+3.0.1.0+3.0.2.0+3.2.0.0

@@ -0,0 +1,8 @@+module Lib where++import System.Directory+import System.FilePath++filepath  = "a" </> "b"+directory = doesFileExist "Exe.hs"+foo = 1

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,13 @@+name:                custom-setup+version:             0+build-type:          Custom+cabal-version:       >=1.10+extra-source-files:  stack.yaml++custom-setup+  setup-depends: base, Cabal++library+  exposed-modules:     Lib+  build-depends:       base, filepath, directory+  default-language:    Haskell2010

@@ -0,0 +1,1 @@+./

@@ -0,0 +1,3 @@+resolver: lts-0.0 # will be overridden on the commandline+packages:+- ./

@@ -0,0 +1,5 @@+module Main where++import Lib++main = print foo

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,7 @@+packages: .++source-repository-package+    type: git+    location: ${topdir}+    tag: HEAD+    subdir: tests/exelib

@@ -0,0 +1,1 @@+./

@@ -0,0 +1,19 @@+name:                src-repo+version:             0+build-type:          Simple+cabal-version:       >=1.10++executable src-repo+  main-is:             Exe.hs+  build-depends:       base, exelib+  default-language:    Haskell2010++test-suite exe-test+    type:              exitcode-stdio-1.0+    main-is:           Exe.hs+    build-depends:     base, exelib++benchmark exe-bench+    type:              exitcode-stdio-1.0+    main-is:           Exe.hs+    build-depends:     base, exelib

@@ -1,4 +1,4 @@-8.6.5      lts-14.18+8.6.5      lts-14.27 8.6.5      lts-13.30 8.4.4      lts-12.26 8.2.2      lts-11.22