Add the --only-locals flag (closes #5272)

Author: snoyberg

ChangeLog.md

@@ -64,6 +64,9 @@ Other enhancements:
 * Allow relative paths in `--setup-info-yaml` and tool paths
   [#3394](https://github.com/commercialhaskell/stack/issues/3394)
 
+* Added the `--only-locals` flag. See
+  [#5272](https://github.com/commercialhaskell/stack/issues/5272)
+
 Bug fixes:
 
 * Upgrade `pantry`: module mapping insertions into the database are now atomic.

src/Stack/Build/ConstructPlan.hs

@@ -203,10 +203,11 @@ constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap
                 tasks = M.fromList $ mapMaybe toTask adrs
                 takeSubset =
                     case boptsCLIBuildSubset $ bcoBuildOptsCLI baseConfigOpts0 of
-                        BSAll -> id
-                        BSOnlySnapshot -> stripLocals
-                        BSOnlyDependencies -> stripNonDeps (M.keysSet $ smDeps sourceMap)
-            return $ takeSubset Plan
+                        BSAll -> pure
+                        BSOnlySnapshot -> pure . stripLocals
+                        BSOnlyDependencies -> pure . stripNonDeps (M.keysSet $ smDeps sourceMap)
+                        BSOnlyLocals -> errorOnSnapshot
+            takeSubset Plan
                 { planTasks = tasks
                 , planFinals = M.fromList finals
                 , planUnregisterLocal = mkUnregisterLocal tasks dirtyReason localDumpPkgs initialBuildSteps
@@ -267,6 +268,33 @@ constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap
             return $ PSFilePath lp
       return $ pPackages <> deps
 
+-- | Throw an exception if there are any snapshot packages in the plan.
+errorOnSnapshot :: Plan -> RIO env Plan
+errorOnSnapshot plan@(Plan tasks _finals _unregister installExes) = do
+  let snapTasks = Map.keys $ Map.filter (\t -> taskLocation t == Snap) tasks
+  let snapExes = Map.keys $ Map.filter (== Snap) installExes
+  unless (null snapTasks && null snapExes) $ throwIO $
+    NotOnlyLocal snapTasks snapExes
+  pure plan
+
+data NotOnlyLocal = NotOnlyLocal [PackageName] [Text]
+
+instance Show NotOnlyLocal where
+  show (NotOnlyLocal packages exes) = concat
+    [ "Specified only-locals, but I need to build snapshot contents:\n"
+    , if null packages then "" else concat
+        [ "Packages: "
+        , intercalate ", " (map packageNameString packages)
+        , "\n"
+        ]
+    , if null exes then "" else concat
+        [ "Executables: "
+        , intercalate ", " (map T.unpack exes)
+        , "\n"
+        ]
+    ]
+instance Exception NotOnlyLocal
+
 -- | State to be maintained during the calculation of local packages
 -- to unregister.
 data UnregisterState = UnregisterState

src/Stack/Options/BuildParser.hs

@@ -54,6 +54,11 @@ buildOptsParser cmd =
          (long "only-dependencies" <>
           help
               "Only build packages that are dependencies of targets on the command line") <|>
+     flag'
+         BSOnlyLocals
+         (long "only-locals" <>
+          help
+              "Only build packages in the local database, fail if the build plan includes the snapshot database") <|>
      pure BSAll) <*>
     (flag'
          FileWatch

src/Stack/Types/Config/Build.hs

@@ -339,6 +339,9 @@ data BuildSubset
     -- ^ Only install packages in the snapshot database, skipping
     -- packages intended for the local database.
     | BSOnlyDependencies
+    | BSOnlyLocals
+    -- ^ Refuse to build anything in the snapshot database, see
+    -- https://github.com/commercialhaskell/stack/issues/5272
     deriving (Show, Eq)
 
 -- | Options for the 'FinalAction' 'DoTests'

test/integration/tests/5272-only-locals/Main.hs

@@ -0,0 +1,11 @@
+import StackTest
+import Control.Monad (void)
+
+main :: IO ()
+main = do
+  void $ stack' ["exec", "ghc-pkg", "unregister", "unliftio-core"]
+  stack ["clean"]
+
+  stackErr ["build", "--only-locals"]
+  stack ["build", "--only-snapshot"]
+  stack ["build", "--only-locals"]

test/integration/tests/5272-only-locals/files/.gitignore

@@ -0,0 +1 @@
+foo.cabal

test/integration/tests/5272-only-locals/files/package.yaml

@@ -0,0 +1,9 @@
+name: foo
+version: 0.0.0
+
+dependencies:
+- base
+- unliftio-core
+
+library:
+    source-dirs: src/

test/integration/tests/5272-only-locals/files/src/Foo.hs

@@ -0,0 +1,3 @@
+module Foo () where
+
+import Control.Monad.IO.Unlift ()

test/integration/tests/5272-only-locals/files/stack.yaml

@@ -0,0 +1,5 @@
+resolver: ghc-8.6.5
+extra-deps:
+- unliftio-core-0.1.2.0@rev:2
+# Force a unique snapshot
+- acme-missiles-0.3@rev:0