diff --git a/ChangeLog.md b/ChangeLog.md index 4649ad791c..11937af918 100644 --- 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 index 5bec623fe9..c23eb6d132 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -37,7 +37,7 @@ import Data.List 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 @@ loadSourceMap bopts = do (cliExtraDeps, targets) <- parseTargets (bcImplicitGlobal bconfig) - (boptsTests bopts) - (boptsBenchmarks bopts) (mpiVersion <$> mbpPackages mbp0) (bcExtraDeps bconfig) (fst <$> rawLocals) @@ -119,7 +117,8 @@ loadSourceMap bopts = do 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 @@ loadLocalPackage bopts targets (name, (lpv, gpkg)) = do 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 @@ loadLocalPackage bopts targets (name, (lpv, gpkg)) = do , 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 index a84d51c77b..197cff3448 100644 --- a/src/Stack/Build/Target.hs +++ b/src/Stack/Build/Target.hs @@ -129,16 +129,11 @@ parseRawTargetDirs root locals t = 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 @@ resolveRawTarget :: Map PackageName Version -- ^ snapshot -> 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 @@ resolveRawTarget snap extras locals (ri, rt) = 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 @@ resolveRawTarget snap extras locals (ri, rt) = , " 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 @@ resolveRawTarget snap extras locals (ri, rt) = 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 @@ resolveRawTarget snap extras locals (ri, rt) = 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 (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))] +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 @@ simplifyTargets includeTests includeBenches = ] 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 @@ parseTargets implicitGlobal includeTests includeBenches snap extras locals currD 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 index 572df0f015..58bc90d66d 100644 --- 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 diff --git a/test/integration/tests/443-specify-path/Main.hs b/test/integration/tests/443-specify-path/Main.hs index 621bf652f6..572e1f7e6a 100644 --- a/test/integration/tests/443-specify-path/Main.hs +++ b/test/integration/tests/443-specify-path/Main.hs @@ -1,27 +1,30 @@ import StackTest import System.Directory import System.FilePath +import System.Info (os) main :: IO () main = do + let ext = if os == "mingw32" then ".exe" else "" + -- install in relative path createDirectory "bin" stack ["--local-bin-path", "./bin", "install" , "happy"] - doesExist "./bin/happy" + doesExist ("./bin/happy" ++ ext) -- Default install -- This seems to fail due to direcory being cleaned up, -- a manual test of the default stack install is required -- defaultDir <- getAppUserDataDirectory "local" -- stack ["install", "happy"] - -- doesExist (defaultDir ++ "/bin/happy") + -- doesExist (defaultDir ++ "/bin/happy" ++ ext) -- install in current dir stack ["--local-bin-path", ".", "install", "happy" ] - doesExist "happy" + doesExist ("happy" ++ ext) -- install in absolute path tmpDirectory <- fmap ( "absolute-bin") getCurrentDirectory createDirectory tmpDirectory stack ["--local-bin-path", tmpDirectory, "install", "happy" ] - doesExist (tmpDirectory "happy") + doesExist (tmpDirectory ("happy" ++ ext))