haskell · mergify · Mar 9, 2023 · Jan 12, 2023 · Jan 12, 2023 · Jan 13, 2023
diff --git a/.vscode/tasks.json b/.vscode/tasks.json
@@ -0,0 +1,50 @@
+
+{
+  // Automatically created by phoityne-vscode extension.
+
+  "version": "2.0.0",
+  "presentation": {
+    "reveal": "always",
+    "panel": "new"
+  },
+  "tasks": [
+    {
+      // F7
+      "group": {
+        "kind": "build",
+        "isDefault": true
+      },
+      "label": "haskell build",
+      "type": "shell",
+      //"command": "cabal configure && cabal build"
+      "command": "stack build"
+    },
+    {
+      // F6
+      "group": "build",
+      "type": "shell",
+      "label": "haskell clean & build",
+      //"command": "cabal clean && cabal configure && cabal build"
+      "command": "stack clean && stack build"
+      //"command": "stack clean ; stack build"  // for powershell
+    },
+    {
+      // F8
+      "group": {
+        "kind": "test",
+        "isDefault": true
+      },
+      "type": "shell",
+      "label": "haskell test",
+      //"command": "cabal test"
+      "command": "stack test"
+    },
+    {
+      // F6
+      "isBackground": true,
+      "type": "shell",
+      "label": "haskell watch",
+      "command": "stack build --test --no-run-tests --file-watch"
+    }
+  ]
+}
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
@@ -579,7 +586,6 @@ rebuildTargets verbosity
                  buildSettingNumJobs,
                  buildSettingKeepGoing
                } = do
-
     -- Concurrency control: create the job controller and concurrency limits
     -- for downloading, building and installing.
     jobControl    <- if isParallelBuild
@@ -599,30 +605,33 @@ rebuildTargets verbosity
     createDirectoryIfMissingVerbose verbosity True distTempDirectory
     traverse_ (createPackageDBIfMissing verbosity compiler progdb) packageDBsToUse
 
-    -- Before traversing the install plan, preemptively find all packages that
-    -- will need to be downloaded and start downloading them.
-    asyncDownloadPackages verbosity withRepoCtx
-                          installPlan pkgsBuildStatus $ \downloadMap ->
-
-      -- For each package in the plan, in dependency order, but in parallel...
-      InstallPlan.execute jobControl keepGoing
-                          (BuildFailure Nothing . DependentFailed . packageId)
-                          installPlan $ \pkg ->
-        --TODO: review exception handling
-        handle (\(e :: BuildFailure) -> return (Left e)) $ fmap Right $
-
-        let uid = installedUnitId pkg
-            pkgBuildStatus = Map.findWithDefault (error "rebuildTargets") uid pkgsBuildStatus in
-
-        rebuildTarget
-          verbosity
-          distDirLayout
-          storeDirLayout
-          buildSettings downloadMap
-          registerLock cacheLock
-          sharedPackageConfig
-          installPlan pkg
-          pkgBuildStatus
+    if fromFlagOrDefault False (projectConfigOfflineMode config) && not (null packagesToDownload) then
+      return offlineError
+    else
+      -- Before traversing the install plan, preemptively find all packages that
+      -- will need to be downloaded and start downloading them.
+      asyncDownloadPackages verbosity withRepoCtx
+                            installPlan pkgsBuildStatus $ \downloadMap ->
+
+        -- For each package in the plan, in dependency order, but in parallel...
+        InstallPlan.execute jobControl keepGoing
+                            (BuildFailure Nothing . DependentFailed . packageId)
+                            installPlan $ \pkg ->
+          --TODO: review exception handling
+          handle (\(e :: BuildFailure) -> return (Left e)) $ fmap Right $
+
+          let uid = installedUnitId pkg
+              pkgBuildStatus = Map.findWithDefault (error "rebuildTargets") uid pkgsBuildStatus in
+
+          rebuildTarget
+            verbosity
+            distDirLayout
+            storeDirLayout
+            buildSettings downloadMap
+            registerLock cacheLock
+            sharedPackageConfig
+            installPlan pkg
+            pkgBuildStatus
   where
     isParallelBuild = buildSettingNumJobs >= 2
     keepGoing       = buildSettingKeepGoing
@@ -637,6 +646,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 = DownloadFailed . error $ makeError pkgName pkgVersion
+        }))
+        makeError :: PackageName -> Version -> String
+        makeError n v = "--offline was specified, could not download 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/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
@@ -399,6 +399,7 @@ runProjectBuildPhase verbosity
                      ProjectBaseContext{..} ProjectBuildContext {..} =
     fmap (Map.union (previousBuildOutcomes pkgsBuildStatus)) $
     rebuildTargets verbosity
+                   projectConfig
                    distDirLayout
                    (cabalStoreDirLayout cabalDirLayout)
                    elaboratedPlanToExecute

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

diff --git a/cabal-testsuite/PackageTests/MultipleLibraries/T7270/p/Main b/cabal-testsuite/PackageTests/MultipleLibraries/T7270/p/Main
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:         coltonclemmerdev@gmail.com
+-- 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,25 @@
+# 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)
+cabal: --offline was specified, could not download package remote version 0.1.0.0
+CallStack (from HasCallStack):
+<CABAL_ERROR>
+# 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:         coltonclemmerdev@gmail.com
+build-type:         Simple
+extra-doc-files:    CHANGELOG.md
+
+library
+  build-depends:       base
+  exposed-modules:     P
+  default-language:    Haskell2010
diff --git a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs
@@ -27,6 +27,7 @@ normalizeOutput nenv =
     -- Install path frequently has architecture specific elements, so
     -- nub it out
   . resub "Installing (.+) in .+" "Installing \\1 in <PATH>"
+  . resub "  error, called at .*" "<CABAL_ERROR>"
     -- Things that look like libraries
   . resub "libHS[A-Za-z0-9.-]+\\.(so|dll|a|dynlib)" "<LIBRARY>"
     -- look for PackageHash directories

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.
+}