diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,9 @@ +## 0.1.3.1 + +Bug fixes: + +* Ignore disabled executables [#763](https://github.com/commercialhaskell/stack/issues/763) + ## 0.1.3.0 Major changes: diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -37,7 +37,7 @@ import qualified Data.Map as Map import Data.Map.Strict (Map) import Data.Maybe -import Data.Monoid ((<>), Any (..), mconcat) +import Data.Monoid ((<>), Any (..), mconcat, mempty) import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) @@ -88,8 +88,6 @@ (cliExtraDeps, targets) <- parseTargets (bcImplicitGlobal bconfig) - (boptsTests bopts) - (boptsBenchmarks bopts) (mpiVersion <$> mbpPackages mbp0) (bcExtraDeps bconfig) (fst <$> rawLocals) @@ -119,7 +117,8 @@ nonLocalTargets = Map.keysSet $ Map.filter (not . isLocal) targets where - isLocal (STLocal _) = True + isLocal (STLocalComps _) = True + isLocal STLocalAll = True isLocal STUnknown = False isLocal STNonLocal = False @@ -203,26 +202,36 @@ bconfig <- asks getBuildConfig econfig <- asks getEnvConfig - 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 + let config = PackageConfig { packageConfigEnableTests = False , packageConfigEnableBenchmarks = False , packageConfigFlags = localFlags (boptsFlags bopts) bconfig name , packageConfigGhcVersion = envConfigGhcVersion econfig , packageConfigPlatform = configPlatform $ getConfig bconfig } + pkg = resolvePackage config gpkg + + mtarget = Map.lookup name targets + (exes, tests, benches) = + case mtarget of + Just (STLocalComps comps) -> splitComponents $ Set.toList comps + Just STLocalAll -> + ( packageExes pkg + , if boptsTests bopts + then packageTests pkg + else Set.empty + , if boptsBenchmarks bopts + then packageBenchmarks pkg + else Set.empty + ) + Just STNonLocal -> assert False mempty + Just STUnknown -> assert False mempty + Nothing -> mempty + 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 @@ -248,7 +257,11 @@ , lpNewBuildCache = newBuildCache , lpCabalFile = lpvCabalFP lpv , lpDir = lpvRoot lpv - , lpComponents = components + , lpComponents = Set.unions + [ Set.map CExe exes + , Set.map CTest tests + , Set.map CBench benches + ] } -- | Ensure that the flags specified in the stack.yaml file and on the command diff --git a/src/Stack/Build/Target.hs b/src/Stack/Build/Target.hs --- a/src/Stack/Build/Target.hs +++ b/src/Stack/Build/Target.hs @@ -129,16 +129,11 @@ then Just name else Nothing -data TargetType - = TTUnknown - | TTNonLocal - | TTLocalComp !NamedComponent - | TTLocalAllComps !(Set NamedComponent) - data SimpleTarget = STUnknown | STNonLocal - | STLocal !(Set NamedComponent) + | STLocalComps !(Set NamedComponent) + | STLocalAll deriving (Show, Eq, Ord) resolveIdents :: Map PackageName Version -- ^ snapshot @@ -180,7 +175,7 @@ -> Map PackageName Version -- ^ extra deps -> Map PackageName LocalPackageView -> (RawInput, RawTarget NoIdents) - -> Either Text (PackageName, (RawInput, TargetType)) + -> Either Text (PackageName, (RawInput, SimpleTarget)) resolveRawTarget snap extras locals (ri, rt) = go rt where @@ -191,7 +186,7 @@ case ucomp of ResolvedComponent comp | comp `Set.member` lpvComponents lpv -> - Right (name, (ri, TTLocalComp comp)) + Right (name, (ri, STLocalComps $ Set.singleton comp)) | otherwise -> Left $ T.pack $ concat [ "Component " , show comp @@ -206,7 +201,7 @@ , " does not exist in package " , T.pack $ packageNameString name ] - [x] -> Right (name, (ri, TTLocalComp x)) + [x] -> Right (name, (ri, STLocalComps $ Set.singleton x)) matches -> Left $ T.concat [ "Ambiguous component name " , comp @@ -222,7 +217,7 @@ 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)) + Right (name, (ri, STLocalComps $ Set.singleton comp)) matches -> Left $ T.concat [ "Ambiugous component name " , cname @@ -232,14 +227,14 @@ go (RTPackage name) = case Map.lookup name locals of - Just lpv -> Right (name, (ri, TTLocalAllComps $ lpvComponents lpv)) + Just _lpv -> Right (name, (ri, STLocalAll)) Nothing -> case Map.lookup name extras of - Just _ -> Right (name, (ri, TTNonLocal)) + Just _ -> Right (name, (ri, STNonLocal)) Nothing -> case Map.lookup name snap of - Just _ -> Right (name, (ri, TTNonLocal)) - Nothing -> Right (name, (ri, TTUnknown)) + Just _ -> Right (name, (ri, STNonLocal)) + Nothing -> Right (name, (ri, STUnknown)) isCompNamed :: Text -> NamedComponent -> Bool isCompNamed _ CLib = False @@ -247,26 +242,18 @@ isCompNamed t1 (CTest t2) = t1 == t2 isCompNamed t1 (CBench t2) = t1 == t2 -simplifyTargets :: Bool -- ^ include tests - -> Bool -- ^ include benchmarks - -> [(PackageName, (RawInput, TargetType))] +simplifyTargets :: [(PackageName, (RawInput, SimpleTarget))] -> ([Text], Map PackageName SimpleTarget) -simplifyTargets includeTests includeBenches = +simplifyTargets = mconcat . map go . Map.toList . Map.fromListWith (++) . fmap (second return) where - go :: (PackageName, [(RawInput, TargetType)]) + go :: (PackageName, [(RawInput, SimpleTarget)]) -> ([Text], Map PackageName SimpleTarget) go (_, []) = error "Stack.Build.Target.simplifyTargets: the impossible happened" - go (name, [(_, tt)]) = ([], Map.singleton name $ - case tt of - TTUnknown -> STUnknown - TTNonLocal -> STNonLocal - TTLocalComp comp -> STLocal $ Set.singleton comp - TTLocalAllComps comps -> STLocal $ Set.filter keepComp comps - ) + go (name, [(_, st)]) = ([], Map.singleton name st) go (name, pairs) = case partitionEithers $ map (getLocalComp . snd) pairs of - ([], comps) -> ([], Map.singleton name $ STLocal $ Set.fromList comps) + ([], comps) -> ([], Map.singleton name $ STLocalComps $ Set.unions comps) _ -> let err = T.pack $ concat [ "Overlapping targets provided for package " @@ -276,25 +263,18 @@ ] in ([err], Map.empty) - keepComp CLib = True - keepComp (CExe _) = True - keepComp (CTest _) = includeTests - keepComp (CBench _) = includeBenches - - getLocalComp (TTLocalComp comp) = Right comp + getLocalComp (STLocalComps comps) = Right comps getLocalComp _ = Left () parseTargets :: (MonadThrow m, MonadIO m) => Bool -- ^ using implicit global? - -> 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 SimpleTarget) -parseTargets implicitGlobal includeTests includeBenches snap extras locals currDir textTargets' = do +parseTargets implicitGlobal snap extras locals currDir textTargets' = do let textTargets = if null textTargets' then map (T.pack . packageNameString) $ Map.keys $ Map.filter (not . lpvExtraDep) locals @@ -306,7 +286,7 @@ map (resolveIdents snap extras locals) $ concat rawTargets (errs3, targetTypes) = partitionEithers $ map (resolveRawTarget snap extras locals) rawTargets' - (errs4, targets) = simplifyTargets includeTests includeBenches targetTypes + (errs4, targets) = simplifyTargets targetTypes errs = concat [errs1, errs2, errs3, errs4] if null errs diff --git a/stack.cabal b/stack.cabal --- a/stack.cabal +++ b/stack.cabal @@ -1,5 +1,5 @@ name: stack -version: 0.1.3.0 +version: 0.1.3.1 synopsis: The Haskell Tool Stack description: Please see the README.md for usage information, and the wiki on Github for more details. Also, note that