Fix --offline flag (#8676)

* WIP * WIP * WIP * WIP * WIP * add offline logic branch * Clean up * Formatting * Optimize * Rename test folder * Add changelog file * Fix whitespace * Add <CABAL_ERROR> normalizer tag * code review changes * Delet vs code file * Fix import * fix wrong output file --------- Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
haskell · Mar 9, 2023 · 0ed1218 · 0ed1218
1 parent fda8100
commit 0ed1218
Show file tree

Hide file tree

Showing 15 changed files with 128 additions and 3 deletions.
diff --git a/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs b/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs
@@ -73,6 +73,7 @@ newBuildReport os' arch' comp pkgid flags deps result =
   where
     convertInstallOutcome = case result of
       Left  BR.PlanningFailed      -> PlanningFailed
+      Left  (BR.GracefulFailure _) -> PlanningFailed
       Left  (BR.DependentFailed p) -> DependencyFailed p
       Left  (BR.DownloadFailed  _) -> DownloadFailed
       Left  (BR.UnpackFailed    _) -> UnpackFailed

diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs
@@ -968,6 +968,7 @@ printBuildFailures verbosity buildOutcomes =
               | (pkgid, reason) <- failed ]
   where
     printFailureReason reason = case reason of
+      GracefulFailure msg -> msg
       DependentFailed pkgid -> " depends on " ++ prettyShow pkgid
                             ++ " which failed to install."
       DownloadFailed  e -> " failed while downloading the package."

diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
@@ -99,12 +99,15 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString.Lazy.Char8 as LBS.Char8
 
+import qualified Text.PrettyPrint as Disp
+
 import Control.Exception (Handler (..), SomeAsyncException, assert, catches, handle)
 import System.Directory  (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeFile, renameDirectory)
 import System.FilePath   (dropDrive, makeRelative, normalise, takeDirectory, (<.>), (</>))
 import System.IO         (IOMode (AppendMode), Handle, withFile)
 
 import Distribution.Compat.Directory (listDirectory)
+import Distribution.Simple.Flag (fromFlagOrDefault)
 
 
 ------------------------------------------------------------------------------
@@ -559,6 +562,7 @@ invalidatePackageRegFileMonitor PackageFileMonitor{pkgFileMonitorReg} =
 -- It requires the 'BuildStatusMap' gathered by 'rebuildTargetsDryRun'.
 --
 rebuildTargets :: Verbosity
+               -> ProjectConfig
                -> DistDirLayout
                -> StoreDirLayout
                -> ElaboratedInstallPlan
@@ -567,6 +571,9 @@ rebuildTargets :: Verbosity
                -> BuildTimeSettings
                -> IO BuildOutcomes
 rebuildTargets verbosity
+               ProjectConfig {
+                projectConfigBuildOnly = config
+               }
                distDirLayout@DistDirLayout{..}
                storeDirLayout
                installPlan
@@ -578,8 +585,9 @@ rebuildTargets verbosity
                buildSettings@BuildTimeSettings{
                  buildSettingNumJobs,
                  buildSettingKeepGoing
-               } = do
-
+               }
+  | fromFlagOrDefault False (projectConfigOfflineMode config) && not (null packagesToDownload) = return offlineError
+  | otherwise = do
     -- Concurrency control: create the job controller and concurrency limits
     -- for downloading, building and installing.
     jobControl    <- if isParallelBuild
@@ -637,6 +645,32 @@ rebuildTargets verbosity
                           , elabSetupPackageDBStack elab ]
         ]
 
+    offlineError :: BuildOutcomes
+    offlineError = Map.fromList . map makeBuildOutcome $ packagesToDownload
+      where
+        makeBuildOutcome :: ElaboratedConfiguredPackage -> (UnitId, BuildOutcome)
+        makeBuildOutcome ElaboratedConfiguredPackage {
+          elabUnitId,
+          elabPkgSourceId = PackageIdentifier { pkgName, pkgVersion }
+        } = (elabUnitId, Left (BuildFailure {
+          buildFailureLogFile = Nothing,
+          buildFailureReason = GracefulFailure $ makeError pkgName pkgVersion
+        }))
+        makeError :: PackageName -> Version -> String
+        makeError n v = "--offline was specified, hence refusing to download the package: "
+          ++ unPackageName n
+          ++ " version " ++ Disp.render (pretty v)
+
+    packagesToDownload :: [ElaboratedConfiguredPackage]
+    packagesToDownload = [elab | InstallPlan.Configured elab <- InstallPlan.reverseTopologicalOrder installPlan,
+                             isRemote $ elabPkgSourceLocation elab]
+      where
+        isRemote :: PackageLocation a -> Bool
+        isRemote (RemoteTarballPackage _ _) = True
+        isRemote (RepoTarballPackage {}) = True
+        isRemote (RemoteSourceRepoPackage _ _) = True
+        isRemote _ = False
+
 
 -- | Create a package DB if it does not currently exist. Note that this action
 -- is /not/ safe to run concurrently.

diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs
@@ -192,6 +192,7 @@ instance Exception BuildFailure
 -- | Detail on the reason that a package failed to build.
 --
 data BuildFailureReason = DependentFailed PackageId
+                        | GracefulFailure String
                         | DownloadFailed  SomeException
                         | UnpackFailed    SomeException
                         | ConfigureFailed SomeException

diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
@@ -400,6 +400,7 @@ runProjectBuildPhase verbosity
                      ProjectBaseContext{..} ProjectBuildContext {..} =
     fmap (Map.union (previousBuildOutcomes pkgsBuildStatus)) $
     rebuildTargets verbosity
+                   projectConfig
                    distDirLayout
                    (cabalStoreDirLayout cabalDirLayout)
                    elaboratedPlanToExecute
@@ -1019,6 +1020,7 @@ writeBuildReports settings buildContext plan buildOutcomes = do
       fromPlanPackage (InstallPlan.Configured pkg) (Just result) =
             let installOutcome = case result of
                    Left bf -> case buildFailureReason bf of
+                      GracefulFailure _ -> BuildReports.PlanningFailed
                       DependentFailed p -> BuildReports.DependencyFailed p
                       DownloadFailed _  -> BuildReports.DownloadFailed
                       UnpackFailed _ -> BuildReports.UnpackFailed
@@ -1209,6 +1211,7 @@ dieOnBuildFailures verbosity currentCommand plan buildOutcomes
           TestsFailed     _ -> "Tests failed for " ++ pkgstr
           BenchFailed     _ -> "Benchmarks failed for " ++ pkgstr
           InstallFailed   _ -> "Failed to build "  ++ pkgstr
+          GracefulFailure msg -> msg
           DependentFailed depid
                             -> "Failed to build " ++ prettyShow (packageId pkg)
                             ++ " because it depends on " ++ prettyShow depid
@@ -1301,6 +1304,7 @@ dieOnBuildFailures verbosity currentCommand plan buildOutcomes
         TestsFailed     e -> Just e
         BenchFailed     e -> Just e
         InstallFailed   e -> Just e
+        GracefulFailure _ -> Nothing
         DependentFailed _ -> Nothing
 
 data BuildFailurePresentation =

diff --git a/cabal-install/src/Distribution/Client/Types/BuildResults.hs b/cabal-install/src/Distribution/Client/Types/BuildResults.hs
@@ -25,6 +25,7 @@ type BuildOutcomes = Map UnitId BuildOutcome
 
 data BuildFailure = PlanningFailed
                   | DependentFailed PackageId
+                  | GracefulFailure String
                   | DownloadFailed  SomeException
                   | UnpackFailed    SomeException
                   | ConfigureFailed SomeException

diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs
@@ -1715,7 +1715,7 @@ planProject testdir cliConfig = do
             elaboratedShared)
 
 executePlan :: PlanDetails -> IO (ElaboratedInstallPlan, BuildOutcomes)
-executePlan ((distDirLayout, cabalDirLayout, _, _, buildSettings),
+executePlan ((distDirLayout, cabalDirLayout, config, _, buildSettings),
              elaboratedPlan,
              elaboratedShared) = do
 
@@ -1741,6 +1741,7 @@ executePlan ((distDirLayout, cabalDirLayout, _, _, buildSettings),
 
     buildOutcomes <-
       rebuildTargets verbosity
+                     config
                      distDirLayout
                      (cabalStoreDirLayout cabalDirLayout)
                      elaboratedPlan''

diff --git a/cabal-testsuite/PackageTests/OfflineFlag/Main.hs b/cabal-testsuite/PackageTests/OfflineFlag/Main.hs
@@ -0,0 +1,4 @@
+import P (p)
+
+main :: IO ()
+main = print p
diff --git a/cabal-testsuite/PackageTests/OfflineFlag/cabal.repo.project b/cabal-testsuite/PackageTests/OfflineFlag/cabal.repo.project
@@ -0,0 +1 @@
+packages: ./main.cabal
diff --git a/cabal-testsuite/PackageTests/OfflineFlag/main.cabal b/cabal-testsuite/PackageTests/OfflineFlag/main.cabal
@@ -0,0 +1,19 @@
+cabal-version:      3.0
+name:               current
+version:            0.1.0.0
+license:            MIT
+author:             Colton Clemmer
+maintainer:         [email protected]
+-- copyright:
+build-type:         Simple
+extra-doc-files:    CHANGELOG.md
+-- extra-source-files:
+
+common warnings
+    ghc-options: -Wall
+
+executable current
+    import:           warnings
+    main-is:          Main.hs
+    build-depends:    base, remote
+    default-language: Haskell2010
diff --git a/cabal-testsuite/PackageTests/OfflineFlag/offlineFlag.out b/cabal-testsuite/PackageTests/OfflineFlag/offlineFlag.out
@@ -0,0 +1,23 @@
+# cabal v2-update
+Downloading the latest package list from test-local-repo
+# cabal v2-build
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - remote-0.1.0.0 (lib) (requires build)
+ - current-0.1.0.0 (exe:current) (first run)
+Error: cabal: --offline was specified, hence refusing to download the package: remote version 0.1.0.0.
+# cabal v2-build
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - remote-0.1.0.0 (lib) (requires build)
+ - current-0.1.0.0 (exe:current) (first run)
+Configuring library for remote-0.1.0.0..
+Preprocessing library for remote-0.1.0.0..
+Building library for remote-0.1.0.0..
+Installing library in <PATH>
+Configuring executable 'current' for current-0.1.0.0..
+Preprocessing executable 'current' for current-0.1.0.0..
+Building executable 'current' for current-0.1.0.0..
+# cabal v2-build
+Up to date
diff --git a/cabal-testsuite/PackageTests/OfflineFlag/offlineFlag.test.hs b/cabal-testsuite/PackageTests/OfflineFlag/offlineFlag.test.hs
@@ -0,0 +1,11 @@
+import Test.Cabal.Prelude
+
+main = withShorterPathForNewBuildStore $ \storeDir ->
+  cabalTest $ do
+    skipUnlessGhcVersion ">= 8.1"
+    skipIfWindows
+    withProjectFile "cabal.repo.project" $ do
+      withRepo "repo" $ do
+        fails $ cabalG ["--store-dir=" ++ storeDir] "v2-build" ["current", "--offline"]
+        cabalG ["--store-dir=" ++ storeDir] "v2-build" ["current"]
+        cabalG ["--store-dir=" ++ storeDir] "v2-build" ["current", "--offline"]
diff --git a/cabal-testsuite/PackageTests/OfflineFlag/repo/remote-0.1.0.0/P.hs b/cabal-testsuite/PackageTests/OfflineFlag/repo/remote-0.1.0.0/P.hs
@@ -0,0 +1,3 @@
+module P (p) where
+
+p = "Foo"
diff --git a/cabal-testsuite/PackageTests/OfflineFlag/repo/remote-0.1.0.0/remote.cabal b/cabal-testsuite/PackageTests/OfflineFlag/repo/remote-0.1.0.0/remote.cabal
@@ -0,0 +1,13 @@
+cabal-version:      3.0
+name:               remote
+version:            0.1.0.0
+license:            MIT
+author:             Colton Clemmer
+maintainer:         [email protected]
+build-type:         Simple
+extra-doc-files:    CHANGELOG.md
+
+library
+  build-depends:       base
+  exposed-modules:     P
+  default-language:    Haskell2010
diff --git a/changelog.d/pr-8676 b/changelog.d/pr-8676
@@ -0,0 +1,8 @@
+synopsis: Adds functionality for the --offline flag with the "build" command.
+packages: cabal-install
+prs: #8676
+
+description: {
+    The --offline flag previously created in #2578 but was only implemented for the install command even thought the flag didn't throw an error whenever the build command was run. This PR adds functionality for the --offline flag with the build command.
+Additionally there is a new PackageTest for the flag using the build command.
+}