From b29636213cccb0db2a68a8e7c216daedec370ab6 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Mon, 10 Aug 2015 14:25:19 +0300
Subject: [PATCH 01/20] Initial target parsing #651

---
 src/Stack/Build/Target.hs          | 308 +++++++++++++++++++++++++++++
 src/test/Stack/Build/TargetSpec.hs |  26 +++
 stack.cabal                        |   2 +
 3 files changed, 336 insertions(+)
 create mode 100644 src/Stack/Build/Target.hs
 create mode 100644 src/test/Stack/Build/TargetSpec.hs

diff --git a/src/Stack/Build/Target.hs b/src/Stack/Build/Target.hs
new file mode 100644
index 0000000000..28ebe8458d
--- /dev/null
+++ b/src/Stack/Build/Target.hs
@@ -0,0 +1,308 @@
+{-# LANGUAGE DataKinds          #-}
+{-# LANGUAGE GADTs              #-}
+{-# LANGUAGE KindSignatures     #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TupleSections      #-}
+{-# LANGUAGE ViewPatterns       #-}
+-- | Parsing command line targets
+module Stack.Build.Target
+    ( -- * Types
+      ComponentName
+    , NamedComponent (..)
+    , UnresolvedComponent (..)
+    , RawTarget (..)
+    , LocalPackageView (..)
+      -- * Parsers
+    , parseRawTarget
+    , parseTargets
+    ) where
+
+import           Control.Applicative
+import           Control.Arrow          (second)
+import           Control.Monad.Catch    (MonadThrow, throwM)
+import           Control.Monad.IO.Class
+import           Data.Either            (partitionEithers)
+import           Data.Map               (Map)
+import qualified Data.Map               as Map
+import           Data.Maybe             (mapMaybe)
+import           Data.Monoid            (mconcat)
+import           Data.Set               (Set)
+import qualified Data.Set               as Set
+import           Data.Text              (Text)
+import qualified Data.Text              as T
+import           Path
+import           Path.IO
+import           Stack.Types
+
+-- | The name of a component, which applies to executables, test suites, and benchmarks
+type ComponentName = Text
+
+newtype RawInput = RawInput { unRawInput :: Text }
+
+-- | A single, fully resolved component of a package
+data NamedComponent
+    = CLib
+    | CExe !ComponentName
+    | CTest !ComponentName
+    | CBench !ComponentName
+    deriving (Show, Eq, Ord)
+
+-- | Either a fully resolved component, or a component name that could be
+-- either an executable, test, or benchmark
+data UnresolvedComponent
+    = ResolvedComponent !NamedComponent
+    | UnresolvedComponent !ComponentName
+    deriving (Show, Eq, Ord)
+
+-- | Raw command line input, without checking against any databases or list of
+-- locals. Does not deal with directories
+data RawTarget (a :: RawTargetType) where
+    RTPackageComponent :: !PackageName -> !UnresolvedComponent -> RawTarget a
+    RTComponent :: !ComponentName -> RawTarget a
+    RTPackage :: !PackageName -> RawTarget a
+    RTPackageIdentifier :: !PackageIdentifier -> RawTarget HasIdents
+
+deriving instance Show (RawTarget a)
+deriving instance Eq (RawTarget a)
+deriving instance Ord (RawTarget a)
+
+data RawTargetType = HasIdents | NoIdents
+
+-- | If this function returns @Nothing@, the input should be treated as a
+-- directory.
+parseRawTarget :: Text -> Maybe (RawTarget HasIdents)
+parseRawTarget t =
+        (RTPackageIdentifier <$> parsePackageIdentifierFromString s)
+    <|> (RTPackage <$> parsePackageNameFromString s)
+    <|> (RTComponent <$> T.stripPrefix ":" t)
+    <|> parsePackageComponent
+  where
+    s = T.unpack t
+
+    parsePackageComponent =
+        case T.splitOn ":" t of
+            [pname, "lib"]
+                | Just pname' <- parsePackageNameFromString (T.unpack pname) ->
+                    Just $ RTPackageComponent pname' $ ResolvedComponent CLib
+            [pname, cname]
+                | Just pname' <- parsePackageNameFromString (T.unpack pname) ->
+                    Just $ RTPackageComponent pname' $ UnresolvedComponent cname
+            [pname, typ, cname]
+                | Just pname' <- parsePackageNameFromString (T.unpack pname)
+                , Just wrapper <- parseCompType typ ->
+                    Just $ RTPackageComponent pname' $ ResolvedComponent $ wrapper cname
+            _ -> Nothing
+
+    parseCompType t' =
+        case t' of
+            "exe" -> Just CExe
+            "test" -> Just CTest
+            "bench" -> Just CBench
+            _ -> Nothing
+
+-- | A view of a local package needed for resolving components
+data LocalPackageView = LocalPackageView
+    { lpvVersion    :: !Version
+    , lpvRoot       :: !(Path Abs Dir)
+    , lpvComponents :: !(Set NamedComponent)
+    }
+
+-- | Same as @parseRawTarget@, but also takes directories into account.
+parseRawTargetDirs :: (MonadIO m, MonadThrow m)
+                   => Path Abs Dir -- ^ current directory
+                   -> Map PackageName LocalPackageView
+                   -> Text
+                   -> m (Either Text [(RawInput, RawTarget HasIdents)])
+parseRawTargetDirs root locals t =
+    case parseRawTarget t of
+        Just rt -> return $ Right [(ri, rt)]
+        Nothing -> do
+            mdir <- resolveDirMaybe root $ T.unpack t
+            case mdir of
+                Nothing -> return $ Left $ "Directory not found: " `T.append` t
+                Just dir ->
+                    case mapMaybe (childOf dir) $ Map.toList locals of
+                        [] -> return $ Left $
+                            "No local directories found as children of " `T.append`
+                            t
+                        names -> return $ Right $ map ((ri, ) . RTPackage) names
+  where
+    ri = RawInput t
+
+    childOf dir (name, lpv) =
+        if dir == lpvRoot lpv || isParentOf dir (lpvRoot lpv)
+            then Just name
+            else Nothing
+
+data TargetType
+    = TTNonLocal
+    | TTLocalComp !NamedComponent
+    | TTLocalAllComps !(Set NamedComponent)
+
+resolveIdents :: Map PackageName Version -- ^ snapshot
+              -> Map PackageName Version -- ^ extra deps
+              -> Map PackageName LocalPackageView
+              -> (RawInput, RawTarget HasIdents)
+              -> Either Text ((RawInput, RawTarget NoIdents), Map PackageName Version)
+resolveIdents _ _ _ (ri, RTPackageComponent x y) = Right ((ri, RTPackageComponent x y), Map.empty)
+resolveIdents _ _ _ (ri, RTComponent x) = Right ((ri, RTComponent x), Map.empty)
+resolveIdents _ _ _ (ri, RTPackage x) = Right $ ((ri, RTPackage x), Map.empty)
+resolveIdents snap extras locals (ri, RTPackageIdentifier (PackageIdentifier name version)) =
+    case mfound of
+        Just (foundPlace, foundVersion) | foundVersion /= version -> Left $ T.pack $ concat
+            [ "Specified target version "
+            , versionString version
+            , " for package "
+            , packageNameString name
+            , " does not match "
+            , foundPlace
+            , " version "
+            , versionString foundVersion
+            ]
+        _ -> Right
+            ( (ri, RTPackage name)
+            , case mfound of
+                -- Add to extra deps since we didn't have it already
+                Nothing -> Map.singleton name version
+                -- Already had it, don't add to extra deps
+                Just _ -> Map.empty
+            )
+  where
+    mfound = mlocal <|> mextra <|> msnap
+
+    mlocal = (("local", ) . lpvVersion) <$> Map.lookup name locals
+    mextra = ("extra-deps", ) <$> Map.lookup name extras
+    msnap = ("snapshot", ) <$> Map.lookup name snap
+
+resolveRawTarget :: Map PackageName Version -- ^ snapshot
+                 -> Map PackageName Version -- ^ extra deps
+                 -> Map PackageName LocalPackageView
+                 -> (RawInput, RawTarget NoIdents)
+                 -> Either Text (PackageName, (RawInput, TargetType))
+resolveRawTarget snap extras locals (ri, rt) =
+    go rt
+  where
+    go (RTPackageComponent name ucomp) =
+        case Map.lookup name locals of
+            Nothing -> Left $ T.pack $ "Unknown local package: " ++ packageNameString name
+            Just lpv ->
+                case ucomp of
+                    ResolvedComponent comp
+                        | comp `Set.member` lpvComponents lpv ->
+                            Right (name, (ri, TTLocalComp comp))
+                        | otherwise -> Left $ T.pack $ concat
+                            [ "Component "
+                            , show comp
+                            , " does not exist in package "
+                            , packageNameString name
+                            ]
+                    UnresolvedComponent comp ->
+                        case filter (isCompNamed comp) $ Set.toList $ lpvComponents lpv of
+                            [] -> Left $ T.concat
+                                [ "Component "
+                                , comp
+                                , " does not exist in package "
+                                , T.pack $ packageNameString name
+                                ]
+                            [x] -> Right (name, (ri, TTLocalComp x))
+                            matches -> Left $ T.concat
+                                [ "Ambiguous component name "
+                                , comp
+                                , " for package "
+                                , T.pack $ packageNameString name
+                                , ": "
+                                , T.pack $ show matches
+                                ]
+    go (RTComponent cname) =
+        let allPairs = concatMap
+                (\(name, lpv) -> map (name,) $ Set.toList $ lpvComponents lpv)
+                (Map.toList locals)
+         in case filter (isCompNamed cname . snd) allPairs of
+                [] -> Left $ "Could not find a component named " `T.append` cname
+                [(name, comp)] ->
+                    Right (name, (ri, TTLocalComp comp))
+                matches -> Left $ T.concat
+                    [ "Ambiugous component name "
+                    , cname
+                    , ", matches: "
+                    , T.pack $ show matches
+                    ]
+
+    go (RTPackage name) =
+        case Map.lookup name locals of
+            Just lpv -> Right (name, (ri, TTLocalAllComps $ lpvComponents lpv))
+            Nothing ->
+                case Map.lookup name extras of
+                    Just _ -> Right (name, (ri, TTNonLocal))
+                    Nothing ->
+                        case Map.lookup name snap of
+                            Just _ -> Right (name, (ri, TTNonLocal))
+                            Nothing -> Left $ "Package not found in locals, extra deps, or snapshot: "
+                                `T.append` T.pack (packageNameString name)
+
+isCompNamed :: Text -> NamedComponent -> Bool
+isCompNamed _ CLib = False
+isCompNamed t1 (CExe t2) = t1 == t2
+isCompNamed t1 (CTest t2) = t1 == t2
+isCompNamed t1 (CBench t2) = t1 == t2
+
+simplifyTargets :: Bool -- ^ include tests
+                -> Bool -- ^ include benchmarks
+                -> [(PackageName, (RawInput, TargetType))]
+                -> ([Text], Map PackageName (Maybe (Set NamedComponent)))
+simplifyTargets includeTests includeBenches =
+    mconcat . map go . Map.toList . Map.fromListWith (++) . fmap (second return)
+  where
+    go :: (PackageName, [(RawInput, TargetType)])
+       -> ([Text], Map PackageName (Maybe (Set NamedComponent)))
+    go (_, []) = error "Stack.Build.Target.simplifyTargets: the impossible happened"
+    go (name, [(_, tt)]) = ([], Map.singleton name $
+        case tt of
+            TTNonLocal -> Nothing
+            TTLocalComp comp -> Just $ Set.singleton comp
+            TTLocalAllComps comps -> Just $ Set.filter keepComp comps
+        )
+    go (name, pairs) =
+        case partitionEithers $ map (getLocalComp . snd) pairs of
+            ([], comps) -> ([], Map.singleton name $ Just $ Set.fromList comps)
+            _ ->
+                let err = T.pack $ concat
+                        [ "Overlapping targets provided for package "
+                        , packageNameString name
+                        , ": "
+                        , show $ map (unRawInput . fst) pairs
+                        ]
+                 in ([err], Map.empty)
+
+    keepComp CLib = True
+    keepComp (CExe _) = True
+    keepComp (CTest _) = includeTests
+    keepComp (CBench _) = includeBenches
+
+    getLocalComp (TTLocalComp comp) = Right comp
+    getLocalComp _ = Left ()
+
+parseTargets :: (MonadThrow m, MonadIO m)
+             => Bool -- ^ include tests
+             -> Bool -- ^ include benchmarks
+             -> Map PackageName Version -- ^ snapshot
+             -> Map PackageName Version -- ^ extra deps
+             -> Map PackageName LocalPackageView
+             -> Path Abs Dir -- ^ current directory
+             -> [Text] -- ^ command line targets
+             -> m (Map PackageName Version, Map PackageName (Maybe (Set NamedComponent)))
+parseTargets includeTests includeBenches snap extras locals currDir textTargets = do
+    erawTargets <- mapM (parseRawTargetDirs currDir locals) textTargets
+
+    let (errs1, rawTargets) = partitionEithers erawTargets
+        (errs2, unzip -> (rawTargets', newExtras)) = partitionEithers $
+            map (resolveIdents snap extras locals) $ concat rawTargets
+        (errs3, targetTypes) = partitionEithers $
+            map (resolveRawTarget snap extras locals) rawTargets'
+        (errs4, targets) = simplifyTargets includeTests includeBenches targetTypes
+        errs = concat [errs1, errs2, errs3, errs4]
+
+    if null errs
+        then return (Map.unions newExtras, targets)
+        else throwM $ Couldn'tParseTargets errs
diff --git a/src/test/Stack/Build/TargetSpec.hs b/src/test/Stack/Build/TargetSpec.hs
new file mode 100644
index 0000000000..5cc420cf2f
--- /dev/null
+++ b/src/test/Stack/Build/TargetSpec.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+module Stack.Build.TargetSpec (main, spec) where
+
+import qualified Data.Text           as T
+import           Stack.Build.Target
+import           Stack.Types
+import           Test.Hspec
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = do
+    describe "parseRawTarget" $ do
+        let test s e = it s $ parseRawTarget (T.pack s) `shouldBe` e
+        test "foobar" $ Just $ RTPackage $(mkPackageName "foobar")
+        test "foobar-1.2.3" $ Just $ RTPackageIdentifier $ PackageIdentifier
+            $(mkPackageName "foobar") $(mkVersion "1.2.3")
+        test "./foobar" Nothing
+        test "foobar/" Nothing
+        test "/foobar" Nothing
+        test ":some-exe" $ Just $ RTComponent "some-exe"
+        test "foobar:some-exe" $ Just $ RTPackageComponent $(mkPackageName "foobar") $ UnresolvedComponent "some-exe"
+        test "foobar:exe:some-exe" $ Just $ RTPackageComponent $(mkPackageName "foobar")
+            $ ResolvedComponent $ CExe "some-exe"
diff --git a/stack.cabal b/stack.cabal
index 62d7b779e5..cb7a665966 100644
--- a/stack.cabal
+++ b/stack.cabal
@@ -79,6 +79,7 @@ library
                      Stack.Build.Haddock
                      Stack.Build.Installed
                      Stack.Build.Source
+                     Stack.Build.Target
                      Stack.Upgrade
                      Stack.Upload
                      System.Process.Read
@@ -219,6 +220,7 @@ test-suite stack-test
   other-modules:  Spec
                 , Stack.BuildPlanSpec
                 , Stack.Build.ExecuteSpec
+                , Stack.Build.TargetSpec
                 , Stack.ConfigSpec
                 , Stack.DotSpec
                 , Stack.PackageDumpSpec

From 14ce34e9fea3aeefd423f3ce7275f36bdc8459d5 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Mon, 10 Aug 2015 15:15:59 +0300
Subject: [PATCH 02/20] Start integrating new Target module with Source module

---
 src/Stack/Build/Source.hs | 50 ++++++++++++++++++++++++++++++++++++++-
 src/Stack/Build/Target.hs | 17 +++++++++----
 src/Stack/Types/Build.hs  |  5 ++++
 3 files changed, 67 insertions(+), 5 deletions(-)

diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs
index b64a19d4f4..9927b9b683 100644
--- a/src/Stack/Build/Source.hs
+++ b/src/Stack/Build/Source.hs
@@ -42,10 +42,15 @@ import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Data.Text (Text)
 import qualified Data.Text as T
+import           Distribution.Package (pkgName, pkgVersion)
+import           Distribution.PackageDescription (GenericPackageDescription, package, packageDescription)
+import qualified Distribution.PackageDescription as C
 import           Network.HTTP.Client.Conduit (HasHttpManager)
 import           Path
+import           Path.IO
 import           Prelude
 import           Stack.Build.Cache
+import           Stack.Build.Target
 import           Stack.Types.Build
 import           Stack.BuildPlan (loadMiniBuildPlan, shadowMiniBuildPlan,
                                   parseCustomMiniBuildPlan)
@@ -78,9 +83,22 @@ loadSourceMap bopts = do
             stackYamlFP <- asks $ bcStackYaml . getBuildConfig
             parseCustomMiniBuildPlan stackYamlFP url
 
+    rawLocals <- getLocalPackageViews
+    workingDir <- getWorkingDir
+    targetsFIXME <-
+        parseTargets
+            False -- include tests
+            False -- include benchmarks
+            (mpiVersion <$> mbpPackages mbp0)
+            (bcExtraDeps bconfig)
+            (fst <$> rawLocals)
+            workingDir
+            (boptsTargets bopts)
+    _ <- error $ show targetsFIXME
+
     menv <- getMinimalEnvOverride
     caches <- getPackageCaches menv
-    let latestVersion = Map.fromList $ map toTuple $ Map.keys caches
+    let latestVersion = Map.fromListWith max $ map toTuple $ Map.keys caches
     (locals, extraNames, extraIdents) <- loadLocals bopts latestVersion
 
     let
@@ -138,6 +156,36 @@ loadSourceMap bopts = do
 
     return (mbp, locals, nonLocalTargets, sourceMap)
 
+-- | Parse out the local package views for the current project
+getLocalPackageViews :: (MonadThrow m, MonadIO m, MonadReader env m, HasEnvConfig env)
+                     => m (Map PackageName (LocalPackageView, GenericPackageDescription))
+getLocalPackageViews = do
+    econfig <- asks getEnvConfig
+    -- TODO ensure that there are no overlapping package names
+    liftM Map.fromList $ forM (Map.toList $ envConfigPackages econfig) $ \(dir, validWanted) -> do
+        cabalfp <- getCabalFileName dir
+        gpkg <- readPackageUnresolved cabalfp
+        let cabalID = package $ packageDescription gpkg
+        name <- parsePackageNameFromFilePath cabalfp
+        when (fromCabalPackageName (pkgName $ cabalID) /= name)
+            $ throwM $ MismatchedCabalName cabalfp name
+        let lpv = LocalPackageView
+                { lpvVersion = fromCabalVersion $ pkgVersion cabalID
+                , lpvRoot = dir
+                , lpvExtraDep = not validWanted
+                , lpvComponents = getNamedComponents gpkg
+                }
+        return (name, (lpv, gpkg))
+  where
+    getNamedComponents gpkg = Set.fromList $ concat
+        [ maybe [] (const [CLib]) (C.condLibrary gpkg)
+        , go CExe  C.condExecutables
+        , go CTest C.condTestSuites
+        , go CBench C.condBenchmarks
+        ]
+      where
+        go wrapper f = map (wrapper . T.pack . fst) $ f gpkg
+
 -- | 'loadLocals' combines two pieces of information:
 --
 -- 1. Targets, i.e. arguments passed to stack such as @foo@ and @bar@ in the @stack foo bar@ invocation
diff --git a/src/Stack/Build/Target.hs b/src/Stack/Build/Target.hs
index 28ebe8458d..0b90bc0cdb 100644
--- a/src/Stack/Build/Target.hs
+++ b/src/Stack/Build/Target.hs
@@ -106,6 +106,7 @@ data LocalPackageView = LocalPackageView
     { lpvVersion    :: !Version
     , lpvRoot       :: !(Path Abs Dir)
     , lpvComponents :: !(Set NamedComponent)
+    , lpvExtraDep   :: !Bool
     }
 
 -- | Same as @parseRawTarget@, but also takes directories into account.
@@ -131,7 +132,7 @@ parseRawTargetDirs root locals t =
     ri = RawInput t
 
     childOf dir (name, lpv) =
-        if dir == lpvRoot lpv || isParentOf dir (lpvRoot lpv)
+        if (dir == lpvRoot lpv || isParentOf dir (lpvRoot lpv)) && not (lpvExtraDep lpv)
             then Just name
             else Nothing
 
@@ -292,7 +293,11 @@ parseTargets :: (MonadThrow m, MonadIO m)
              -> Path Abs Dir -- ^ current directory
              -> [Text] -- ^ command line targets
              -> m (Map PackageName Version, Map PackageName (Maybe (Set NamedComponent)))
-parseTargets includeTests includeBenches snap extras locals currDir textTargets = do
+parseTargets includeTests includeBenches snap extras locals currDir textTargets' = do
+    let textTargets =
+            if null textTargets'
+                then map (T.pack . packageNameString) $ Map.keys locals
+                else textTargets'
     erawTargets <- mapM (parseRawTargetDirs currDir locals) textTargets
 
     let (errs1, rawTargets) = partitionEithers erawTargets
@@ -304,5 +309,9 @@ parseTargets includeTests includeBenches snap extras locals currDir textTargets
         errs = concat [errs1, errs2, errs3, errs4]
 
     if null errs
-        then return (Map.unions newExtras, targets)
-        else throwM $ Couldn'tParseTargets errs
+        then if Map.null targets
+                 -- TODO perhaps check if we're using the implicit global and,
+                 -- if so, recommend running stack init/new?
+                 then throwM $ TargetParseException ["The specified targets matched no packages"]
+                 else return (Map.unions newExtras, targets)
+        else throwM $ TargetParseException errs
diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs
index bbd2894184..fbbc0060f1 100644
--- a/src/Stack/Types/Build.hs
+++ b/src/Stack/Types/Build.hs
@@ -103,6 +103,7 @@ data StackBuildException
         Version -- version specified on command line
   | NoSetupHsFound (Path Abs Dir)
   | InvalidFlagSpecification (Set UnusedFlags)
+  | TargetParseException [Text]
   deriving Typeable
 
 data FlagSource = FSCommandLine | FSStackYaml
@@ -270,6 +271,10 @@ instance Show StackBuildException where
             ]
           where name = packageNameString (packageName pkg)
                 pkgFlags = packageDefinedFlags pkg
+    show (TargetParseException [err]) = "Error parsing targets: " ++ T.unpack err
+    show (TargetParseException errs) = unlines
+        $ "The following errors occurred while parsing the build targets:"
+        : map (("- " ++) . T.unpack) errs
 
 instance Exception StackBuildException
 

From 3ed6e4c63a8bc928ae02f935c0f468dcba43ceba Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Mon, 10 Aug 2015 15:43:56 +0300
Subject: [PATCH 03/20] Switch command line arguments as per #651

---
 src/Stack/Build.hs               |  2 +-
 src/Stack/Build/ConstructPlan.hs |  4 ++-
 src/Stack/Build/Execute.hs       | 39 ++++++++---------------------
 src/Stack/Build/Source.hs        | 13 ++++------
 src/Stack/Options.hs             | 33 ++++++++++++++++++------
 src/Stack/Types/Build.hs         | 35 +++++++++++++++++++-------
 src/main/Main.hs                 | 43 +++++++++++++-------------------
 7 files changed, 89 insertions(+), 80 deletions(-)

diff --git a/src/Stack/Build.hs b/src/Stack/Build.hs
index 9bc32b76bf..bac962cb10 100644
--- a/src/Stack/Build.hs
+++ b/src/Stack/Build.hs
@@ -97,7 +97,7 @@ build setLocalFiles mbuildLk bopts = do
         preFetch plan
 
     if boptsDryrun bopts
-        then printPlan (boptsFinalAction bopts) plan
+        then printPlan plan
         else executePlan menv bopts baseConfigOpts locals sourceMap plan
   where
     profiling = boptsLibProfile bopts || boptsExeProfile bopts
diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs
index 6a62b33b70..0fad2f3ead 100644
--- a/src/Stack/Build/ConstructPlan.hs
+++ b/src/Stack/Build/ConstructPlan.hs
@@ -121,10 +121,12 @@ constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 locallyRegistered loadPa
     let latest = Map.fromListWith max $ map toTuple $ Map.keys caches
 
     econfig <- asks getEnvConfig
-    let onWanted =
+    let onWanted = error "constructPlan.onWanted"
+        {-
             case boptsFinalAction $ bcoBuildOpts baseConfigOpts0 of
                 DoNothing -> void . addDep . packageName . lpPackage
                 _ -> addFinal
+                -}
     let inner = do
             mapM_ onWanted $ filter lpWanted locals
             mapM_ addDep $ Set.toList extraToBuild0
diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs
index 42440250ae..acffcffbe5 100644
--- a/src/Stack/Build/Execute.hs
+++ b/src/Stack/Build/Execute.hs
@@ -105,10 +105,9 @@ preFetch plan
                 (packageVersion package)
 
 printPlan :: M env m
-          => FinalAction
-          -> Plan
+          => Plan
           -> m ()
-printPlan finalAction plan = do
+printPlan plan = do
     case Map.toList $ planUnregisterLocal plan of
         [] -> $logInfo "No packages would be unregistered."
         xs -> do
@@ -128,22 +127,6 @@ printPlan finalAction plan = do
             $logInfo "Would build:"
             mapM_ ($logInfo . displayTask) xs
 
-    let mfinalLabel =
-            case finalAction of
-                DoNothing -> Nothing
-                DoBenchmarks _ -> Just "benchmark"
-                DoTests _ -> Just "test"
-    case mfinalLabel of
-        Nothing -> return ()
-        Just finalLabel -> do
-            $logInfo ""
-
-            case Map.toList $ planFinals plan of
-                [] -> $logInfo $ "Nothing to " <> finalLabel <> "."
-                xs -> do
-                    $logInfo $ "Would " <> finalLabel <> ":"
-                    forM_ xs $ \(name, _) -> $logInfo $ packageNameText name
-
     $logInfo ""
 
     case Map.toList $ planInstallExes plan of
@@ -356,14 +339,11 @@ executePlan' plan ee@ExecuteEnv {..} = do
     let keepGoing =
             case boptsKeepGoing eeBuildOpts of
                 Just kg -> kg
-                Nothing ->
-                    case boptsFinalAction eeBuildOpts of
-                        DoNothing -> False
-                        _ -> True
+                Nothing -> boptsTests eeBuildOpts || boptsBenchmarks eeBuildOpts
         concurrentFinal =
-            case boptsFinalAction eeBuildOpts of
-                DoTests _ -> concurrentTests
-                _ -> True
+            if boptsTests eeBuildOpts
+                then concurrentTests
+                else True
     terminal <- asks getTerminal
     errs <- liftIO $ runActions threads keepGoing concurrentFinal actions $ \doneVar -> do
         let total = length actions
@@ -386,9 +366,7 @@ executePlan' plan ee@ExecuteEnv {..} = do
         generateLocalHaddockIndex eeEnvOverride eeBaseConfigOpts eeLocals
         generateDepsHaddockIndex eeEnvOverride eeBaseConfigOpts eeLocals
         generateSnapHaddockIndex eeEnvOverride eeBaseConfigOpts eeGlobalDB
-    case boptsFinalAction eeBuildOpts of
-        DoTests topts | toCoverage topts -> generateHpcMarkupIndex
-        _ -> return ()
+    when (toCoverage $ boptsTestOpts eeBuildOpts) generateHpcMarkupIndex
 
 toActions :: M env m
           => (m () -> IO ())
@@ -396,6 +374,8 @@ toActions :: M env m
           -> (Maybe Task, Maybe Task) -- build and final
           -> [Action]
 toActions runInBase ee (mbuild, mfinal) =
+    error "toActions"
+    {-
     abuild ++ afinal
   where
     abuild =
@@ -441,6 +421,7 @@ toActions runInBase ee (mbuild, mfinal) =
         case taskType task of
             TTLocal lp -> not $ Set.null $ packageBenchmarks $ lpPackage lp
             _ -> assert False False
+    -}
 
 -- | Ensure that the configuration for the package matches what is given
 ensureConfig :: M env m
diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs
index 9927b9b683..86207f0204 100644
--- a/src/Stack/Build/Source.hs
+++ b/src/Stack/Build/Source.hs
@@ -87,8 +87,8 @@ loadSourceMap bopts = do
     workingDir <- getWorkingDir
     targetsFIXME <-
         parseTargets
-            False -- include tests
-            False -- include benchmarks
+            (boptsTests bopts)
+            (boptsBenchmarks bopts)
             (mpiVersion <$> mbpPackages mbp0)
             (bcExtraDeps bconfig)
             (fst <$> rawLocals)
@@ -240,12 +240,9 @@ loadLocals bopts latestVersion = do
                 }
             configFinal = config
                 { packageConfigEnableTests =
-                    case boptsFinalAction bopts of
-                        DoTests _ -> wanted
-                        _ -> False
-                , packageConfigEnableBenchmarks = wanted && case boptsFinalAction bopts of
-                                                              (DoBenchmarks _) -> True
-                                                              _ -> False
+                    error "FIXME packageConfigEnableTests"
+                , packageConfigEnableBenchmarks =
+                    error "FIXME packageConfigEnableBenchmarks"
                 }
         pkg <- readPackage config cabalfp
         pkgFinal <- readPackage configFinal cabalfp
diff --git a/src/Stack/Options.hs b/src/Stack/Options.hs
index bd617fc651..eeb1240b66 100644
--- a/src/Stack/Options.hs
+++ b/src/Stack/Options.hs
@@ -46,6 +46,7 @@ data Command
     | Test
     | Haddock
     | Bench
+    | Install
     deriving (Eq)
 
 -- | Parser for bench arguments.
@@ -56,16 +57,24 @@ benchOptsParser = BenchmarkOpts
                                  help ("Forward BENCH_ARGS to the benchmark suite. " <>
                                        "Supports templates from `cabal bench`")))
 
+addCoverageFlags :: BuildOpts -> BuildOpts
+addCoverageFlags bopts
+    | toCoverage $ boptsTestOpts bopts
+        = bopts { boptsGhcOptions = "-fhpc" : boptsGhcOptions bopts }
+    | otherwise = bopts
+
 -- | Parser for build arguments.
 buildOptsParser :: Command
-                -> Bool -- ^ default copy-bins value
                 -> Parser BuildOpts
-buildOptsParser cmd defCopyBins =
+buildOptsParser cmd =
+            fmap addCoverageFlags $
             BuildOpts <$> target <*> libProfiling <*> exeProfiling <*>
-            optimize <*> haddock <*> haddockDeps <*> finalAction <*> dryRun <*> ghcOpts <*>
+            optimize <*> haddock <*> haddockDeps <*> dryRun <*> ghcOpts <*>
             flags <*> copyBins <*> preFetch <*>
             ((||) <$> onlySnapshot <*> onlyDependencies) <*>
-            fileWatch' <*> keepGoing <*> forceDirty
+            fileWatch' <*> keepGoing <*> forceDirty <*>
+            tests <*> testOptsParser <*>
+            benches <*> benchOptsParser
   where optimize =
           maybeBoolFlags "optimizations" "optimizations for TARGETs and all its dependencies" idm
         target =
@@ -86,7 +95,7 @@ buildOptsParser cmd defCopyBins =
         haddock =
           boolFlags (cmd == Haddock)
                     "haddock"
-                    "building Haddocks"
+                    "generating Haddocks the project(s) in this directory/configuration"
                     idm
         haddockDeps =
           if cmd == Haddock
@@ -95,9 +104,8 @@ buildOptsParser cmd defCopyBins =
                             "building Haddocks for dependencies"
                             idm
              else pure Nothing
-        finalAction = pure DoNothing
 
-        copyBins = boolFlags defCopyBins
+        copyBins = boolFlags (cmd == Install)
             "copy-bins"
             "copying binaries to the local-bin-path (see 'stack path')"
             idm
@@ -145,6 +153,17 @@ buildOptsParser cmd defCopyBins =
             (long "force-dirty" <>
              help "Force treating all local packages as having dirty files (useful for cases where stack can't detect a file change)")
 
+
+        tests = boolFlags (cmd == Test)
+            "test"
+            "testing the project(s) in this directory/configuration"
+            idm
+
+        benches = boolFlags (cmd == Bench)
+            "bench"
+            "benchmarking the project(s) in this directory/configuration"
+            idm
+
 -- | Parser for package:[-]flag
 readFlag :: ReadM (Map (Maybe PackageName) (Map FlagName Bool))
 readFlag = do
diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs
index fbbc0060f1..4878c298e0 100644
--- a/src/Stack/Types/Build.hs
+++ b/src/Stack/Types/Build.hs
@@ -25,7 +25,6 @@ module Stack.Types.Build
     ,Plan(..)
     ,TestOpts(..)
     ,BenchmarkOpts(..)
-    ,FinalAction(..)
     ,BuildOpts(..)
     ,defaultBuildOpts
     ,TaskType(..)
@@ -350,7 +349,6 @@ data BuildOpts =
             -- ^ Build haddocks?
             ,boptsHaddockDeps :: !(Maybe Bool)
             -- ^ Build haddocks for dependencies?
-            ,boptsFinalAction :: !FinalAction
             ,boptsDryrun :: !Bool
             ,boptsGhcOptions :: ![Text]
             ,boptsFlags :: !(Map (Maybe PackageName) (Map FlagName Bool))
@@ -367,6 +365,16 @@ data BuildOpts =
             -- ^ Keep building/running after failure
             ,boptsForceDirty :: !Bool
             -- ^ Force treating all local packages as having dirty files
+
+            ,boptsTests :: !Bool
+            -- ^ Turn on tests for local targets
+            ,boptsTestOpts :: !TestOpts
+            -- ^ Additional test arguments
+
+            ,boptsBenchmarks :: !Bool
+            -- ^ Turn on benchmarks for local targets
+            ,boptsBenchmarkOpts :: !BenchmarkOpts
+            -- ^ Additional test arguments
             }
   deriving (Show)
 
@@ -378,7 +386,6 @@ defaultBuildOpts = BuildOpts
     , boptsEnableOptimizations = Nothing
     , boptsHaddock = False
     , boptsHaddockDeps = Nothing
-    , boptsFinalAction = DoNothing
     , boptsDryrun = False
     , boptsGhcOptions = []
     , boptsFlags = Map.empty
@@ -388,6 +395,10 @@ defaultBuildOpts = BuildOpts
     , boptsFileWatch = False
     , boptsKeepGoing = Nothing
     , boptsForceDirty = False
+    , boptsTests = False
+    , boptsTestOpts = defaultTestOpts
+    , boptsBenchmarks = False
+    , boptsBenchmarkOpts = defaultBenchmarkOpts
     }
 
 -- | Options for the 'FinalAction' 'DoTests'
@@ -398,17 +409,23 @@ data TestOpts =
            ,toDisableRun :: !Bool -- ^ Disable running of tests
            } deriving (Eq,Show)
 
+defaultTestOpts :: TestOpts
+defaultTestOpts = TestOpts
+    { toRerunTests = True
+    , toAdditionalArgs = []
+    , toCoverage = False
+    , toDisableRun = False
+    }
+
 -- | Options for the 'FinalAction' 'DoBenchmarks'
 data BenchmarkOpts =
   BenchmarkOpts {beoAdditionalArgs :: !(Maybe String) -- ^ Arguments passed to the benchmark program
                 } deriving (Eq,Show)
 
--- | Run a Setup.hs action after building a package, before installing.
-data FinalAction
-  = DoTests TestOpts
-  | DoBenchmarks BenchmarkOpts
-  | DoNothing
-  deriving (Eq,Show)
+defaultBenchmarkOpts :: BenchmarkOpts
+defaultBenchmarkOpts = BenchmarkOpts
+    { beoAdditionalArgs = Nothing
+    }
 
 -- | Package dependency oracle.
 newtype PkgDepsOracle =
diff --git a/src/main/Main.hs b/src/main/Main.hs
index 90a31dfd13..00ce0c17fc 100644
--- a/src/main/Main.hs
+++ b/src/main/Main.hs
@@ -151,32 +151,28 @@ main = withInterpreterArgs stackProgName $ \args isInterpreter -> fixCodePage $
           globalOptsParser isTerminal)
          (do addCommand "build"
                         "Build the project(s) in this directory/configuration"
-                        (buildCmd DoNothing)
-                        (buildOptsParser Build False)
+                        buildCmd
+                        (buildOptsParser Build)
              addCommand "install"
-                        "Identical to 'build --copy-bins', not actually a managed installation tool!"
+                        "Shortcut for 'build --copy-bins'"
                         installCmd
-                        (buildOptsParser Build True)
+                        (buildOptsParser Install)
              addCommand "uninstall"
                         "DEPRECATED: This command performs no actions, and is present for documentation only"
                         uninstallCmd
                         (many $ strArgument $ metavar "IGNORED")
              addCommand "test"
-                        "Build and test the project(s) in this directory/configuration"
-                        (\(bopts, topts) ->
-                             let bopts' = if toCoverage topts
-                                             then bopts { boptsGhcOptions = "-fhpc" : boptsGhcOptions bopts}
-                                             else bopts
-                             in buildCmd (DoTests topts) bopts')
-                        ((,) <$> buildOptsParser Test False <*> testOptsParser)
+                        "Shortcut for 'build --test'"
+                        buildCmd
+                        (buildOptsParser Test)
              addCommand "bench"
-                        "Build and benchmark the project(s) in this directory/configuration"
-                        (\(bopts, beopts) -> buildCmd (DoBenchmarks beopts) bopts)
-                        ((,) <$> buildOptsParser Bench False <*> benchOptsParser)
+                        "Shortcut for 'build --bench'"
+                        buildCmd
+                        (buildOptsParser Bench)
              addCommand "haddock"
-                        "Generate haddocks for the project(s) in this directory/configuration"
-                        (buildCmd DoNothing)
-                        (buildOptsParser Haddock False)
+                        "Shortcut for 'build --haddock'"
+                        buildCmd
+                        (buildOptsParser Haddock)
              addCommand "new"
                         "Create a brand new project"
                         newCmd
@@ -666,31 +662,28 @@ cleanCmd () go = withBuildConfigAndLock go (\_ -> clean)
 
 -- | Helper for build and install commands
 buildCmdHelper :: StackT EnvConfig IO () -- ^ do before build
-               -> FinalAction -> BuildOpts -> GlobalOpts -> IO ()
-buildCmdHelper beforeBuild finalAction opts go
+               -> BuildOpts -> GlobalOpts -> IO ()
+buildCmdHelper beforeBuild opts go
     | boptsFileWatch opts = fileWatch inner
     | otherwise = inner $ const $ return ()
   where
     inner setLocalFiles = withBuildConfigAndLock go $ \lk -> do
         beforeBuild
-        Stack.Build.build setLocalFiles (Just lk) opts { boptsFinalAction = finalAction }
+        Stack.Build.build setLocalFiles (Just lk) opts
 
 -- | Build the project.
-buildCmd :: FinalAction -> BuildOpts -> GlobalOpts -> IO ()
+buildCmd :: BuildOpts -> GlobalOpts -> IO ()
 buildCmd = buildCmdHelper (return ())
 
 -- | Install
 installCmd :: BuildOpts -> GlobalOpts -> IO ()
 installCmd =
-    buildCmdHelper warning DoNothing
+    buildCmdHelper warning
   where
     warning = do
         $logInfo "NOTE: the install command will copy executables to a destination directory"
         $logInfo "It is functionally equivalent to the --copy-bins option"
 
-copyCmd :: BuildOpts -> GlobalOpts -> IO ()
-copyCmd opts = buildCmdHelper (return ()) DoNothing opts { boptsInstallExes = True }
-
 uninstallCmd :: [String] -> GlobalOpts -> IO ()
 uninstallCmd _ go = withConfigAndLock go $ do
     $logError "stack does not manage installations in global locations"

From 1b8e2aaaf9ee5a16286ab51adf0580fbfeb8d848 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Mon, 10 Aug 2015 16:12:35 +0300
Subject: [PATCH 04/20] Properly extend extra deps

---
 src/Stack/Build/Source.hs | 76 +++++++++++++++++++--------------------
 src/Stack/Build/Target.hs | 28 +++++++++------
 2 files changed, 55 insertions(+), 49 deletions(-)

diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs
index 86207f0204..ae767cbf29 100644
--- a/src/Stack/Build/Source.hs
+++ b/src/Stack/Build/Source.hs
@@ -30,7 +30,6 @@ import           Data.Conduit (($$), ZipSink (..))
 import qualified Data.Conduit.Binary as CB
 import qualified Data.Conduit.List as CL
 import           Data.Either
-import qualified Data.Foldable as F
 import           Data.Function
 import qualified Data.HashSet as HashSet
 import           Data.List
@@ -85,7 +84,7 @@ loadSourceMap bopts = do
 
     rawLocals <- getLocalPackageViews
     workingDir <- getWorkingDir
-    targetsFIXME <-
+    (cliExtraDeps, targets) <-
         parseTargets
             (boptsTests bopts)
             (boptsBenchmarks bopts)
@@ -94,12 +93,22 @@ loadSourceMap bopts = do
             (fst <$> rawLocals)
             workingDir
             (boptsTargets bopts)
-    _ <- error $ show targetsFIXME
 
     menv <- getMinimalEnvOverride
     caches <- getPackageCaches menv
     let latestVersion = Map.fromListWith max $ map toTuple $ Map.keys caches
-    (locals, extraNames, extraIdents) <- loadLocals bopts latestVersion
+
+    -- Extend extra-deps to encompass targets requested on the command line
+    -- that are not in the snapshot.
+    extraDeps0 <- extendExtraDeps
+        (bcExtraDeps bconfig)
+        cliExtraDeps
+        (Map.keysSet $ Map.filter (== STUnknown) targets)
+        latestVersion
+
+    _ <- error $ show (extraDeps0, targets)
+
+    (locals, extraNames, extraIdents) <- loadLocals bopts latestVersion -- FIXME remove
 
     let
         -- loadLocals returns PackageName (foo) and PackageIdentifier (bar-1.2.3) targets separately;
@@ -108,15 +117,6 @@ loadSourceMap bopts = do
         nonLocalTargets :: Set PackageName
         nonLocalTargets = extraNames <> Set.map packageIdentifierName extraIdents
 
-        -- Extend extra-deps to encompass targets requested on the command line
-        -- that are not in the snapshot.
-        extraDeps0 = extendExtraDeps
-            (bcExtraDeps bconfig)
-            mbp0
-            latestVersion
-            extraNames
-            extraIdents
-
     let shadowed = Set.fromList (map (packageName . lpPackage) locals)
                 <> Map.keysSet extraDeps0
         (mbp, extraDeps1) = shadowMiniBuildPlan mbp0 shadowed
@@ -376,36 +376,34 @@ localFlags boptsflags bconfig name = Map.unions
 
 -- | Add in necessary packages to extra dependencies
 --
--- See https://github.com/commercialhaskell/stack/issues/272 for the requirements of this function
-extendExtraDeps :: Map PackageName Version -- ^ original extra deps
-                -> MiniBuildPlan
+-- Originally part of https://github.com/commercialhaskell/stack/issues/272,
+-- this was then superseded by
+-- https://github.com/commercialhaskell/stack/issues/651
+extendExtraDeps :: (MonadThrow m, MonadReader env m, HasBuildConfig env)
+                => Map PackageName Version -- ^ original extra deps
+                -> Map PackageName Version -- ^ package identifiers from the command line
+                -> Set PackageName -- ^ all packages added on the command line
                 -> Map PackageName Version -- ^ latest versions in indices
-                -> Set PackageName -- ^ extra package names desired
-                -> Set PackageIdentifier -- ^ extra package identifiers desired
-                -> Map PackageName Version -- ^ new extradeps
-extendExtraDeps extraDeps0 mbp latestVersion extraNames extraIdents =
-    F.foldl' addIdent
-        (F.foldl' addName extraDeps0 extraNames)
-        extraIdents
+                -> m (Map PackageName Version) -- ^ new extradeps
+extendExtraDeps extraDeps0 cliExtraDeps unknowns latestVersion
+    | null errs = return $ Map.unions $ extraDeps1 : unknowns'
+    | otherwise = do
+        bconfig <- asks getBuildConfig
+        throwM $ UnknownTargets
+            (Set.fromList errs)
+            Map.empty -- TODO check the cliExtraDeps for presence in index
+            (bcStackYaml bconfig)
   where
-    snapshot = fmap mpiVersion $ mbpPackages mbp
+    extraDeps1 = Map.union extraDeps0 cliExtraDeps
 
-    addName m name =
-        case Map.lookup name m <|> Map.lookup name snapshot of
-            -- alright exists in snapshot or extra-deps
-            Just _ -> m
+    (errs, unknowns') = partitionEithers $ map addUnknown $ Set.toList unknowns
+    addUnknown pn =
+        case Map.lookup pn extraDeps1 of
+            Just _ -> Right Map.empty
             Nothing ->
-                case Map.lookup name latestVersion of
-                    -- use the latest version in the index
-                    Just v -> Map.insert name v m
-                    -- does not exist, will be reported as an error
-                    Nothing -> m
-
-    addIdent m (PackageIdentifier name version) =
-        case Map.lookup name snapshot of
-            -- the version matches what's in the snapshot, so just use the snapshot version
-            Just version' | version == version' -> m
-            _ -> Map.insert name version m
+                case Map.lookup pn latestVersion of
+                    Just v -> Right $ Map.singleton pn v
+                    Nothing -> Left pn
 
 -- | Compare the current filesystem state to the cached information, and
 -- determine (1) if the files are dirty, and (2) the new cache values.
diff --git a/src/Stack/Build/Target.hs b/src/Stack/Build/Target.hs
index 0b90bc0cdb..559d5cd1f0 100644
--- a/src/Stack/Build/Target.hs
+++ b/src/Stack/Build/Target.hs
@@ -13,6 +13,7 @@ module Stack.Build.Target
     , UnresolvedComponent (..)
     , RawTarget (..)
     , LocalPackageView (..)
+    , SimpleTarget (..)
       -- * Parsers
     , parseRawTarget
     , parseTargets
@@ -137,10 +138,17 @@ parseRawTargetDirs root locals t =
             else Nothing
 
 data TargetType
-    = TTNonLocal
+    = TTUnknown
+    | TTNonLocal
     | TTLocalComp !NamedComponent
     | TTLocalAllComps !(Set NamedComponent)
 
+data SimpleTarget
+    = STUnknown
+    | STNonLocal
+    | STLocal !(Set NamedComponent)
+    deriving (Show, Eq, Ord)
+
 resolveIdents :: Map PackageName Version -- ^ snapshot
               -> Map PackageName Version -- ^ extra deps
               -> Map PackageName LocalPackageView
@@ -239,8 +247,7 @@ resolveRawTarget snap extras locals (ri, rt) =
                     Nothing ->
                         case Map.lookup name snap of
                             Just _ -> Right (name, (ri, TTNonLocal))
-                            Nothing -> Left $ "Package not found in locals, extra deps, or snapshot: "
-                                `T.append` T.pack (packageNameString name)
+                            Nothing -> Right (name, (ri, TTUnknown))
 
 isCompNamed :: Text -> NamedComponent -> Bool
 isCompNamed _ CLib = False
@@ -251,22 +258,23 @@ isCompNamed t1 (CBench t2) = t1 == t2
 simplifyTargets :: Bool -- ^ include tests
                 -> Bool -- ^ include benchmarks
                 -> [(PackageName, (RawInput, TargetType))]
-                -> ([Text], Map PackageName (Maybe (Set NamedComponent)))
+                -> ([Text], Map PackageName SimpleTarget)
 simplifyTargets includeTests includeBenches =
     mconcat . map go . Map.toList . Map.fromListWith (++) . fmap (second return)
   where
     go :: (PackageName, [(RawInput, TargetType)])
-       -> ([Text], Map PackageName (Maybe (Set NamedComponent)))
+       -> ([Text], Map PackageName SimpleTarget)
     go (_, []) = error "Stack.Build.Target.simplifyTargets: the impossible happened"
     go (name, [(_, tt)]) = ([], Map.singleton name $
         case tt of
-            TTNonLocal -> Nothing
-            TTLocalComp comp -> Just $ Set.singleton comp
-            TTLocalAllComps comps -> Just $ Set.filter keepComp comps
+            TTUnknown -> STUnknown
+            TTNonLocal -> STNonLocal
+            TTLocalComp comp -> STLocal $ Set.singleton comp
+            TTLocalAllComps comps -> STLocal $ Set.filter keepComp comps
         )
     go (name, pairs) =
         case partitionEithers $ map (getLocalComp . snd) pairs of
-            ([], comps) -> ([], Map.singleton name $ Just $ Set.fromList comps)
+            ([], comps) -> ([], Map.singleton name $ STLocal $ Set.fromList comps)
             _ ->
                 let err = T.pack $ concat
                         [ "Overlapping targets provided for package "
@@ -292,7 +300,7 @@ parseTargets :: (MonadThrow m, MonadIO m)
              -> Map PackageName LocalPackageView
              -> Path Abs Dir -- ^ current directory
              -> [Text] -- ^ command line targets
-             -> m (Map PackageName Version, Map PackageName (Maybe (Set NamedComponent)))
+             -> m (Map PackageName Version, Map PackageName SimpleTarget)
 parseTargets includeTests includeBenches snap extras locals currDir textTargets' = do
     let textTargets =
             if null textTargets'

From 750856b0b9184050f97c6f3b90084d03b1a67db0 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Mon, 10 Aug 2015 18:52:12 +0300
Subject: [PATCH 05/20] Uniform option synonym message

---
 src/main/Main.hs | 39 +++++++++++++++++----------------------
 1 file changed, 17 insertions(+), 22 deletions(-)

diff --git a/src/main/Main.hs b/src/main/Main.hs
index 00ce0c17fc..28de296ce9 100644
--- a/src/main/Main.hs
+++ b/src/main/Main.hs
@@ -151,11 +151,11 @@ main = withInterpreterArgs stackProgName $ \args isInterpreter -> fixCodePage $
           globalOptsParser isTerminal)
          (do addCommand "build"
                         "Build the project(s) in this directory/configuration"
-                        buildCmd
+                        (buildCmd Nothing)
                         (buildOptsParser Build)
              addCommand "install"
                         "Shortcut for 'build --copy-bins'"
-                        installCmd
+                        (buildCmd $ Just ("install", "copy-bins"))
                         (buildOptsParser Install)
              addCommand "uninstall"
                         "DEPRECATED: This command performs no actions, and is present for documentation only"
@@ -163,15 +163,15 @@ main = withInterpreterArgs stackProgName $ \args isInterpreter -> fixCodePage $
                         (many $ strArgument $ metavar "IGNORED")
              addCommand "test"
                         "Shortcut for 'build --test'"
-                        buildCmd
+                        (buildCmd $ Just ("test", "test"))
                         (buildOptsParser Test)
              addCommand "bench"
                         "Shortcut for 'build --bench'"
-                        buildCmd
+                        (buildCmd $ Just ("bench", "bench"))
                         (buildOptsParser Bench)
              addCommand "haddock"
                         "Shortcut for 'build --haddock'"
-                        buildCmd
+                        (buildCmd $ Just ("haddock", "haddock"))
                         (buildOptsParser Haddock)
              addCommand "new"
                         "Create a brand new project"
@@ -661,29 +661,24 @@ cleanCmd :: () -> GlobalOpts -> IO ()
 cleanCmd () go = withBuildConfigAndLock go (\_ -> clean)
 
 -- | Helper for build and install commands
-buildCmdHelper :: StackT EnvConfig IO () -- ^ do before build
-               -> BuildOpts -> GlobalOpts -> IO ()
-buildCmdHelper beforeBuild opts go
+buildCmd :: Maybe (Text, Text) -- ^ option synonym
+         -> BuildOpts -> GlobalOpts -> IO ()
+buildCmd moptionSynonym opts go
     | boptsFileWatch opts = fileWatch inner
     | otherwise = inner $ const $ return ()
   where
     inner setLocalFiles = withBuildConfigAndLock go $ \lk -> do
-        beforeBuild
+        case moptionSynonym of
+            Nothing -> return ()
+            Just (cmd, opt) -> $logInfo $ T.concat
+                [ "NOTE: the "
+                , cmd
+                , " command is functionally equivalent to 'build --"
+                , opt
+                , "'"
+                ]
         Stack.Build.build setLocalFiles (Just lk) opts
 
--- | Build the project.
-buildCmd :: BuildOpts -> GlobalOpts -> IO ()
-buildCmd = buildCmdHelper (return ())
-
--- | Install
-installCmd :: BuildOpts -> GlobalOpts -> IO ()
-installCmd =
-    buildCmdHelper warning
-  where
-    warning = do
-        $logInfo "NOTE: the install command will copy executables to a destination directory"
-        $logInfo "It is functionally equivalent to the --copy-bins option"
-
 uninstallCmd :: [String] -> GlobalOpts -> IO ()
 uninstallCmd _ go = withConfigAndLock go $ do
     $logError "stack does not manage installations in global locations"

From a26090e80c431fccb79aebef51a464d143a4bad9 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Mon, 10 Aug 2015 21:07:24 +0300
Subject: [PATCH 06/20] WIP

---
 src/Stack/Build/ConstructPlan.hs |   6 +-
 src/Stack/Build/Execute.hs       |  32 +---
 src/Stack/Build/Source.hs        | 252 ++++++++++---------------------
 src/Stack/Build/Target.hs        |  12 +-
 src/Stack/Dot.hs                 |   2 +-
 src/Stack/Types/Package.hs       |  42 +++++-
 6 files changed, 133 insertions(+), 213 deletions(-)

diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs
index 0fad2f3ead..74377bfd3c 100644
--- a/src/Stack/Build/ConstructPlan.hs
+++ b/src/Stack/Build/ConstructPlan.hs
@@ -194,6 +194,7 @@ mkUnregisterLocal tasks dirtyReason locallyRegistered =
         ident = ghcPkgIdPackageIdentifier gid
         name = packageIdentifierName ident
 
+{- FIXME
 addFinal :: LocalPackage -> M ()
 addFinal lp = do
     depsRes <- addPackageDeps package
@@ -220,6 +221,7 @@ addFinal lp = do
     tell (Map.singleton (packageName package) res, mempty, mempty)
   where
     package = lpPackageFinal lp
+-}
 
 addDep :: PackageName -> M (Either ConstructPlanException AddDepRes)
 addDep name = do
@@ -285,7 +287,7 @@ tellExecutablesPackage loc p = do
                 Just (PIOnlySource ps) -> goSource ps
                 Just (PIBoth ps _) -> goSource ps
 
-        goSource (PSLocal lp) = lpComponents lp
+        goSource (PSLocal lp) = fromMaybe Set.empty $ lpExeComponents lp
         goSource (PSUpstream _ _ _) = Set.empty
 
     tell (Map.empty, m myComps, Map.empty)
@@ -405,7 +407,7 @@ checkDirtiness ps installed package present wanted = do
             , configCacheDeps = present
             , configCacheComponents =
                 case ps of
-                    PSLocal lp -> Set.map encodeUtf8 $ lpComponents lp
+                    PSLocal lp -> Set.map renderComponent $ lpComponents lp
                     PSUpstream _ _ _ -> Set.empty
             , configCacheHaddock =
                 shouldHaddockPackage buildOpts wanted (packageName package) ||
diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs
index acffcffbe5..2e65f861f9 100644
--- a/src/Stack/Build/Execute.hs
+++ b/src/Stack/Build/Execute.hs
@@ -13,8 +13,6 @@ module Stack.Build.Execute
     , ExecuteEnv
     , withExecuteEnv
     , withSingleContext
-    -- * Testing
-    , compareTestsComponents
     ) where
 
 import           Control.Applicative            ((<$>), (<*>))
@@ -456,7 +454,7 @@ ensureConfig pkgDir ExecuteEnv {..} Task {..} announce cabal cabalfp extra = do
             , configCacheDeps = allDeps
             , configCacheComponents =
                 case taskType of
-                    TTLocal lp -> Set.map encodeUtf8 $ lpComponents lp
+                    TTLocal lp -> Set.map renderComponent $ lpComponents lp
                     TTUpstream _ _ -> Set.empty
             , configCacheHaddock =
                 shouldHaddockPackage eeBuildOpts eeWanted (packageIdentifierName taskProvides)
@@ -653,7 +651,8 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} =
     extraOpts <- extraBuildOptions
     cabal (console && configHideTHLoading config) $
         (case taskType of
-            TTLocal lp -> "build" : map T.unpack (Set.toList $ lpComponents lp)
+            TTLocal lp -> "build" : "lib" : map (T.unpack . T.append "exe:")
+                                                (maybe [] Set.toList $ lpExeComponents lp)
             TTUpstream _ _ -> ["build"]) ++ extraOpts
 
     let doHaddock = shouldHaddockPackage eeBuildOpts eeWanted (packageName package) &&
@@ -703,11 +702,12 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} =
 
 singleTest :: M env m
            => TestOpts
+           -> LocalPackageTB
            -> ActionContext
            -> ExecuteEnv
            -> Task
            -> m ()
-singleTest topts ac ee task =
+singleTest topts lptb ac ee task =
     withSingleContext ac ee task (Just "test") $ \package cabalfp pkgDir cabal announce console mlogFile -> do
         (_cache, neededConfig) <- ensureConfig pkgDir ee task (announce "configure (test)") cabal cabalfp ["--enable-tests"]
         config <- asks getConfig
@@ -722,11 +722,7 @@ singleTest topts ac ee task =
 
             needHpc = toCoverage topts
 
-            componentsRaw =
-                case taskType task of
-                    TTLocal lp -> Set.toList $ lpComponents lp
-                    TTUpstream _ _ -> assert False []
-            testsToRun = compareTestsComponents componentsRaw $ Set.toList $ packageTests package
+            testsToRun = Set.toList $ lptbTests lptb
             components = map (T.unpack . T.append "test:") testsToRun
 
         when needBuild $ do
@@ -845,22 +841,6 @@ singleTest topts ac ee task =
 
             setTestSuccess pkgDir
 
--- | Determine the tests to be run based on the list of components.
-compareTestsComponents :: [Text] -- ^ components
-                       -> [Text] -- ^ all test names
-                       -> [Text] -- ^ tests to be run
-compareTestsComponents [] tests = tests -- no components -- all tests
-compareTestsComponents comps tests2 =
-    Set.toList $ Set.intersection tests1 $ Set.fromList tests2
-  where
-    tests1 = Set.unions $ map toSet comps
-
-    toSet x =
-        case T.break (== ':') x of
-            (y, "") -> assert (x == y) (Set.singleton x)
-            ("test", y) -> Set.singleton $ T.drop 1 y
-            _ -> Set.empty
-
 singleBench :: M env m
             => BenchmarkOpts
             -> ActionContext
diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs
index ae767cbf29..e0236db548 100644
--- a/src/Stack/Build/Source.hs
+++ b/src/Stack/Build/Source.hs
@@ -10,12 +10,11 @@ module Stack.Build.Source
     , SourceMap
     , PackageSource (..)
     , localFlags
-    , loadLocals
     ) where
 
 import           Control.Applicative ((<|>), (<$>), (<*>))
 import           Control.Arrow ((&&&))
-import           Control.Exception (catch)
+import           Control.Exception (assert, catch)
 import           Control.Monad
 import           Control.Monad.Catch (MonadCatch)
 import           Control.Monad.IO.Class
@@ -106,19 +105,21 @@ loadSourceMap bopts = do
         (Map.keysSet $ Map.filter (== STUnknown) targets)
         latestVersion
 
-    _ <- error $ show (extraDeps0, targets)
-
-    (locals, extraNames, extraIdents) <- loadLocals bopts latestVersion -- FIXME remove
+    locals <- mapM (loadLocalPackage bopts targets) $ Map.toList rawLocals
 
     let
         -- loadLocals returns PackageName (foo) and PackageIdentifier (bar-1.2.3) targets separately;
         -- here we combine them into nonLocalTargets. This is one of the
         -- return values of this function.
         nonLocalTargets :: Set PackageName
-        nonLocalTargets = extraNames <> Set.map packageIdentifierName extraIdents
-
-    let shadowed = Set.fromList (map (packageName . lpPackage) locals)
-                <> Map.keysSet extraDeps0
+        nonLocalTargets =
+            Map.keysSet $ Map.filter (not . isLocal) targets
+          where
+            isLocal (STLocal _) = True
+            isLocal STUnknown = False
+            isLocal STNonLocal = False
+
+        shadowed = Map.keysSet rawLocals <> Map.keysSet extraDeps0
         (mbp, extraDeps1) = shadowMiniBuildPlan mbp0 shadowed
 
         -- Add the extra deps from the stack.yaml file to the deps grabbed from
@@ -141,19 +142,6 @@ loadSourceMap bopts = do
                 (PSUpstream (mpiVersion mpi) Snap (mpiFlags mpi))
             ] `Map.difference` Map.fromList (map (, ()) (HashSet.toList wiredInPackages))
 
-    let unknown = Set.difference nonLocalTargets $ Map.keysSet sourceMap
-    unless (Set.null unknown) $ do
-        let toEither name =
-                case Map.lookup name latestVersion of
-                    Nothing -> Left name
-                    Just version -> Right (name, version)
-            eithers = map toEither $ Set.toList unknown
-            (unknown', notInIndex) = partitionEithers eithers
-        throwM $ UnknownTargets
-            (Set.fromList unknown')
-            (Map.fromList notInIndex)
-            (bcStackYaml bconfig)
-
     return (mbp, locals, nonLocalTargets, sourceMap)
 
 -- | Parse out the local package views for the current project
@@ -172,6 +160,7 @@ getLocalPackageViews = do
         let lpv = LocalPackageView
                 { lpvVersion = fromCabalVersion $ pkgVersion cabalID
                 , lpvRoot = dir
+                , lpvCabalFP = cabalfp
                 , lpvExtraDep = not validWanted
                 , lpvComponents = getNamedComponents gpkg
                 }
@@ -186,97 +175,79 @@ getLocalPackageViews = do
       where
         go wrapper f = map (wrapper . T.pack . fst) $ f gpkg
 
--- | 'loadLocals' combines two pieces of information:
---
--- 1. Targets, i.e. arguments passed to stack such as @foo@ and @bar@ in the @stack foo bar@ invocation
---
--- 2. Local packages listed in @stack.yaml@
---
--- It returns:
---
--- 1. For every local package, a 'LocalPackage' structure
---
--- 2. If a target does not correspond to a local package but is a valid
--- 'PackageName' or 'PackageIdentifier', it is returned as such.
---
--- NOTE: as the function is written right now, it may "drop" targets if
--- they correspond to existing directories not listed in stack.yaml. This
--- may be a bug.
-loadLocals :: forall m env .
-              (MonadReader env m, HasBuildConfig env, MonadIO m, MonadLogger m, MonadThrow m, MonadCatch m,HasEnvConfig env)
-           => BuildOpts
-           -> Map PackageName Version
-           -> m ([LocalPackage], Set PackageName, Set PackageIdentifier)
-loadLocals bopts latestVersion = do
-    (isWanted', names, idents) <-
-        case boptsTargets bopts of
-            -- If there are no targets specified: build all locals
-            [] -> return (\_ _ -> True, Map.empty, Set.empty)
-            _targets -> do
-                targets' <- mapM parseTarget $ boptsTargets bopts
-                -- Group targets by their kind
-                (dirs, names, idents) <-
-                    case partitionEithers targets' of
-                        ([], targets'') -> return $ partitionTargetSpecs targets''
-                        (bad, _) -> throwM $ Couldn'tParseTargets bad
-                return (isWanted dirs names, names, idents)
-    let identsMap = Map.fromList $ map toTuple $ Set.toList idents
-
-    econfig <- asks getEnvConfig
+splitComponents :: [NamedComponent]
+                -> (Set Text, Set Text, Set Text)
+splitComponents =
+    go id id id
+  where
+    go a b c [] = (Set.fromList $ a [], Set.fromList $ b [], Set.fromList $ c [])
+    go a b c (CLib:xs) = go a b c xs
+    go a b c (CExe x:xs) = go (a . (x:)) b c xs
+    go a b c (CTest x:xs) = go a (b . (x:)) c xs
+    go a b c (CBench x:xs) = go a b (c . (x:)) xs
+
+-- | Upgrade the initial local package info to a full-blown @LocalPackage@
+-- based on the selected components
+loadLocalPackage
+    :: forall m env.
+       (MonadReader env m, HasEnvConfig env, MonadCatch m, MonadLogger m, MonadIO m)
+    => BuildOpts
+    -> Map PackageName SimpleTarget
+    -> (PackageName, (LocalPackageView, GenericPackageDescription))
+    -> m LocalPackage
+loadLocalPackage bopts targets (name, (lpv, gpkg)) = do
     bconfig <- asks getBuildConfig
-    -- Iterate over local packages declared in stack.yaml and turn them
-    -- into LocalPackage structures. The targets affect whether these
-    -- packages will be marked as wanted.
-    lps <- forM (Map.toList $ envConfigPackages econfig) $ \(dir, validWanted) -> do
-        cabalfp <- getCabalFileName dir
-        name <- parsePackageNameFromFilePath cabalfp
-        let wanted = validWanted && isWanted' dir name
-            config = PackageConfig
-                { packageConfigEnableTests = False
-                , packageConfigEnableBenchmarks = False
-                , packageConfigFlags = localFlags (boptsFlags bopts) bconfig name
-                , packageConfigGhcVersion = envConfigGhcVersion econfig
-                , packageConfigPlatform = configPlatform $ getConfig bconfig
-                }
-            configFinal = config
-                { packageConfigEnableTests =
-                    error "FIXME packageConfigEnableTests"
-                , packageConfigEnableBenchmarks =
-                    error "FIXME packageConfigEnableBenchmarks"
-                }
-        pkg <- readPackage config cabalfp
-        pkgFinal <- readPackage configFinal cabalfp
-        when (packageName pkg /= name) $ throwM
-            $ MismatchedCabalName cabalfp (packageName pkg)
-        mbuildCache <- tryGetBuildCache dir
-        files <- getPackageFiles (packageFiles pkg) cabalfp
-        (isDirty, newBuildCache) <- checkBuildCache
-            (fromMaybe Map.empty mbuildCache)
-            (map toFilePath $ Set.toList files)
-
-        case Map.lookup (packageName pkg) identsMap of
-            Just version | version /= packageVersion pkg ->
-                throwM $ LocalPackageDoesn'tMatchTarget
-                    (packageName pkg)
-                    (packageVersion pkg)
-                    version
-            _ -> return ()
+    econfig <- asks getEnvConfig
 
-        return LocalPackage
-            { lpPackage = pkg
-            , lpPackageFinal = pkgFinal
-            , lpWanted = wanted
-            , lpFiles = files
-            , lpDirtyFiles = isDirty || boptsForceDirty bopts
-            , lpNewBuildCache = newBuildCache
-            , lpCabalFile = cabalfp
-            , lpDir = dir
-            , lpComponents = fromMaybe Set.empty $ Map.lookup name names
+    let mtarget = Map.lookup name targets
+        components =
+            case mtarget of
+                Just (STLocal comps) -> comps
+                Just STNonLocal -> assert False Set.empty
+                Just STUnknown -> assert False Set.empty
+                Nothing -> Set.empty
+        (exes, tests, benches) = splitComponents $ Set.toList components
+        config = PackageConfig
+            { packageConfigEnableTests = False
+            , packageConfigEnableBenchmarks = False
+            , packageConfigFlags = localFlags (boptsFlags bopts) bconfig name
+            , packageConfigGhcVersion = envConfigGhcVersion econfig
+            , packageConfigPlatform = configPlatform $ getConfig bconfig
             }
-
-    let known = Set.fromList $ map (packageName . lpPackage) lps
-        unknown = Set.difference (Map.keysSet names) known
-
+        btconfig = config
+            { packageConfigEnableTests = not $ Set.null tests
+            , packageConfigEnableBenchmarks = not $ Set.null benches
+            }
+        pkg = resolvePackage config gpkg
+        btpkg
+            | Set.null tests && Set.null benches = Nothing
+            | otherwise = Just $ LocalPackageTB
+                { lptbPackage = resolvePackage btconfig gpkg
+                , lptbTests = tests
+                , lptbBenches = benches
+                }
+    mbuildCache <- tryGetBuildCache $ lpvRoot lpv
+    files <- getPackageFiles (packageFiles pkg) (lpvCabalFP lpv)
+    (isDirty, newBuildCache) <- checkBuildCache
+        (fromMaybe Map.empty mbuildCache)
+        (map toFilePath $ Set.toList files)
+
+    return LocalPackage
+        { lpPackage = pkg
+        , lpExeComponents =
+            case mtarget of
+                Nothing -> Nothing
+                Just _ -> Just exes
+        , lpTestBench = btpkg
+        , lpFiles = files
+        , lpDirtyFiles = isDirty || boptsForceDirty bopts
+        , lpNewBuildCache = newBuildCache
+        , lpCabalFile = lpvCabalFP lpv
+        , lpDir = lpvRoot lpv
+        , lpComponents = components
+        }
+
+        {-
         -- Check if flags specified in stack.yaml and the command line are
         -- used, see https://github.com/commercialhaskell/stack/issues/617
         flags = map (, FSCommandLine) [(k, v) | (Just k, v) <- Map.toList $ boptsFlags bopts]
@@ -302,66 +273,7 @@ loadLocals bopts latestVersion = do
                             else Just $ UFFlagsNotDefined source pkg unused
 
         unusedFlags = mapMaybe checkFlagUsed flags
-
-        unusedComponents = Set.difference (Map.keysSet names) known
-
-    unless (null unusedFlags) $ throwM $ InvalidFlagSpecification $ Set.fromList unusedFlags
-    unless (Set.null unusedComponents) $ do
-        $logWarn "Warning: You've specified components for non-local packages"
-        $logWarn "Components for the following packages will be ignored:"
-        forM_ (Set.toList unusedComponents) $ \x -> do
-            $logWarn $ "* " <> T.pack (packageNameString x)
-
-    return (lps, unknown, idents)
-  where
-    -- Attempt to parse a TargetSpec based on its textual form and on
-    -- whether it is a name of an existing directory.
-    --
-    -- If a TargetSpec is not recognized, return it verbatim as Left.
-    parseTarget :: Text -> m (Either Text TargetSpec)
-    parseTarget t = do
-        let s = T.unpack t
-        isDir <- liftIO $ doesDirectoryExist s
-        if isDir
-            then liftM (Right . TSDir) $ liftIO (canonicalizePath s) >>= parseAbsDir
-            else return
-                    $ maybe (Left t) Right
-                    $ (flip TSName Set.empty <$> parsePackageNameFromString s)
-                  <|> (TSIdent <$> parsePackageIdentifierFromString s)
-                  <|> (do
-                        t' <- T.stripSuffix ":latest" t
-                        name <- parsePackageNameFromString $ T.unpack t'
-                        version <- Map.lookup name latestVersion
-                        Just $ TSIdent $ PackageIdentifier name version)
-                  <|> (do
-                        let (name', rest) = T.break (== ':') t
-                        component <- T.stripPrefix ":" rest
-                        name <- parsePackageNameFromString $ T.unpack name'
-                        Just $ TSName name $ Set.singleton component)
-    isWanted dirs names dir name =
-        name `Map.member` names ||
-        any (`isParentOf` dir) dirs ||
-        any (== dir) dirs
-
-data TargetSpec
-    = TSName PackageName (Set Text)
-    | TSIdent PackageIdentifier
-    | TSDir (Path Abs Dir)
-
-partitionTargetSpecs :: [TargetSpec] -> ([Path Abs Dir], Map PackageName (Set Text), Set PackageIdentifier)
-partitionTargetSpecs =
-    loop id Map.empty Set.empty
-  where
-    loop dirs names idents ts0 =
-        case ts0 of
-            [] -> (dirs [], names, idents)
-            TSName name comps:ts -> loop
-                dirs
-                (Map.insertWith Set.union name comps names)
-                idents
-                ts
-            TSIdent ident:ts -> loop dirs names (Set.insert ident idents) ts
-            TSDir dir:ts -> loop (dirs . (dir:)) names idents ts
+-}
 
 -- | All flags for a local package
 localFlags :: (Map (Maybe PackageName) (Map FlagName Bool))
diff --git a/src/Stack/Build/Target.hs b/src/Stack/Build/Target.hs
index 559d5cd1f0..9dc70c490e 100644
--- a/src/Stack/Build/Target.hs
+++ b/src/Stack/Build/Target.hs
@@ -9,7 +9,6 @@
 module Stack.Build.Target
     ( -- * Types
       ComponentName
-    , NamedComponent (..)
     , UnresolvedComponent (..)
     , RawTarget (..)
     , LocalPackageView (..)
@@ -41,14 +40,6 @@ type ComponentName = Text
 
 newtype RawInput = RawInput { unRawInput :: Text }
 
--- | A single, fully resolved component of a package
-data NamedComponent
-    = CLib
-    | CExe !ComponentName
-    | CTest !ComponentName
-    | CBench !ComponentName
-    deriving (Show, Eq, Ord)
-
 -- | Either a fully resolved component, or a component name that could be
 -- either an executable, test, or benchmark
 data UnresolvedComponent
@@ -106,6 +97,7 @@ parseRawTarget t =
 data LocalPackageView = LocalPackageView
     { lpvVersion    :: !Version
     , lpvRoot       :: !(Path Abs Dir)
+    , lpvCabalFP    :: !(Path Abs File)
     , lpvComponents :: !(Set NamedComponent)
     , lpvExtraDep   :: !Bool
     }
@@ -304,7 +296,7 @@ parseTargets :: (MonadThrow m, MonadIO m)
 parseTargets includeTests includeBenches snap extras locals currDir textTargets' = do
     let textTargets =
             if null textTargets'
-                then map (T.pack . packageNameString) $ Map.keys locals
+                then map (T.pack . packageNameString) $ Map.keys $ Map.filter (not . lpvExtraDep) locals
                 else textTargets'
     erawTargets <- mapM (parseRawTargetDirs currDir locals) textTargets
 
diff --git a/src/Stack/Dot.hs b/src/Stack/Dot.hs
index 6d077fb2bd..2110038d04 100644
--- a/src/Stack/Dot.hs
+++ b/src/Stack/Dot.hs
@@ -63,7 +63,7 @@ dot :: (HasEnvConfig env
     => DotOpts
     -> m ()
 dot dotOpts = do
-    (locals,_,_) <- loadLocals defaultBuildOpts Map.empty
+    (locals,_,_) <- error "FIXME loadLocals defaultBuildOpts Map.empty"
     resultGraph <- createDependencyGraph dotOpts
     let pkgsToPrune = if dotIncludeBase dotOpts
                          then dotPrune dotOpts
diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs
index 1b0931d529..030ad0e165 100644
--- a/src/Stack/Types/Package.hs
+++ b/src/Stack/Types/Package.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 -- |
 
@@ -23,6 +24,7 @@ import           Data.Maybe
 import           Data.Monoid
 import           Data.Set (Set)
 import           Data.Text (Text)
+import           Data.Text.Encoding (encodeUtf8)
 import           Distribution.InstalledPackageInfo (PError)
 import           Distribution.ModuleName (ModuleName)
 import           Distribution.Package hiding (Package,PackageName,packageName,packageVersion,PackageIdentifier)
@@ -159,20 +161,52 @@ class PackageInstallInfo a where
     piiVersion :: a -> Version
     piiLocation :: a -> InstallLocation
 
+-- | Second-stage build information: tests and benchmarks
+data LocalPackageTB = LocalPackageTB
+    { lptbPackage :: !Package
+    -- ^ Package resolved with dependencies for tests and benchmarks, depending
+    -- on which components are active
+    , lptbTests   :: !(Set Text)
+    -- ^ Test components
+    , lptbBenches :: !(Set Text)
+    -- ^ Benchmark components
+    }
+    deriving Show
+
 -- | Information on a locally available package of source code
 data LocalPackage = LocalPackage
-    { lpPackage        :: !Package         -- ^ The @Package@ info itself, after resolution with package flags, not including any final actions
-    , lpPackageFinal   :: !Package         -- ^ Same as lpPackage, but with any test suites or benchmarks enabled as necessary
-    , lpWanted         :: !Bool            -- ^ Is this package a \"wanted\" target based on command line input
+    { lpPackage        :: !Package         -- ^ The @Package@ info itself, after resolution with package flags, not including any tests or benchmarks
+    , lpExeComponents  :: !(Maybe (Set Text)) -- ^ Executable components to build, Nothing if not a target
+
+    , lpTestBench      :: !(Maybe LocalPackageTB)
+
     , lpDir            :: !(Path Abs Dir)  -- ^ Directory of the package.
     , lpCabalFile      :: !(Path Abs File) -- ^ The .cabal file
     , lpDirtyFiles     :: !Bool            -- ^ are there files that have changed since the last build?
     , lpNewBuildCache  :: !(Map FilePath FileCacheInfo) -- ^ current state of the files
     , lpFiles          :: !(Set (Path Abs File)) -- ^ all files used by this package
-    , lpComponents     :: !(Set Text)      -- ^ components to build, passed directly to Setup.hs build
+    , lpComponents     :: !(Set NamedComponent)
     }
     deriving Show
 
+-- | Is the given local a target
+lpWanted :: LocalPackage -> Bool
+lpWanted lp = isJust (lpExeComponents lp) || isJust (lpTestBench lp)
+
+-- | A single, fully resolved component of a package
+data NamedComponent
+    = CLib
+    | CExe !Text
+    | CTest !Text
+    | CBench !Text
+    deriving (Show, Eq, Ord)
+
+renderComponent :: NamedComponent -> S.ByteString
+renderComponent CLib = "lib"
+renderComponent (CExe x) = "exe:" <> encodeUtf8 x
+renderComponent (CTest x) = "test:" <> encodeUtf8 x
+renderComponent (CBench x) = "bench:" <> encodeUtf8 x
+
 -- | A location to install a package into, either snapshot or local
 data InstallLocation = Snap | Local
     deriving (Show, Eq)

From 8f90cc782a396ff88b69ba32df3dccd1c0025da3 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 06:11:09 +0300
Subject: [PATCH 07/20] Get codebase to compile again

---
 src/Stack/Build/Source.hs |  2 ++
 src/Stack/Dot.hs          | 31 +++++++++++++++----------------
 src/Stack/SDist.hs        |  4 ++--
 3 files changed, 19 insertions(+), 18 deletions(-)

diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs
index e0236db548..6d9e3c1e83 100644
--- a/src/Stack/Build/Source.hs
+++ b/src/Stack/Build/Source.hs
@@ -10,6 +10,8 @@ module Stack.Build.Source
     , SourceMap
     , PackageSource (..)
     , localFlags
+    , getLocalPackageViews
+    , loadLocalPackage
     ) where
 
 import           Control.Applicative ((<|>), (<$>), (<*>))
diff --git a/src/Stack/Dot.hs b/src/Stack/Dot.hs
index 2110038d04..3c1f5a5206 100644
--- a/src/Stack/Dot.hs
+++ b/src/Stack/Dot.hs
@@ -11,7 +11,7 @@ module Stack.Dot (dot
 
 import           Control.Applicative
 import           Control.Arrow ((&&&))
-import           Control.Monad (void)
+import           Control.Monad (liftM, void)
 import           Control.Monad.Catch (MonadCatch,MonadMask)
 import           Control.Monad.IO.Class
 import           Control.Monad.Logger (MonadLogger)
@@ -63,14 +63,13 @@ dot :: (HasEnvConfig env
     => DotOpts
     -> m ()
 dot dotOpts = do
-    (locals,_,_) <- error "FIXME loadLocals defaultBuildOpts Map.empty"
+    localNames <- liftM Map.keysSet getLocalPackageViews
     resultGraph <- createDependencyGraph dotOpts
     let pkgsToPrune = if dotIncludeBase dotOpts
                          then dotPrune dotOpts
                          else Set.insert "base" (dotPrune dotOpts)
-        localNames = Set.fromList (map (packageName . lpPackageFinal) locals)
         prunedGraph = pruneGraph localNames pkgsToPrune resultGraph
-    printGraph dotOpts locals prunedGraph
+    printGraph dotOpts localNames prunedGraph
 
 -- | Create the dependency graph, the result is a map from a package
 -- name to a tuple of dependencies and a version if available.  This
@@ -194,7 +193,7 @@ createDepLoader :: Applicative m
                 -> m (Set PackageName, Maybe Version)
 createDepLoader sourceMap installed loadPackageDeps pkgName =
   case Map.lookup pkgName sourceMap of
-    Just (PSLocal lp) -> pure ((packageAllDeps &&& (Just . packageVersion)) (lpPackageFinal lp))
+    Just (PSLocal lp) -> pure ((packageAllDeps &&& (Just . packageVersion)) (lpPackage lp))
     Just (PSUpstream version _ flags) -> loadPackageDeps pkgName version flags
     Nothing -> pure (Set.empty, do m' <- T.traverse libVersionFromInstalled installed
                                    Map.lookup pkgName m')
@@ -202,18 +201,18 @@ createDepLoader sourceMap installed loadPackageDeps pkgName =
 -- | Resolve the direct (depth 0) external dependencies of the given local packages
 localDependencies :: DotOpts -> [LocalPackage] -> [(PackageName,(Set PackageName,Maybe Version))]
 localDependencies dotOpts locals =
-    map (\lp -> (packageName (lpPackageFinal lp), (deps lp,Just (lpVersion lp)))) locals
+    map (\lp -> (packageName (lpPackage lp), (deps lp,Just (lpVersion lp)))) locals
   where deps lp = if dotIncludeExternal dotOpts
-                then Set.delete (lpName lp) (packageAllDeps (lpPackageFinal lp))
-                else Set.intersection localNames (packageAllDeps (lpPackageFinal lp))
-        lpName lp = packageName (lpPackageFinal lp)
-        localNames = Set.fromList $ map (packageName . lpPackageFinal) locals
-        lpVersion lp = packageVersion (lpPackageFinal lp)
+                then Set.delete (lpName lp) (packageAllDeps (lpPackage lp))
+                else Set.intersection localNames (packageAllDeps (lpPackage lp))
+        lpName lp = packageName (lpPackage lp)
+        localNames = Set.fromList $ map (packageName . lpPackage) locals
+        lpVersion lp = packageVersion (lpPackage lp)
 
 -- | Print a graphviz graph of the edges in the Map and highlight the given local packages
 printGraph :: (Applicative m, MonadIO m)
            => DotOpts
-           -> [LocalPackage]
+           -> Set PackageName -- ^ all locals
            -> Map PackageName (Set PackageName, Maybe Version)
            -> m ()
 printGraph dotOpts locals graph = do
@@ -222,13 +221,13 @@ printGraph dotOpts locals graph = do
   printLeaves graph
   void (Map.traverseWithKey printEdges (fst <$> graph))
   liftIO $ Text.putStrLn "}"
-  where filteredLocals = filter (\local ->
-          show (packageName (lpPackageFinal local)) `Set.notMember` dotPrune dotOpts) locals
+  where filteredLocals = Set.filter (\local ->
+          packageNameString local `Set.notMember` dotPrune dotOpts) locals
 
 -- | Print the local nodes with a different style depending on options
 printLocalNodes :: (F.Foldable t, MonadIO m)
                 => DotOpts
-                -> t LocalPackage
+                -> t PackageName
                 -> m ()
 printLocalNodes dotOpts locals = liftIO $ Text.putStrLn (Text.intercalate "\n" lpNodes)
   where applyStyle :: Text -> Text
@@ -236,7 +235,7 @@ printLocalNodes dotOpts locals = liftIO $ Text.putStrLn (Text.intercalate "\n" l
                          then n <> " [style=dashed];"
                          else n <> " [style=solid];"
         lpNodes :: [Text]
-        lpNodes = map (applyStyle . nodeName . packageName . lpPackageFinal) (F.toList locals)
+        lpNodes = map (applyStyle . nodeName) (F.toList locals)
 
 -- | Print nodes without dependencies
 printLeaves :: (Applicative m, MonadIO m)
diff --git a/src/Stack/SDist.hs b/src/Stack/SDist.hs
index 55b61f9550..f9e18a105d 100644
--- a/src/Stack/SDist.hs
+++ b/src/Stack/SDist.hs
@@ -89,12 +89,12 @@ readLocalPackage pkgDir = do
     package <- readPackage config cabalfp
     return LocalPackage
         { lpPackage = package
-        , lpWanted = False -- HACK: makes it so that sdist output goes to a log instead of a file.
+        , lpExeComponents = Nothing -- HACK: makes it so that sdist output goes to a log instead of a file.
         , lpDir = pkgDir
         , lpCabalFile = cabalfp
         -- NOTE: these aren't the 'correct values, but aren't used in
         -- the usage of this function in this module.
-        , lpPackageFinal = package
+        , lpTestBench = Nothing
         , lpDirtyFiles = True
         , lpNewBuildCache = Map.empty
         , lpFiles = Set.empty

From d3f3b4502db9c648085fc3ed0819936c23efb18b Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 07:29:25 +0300
Subject: [PATCH 08/20] Plan construction updated

---
 src/Stack/Build/ConstructPlan.hs | 27 +++++++++++++--------------
 src/Stack/Build/Execute.hs       | 14 +++++++++++++-
 src/Stack/Types/Build.hs         |  2 +-
 3 files changed, 27 insertions(+), 16 deletions(-)

diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs
index 74377bfd3c..c65fc2ce38 100644
--- a/src/Stack/Build/ConstructPlan.hs
+++ b/src/Stack/Build/ConstructPlan.hs
@@ -76,7 +76,7 @@ data AddDepRes
 
 type M = RWST
     Ctx
-    ( Map PackageName (Either ConstructPlanException Task) -- finals
+    ( Map PackageName (Either ConstructPlanException (Task, LocalPackageTB)) -- finals
     , Map Text InstallLocation -- executable to be installed, and location where the binary is placed
     , Map PackageName Text -- why a local package is considered dirty
     )
@@ -121,12 +121,13 @@ constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 locallyRegistered loadPa
     let latest = Map.fromListWith max $ map toTuple $ Map.keys caches
 
     econfig <- asks getEnvConfig
-    let onWanted = error "constructPlan.onWanted"
-        {-
-            case boptsFinalAction $ bcoBuildOpts baseConfigOpts0 of
-                DoNothing -> void . addDep . packageName . lpPackage
-                _ -> addFinal
-                -}
+    let onWanted lp = do
+            case lpExeComponents lp of
+                Nothing -> return ()
+                Just _ -> void $ addDep $ packageName $ lpPackage lp
+            case lpTestBench lp of
+                Nothing -> return ()
+                Just tb -> addFinal lp tb
     let inner = do
             mapM_ onWanted $ filter lpWanted locals
             mapM_ addDep $ Set.toList extraToBuild0
@@ -194,15 +195,14 @@ mkUnregisterLocal tasks dirtyReason locallyRegistered =
         ident = ghcPkgIdPackageIdentifier gid
         name = packageIdentifierName ident
 
-{- FIXME
-addFinal :: LocalPackage -> M ()
-addFinal lp = do
+addFinal :: LocalPackage -> LocalPackageTB -> M ()
+addFinal lp lptb = do
     depsRes <- addPackageDeps package
     res <- case depsRes of
         Left e -> return $ Left e
         Right (missing, present, _minLoc) -> do
             ctx <- ask
-            return $ Right Task
+            return $ Right (Task
                 { taskProvides = PackageIdentifier
                     (packageName package)
                     (packageVersion package)
@@ -217,11 +217,10 @@ addFinal lp = do
                             package
                 , taskPresent = present
                 , taskType = TTLocal lp
-                }
+                }, lptb)
     tell (Map.singleton (packageName package) res, mempty, mempty)
   where
-    package = lpPackageFinal lp
--}
+    package = lptbPackage lptb
 
 addDep :: PackageName -> M (Either ConstructPlanException AddDepRes)
 addDep name = do
diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs
index 2e65f861f9..518a502489 100644
--- a/src/Stack/Build/Execute.hs
+++ b/src/Stack/Build/Execute.hs
@@ -127,6 +127,18 @@ printPlan plan = do
 
     $logInfo ""
 
+    let hasTests = not . Set.null . lptbTests
+        hasBenches = not . Set.null . lptbBenches
+        tests = Map.elems $ fmap fst $ Map.filter (hasTests . snd) $ planFinals plan
+        benches = Map.elems $ fmap fst $ Map.filter (hasBenches . snd) $ planFinals plan
+
+    unless (null tests) $ do
+        $logInfo "Would test:"
+        mapM_ ($logInfo . displayTask) tests
+    unless (null benches) $ do
+        $logInfo "Would benchmark:"
+        mapM_ ($logInfo . displayTask) benches
+
     case Map.toList $ planInstallExes plan of
         [] -> $logInfo "No executables to be installed."
         xs -> do
@@ -331,7 +343,7 @@ executePlan' plan ee@ExecuteEnv {..} = do
             (fmap (\b -> (Just b, Nothing)))
             (fmap (\f -> (Nothing, Just f)))
             (planTasks plan)
-            (planFinals plan)
+            (fmap fst $ planFinals plan) -- FIXME
     threads <- asks $ configJobs . getConfig
     concurrentTests <- asks $ configConcurrentTests . getConfig
     let keepGoing =
diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs
index 4878c298e0..226d3e0337 100644
--- a/src/Stack/Types/Build.hs
+++ b/src/Stack/Types/Build.hs
@@ -493,7 +493,7 @@ taskLocation task =
 -- | A complete plan of what needs to be built and how to do it
 data Plan = Plan
     { planTasks :: !(Map PackageName Task)
-    , planFinals :: !(Map PackageName Task)
+    , planFinals :: !(Map PackageName (Task, LocalPackageTB))
     -- ^ Final actions to be taken (test, benchmark, etc)
     , planUnregisterLocal :: !(Map GhcPkgId Text)
     -- ^ Text is reason we're unregistering, for display only

From fa4987cf43b1b26bc1f97d3f1b7fed95c6e97d88 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 07:43:03 +0300
Subject: [PATCH 09/20] Executing plans

---
 src/Stack/Build/Execute.hs | 53 +++++++++++++++++---------------------
 1 file changed, 24 insertions(+), 29 deletions(-)

diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs
index 518a502489..e2775f57d5 100644
--- a/src/Stack/Build/Execute.hs
+++ b/src/Stack/Build/Execute.hs
@@ -125,20 +125,22 @@ printPlan plan = do
             $logInfo "Would build:"
             mapM_ ($logInfo . displayTask) xs
 
-    $logInfo ""
-
     let hasTests = not . Set.null . lptbTests
         hasBenches = not . Set.null . lptbBenches
         tests = Map.elems $ fmap fst $ Map.filter (hasTests . snd) $ planFinals plan
         benches = Map.elems $ fmap fst $ Map.filter (hasBenches . snd) $ planFinals plan
 
     unless (null tests) $ do
+        $logInfo ""
         $logInfo "Would test:"
         mapM_ ($logInfo . displayTask) tests
     unless (null benches) $ do
+        $logInfo ""
         $logInfo "Would benchmark:"
         mapM_ ($logInfo . displayTask) benches
 
+    $logInfo ""
+
     case Map.toList $ planInstallExes plan of
         [] -> $logInfo "No executables to be installed."
         xs -> do
@@ -343,7 +345,7 @@ executePlan' plan ee@ExecuteEnv {..} = do
             (fmap (\b -> (Just b, Nothing)))
             (fmap (\f -> (Nothing, Just f)))
             (planTasks plan)
-            (fmap fst $ planFinals plan) -- FIXME
+            (planFinals plan)
     threads <- asks $ configJobs . getConfig
     concurrentTests <- asks $ configConcurrentTests . getConfig
     let keepGoing =
@@ -381,11 +383,9 @@ executePlan' plan ee@ExecuteEnv {..} = do
 toActions :: M env m
           => (m () -> IO ())
           -> ExecuteEnv
-          -> (Maybe Task, Maybe Task) -- build and final
+          -> (Maybe Task, Maybe (Task, LocalPackageTB)) -- build and final
           -> [Action]
 toActions runInBase ee (mbuild, mfinal) =
-    error "toActions"
-    {-
     abuild ++ afinal
   where
     abuild =
@@ -400,38 +400,29 @@ toActions runInBase ee (mbuild, mfinal) =
                     }
                 ]
     afinal =
-        case (,) <$> mfinal <*> mfunc of
-            Just (task@Task {..}, (func, checkTask)) | checkTask task ->
+        case mfinal of
+            Nothing -> []
+            Just (task@Task {..}, lptb) ->
                 [ Action
                     { actionId = ActionId taskProvides ATFinal
                     , actionDeps = addBuild taskProvides $
                         (Set.map (\ident -> ActionId ident ATBuild) (tcoMissing taskConfigOpts))
-                    , actionDo = \ac -> runInBase $ func ac ee task
+                    , actionDo = \ac -> runInBase $ do
+                        unless (Set.null $ lptbTests lptb) $ do
+                            singleTest topts lptb ac ee task
+                        unless (Set.null $ lptbBenches lptb) $ do
+                            singleBench beopts lptb ac ee task
                     }
                 ]
-            _ -> []
       where
         addBuild ident =
             case mbuild of
                 Nothing -> id
                 Just _ -> Set.insert $ ActionId ident ATBuild
 
-    mfunc =
-        case boptsFinalAction $ eeBuildOpts ee of
-            DoNothing -> Nothing
-            DoTests topts -> Just (singleTest topts, checkTest)
-            DoBenchmarks beopts -> Just (singleBench beopts, checkBench)
-
-    checkTest task =
-        case taskType task of
-            TTLocal lp -> not $ Set.null $ packageTests $ lpPackage lp
-            _ -> assert False False
-
-    checkBench task =
-        case taskType task of
-            TTLocal lp -> not $ Set.null $ packageBenchmarks $ lpPackage lp
-            _ -> assert False False
-    -}
+    bopts = eeBuildOpts ee
+    topts = boptsTestOpts bopts
+    beopts = boptsBenchmarkOpts bopts
 
 -- | Ensure that the configuration for the package matches what is given
 ensureConfig :: M env m
@@ -663,8 +654,11 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} =
     extraOpts <- extraBuildOptions
     cabal (console && configHideTHLoading config) $
         (case taskType of
-            TTLocal lp -> "build" : "lib" : map (T.unpack . T.append "exe:")
-                                                (maybe [] Set.toList $ lpExeComponents lp)
+            TTLocal lp -> "build"
+                        -- Cabal... There doesn't seem to be a way to call out the library component...
+                        -- : "lib"
+                        : map (T.unpack . T.append "exe:")
+                              (maybe [] Set.toList $ lpExeComponents lp)
             TTUpstream _ _ -> ["build"]) ++ extraOpts
 
     let doHaddock = shouldHaddockPackage eeBuildOpts eeWanted (packageName package) &&
@@ -855,11 +849,12 @@ singleTest topts lptb ac ee task =
 
 singleBench :: M env m
             => BenchmarkOpts
+            -> LocalPackageTB
             -> ActionContext
             -> ExecuteEnv
             -> Task
             -> m ()
-singleBench beopts ac ee task =
+singleBench beopts lptb ac ee task =
     withSingleContext ac ee task (Just "bench") $ \_package cabalfp pkgDir cabal announce console _mlogFile -> do
         (_cache, neededConfig) <- ensureConfig pkgDir ee task (announce "configure (benchmarks)") cabal cabalfp ["--enable-benchmarks"]
 

From 3a48d5f002483ea3f854ee47aaaf4c96efd505df Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 07:45:13 +0300
Subject: [PATCH 10/20] Disable no-longer-needed test

---
 src/test/Stack/Build/ExecuteSpec.hs | 15 +--------------
 1 file changed, 1 insertion(+), 14 deletions(-)

diff --git a/src/test/Stack/Build/ExecuteSpec.hs b/src/test/Stack/Build/ExecuteSpec.hs
index fe7bb4294b..f4d317c54e 100644
--- a/src/test/Stack/Build/ExecuteSpec.hs
+++ b/src/test/Stack/Build/ExecuteSpec.hs
@@ -8,17 +8,4 @@ main :: IO ()
 main = hspec spec
 
 spec :: Spec
-spec = describe "compareTestComponents" $ do
-    let test comps names expected = it (show (comps, names)) $
-            compareTestsComponents
-                (T.words $ T.pack comps)
-                (T.words $ T.pack names)
-                `shouldBe`
-                (T.words $ T.pack expected)
-
-    test "" "" ""
-    test "" "foo" "foo"
-    test "foo" "bar" ""
-    test "foo" "foo bar" "foo"
-    test "test:foo" "foo bar" "foo"
-    test "test:foo exe:bar" "foo bar" "foo"
+spec = return ()

From 232d272e64c15052cf9e15c47644904e05589114 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 08:01:21 +0300
Subject: [PATCH 11/20] Less frequent rebuilds

---
 src/Stack/Build/ConstructPlan.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs
index c65fc2ce38..275e440540 100644
--- a/src/Stack/Build/ConstructPlan.hs
+++ b/src/Stack/Build/ConstructPlan.hs
@@ -122,12 +122,20 @@ constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 locallyRegistered loadPa
 
     econfig <- asks getEnvConfig
     let onWanted lp = do
+            {-
+             - Arguably this is the right thing to do. However, forcing the
+             - library to rebuild causes the cabal_macros.h file to change,
+             - which makes GHC rebuild everything...
+
             case lpExeComponents lp of
                 Nothing -> return ()
                 Just _ -> void $ addDep $ packageName $ lpPackage lp
+            -}
+
             case lpTestBench lp of
-                Nothing -> return ()
                 Just tb -> addFinal lp tb
+                -- See comment above
+                Nothing -> void $ addDep $ packageName $ lpPackage lp
     let inner = do
             mapM_ onWanted $ filter lpWanted locals
             mapM_ addDep $ Set.toList extraToBuild0

From f113e0373047301da0d05036146f965686cf545f Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 08:09:56 +0300
Subject: [PATCH 12/20] Reenable flag usage checking

---
 src/Stack/Build/Source.hs | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs
index 6d9e3c1e83..41b969921d 100644
--- a/src/Stack/Build/Source.hs
+++ b/src/Stack/Build/Source.hs
@@ -108,6 +108,7 @@ loadSourceMap bopts = do
         latestVersion
 
     locals <- mapM (loadLocalPackage bopts targets) $ Map.toList rawLocals
+    checkFlagsUsed bopts locals
 
     let
         -- loadLocals returns PackageName (foo) and PackageIdentifier (bar-1.2.3) targets separately;
@@ -249,10 +250,18 @@ loadLocalPackage bopts targets (name, (lpv, gpkg)) = do
         , lpComponents = components
         }
 
-        {-
+-- | Ensure that the flags specified in the stack.yaml file and on the command
+-- line are used.
+checkFlagsUsed :: (MonadThrow m, MonadReader env m, HasBuildConfig env)
+               => BuildOpts
+               -> [LocalPackage]
+               -> m ()
+checkFlagsUsed bopts lps = do
+    bconfig <- asks getBuildConfig
+
         -- Check if flags specified in stack.yaml and the command line are
         -- used, see https://github.com/commercialhaskell/stack/issues/617
-        flags = map (, FSCommandLine) [(k, v) | (Just k, v) <- Map.toList $ boptsFlags bopts]
+    let flags = map (, FSCommandLine) [(k, v) | (Just k, v) <- Map.toList $ boptsFlags bopts]
              ++ map (, FSStackYaml) (Map.toList $ bcFlags bconfig)
 
         localNameMap = Map.fromList $ map (packageName . lpPackage &&& lpPackage) lps
@@ -275,7 +284,11 @@ loadLocalPackage bopts targets (name, (lpv, gpkg)) = do
                             else Just $ UFFlagsNotDefined source pkg unused
 
         unusedFlags = mapMaybe checkFlagUsed flags
--}
+
+    unless (null unusedFlags)
+        $ throwM
+        $ InvalidFlagSpecification
+        $ Set.fromList unusedFlags
 
 -- | All flags for a local package
 localFlags :: (Map (Maybe PackageName) (Map FlagName Bool))

From 1c08ab02edbb327c437da00e2986f0efa330a7ba Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 08:14:24 +0300
Subject: [PATCH 13/20] Fix spurious test failure

---
 test/integration/tests/617-extra-dep-flag/Main.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/integration/tests/617-extra-dep-flag/Main.hs b/test/integration/tests/617-extra-dep-flag/Main.hs
index e61b083aa4..50fcae4fa6 100644
--- a/test/integration/tests/617-extra-dep-flag/Main.hs
+++ b/test/integration/tests/617-extra-dep-flag/Main.hs
@@ -1,4 +1,4 @@
 import StackTest
 
 main :: IO ()
-main = stack ["build"]
+main = stack ["build", "acme-dont-1.1"]

From d2e03c51bbf892b32861badda5ff7d07a15dd590 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 09:00:04 +0300
Subject: [PATCH 14/20] Fix warnings

---
 src/Stack/Build/Execute.hs | 4 ++--
 src/Stack/Build/Source.hs  | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs
index e2775f57d5..01a172a3f7 100644
--- a/src/Stack/Build/Execute.hs
+++ b/src/Stack/Build/Execute.hs
@@ -15,7 +15,7 @@ module Stack.Build.Execute
     , withSingleContext
     ) where
 
-import           Control.Applicative            ((<$>), (<*>))
+import           Control.Applicative            ((<$>))
 import           Control.Concurrent.Execute
 import           Control.Concurrent.Lifted      (fork)
 import           Control.Concurrent.MVar.Lifted
@@ -854,7 +854,7 @@ singleBench :: M env m
             -> ExecuteEnv
             -> Task
             -> m ()
-singleBench beopts lptb ac ee task =
+singleBench beopts _lptb ac ee task =
     withSingleContext ac ee task (Just "bench") $ \_package cabalfp pkgDir cabal announce console _mlogFile -> do
         (_cache, neededConfig) <- ensureConfig pkgDir ee task (announce "configure (benchmarks)") cabal cabalfp ["--enable-benchmarks"]
 
diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs
index 41b969921d..bcbe71b1f1 100644
--- a/src/Stack/Build/Source.hs
+++ b/src/Stack/Build/Source.hs
@@ -14,7 +14,7 @@ module Stack.Build.Source
     , loadLocalPackage
     ) where
 
-import           Control.Applicative ((<|>), (<$>), (<*>))
+import           Control.Applicative ((<$>), (<*>))
 import           Control.Arrow ((&&&))
 import           Control.Exception (assert, catch)
 import           Control.Monad

From 9489e065000466b9cb7910499bf7d88c7b236f4b Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 09:23:49 +0300
Subject: [PATCH 15/20] --exec option #651

---
 ChangeLog.md                    |  2 ++
 src/Options/Applicative/Args.hs | 11 +++++++++++
 src/Stack/Build/Execute.hs      |  5 +++++
 src/Stack/Options.hs            |  8 +++++++-
 src/Stack/Types/Build.hs        |  3 +++
 5 files changed, 28 insertions(+), 1 deletion(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index 7f7b5d6fdb..1514d92204 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,6 +1,8 @@
 ## Unreleased changes
 
 * Detect unlisted modules and TemplateHaskell dependent files (#32, #105)
+* Overhauled target parsing, added `--test` and `--bench` options [#651](https://github.com/commercialhaskell/stack/issues/651)
+* `--exec` option [#651](https://github.com/commercialhaskell/stack/issues/651)
 
 ## 0.1.2.2
 
diff --git a/src/Options/Applicative/Args.hs b/src/Options/Applicative/Args.hs
index fafbb1fb92..bc7a025a61 100644
--- a/src/Options/Applicative/Args.hs
+++ b/src/Options/Applicative/Args.hs
@@ -5,6 +5,7 @@
 module Options.Applicative.Args
     (argsArgument
     ,argsOption
+    ,cmdOption
     ,parseArgsFromString)
     where
 
@@ -27,6 +28,16 @@ argsOption =
         (do string <- O.str
             either O.readerError return (parseArgsFromString string))
 
+-- | An option which accepts a command and a list of arguments e.g. @--exec "echo hello world"@
+cmdOption :: O.Mod O.OptionFields (String, [String]) -> O.Parser (String, [String])
+cmdOption =
+    O.option
+        (do string <- O.str
+            xs <- either O.readerError return (parseArgsFromString string)
+            case xs of
+                [] -> O.readerError "Must provide a command"
+                x:xs' -> return (x, xs'))
+
 -- | Parse from a string.
 parseArgsFromString :: String -> Either String [String]
 parseArgsFromString = P.parseOnly (argsParser Escaping) . T.pack
diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs
index 01a172a3f7..ca28acb5c1 100644
--- a/src/Stack/Build/Execute.hs
+++ b/src/Stack/Build/Execute.hs
@@ -79,6 +79,7 @@ import           System.IO
 import           System.IO.Temp                 (withSystemTempDirectory)
 import           System.Process.Internals       (createProcess_)
 import           System.Process.Read
+import           System.Process.Run
 import           System.Process.Log             (showProcessArgDebug)
 
 type M env m = (MonadIO m,MonadReader env m,HasHttpManager env,HasBuildConfig env,MonadLogger m,MonadBaseControl IO m,MonadCatch m,MonadMask m,HasLogLevel env,HasEnvConfig env,HasTerminal env)
@@ -304,6 +305,10 @@ executePlan menv bopts baseConfigOpts locals sourceMap plan = do
                 , ":"]
             forM_ executables $ \exe -> $logInfo $ T.append "- " exe
 
+    forM_ (boptsExec bopts) $ \(cmd, args) -> do
+        $logProcessRun cmd args
+        callProcess Nothing menv cmd args
+
 -- | Windows can't write over the current executable. Instead, we rename the
 -- current executable to something else and then do the copy.
 windowsRenameCopy :: FilePath -> FilePath -> IO ()
diff --git a/src/Stack/Options.hs b/src/Stack/Options.hs
index eeb1240b66..ad72535f5e 100644
--- a/src/Stack/Options.hs
+++ b/src/Stack/Options.hs
@@ -74,7 +74,8 @@ buildOptsParser cmd =
             ((||) <$> onlySnapshot <*> onlyDependencies) <*>
             fileWatch' <*> keepGoing <*> forceDirty <*>
             tests <*> testOptsParser <*>
-            benches <*> benchOptsParser
+            benches <*> benchOptsParser <*>
+            many exec
   where optimize =
           maybeBoolFlags "optimizations" "optimizations for TARGETs and all its dependencies" idm
         target =
@@ -164,6 +165,11 @@ buildOptsParser cmd =
             "benchmarking the project(s) in this directory/configuration"
             idm
 
+        exec = cmdOption
+            ( long "exec" <>
+              metavar "CMD [ARGS]" <>
+              help "Command and arguments to run after a successful build" )
+
 -- | Parser for package:[-]flag
 readFlag :: ReadM (Map (Maybe PackageName) (Map FlagName Bool))
 readFlag = do
diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs
index 226d3e0337..f5aad24795 100644
--- a/src/Stack/Types/Build.hs
+++ b/src/Stack/Types/Build.hs
@@ -375,6 +375,8 @@ data BuildOpts =
             -- ^ Turn on benchmarks for local targets
             ,boptsBenchmarkOpts :: !BenchmarkOpts
             -- ^ Additional test arguments
+            ,boptsExec :: ![(String, [String])]
+            -- ^ Commands (with arguments) to run after a successful build
             }
   deriving (Show)
 
@@ -399,6 +401,7 @@ defaultBuildOpts = BuildOpts
     , boptsTestOpts = defaultTestOpts
     , boptsBenchmarks = False
     , boptsBenchmarkOpts = defaultBenchmarkOpts
+    , boptsExec = []
     }
 
 -- | Options for the 'FinalAction' 'DoTests'

From 949c2774abaa9502e5c6c0084c148850f34abb4b Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 09:40:25 +0300
Subject: [PATCH 16/20] Factor tuple into a datatype

---
 src/Stack/Build/ConstructPlan.hs | 28 ++++++++++++++++++----------
 1 file changed, 18 insertions(+), 10 deletions(-)

diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs
index 275e440540..135abd8d7d 100644
--- a/src/Stack/Build/ConstructPlan.hs
+++ b/src/Stack/Build/ConstructPlan.hs
@@ -74,12 +74,20 @@ data AddDepRes
     | ADRFound InstallLocation Version Installed
     deriving Show
 
+data W = W
+    { wFinals :: !(Map PackageName (Either ConstructPlanException (Task, LocalPackageTB)))
+    , wInstall :: !(Map Text InstallLocation)
+    -- ^ executable to be installed, and location where the binary is placed
+    , wDirty :: !(Map PackageName Text)
+    -- ^ why a local package is considered dirty
+    }
+instance Monoid W where
+    mempty = W mempty mempty mempty
+    mappend (W a b c) (W w x y) = W (mappend a w) (mappend b x) (mappend c y)
+
 type M = RWST
     Ctx
-    ( Map PackageName (Either ConstructPlanException (Task, LocalPackageTB)) -- finals
-    , Map Text InstallLocation -- executable to be installed, and location where the binary is placed
-    , Map PackageName Text -- why a local package is considered dirty
-    )
+    W
     (Map PackageName (Either ConstructPlanException AddDepRes))
     IO
 
@@ -139,7 +147,7 @@ constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 locallyRegistered loadPa
     let inner = do
             mapM_ onWanted $ filter lpWanted locals
             mapM_ addDep $ Set.toList extraToBuild0
-    ((), m, (efinals, installExes, dirtyReason)) <- liftIO $ runRWST inner (ctx econfig latest) M.empty
+    ((), m, W efinals installExes dirtyReason) <- liftIO $ runRWST inner (ctx econfig latest) M.empty
     let toEither (_, Left e)  = Left e
         toEither (k, Right v) = Right (k, v)
         (errlibs, adrs) = partitionEithers $ map toEither $ M.toList m
@@ -226,7 +234,7 @@ addFinal lp lptb = do
                 , taskPresent = present
                 , taskType = TTLocal lp
                 }, lptb)
-    tell (Map.singleton (packageName package) res, mempty, mempty)
+    tell mempty { wFinals = Map.singleton (packageName package) res }
   where
     package = lptbPackage lptb
 
@@ -297,7 +305,7 @@ tellExecutablesPackage loc p = do
         goSource (PSLocal lp) = fromMaybe Set.empty $ lpExeComponents lp
         goSource (PSUpstream _ _ _) = Set.empty
 
-    tell (Map.empty, m myComps, Map.empty)
+    tell mempty { wInstall = m myComps }
   where
     m myComps = Map.fromList $ map (, loc) $ Set.toList
               $ filterComps myComps $ packageExes p
@@ -351,12 +359,12 @@ checkNeedInstall name ps installed wanted = assert (piiLocation ps == Local) $ d
         Right (missing, present, _loc)
             | Set.null missing -> checkDirtiness ps installed package present wanted
             | otherwise -> do
-                tell (Map.empty, Map.empty, Map.singleton name $
+                tell mempty { wDirty = Map.singleton name $
                     let t = T.intercalate ", " $ map (T.pack . packageNameString . packageIdentifierName) (Set.toList missing)
                      in T.append "missing dependencies: " $
                             if T.length t < 100
                                 then t
-                                else T.take 97 t <> "...")
+                                else T.take 97 t <> "..." }
                 return True
 
 addPackageDeps :: Package -> M (Either ConstructPlanException (Set PackageIdentifier, Set GhcPkgId, InstallLocation))
@@ -431,7 +439,7 @@ checkDirtiness ps installed package present wanted = do
     case mreason of
         Nothing -> return False
         Just reason -> do
-            tell (Map.empty, Map.empty, Map.singleton (packageName package) reason)
+            tell mempty { wDirty = Map.singleton (packageName package) reason }
             return True
 
 describeConfigDiff :: ConfigCache -> ConfigCache -> Text

From f8dcf8ef5bff5244556f731ead1e63085cd43d7a Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 10:06:40 +0300
Subject: [PATCH 17/20] Implement --only-dependencies #387 (pinging @gregwebs)

---
 ChangeLog.md                     |  1 +
 src/Stack/Build/ConstructPlan.hs | 86 ++++++++++++++++++++------------
 src/Stack/Options.hs             | 17 ++++---
 src/Stack/Types/Build.hs         | 16 ++++--
 4 files changed, 78 insertions(+), 42 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index 1514d92204..90565ad1aa 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -3,6 +3,7 @@
 * Detect unlisted modules and TemplateHaskell dependent files (#32, #105)
 * Overhauled target parsing, added `--test` and `--bench` options [#651](https://github.com/commercialhaskell/stack/issues/651)
 * `--exec` option [#651](https://github.com/commercialhaskell/stack/issues/651)
+* `--only-dependencies` implemented correctly [#387](https://github.com/commercialhaskell/stack/issues/387)
 
 ## 0.1.2.2
 
diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs
index 135abd8d7d..5b3b2f3e4d 100644
--- a/src/Stack/Build/ConstructPlan.hs
+++ b/src/Stack/Build/ConstructPlan.hs
@@ -80,10 +80,12 @@ data W = W
     -- ^ executable to be installed, and location where the binary is placed
     , wDirty :: !(Map PackageName Text)
     -- ^ why a local package is considered dirty
+    , wDeps :: !(Set PackageName)
+    -- ^ Packages which count as dependencies
     }
 instance Monoid W where
-    mempty = W mempty mempty mempty
-    mappend (W a b c) (W w x y) = W (mappend a w) (mappend b x) (mappend c y)
+    mempty = W mempty mempty mempty mempty
+    mappend (W a b c d) (W w x y z) = W (mappend a w) (mappend b x) (mappend c y) (mappend d z)
 
 type M = RWST
     Ctx
@@ -143,11 +145,11 @@ constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 locallyRegistered loadPa
             case lpTestBench lp of
                 Just tb -> addFinal lp tb
                 -- See comment above
-                Nothing -> void $ addDep $ packageName $ lpPackage lp
+                Nothing -> void $ addDep False $ packageName $ lpPackage lp
     let inner = do
             mapM_ onWanted $ filter lpWanted locals
-            mapM_ addDep $ Set.toList extraToBuild0
-    ((), m, W efinals installExes dirtyReason) <- liftIO $ runRWST inner (ctx econfig latest) M.empty
+            mapM_ (addDep False) $ Set.toList extraToBuild0
+    ((), m, W efinals installExes dirtyReason deps) <- liftIO $ runRWST inner (ctx econfig latest) M.empty
     let toEither (_, Left e)  = Left e
         toEither (k, Right v) = Right (k, v)
         (errlibs, adrs) = partitionEithers $ map toEither $ M.toList m
@@ -158,11 +160,12 @@ constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 locallyRegistered loadPa
             let toTask (_, ADRFound _ _ _) = Nothing
                 toTask (name, ADRToInstall task) = Just (name, task)
                 tasks = M.fromList $ mapMaybe toTask adrs
-                maybeStripLocals
-                    | boptsOnlySnapshot $ bcoBuildOpts baseConfigOpts0 =
-                        stripLocals
-                    | otherwise = id
-            return $ maybeStripLocals Plan
+                takeSubset =
+                    case boptsBuildSubset $ bcoBuildOpts baseConfigOpts0 of
+                        BSAll -> id
+                        BSOnlySnapshot -> stripLocals
+                        BSOnlyDependencies -> stripNonDeps deps
+            return $ takeSubset Plan
                 { planTasks = tasks
                 , planFinals = M.fromList finals
                 , planUnregisterLocal = mkUnregisterLocal tasks dirtyReason locallyRegistered
@@ -213,7 +216,7 @@ mkUnregisterLocal tasks dirtyReason locallyRegistered =
 
 addFinal :: LocalPackage -> LocalPackageTB -> M ()
 addFinal lp lptb = do
-    depsRes <- addPackageDeps package
+    depsRes <- addPackageDeps False package
     res <- case depsRes of
         Left e -> return $ Left e
         Right (missing, present, _minLoc) -> do
@@ -238,27 +241,33 @@ addFinal lp lptb = do
   where
     package = lptbPackage lptb
 
-addDep :: PackageName -> M (Either ConstructPlanException AddDepRes)
-addDep name = do
+addDep :: Bool -- ^ is this being used by a dependency?
+       -> PackageName -> M (Either ConstructPlanException AddDepRes)
+addDep treatAsDep' name = do
+    ctx <- ask
+    let treatAsDep = treatAsDep' || name `Set.notMember` wanted ctx
+    when treatAsDep $ markAsDep name
     m <- get
     case Map.lookup name m of
         Just res -> return res
         Nothing -> do
-            res <- addDep' name
+            res <- addDep' treatAsDep name
             modify $ Map.insert name res
             return res
 
-addDep' :: PackageName -> M (Either ConstructPlanException AddDepRes)
-addDep' name = do
+addDep' :: Bool -- ^ is this being used by a dependency?
+        -> PackageName -> M (Either ConstructPlanException AddDepRes)
+addDep' treatAsDep name = do
     ctx <- ask
     if name `elem` callStack ctx
         then return $ Left $ DependencyCycleDetected $ name : callStack ctx
         else local
             (\ctx' -> ctx' { callStack = name : callStack ctx' }) $ do
-            (addDep'' name)
+            (addDep'' treatAsDep name)
 
-addDep'' :: PackageName -> M (Either ConstructPlanException AddDepRes)
-addDep'' name = do
+addDep'' :: Bool -- ^ is this being used by a dependency?
+         -> PackageName -> M (Either ConstructPlanException AddDepRes)
+addDep'' treatAsDep name = do
     ctx <- ask
     case Map.lookup name $ combinedMap ctx of
         -- TODO look up in the package index and see if there's a
@@ -269,12 +278,12 @@ addDep'' name = do
             return $ Right $ ADRFound loc version installed
         Just (PIOnlySource ps) -> do
             tellExecutables name ps
-            installPackage name ps
+            installPackage treatAsDep name ps
         Just (PIBoth ps installed) -> do
             tellExecutables name ps
-            needInstall <- checkNeedInstall name ps installed (wanted ctx)
+            needInstall <- checkNeedInstall treatAsDep name ps installed (wanted ctx)
             if needInstall
-                then installPackage name ps
+                then installPackage treatAsDep name ps
                 else return $ Right $ ADRFound (piiLocation ps) (piiVersion ps) installed
 
 tellExecutables :: PackageName -> PackageSource -> M () -- TODO merge this with addFinal above?
@@ -319,11 +328,12 @@ tellExecutablesPackage loc p = do
 -- TODO There are a lot of duplicated computations below. I've kept that for
 -- simplicity right now
 
-installPackage :: PackageName -> PackageSource -> M (Either ConstructPlanException AddDepRes)
-installPackage name ps = do
+installPackage :: Bool -- ^ is this being used by a dependency?
+               -> PackageName -> PackageSource -> M (Either ConstructPlanException AddDepRes)
+installPackage treatAsDep name ps = do
     ctx <- ask
     package <- psPackage name ps
-    depsRes <- addPackageDeps package
+    depsRes <- addPackageDeps treatAsDep package
     case depsRes of
         Left e -> return $ Left e
         Right (missing, present, minLoc) -> do
@@ -350,10 +360,11 @@ installPackage name ps = do
                         PSUpstream _ loc _ -> TTUpstream package $ loc <> minLoc
                 }
 
-checkNeedInstall :: PackageName -> PackageSource -> Installed -> Set PackageName -> M Bool
-checkNeedInstall name ps installed wanted = assert (piiLocation ps == Local) $ do
+checkNeedInstall :: Bool
+                 -> PackageName -> PackageSource -> Installed -> Set PackageName -> M Bool
+checkNeedInstall treatAsDep name ps installed wanted = assert (piiLocation ps == Local) $ do
     package <- psPackage name ps
-    depsRes <- addPackageDeps package
+    depsRes <- addPackageDeps treatAsDep package
     case depsRes of
         Left _e -> return True -- installPackage will find the error again
         Right (missing, present, _loc)
@@ -367,12 +378,13 @@ checkNeedInstall name ps installed wanted = assert (piiLocation ps == Local) $ d
                                 else T.take 97 t <> "..." }
                 return True
 
-addPackageDeps :: Package -> M (Either ConstructPlanException (Set PackageIdentifier, Set GhcPkgId, InstallLocation))
-addPackageDeps package = do
+addPackageDeps :: Bool -- ^ is this being used by a dependency?
+               -> Package -> M (Either ConstructPlanException (Set PackageIdentifier, Set GhcPkgId, InstallLocation))
+addPackageDeps treatAsDep package = do
     ctx <- ask
     deps' <- packageDepsWithTools package
     deps <- forM (Map.toList deps') $ \(depname, range) -> do
-        eres <- addDep depname
+        eres <- addDep treatAsDep depname
         let mlatest = Map.lookup depname $ latestVersions ctx
         case eres of
             Left e ->
@@ -512,3 +524,15 @@ stripLocals plan = plan
             TTLocal _ -> False
             TTUpstream _ Local -> False
             TTUpstream _ Snap -> True
+
+stripNonDeps :: Set PackageName -> Plan -> Plan
+stripNonDeps deps plan = plan
+    { planTasks = Map.filter checkTask $ planTasks plan
+    , planFinals = Map.empty
+    , planInstallExes = Map.empty -- TODO maybe don't disable this?
+    }
+  where
+    checkTask task = packageIdentifierName (taskProvides task) `Set.member` deps
+
+markAsDep :: PackageName -> M ()
+markAsDep name = tell mempty { wDeps = Set.singleton name }
diff --git a/src/Stack/Options.hs b/src/Stack/Options.hs
index ad72535f5e..0a612314b5 100644
--- a/src/Stack/Options.hs
+++ b/src/Stack/Options.hs
@@ -71,7 +71,7 @@ buildOptsParser cmd =
             BuildOpts <$> target <*> libProfiling <*> exeProfiling <*>
             optimize <*> haddock <*> haddockDeps <*> dryRun <*> ghcOpts <*>
             flags <*> copyBins <*> preFetch <*>
-            ((||) <$> onlySnapshot <*> onlyDependencies) <*>
+            buildSubset <*>
             fileWatch' <*> keepGoing <*> forceDirty <*>
             tests <*> testOptsParser <*>
             benches <*> benchOptsParser <*>
@@ -134,12 +134,15 @@ buildOptsParser cmd =
         preFetch = flag False True
             (long "prefetch" <>
              help "Fetch packages necessary for the build immediately, useful with --dry-run")
-        onlySnapshot = flag False True
-            (long "only-snapshot" <>
-             help "Only build packages for the snapshot database, not the local database")
-        onlyDependencies = flag False True
-            (long "only-dependencies" <>
-             help "Currently: a synonym for only-snapshot, see https://github.com/commercialhaskell/stack/issues/387")
+
+        buildSubset =
+            flag' BSOnlySnapshot
+                (long "only-snapshot" <>
+                 help "Only build packages for the snapshot database, not the local database")
+            <|> flag' BSOnlyDependencies
+                (long "only-dependencies" <>
+                 help "Only build packages that are dependencies of targets on the command line")
+            <|> pure BSAll
 
         fileWatch' = flag False True
             (long "file-watch" <>
diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs
index f5aad24795..b51248b920 100644
--- a/src/Stack/Types/Build.hs
+++ b/src/Stack/Types/Build.hs
@@ -26,6 +26,7 @@ module Stack.Types.Build
     ,TestOpts(..)
     ,BenchmarkOpts(..)
     ,BuildOpts(..)
+    ,BuildSubset(..)
     ,defaultBuildOpts
     ,TaskType(..)
     ,TaskConfigOpts(..)
@@ -339,6 +340,15 @@ instance Show ConstructPlanException where
 
 ----------------------------------------------
 
+-- | Which subset of packages to build
+data BuildSubset
+    = BSAll
+    | BSOnlySnapshot
+    -- ^ Only install packages in the snapshot database, skipping
+    -- packages intended for the local database.
+    | BSOnlyDependencies
+    deriving Show
+
 -- | Configuration for building.
 data BuildOpts =
   BuildOpts {boptsTargets :: ![Text]
@@ -356,9 +366,7 @@ data BuildOpts =
             -- ^ Install executables to user path after building?
             ,boptsPreFetch :: !Bool
             -- ^ Fetch all packages immediately
-            ,boptsOnlySnapshot :: !Bool
-            -- ^ Only install packages in the snapshot database, skipping
-            -- packages intended for the local database.
+            ,boptsBuildSubset :: !BuildSubset
             ,boptsFileWatch :: !Bool
             -- ^ Watch files for changes and automatically rebuild
             ,boptsKeepGoing :: !(Maybe Bool)
@@ -393,7 +401,7 @@ defaultBuildOpts = BuildOpts
     , boptsFlags = Map.empty
     , boptsInstallExes = False
     , boptsPreFetch = False
-    , boptsOnlySnapshot = False
+    , boptsBuildSubset = BSAll
     , boptsFileWatch = False
     , boptsKeepGoing = Nothing
     , boptsForceDirty = False

From 268b373d2ee9fd1e17bf6dc5887412003ad5220d Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 11:44:51 +0300
Subject: [PATCH 18/20] Link wiki page from Changelog

---
 ChangeLog.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/ChangeLog.md b/ChangeLog.md
index 90565ad1aa..0b336100b3 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -2,6 +2,7 @@
 
 * Detect unlisted modules and TemplateHaskell dependent files (#32, #105)
 * Overhauled target parsing, added `--test` and `--bench` options [#651](https://github.com/commercialhaskell/stack/issues/651)
+    * For details, see [Build commands Wiki page](https://github.com/commercialhaskell/stack/wiki/Build-command)
 * `--exec` option [#651](https://github.com/commercialhaskell/stack/issues/651)
 * `--only-dependencies` implemented correctly [#387](https://github.com/commercialhaskell/stack/issues/387)
 

From 1637c989438de1b5cf0cd7d14fae1b4748ac782b Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 11:53:29 +0300
Subject: [PATCH 19/20] Add an extra TODO

---
 src/Stack/Build/Execute.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs
index ca28acb5c1..1456ff16a9 100644
--- a/src/Stack/Build/Execute.hs
+++ b/src/Stack/Build/Execute.hs
@@ -358,6 +358,9 @@ executePlan' plan ee@ExecuteEnv {..} = do
                 Just kg -> kg
                 Nothing -> boptsTests eeBuildOpts || boptsBenchmarks eeBuildOpts
         concurrentFinal =
+            -- TODO it probably makes more sense to use a lock for test suites
+            -- and just have the execution blocked. Turning off all concurrency
+            -- on finals based on the --test option doesn't fit in well.
             if boptsTests eeBuildOpts
                 then concurrentTests
                 else True

From eb014387785a069158b42ecd9f698bb61af77631 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Tue, 11 Aug 2015 11:59:28 +0300
Subject: [PATCH 20/20] Suggest stack init when using implicit global

---
 src/Stack/Build/Source.hs |  1 +
 src/Stack/Build/Target.hs | 12 +++++++-----
 src/Stack/Config.hs       |  1 +
 src/Stack/Types/Config.hs |  3 +++
 4 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs
index bcbe71b1f1..5bec623fe9 100644
--- a/src/Stack/Build/Source.hs
+++ b/src/Stack/Build/Source.hs
@@ -87,6 +87,7 @@ loadSourceMap bopts = do
     workingDir <- getWorkingDir
     (cliExtraDeps, targets) <-
         parseTargets
+            (bcImplicitGlobal bconfig)
             (boptsTests bopts)
             (boptsBenchmarks bopts)
             (mpiVersion <$> mbpPackages mbp0)
diff --git a/src/Stack/Build/Target.hs b/src/Stack/Build/Target.hs
index 9dc70c490e..a84d51c77b 100644
--- a/src/Stack/Build/Target.hs
+++ b/src/Stack/Build/Target.hs
@@ -285,7 +285,8 @@ simplifyTargets includeTests includeBenches =
     getLocalComp _ = Left ()
 
 parseTargets :: (MonadThrow m, MonadIO m)
-             => Bool -- ^ include tests
+             => Bool -- ^ using implicit global?
+             -> Bool -- ^ include tests
              -> Bool -- ^ include benchmarks
              -> Map PackageName Version -- ^ snapshot
              -> Map PackageName Version -- ^ extra deps
@@ -293,7 +294,7 @@ parseTargets :: (MonadThrow m, MonadIO m)
              -> Path Abs Dir -- ^ current directory
              -> [Text] -- ^ command line targets
              -> m (Map PackageName Version, Map PackageName SimpleTarget)
-parseTargets includeTests includeBenches snap extras locals currDir textTargets' = do
+parseTargets implicitGlobal includeTests includeBenches snap extras locals currDir textTargets' = do
     let textTargets =
             if null textTargets'
                 then map (T.pack . packageNameString) $ Map.keys $ Map.filter (not . lpvExtraDep) locals
@@ -310,8 +311,9 @@ parseTargets includeTests includeBenches snap extras locals currDir textTargets'
 
     if null errs
         then if Map.null targets
-                 -- TODO perhaps check if we're using the implicit global and,
-                 -- if so, recommend running stack init/new?
-                 then throwM $ TargetParseException ["The specified targets matched no packages"]
+                 then throwM $ TargetParseException
+                        $ if implicitGlobal
+                            then ["The specified targets matched no packages.\nPerhaps you need to run 'stack init'?"]
+                            else ["The specified targets matched no packages"]
                  else return (Map.unions newExtras, targets)
         else throwM $ TargetParseException errs
diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs
index f508797535..56ff708131 100644
--- a/src/Stack/Config.hs
+++ b/src/Stack/Config.hs
@@ -296,6 +296,7 @@ loadBuildConfig mproject config stackRoot mresolver = do
         , bcExtraDeps = projectExtraDeps project
         , bcStackYaml = stackYamlFP
         , bcFlags = projectFlags project
+        , bcImplicitGlobal = isNothing mproject
         }
 
 -- | Resolve a PackageEntry into a list of paths, downloading and cloning as
diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs
index 0e3c19793d..73d2162b89 100644
--- a/src/Stack/Types/Config.hs
+++ b/src/Stack/Types/Config.hs
@@ -240,6 +240,9 @@ data BuildConfig = BuildConfig
       -- different from bcRoot </> "stack.yaml"
     , bcFlags      :: !(Map PackageName (Map FlagName Bool))
       -- ^ Per-package flag overrides
+    , bcImplicitGlobal :: !Bool
+      -- ^ Are we loading from the implicit global stack.yaml? This is useful
+      -- for providing better error messages.
     }
 
 -- | Directory containing the project's stack.yaml file