diff --git a/.stan.toml b/.stan.toml index 00411fa02c..bb90593661 100644 --- a/.stan.toml +++ b/.stan.toml @@ -63,7 +63,7 @@ # Anti-pattern: Data.ByteString.Char8.pack [[ignore]] - id = "OBS-STAN-0203-fki0nd-2614:3" + id = "OBS-STAN-0203-fki0nd-2626:3" # ✦ Description: Usage of 'pack' function that doesn't handle Unicode characters # ✦ Category: #AntiPattern # ✦ File: src\Stack\Build\Execute.hs diff --git a/src/Stack/Build.hs b/src/Stack/Build.hs index 3fa6099862..73969daea7 100644 --- a/src/Stack/Build.hs +++ b/src/Stack/Build.hs @@ -163,7 +163,13 @@ build msetLocalFiles = do getInstalled installMap baseConfigOpts <- mkBaseConfigOpts boptsCli - plan <- constructPlan baseConfigOpts localDumpPkgs loadPackage sourceMap installedMap (boptsCLIInitialBuildSteps boptsCli) + plan <- constructPlan + baseConfigOpts + localDumpPkgs + loadPackage + sourceMap + installedMap + (boptsCLIInitialBuildSteps boptsCli) allowLocals <- view $ configL.to configAllowLocals unless allowLocals $ case justLocals plan of diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index 85db150788..439962e8b4 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -238,73 +238,81 @@ constructPlan :: -> InstalledMap -> Bool -> RIO env Plan -constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap initialBuildSteps = do - logDebug "Constructing the build plan" - - when hasBaseInDeps $ - prettyWarn $ - fillSep - [ flow "You are trying to upgrade or downgrade the" - , style Current "base" - , flow "package, which is almost certainly not what you really \ - \want. Please, consider using another GHC version if you \ - \need a certain version of" - , style Current "base" <> "," - , flow "or removing" - , style Current "base" - , flow "as an" - , style Shell "extra-deps" <> "." - , flow "For further information, see" - , style Url "https://github.com/commercialhaskell/stack/issues/3940" <> "." - ] - <> line - - econfig <- view envConfigL - globalCabalVersion <- view $ compilerPathsL.to cpCabalVersion - sources <- getSources globalCabalVersion - mcur <- view $ buildConfigL.to bcCurator - - let onTarget = void . getCachedDepOrAddDep - let inner = mapM_ onTarget $ Map.keys (smtTargets $ smTargets sourceMap) - pathEnvVar' <- liftIO $ maybe mempty T.pack <$> lookupEnv "PATH" - let ctx = mkCtx econfig globalCabalVersion sources mcur pathEnvVar' - ((), m, W efinals installExes dirtyReason warnings parents) <- - liftIO $ runRWST inner ctx Map.empty - mapM_ prettyWarn (warnings []) - let toEither (_, Left e) = Left e - toEither (k, Right v) = Right (k, v) - (errlibs, adrs) = partitionEithers $ map toEither $ Map.toList m - (errfinals, finals) = partitionEithers $ map toEither $ Map.toList efinals - errs = errlibs ++ errfinals - if null errs - then do - let toTask (_, ADRFound _ _) = Nothing - toTask (name, ADRToInstall task) = Just (name, task) - tasks = Map.fromList $ mapMaybe toTask adrs - takeSubset = - case boptsCLIBuildSubset $ bcoBuildOptsCLI baseConfigOpts0 of - BSAll -> pure - BSOnlySnapshot -> pure . stripLocals - BSOnlyDependencies -> - pure . stripNonDeps (Map.keysSet $ smDeps sourceMap) - BSOnlyLocals -> errorOnSnapshot - takeSubset Plan - { planTasks = tasks - , planFinals = Map.fromList finals - , planUnregisterLocal = - mkUnregisterLocal tasks dirtyReason localDumpPkgs initialBuildSteps - , planInstallExes = - if boptsInstallExes (bcoBuildOpts baseConfigOpts0) || - boptsInstallCompilerTool (bcoBuildOpts baseConfigOpts0) - then installExes - else Map.empty - } - else do - stackYaml <- view stackYamlL - stackRoot <- view stackRootL - isImplicitGlobal <- view $ configL.to (isPCGlobalProject . configProject) - prettyThrowM $ ConstructPlanFailed - errs stackYaml stackRoot isImplicitGlobal parents (wanted ctx) prunedGlobalDeps +constructPlan + baseConfigOpts0 + localDumpPkgs + loadPackage0 + sourceMap + installedMap + initialBuildSteps + = do + logDebug "Constructing the build plan" + + when hasBaseInDeps $ + prettyWarn $ + fillSep + [ flow "You are trying to upgrade or downgrade the" + , style Current "base" + , flow "package, which is almost certainly not what you really \ + \want. Please, consider using another GHC version if you \ + \need a certain version of" + , style Current "base" <> "," + , flow "or removing" + , style Current "base" + , flow "as an" + , style Shell "extra-deps" <> "." + , flow "For further information, see" + , style Url "https://github.com/commercialhaskell/stack/issues/3940" <> "." + ] + <> line + + econfig <- view envConfigL + globalCabalVersion <- view $ compilerPathsL.to cpCabalVersion + sources <- getSources globalCabalVersion + mcur <- view $ buildConfigL.to bcCurator + + let onTarget = void . getCachedDepOrAddDep + let inner = mapM_ onTarget $ Map.keys (smtTargets $ smTargets sourceMap) + pathEnvVar' <- liftIO $ maybe mempty T.pack <$> lookupEnv "PATH" + let ctx = mkCtx econfig globalCabalVersion sources mcur pathEnvVar' + ((), m, W efinals installExes dirtyReason warnings parents) <- + liftIO $ runRWST inner ctx Map.empty + mapM_ prettyWarn (warnings []) + let toEither (_, Left e) = Left e + toEither (k, Right v) = Right (k, v) + (errlibs, adrs) = partitionEithers $ map toEither $ Map.toList m + (errfinals, finals) = + partitionEithers $ map toEither $ Map.toList efinals + errs = errlibs ++ errfinals + if null errs + then do + let toTask (_, ADRFound _ _) = Nothing + toTask (name, ADRToInstall task) = Just (name, task) + tasks = Map.fromList $ mapMaybe toTask adrs + takeSubset = + case boptsCLIBuildSubset $ bcoBuildOptsCLI baseConfigOpts0 of + BSAll -> pure + BSOnlySnapshot -> pure . stripLocals + BSOnlyDependencies -> + pure . stripNonDeps (Map.keysSet $ smDeps sourceMap) + BSOnlyLocals -> errorOnSnapshot + takeSubset Plan + { planTasks = tasks + , planFinals = Map.fromList finals + , planUnregisterLocal = + mkUnregisterLocal tasks dirtyReason localDumpPkgs initialBuildSteps + , planInstallExes = + if boptsInstallExes (bcoBuildOpts baseConfigOpts0) || + boptsInstallCompilerTool (bcoBuildOpts baseConfigOpts0) + then installExes + else Map.empty + } + else do + stackYaml <- view stackYamlL + stackRoot <- view stackRootL + isImplicitGlobal <- view $ configL.to (isPCGlobalProject . configProject) + prettyThrowM $ ConstructPlanFailed + errs stackYaml stackRoot isImplicitGlobal parents (wanted ctx) prunedGlobalDeps where hasBaseInDeps = Map.member (mkPackageName "base") (smDeps sourceMap) @@ -1023,11 +1031,10 @@ addPackageDeps package = do ) ) case partitionEithers deps of - -- Note that the Monoid for 'InstallLocation' means that if any - -- is 'Local', the result is 'Local', indicating that the parent - -- package must be installed locally. Otherwise the result is - -- 'Snap', indicating that the parent can either be installed - -- locally or in the snapshot. + -- Note that the Monoid for 'InstallLocation' means that if any is 'Local', + -- the result is 'Local', indicating that the parent package must be + -- installed locally. Otherwise the result is 'Snap', indicating that the + -- parent can either be installed locally or in the snapshot. ([], pairs) -> pure $ Right $ mconcat pairs (errs, _) -> pure $ Left $ DependencyPlanFailures package diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 1612a9abda..ec7115543e 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1280,11 +1280,17 @@ withSingleContext :: -> OutputType -> RIO env a) -> RIO env a -withSingleContext ActionContext {..} ee@ExecuteEnv {..} task@Task {..} allDeps msuffix inner0 = - withPackage $ \package cabalfp pkgDir -> - withOutputType pkgDir package $ \outputType -> - withCabal package pkgDir outputType $ \cabal -> - inner0 package cabalfp pkgDir cabal announce outputType +withSingleContext + ActionContext {..} + ee@ExecuteEnv {..} + task@Task {..} + allDeps + msuffix + inner0 + = withPackage $ \package cabalfp pkgDir -> + withOutputType pkgDir package $ \outputType -> + withCabal package pkgDir outputType $ \cabal -> + inner0 package cabalfp pkgDir cabal announce outputType where announce = announceTask ee task prettyAnnounce = prettyAnnounceTask ee task @@ -1650,22 +1656,28 @@ singleBuild :: forall env. (HasEnvConfig env, HasRunner env) -> InstalledMap -> Bool -- ^ Is this a final build? -> RIO env () -singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap isFinalBuild = do - (allDepsMap, cache) <- - getConfigCache ee task installedMap enableTests enableBenchmarks - mprecompiled <- getPrecompiled cache - minstalled <- - case mprecompiled of - Just precompiled -> copyPreCompiled precompiled - Nothing -> do - mcurator <- view $ buildConfigL.to bcCurator - realConfigAndBuild cache mcurator allDepsMap - case minstalled of - Nothing -> pure () - Just installed -> do - writeFlagCache installed cache - liftIO $ atomically $ - modifyTVar eeGhcPkgIds $ Map.insert taskProvides installed +singleBuild + ac@ActionContext {..} + ee@ExecuteEnv {..} + task@Task {..} + installedMap + isFinalBuild + = do + (allDepsMap, cache) <- + getConfigCache ee task installedMap enableTests enableBenchmarks + mprecompiled <- getPrecompiled cache + minstalled <- + case mprecompiled of + Just precompiled -> copyPreCompiled precompiled + Nothing -> do + mcurator <- view $ buildConfigL.to bcCurator + realConfigAndBuild cache mcurator allDepsMap + case minstalled of + Nothing -> pure () + Just installed -> do + writeFlagCache installed cache + liftIO $ atomically $ + modifyTVar eeGhcPkgIds $ Map.insert taskProvides installed where PackageIdentifier pname pversion = taskProvides doHaddock mcurator package = diff --git a/src/Stack/Build/Haddock.hs b/src/Stack/Build/Haddock.hs index c7dffdcf60..c8dbd7f035 100644 --- a/src/Stack/Build/Haddock.hs +++ b/src/Stack/Build/Haddock.hs @@ -377,13 +377,13 @@ generateLocalHaddockForHackageArchive pkgDir pkgId = do <> line <> pretty tarGzFile -createTarGzFile - :: Path Abs File - -- ^ Full path to archive file +createTarGzFile :: + Path Abs File + -- ^ Full path to archive file -> Path Abs Dir - -- ^ Base directory + -- ^ Base directory -> Path Rel Dir - -- ^ Directory to archive, relative to base directory + -- ^ Directory to archive, relative to base directory -> RIO env () createTarGzFile tar base dir = do entries <- liftIO $ Tar.pack base' [dir'] diff --git a/src/Stack/BuildPlan.hs b/src/Stack/BuildPlan.hs index ecae64712c..620dcedde5 100644 --- a/src/Stack/BuildPlan.hs +++ b/src/Stack/BuildPlan.hs @@ -3,19 +3,18 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} --- | Resolving a build plan for a set of packages in a given Stackage --- snapshot. +-- | Resolving a build plan for a set of packages in a given Stackage snapshot. module Stack.BuildPlan - ( BuildPlanException (..) - , BuildPlanCheck (..) - , checkSnapBuildPlan - , DepError (..) - , DepErrors - , removeSrcPkgDefaultFlags - , selectBestSnapshot - , showItems - ) where + ( BuildPlanException (..) + , BuildPlanCheck (..) + , checkSnapBuildPlan + , DepError (..) + , DepErrors + , removeSrcPkgDefaultFlags + , selectBestSnapshot + , showItems + ) where import qualified Data.Foldable as F import Data.List (intercalate) @@ -59,294 +58,304 @@ import Stack.Types.Version ( VersionRange, withinRange ) -- | Type representing exceptions thrown by functions exported by the -- "Stack.BuildPlan" module. data BuildPlanException - = UnknownPackages - (Path Abs File) -- stack.yaml file - (Map PackageName (Maybe Version, Set PackageName)) -- truly unknown - (Map PackageName (Set PackageIdentifier)) -- shadowed - | SnapshotNotFound SnapName - | NeitherCompilerOrResolverSpecified T.Text - | DuplicatePackagesBug - deriving (Show, Typeable) + = UnknownPackages + (Path Abs File) -- stack.yaml file + (Map PackageName (Maybe Version, Set PackageName)) -- truly unknown + (Map PackageName (Set PackageIdentifier)) -- shadowed + | SnapshotNotFound SnapName + | NeitherCompilerOrResolverSpecified T.Text + | DuplicatePackagesBug + deriving (Show, Typeable) instance Exception BuildPlanException where - displayException (SnapshotNotFound snapName) = unlines - [ "Error: [S-2045]" - , "SnapshotNotFound " ++ snapName' - , "Non existing resolver: " ++ snapName' ++ "." - , "For a complete list of available snapshots see https://www.stackage.org/snapshots" + displayException (SnapshotNotFound snapName) = unlines + [ "Error: [S-2045]" + , "SnapshotNotFound " ++ snapName' + , "Non existing resolver: " ++ snapName' ++ "." + , "For a complete list of available snapshots see https://www.stackage.org/snapshots" + ] + where + snapName' = show snapName + displayException (UnknownPackages stackYaml unknown shadowed) = + "Error: [S-7571]\n" + ++ unlines (unknown' ++ shadowed') + where + unknown' :: [String] + unknown' + | Map.null unknown = [] + | otherwise = concat + [ ["The following packages do not exist in the build plan:"] + , map go (Map.toList unknown) + , case mapMaybe goRecommend $ Map.toList unknown of + [] -> [] + rec -> + ("Recommended action: modify the extra-deps field of " ++ + toFilePath stackYaml ++ + " to include the following:") + : (rec + ++ ["Note: further dependencies may need to be added"]) + , case mapMaybe getNoKnown $ Map.toList unknown of + [] -> [] + noKnown -> + [ "There are no known versions of the following packages:" + , intercalate ", " $ map packageNameString noKnown + ] + ] + where + go (dep, (_, users)) | Set.null users = packageNameString dep + go (dep, (_, users)) = concat + [ packageNameString dep + , " (used by " + , intercalate ", " $ map packageNameString $ Set.toList users + , ")" ] - where - snapName' = show snapName - displayException (UnknownPackages stackYaml unknown shadowed) = - "Error: [S-7571]\n" - ++ unlines (unknown' ++ shadowed') - where - unknown' :: [String] - unknown' - | Map.null unknown = [] - | otherwise = concat - [ ["The following packages do not exist in the build plan:"] - , map go (Map.toList unknown) - , case mapMaybe goRecommend $ Map.toList unknown of - [] -> [] - rec -> - ("Recommended action: modify the extra-deps field of " ++ - toFilePath stackYaml ++ - " to include the following:") - : (rec - ++ ["Note: further dependencies may need to be added"]) - , case mapMaybe getNoKnown $ Map.toList unknown of - [] -> [] - noKnown -> - [ "There are no known versions of the following packages:" - , intercalate ", " $ map packageNameString noKnown - ] - ] - where - go (dep, (_, users)) | Set.null users = packageNameString dep - go (dep, (_, users)) = concat - [ packageNameString dep - , " (used by " - , intercalate ", " $ map packageNameString $ Set.toList users - , ")" - ] - - goRecommend (name, (Just version, _)) = - Just $ "- " ++ packageIdentifierString (PackageIdentifier name version) - goRecommend (_, (Nothing, _)) = Nothing - - getNoKnown (name, (Nothing, _)) = Just name - getNoKnown (_, (Just _, _)) = Nothing - - shadowed' :: [String] - shadowed' - | Map.null shadowed = [] - | otherwise = concat - [ ["The following packages are shadowed by local packages:"] - , map go (Map.toList shadowed) - , ["Recommended action: modify the extra-deps field of " ++ - toFilePath stackYaml ++ - " to include the following:"] - , extraDeps - , ["Note: further dependencies may need to be added"] - ] - where - go (dep, users) | Set.null users = packageNameString dep ++ " (internal Stack error: this should never be null)" - go (dep, users) = concat - [ packageNameString dep - , " (used by " - , intercalate ", " - $ map (packageNameString . pkgName) - $ Set.toList users - , ")" - ] - - extraDeps = map (\ident -> "- " ++ packageIdentifierString ident) - $ Set.toList - $ Set.unions - $ Map.elems shadowed - displayException (NeitherCompilerOrResolverSpecified url) = concat - [ "Error: [S-8559]\n" - , "Failed to load custom snapshot at " - , T.unpack url - , ", because no 'compiler' or 'resolver' is specified." + + goRecommend (name, (Just version, _)) = + Just $ "- " ++ packageIdentifierString (PackageIdentifier name version) + goRecommend (_, (Nothing, _)) = Nothing + + getNoKnown (name, (Nothing, _)) = Just name + getNoKnown (_, (Just _, _)) = Nothing + + shadowed' :: [String] + shadowed' + | Map.null shadowed = [] + | otherwise = concat + [ ["The following packages are shadowed by local packages:"] + , map go (Map.toList shadowed) + , ["Recommended action: modify the extra-deps field of " ++ + toFilePath stackYaml ++ + " to include the following:"] + , extraDeps + , ["Note: further dependencies may need to be added"] + ] + where + go (dep, users) | Set.null users = packageNameString dep ++ " (internal Stack error: this should never be null)" + go (dep, users) = concat + [ packageNameString dep + , " (used by " + , intercalate ", " + $ map (packageNameString . pkgName) + $ Set.toList users + , ")" ] - displayException DuplicatePackagesBug = bugReport "[S-5743]" - "Duplicate packages are not expected here." + + extraDeps = map (\ident -> "- " ++ packageIdentifierString ident) + $ Set.toList + $ Set.unions + $ Map.elems shadowed + displayException (NeitherCompilerOrResolverSpecified url) = concat + [ "Error: [S-8559]\n" + , "Failed to load custom snapshot at " + , T.unpack url + , ", because no 'compiler' or 'resolver' is specified." + ] + displayException DuplicatePackagesBug = bugReport "[S-5743]" + "Duplicate packages are not expected here." gpdPackages :: [GenericPackageDescription] -> Map PackageName Version gpdPackages = Map.fromList . map (toPair . C.package . C.packageDescription) - where - toPair (C.PackageIdentifier name version) = (name, version) + where + toPair (C.PackageIdentifier name version) = (name, version) gpdPackageDeps :: - GenericPackageDescription - -> ActualCompiler - -> Platform - -> Map FlagName Bool - -> Map PackageName VersionRange + GenericPackageDescription + -> ActualCompiler + -> Platform + -> Map FlagName Bool + -> Map PackageName VersionRange gpdPackageDeps gpd ac platform flags = - Map.filterWithKey (const . not . isLocalLibrary) (packageDependencies pkgDesc) - where - isLocalLibrary name' = name' == name || name' `Set.member` subs - - name = gpdPackageName gpd - subs = Set.fromList - $ map (C.mkPackageName . unUnqualComponentName . fst) - $ C.condSubLibraries gpd - - -- Since tests and benchmarks are both enabled, doesn't matter - -- if we choose modified or unmodified - pkgDesc = pdpModifiedBuildable $ resolvePackageDescription pkgConfig gpd - pkgConfig = PackageConfig - { packageConfigEnableTests = True - , packageConfigEnableBenchmarks = True - , packageConfigFlags = flags - , packageConfigGhcOptions = [] - , packageConfigCabalConfigOpts = [] - , packageConfigCompilerVersion = ac - , packageConfigPlatform = platform - } + Map.filterWithKey (const . not . isLocalLibrary) (packageDependencies pkgDesc) + where + isLocalLibrary name' = name' == name || name' `Set.member` subs + + name = gpdPackageName gpd + subs = Set.fromList + $ map (C.mkPackageName . unUnqualComponentName . fst) + $ C.condSubLibraries gpd + + -- Since tests and benchmarks are both enabled, doesn't matter + -- if we choose modified or unmodified + pkgDesc = pdpModifiedBuildable $ resolvePackageDescription pkgConfig gpd + pkgConfig = PackageConfig + { packageConfigEnableTests = True + , packageConfigEnableBenchmarks = True + , packageConfigFlags = flags + , packageConfigGhcOptions = [] + , packageConfigCabalConfigOpts = [] + , packageConfigCompilerVersion = ac + , packageConfigPlatform = platform + } -- Remove any src package flags having default values -- Remove any package entries with no flags set -removeSrcPkgDefaultFlags :: [C.GenericPackageDescription] - -> Map PackageName (Map FlagName Bool) - -> Map PackageName (Map FlagName Bool) +removeSrcPkgDefaultFlags :: + [C.GenericPackageDescription] + -> Map PackageName (Map FlagName Bool) + -> Map PackageName (Map FlagName Bool) removeSrcPkgDefaultFlags gpds flags = - let defaults = Map.unions (map gpdDefaultFlags gpds) - flags' = Map.differenceWith removeSame flags defaults - in Map.filter (not . Map.null) flags' - where - removeSame f1 f2 = - let diff v v' = if v == v' then Nothing else Just v - in Just $ Map.differenceWith diff f1 f2 - - gpdDefaultFlags gpd = - let tuples = map getDefault (C.genPackageFlags gpd) - in Map.singleton (gpdPackageName gpd) (Map.fromList tuples) - - getDefault f - | C.flagDefault f = (C.flagName f, True) - | otherwise = (C.flagName f, False) + let defaults = Map.unions (map gpdDefaultFlags gpds) + flags' = Map.differenceWith removeSame flags defaults + in Map.filter (not . Map.null) flags' + where + removeSame f1 f2 = + let diff v v' = if v == v' then Nothing else Just v + in Just $ Map.differenceWith diff f1 f2 + + gpdDefaultFlags gpd = + let tuples = map getDefault (C.genPackageFlags gpd) + in Map.singleton (gpdPackageName gpd) (Map.fromList tuples) + + getDefault f + | C.flagDefault f = (C.flagName f, True) + | otherwise = (C.flagName f, False) -- | Find the set of @FlagName@s necessary to get the given -- @GenericPackageDescription@ to compile against the given @BuildPlan@. Will -- only modify non-manual flags, and will prefer default values for flags. -- Returns the plan which produces least number of dep errors selectPackageBuildPlan :: - Platform - -> ActualCompiler - -> Map PackageName Version - -> GenericPackageDescription - -> (Map PackageName (Map FlagName Bool), DepErrors) + Platform + -> ActualCompiler + -> Map PackageName Version + -> GenericPackageDescription + -> (Map PackageName (Map FlagName Bool), DepErrors) selectPackageBuildPlan platform compiler pool gpd = - (selectPlan . limitSearchSpace . NE.map makePlan) flagCombinations - where - selectPlan :: NonEmpty (a, DepErrors) -> (a, DepErrors) - selectPlan = F.foldr1 fewerErrors - where - fewerErrors p1 p2 - | nErrors p1 == 0 = p1 - | nErrors p1 <= nErrors p2 = p1 - | otherwise = p2 - where - nErrors = Map.size . snd - - -- Avoid exponential complexity in flag combinations making us sad pandas. - -- See: https://github.com/commercialhaskell/stack/issues/543 - limitSearchSpace :: NonEmpty a -> NonEmpty a - limitSearchSpace (x :| xs) = x :| take (maxFlagCombinations - 1) xs + (selectPlan . limitSearchSpace . NE.map makePlan) flagCombinations + where + selectPlan :: NonEmpty (a, DepErrors) -> (a, DepErrors) + selectPlan = F.foldr1 fewerErrors + where + fewerErrors p1 p2 + | nErrors p1 == 0 = p1 + | nErrors p1 <= nErrors p2 = p1 + | otherwise = p2 where - maxFlagCombinations = 128 - - makePlan :: [(FlagName, Bool)] -> (Map PackageName (Map FlagName Bool), DepErrors) - makePlan flags = checkPackageBuildPlan platform compiler pool (Map.fromList flags) gpd - - flagCombinations :: NonEmpty [(FlagName, Bool)] - flagCombinations = mapM getOptions (genPackageFlags gpd) - where - getOptions :: C.PackageFlag -> NonEmpty (FlagName, Bool) - getOptions f - | flagManual f = (fname, flagDefault f) :| [] - | flagDefault f = (fname, True) :| [(fname, False)] - | otherwise = (fname, False) :| [(fname, True)] - where - fname = flagName f + nErrors = Map.size . snd + + -- Avoid exponential complexity in flag combinations making us sad pandas. + -- See: https://github.com/commercialhaskell/stack/issues/543 + limitSearchSpace :: NonEmpty a -> NonEmpty a + limitSearchSpace (x :| xs) = x :| take (maxFlagCombinations - 1) xs + where + maxFlagCombinations = 128 + + makePlan :: + [(FlagName, Bool)] + -> (Map PackageName (Map FlagName Bool), DepErrors) + makePlan flags = + checkPackageBuildPlan platform compiler pool (Map.fromList flags) gpd + + flagCombinations :: NonEmpty [(FlagName, Bool)] + flagCombinations = mapM getOptions (genPackageFlags gpd) + where + getOptions :: C.PackageFlag -> NonEmpty (FlagName, Bool) + getOptions f + | flagManual f = (fname, flagDefault f) :| [] + | flagDefault f = (fname, True) :| [(fname, False)] + | otherwise = (fname, False) :| [(fname, True)] + where + fname = flagName f -- | Check whether with the given set of flags a package's dependency -- constraints can be satisfied against a given build plan or pool of packages. checkPackageBuildPlan :: - Platform - -> ActualCompiler - -> Map PackageName Version - -> Map FlagName Bool - -> GenericPackageDescription - -> (Map PackageName (Map FlagName Bool), DepErrors) + Platform + -> ActualCompiler + -> Map PackageName Version + -> Map FlagName Bool + -> GenericPackageDescription + -> (Map PackageName (Map FlagName Bool), DepErrors) checkPackageBuildPlan platform compiler pool flags gpd = - (Map.singleton pkg flags, errs) - where - pkg = gpdPackageName gpd - errs = checkPackageDeps pkg constraints pool - constraints = gpdPackageDeps gpd compiler platform flags + (Map.singleton pkg flags, errs) + where + pkg = gpdPackageName gpd + errs = checkPackageDeps pkg constraints pool + constraints = gpdPackageDeps gpd compiler platform flags -- | Checks if the given package dependencies can be satisfied by the given set -- of packages. Will fail if a package is either missing or has a version -- outside of the version range. checkPackageDeps :: - PackageName -- ^ package using dependencies, for constructing DepErrors - -> Map PackageName VersionRange -- ^ dependency constraints - -> Map PackageName Version -- ^ Available package pool or index - -> DepErrors + PackageName -- ^ package using dependencies, for constructing DepErrors + -> Map PackageName VersionRange -- ^ dependency constraints + -> Map PackageName Version -- ^ Available package pool or index + -> DepErrors checkPackageDeps myName deps packages = - Map.unionsWith combineDepError $ map go $ Map.toList deps - where - go :: (PackageName, VersionRange) -> DepErrors - go (name, range) = - case Map.lookup name packages of - Nothing -> Map.singleton name DepError - { deVersion = Nothing - , deNeededBy = Map.singleton myName range - } - Just v - | withinRange v range -> Map.empty - | otherwise -> Map.singleton name DepError - { deVersion = Just v - , deNeededBy = Map.singleton myName range - } + Map.unionsWith combineDepError $ map go $ Map.toList deps + where + go :: (PackageName, VersionRange) -> DepErrors + go (name, range) = + case Map.lookup name packages of + Nothing -> Map.singleton name DepError + { deVersion = Nothing + , deNeededBy = Map.singleton myName range + } + Just v + | withinRange v range -> Map.empty + | otherwise -> Map.singleton name DepError + { deVersion = Just v + , deNeededBy = Map.singleton myName range + } type DepErrors = Map PackageName DepError + data DepError = DepError - { deVersion :: !(Maybe Version) - , deNeededBy :: !(Map PackageName VersionRange) - } - deriving Show + { deVersion :: !(Maybe Version) + , deNeededBy :: !(Map PackageName VersionRange) + } + deriving Show -- | Combine two 'DepError's for the same 'Version'. combineDepError :: DepError -> DepError -> DepError combineDepError (DepError a x) (DepError b y) = - assert (a == b) $ DepError a (Map.unionWith C.intersectVersionRanges x y) + assert (a == b) $ DepError a (Map.unionWith C.intersectVersionRanges x y) -- | Given a bundle of packages (a list of @GenericPackageDescriptions@'s) to -- build and an available package pool (snapshot) check whether the bundle's -- dependencies can be satisfied. If flags is passed as Nothing flag settings -- will be chosen automatically. checkBundleBuildPlan :: - Platform - -> ActualCompiler - -> Map PackageName Version - -> Maybe (Map PackageName (Map FlagName Bool)) - -> [GenericPackageDescription] - -> (Map PackageName (Map FlagName Bool), DepErrors) + Platform + -> ActualCompiler + -> Map PackageName Version + -> Maybe (Map PackageName (Map FlagName Bool)) + -> [GenericPackageDescription] + -> (Map PackageName (Map FlagName Bool), DepErrors) checkBundleBuildPlan platform compiler pool flags gpds = - (Map.unionsWith dupError (map fst plans) - , Map.unionsWith combineDepError (map snd plans)) - - where - plans = map (pkgPlan flags) gpds - pkgPlan Nothing gpd = - selectPackageBuildPlan platform compiler pool' gpd - pkgPlan (Just f) gpd = - checkPackageBuildPlan platform compiler pool' (flags' f gpd) gpd - flags' f gpd = fromMaybe Map.empty (Map.lookup (gpdPackageName gpd) f) - pool' = Map.union (gpdPackages gpds) pool - - dupError _ _ = impureThrow DuplicatePackagesBug - -data BuildPlanCheck = - BuildPlanCheckOk (Map PackageName (Map FlagName Bool)) - | BuildPlanCheckPartial (Map PackageName (Map FlagName Bool)) DepErrors - | BuildPlanCheckFail (Map PackageName (Map FlagName Bool)) DepErrors - ActualCompiler + ( Map.unionsWith dupError (map fst plans) + , Map.unionsWith combineDepError (map snd plans) + ) + where + plans = map (pkgPlan flags) gpds + pkgPlan Nothing gpd = + selectPackageBuildPlan platform compiler pool' gpd + pkgPlan (Just f) gpd = + checkPackageBuildPlan platform compiler pool' (flags' f gpd) gpd + flags' f gpd = fromMaybe Map.empty (Map.lookup (gpdPackageName gpd) f) + pool' = Map.union (gpdPackages gpds) pool + + dupError _ _ = impureThrow DuplicatePackagesBug + +data BuildPlanCheck + = BuildPlanCheckOk (Map PackageName (Map FlagName Bool)) + | BuildPlanCheckPartial (Map PackageName (Map FlagName Bool)) DepErrors + | BuildPlanCheckFail + (Map PackageName (Map FlagName Bool)) + DepErrors + ActualCompiler -- | Compare 'BuildPlanCheck', where GT means a better plan. compareBuildPlanCheck :: BuildPlanCheck -> BuildPlanCheck -> Ordering -compareBuildPlanCheck (BuildPlanCheckPartial _ e1) (BuildPlanCheckPartial _ e2) = +compareBuildPlanCheck + (BuildPlanCheckPartial _ e1) + (BuildPlanCheckPartial _ e2) + = -- Note: order of comparison flipped, since it's better to have fewer errors. compare (Map.size e2) (Map.size e1) compareBuildPlanCheck (BuildPlanCheckFail _ e1 _) (BuildPlanCheckFail _ e2 _) = - let numUserPkgs e = Map.size $ Map.unions (Map.elems (fmap deNeededBy e)) - in compare (numUserPkgs e2) (numUserPkgs e1) + let numUserPkgs e = Map.size $ Map.unions (Map.elems (fmap deNeededBy e)) + in compare (numUserPkgs e2) (numUserPkgs e1) compareBuildPlanCheck BuildPlanCheckOk{} BuildPlanCheckOk{} = EQ compareBuildPlanCheck BuildPlanCheckOk{} BuildPlanCheckPartial{} = GT compareBuildPlanCheck BuildPlanCheckOk{} BuildPlanCheckFail{} = GT @@ -354,183 +363,181 @@ compareBuildPlanCheck BuildPlanCheckPartial{} BuildPlanCheckFail{} = GT compareBuildPlanCheck _ _ = LT instance Show BuildPlanCheck where - show BuildPlanCheckOk {} = "" - show (BuildPlanCheckPartial f e) = T.unpack $ showDepErrors f e - show (BuildPlanCheckFail f e c) = T.unpack $ showCompilerErrors f e c + show BuildPlanCheckOk {} = "" + show (BuildPlanCheckPartial f e) = T.unpack $ showDepErrors f e + show (BuildPlanCheckFail f e c) = T.unpack $ showCompilerErrors f e c -- | Check a set of 'GenericPackageDescription's and a set of flags against a -- given snapshot. Returns how well the snapshot satisfies the dependencies of -- the packages. checkSnapBuildPlan :: - (HasConfig env, HasGHCVariant env) - => [ResolvedPath Dir] - -> Maybe (Map PackageName (Map FlagName Bool)) - -> SnapshotCandidate env - -> RIO env BuildPlanCheck + (HasConfig env, HasGHCVariant env) + => [ResolvedPath Dir] + -> Maybe (Map PackageName (Map FlagName Bool)) + -> SnapshotCandidate env + -> RIO env BuildPlanCheck checkSnapBuildPlan pkgDirs flags snapCandidate = do - platform <- view platformL - sma <- snapCandidate pkgDirs - gpds <- liftIO $ forM (Map.elems $ smaProject sma) (cpGPD . ppCommon) - - let - compiler = smaCompiler sma - globalVersion (GlobalPackageVersion v) = v - depVersion dep | PLImmutable loc <- dpLocation dep = - Just $ packageLocationVersion loc - | otherwise = - Nothing - snapPkgs = Map.union - (Map.mapMaybe depVersion $ smaDeps sma) - (Map.map globalVersion $ smaGlobal sma) - (f, errs) = checkBundleBuildPlan platform compiler snapPkgs flags gpds - cerrs = compilerErrors compiler errs - - if Map.null errs then - pure $ BuildPlanCheckOk f - else if Map.null cerrs then - pure $ BuildPlanCheckPartial f errs - else - pure $ BuildPlanCheckFail f cerrs compiler - where - compilerErrors compiler errs - | whichCompiler compiler == Ghc = ghcErrors errs - | otherwise = Map.empty - - isGhcWiredIn p _ = p `Set.member` wiredInPackages - ghcErrors = Map.filterWithKey isGhcWiredIn + platform <- view platformL + sma <- snapCandidate pkgDirs + gpds <- liftIO $ forM (Map.elems $ smaProject sma) (cpGPD . ppCommon) + + let compiler = smaCompiler sma + globalVersion (GlobalPackageVersion v) = v + depVersion dep + | PLImmutable loc <- dpLocation dep = Just $ packageLocationVersion loc + | otherwise = Nothing + snapPkgs = Map.union + (Map.mapMaybe depVersion $ smaDeps sma) + (Map.map globalVersion $ smaGlobal sma) + (f, errs) = checkBundleBuildPlan platform compiler snapPkgs flags gpds + cerrs = compilerErrors compiler errs + + if Map.null errs + then pure $ BuildPlanCheckOk f + else if Map.null cerrs + then pure $ BuildPlanCheckPartial f errs + else pure $ BuildPlanCheckFail f cerrs compiler + where + compilerErrors compiler errs + | whichCompiler compiler == Ghc = ghcErrors errs + | otherwise = Map.empty + + isGhcWiredIn p _ = p `Set.member` wiredInPackages + ghcErrors = Map.filterWithKey isGhcWiredIn -- | Find a snapshot and set of flags that is compatible with and matches as -- best as possible with the given 'GenericPackageDescription's. selectBestSnapshot :: - (HasConfig env, HasGHCVariant env) - => [ResolvedPath Dir] - -> NonEmpty SnapName - -> RIO env (SnapshotCandidate env, RawSnapshotLocation, BuildPlanCheck) + (HasConfig env, HasGHCVariant env) + => [ResolvedPath Dir] + -> NonEmpty SnapName + -> RIO env (SnapshotCandidate env, RawSnapshotLocation, BuildPlanCheck) selectBestSnapshot pkgDirs snaps = do - prettyInfo $ - fillSep - [ flow "Selecting the best among" - , fromString $ show (NE.length snaps) - , "snapshots..." - ] - <> line - F.foldr1 go (NE.map (getResult <=< snapshotLocation) snaps) - where - go mold mnew = do - old@(_snap, _loc, bpc) <- mold - case bpc of - BuildPlanCheckOk {} -> pure old - _ -> fmap (betterSnap old) mnew - - getResult loc = do - candidate <- loadProjectSnapshotCandidate loc NoPrintWarnings False - result <- checkSnapBuildPlan pkgDirs Nothing candidate - reportResult result loc - pure (candidate, loc, result) - - betterSnap (s1, l1, r1) (s2, l2, r2) - | compareBuildPlanCheck r1 r2 /= LT = (s1, l1, r1) - | otherwise = (s2, l2, r2) - - reportResult BuildPlanCheckOk {} loc = - prettyNote $ - fillSep - [ flow "Matches" - , pretty $ PrettyRawSnapshotLocation loc - ] - <> line - - reportResult r@BuildPlanCheckPartial {} loc = - prettyWarn $ - fillSep - [ flow "Partially matches" - , pretty $ PrettyRawSnapshotLocation loc - ] - <> blankLine - <> indent 4 (string (show r)) - - reportResult r@BuildPlanCheckFail {} loc = - prettyWarn $ - fillSep - [ flow "Rejected" - , pretty $ PrettyRawSnapshotLocation loc - ] - <> blankLine - <> indent 4 (string (show r)) + prettyInfo $ + fillSep + [ flow "Selecting the best among" + , fromString $ show (NE.length snaps) + , "snapshots..." + ] + <> line + F.foldr1 go (NE.map (getResult <=< snapshotLocation) snaps) + where + go mold mnew = do + old@(_snap, _loc, bpc) <- mold + case bpc of + BuildPlanCheckOk {} -> pure old + _ -> fmap (betterSnap old) mnew + + getResult loc = do + candidate <- loadProjectSnapshotCandidate loc NoPrintWarnings False + result <- checkSnapBuildPlan pkgDirs Nothing candidate + reportResult result loc + pure (candidate, loc, result) + + betterSnap (s1, l1, r1) (s2, l2, r2) + | compareBuildPlanCheck r1 r2 /= LT = (s1, l1, r1) + | otherwise = (s2, l2, r2) + + reportResult BuildPlanCheckOk {} loc = + prettyNote $ + fillSep + [ flow "Matches" + , pretty $ PrettyRawSnapshotLocation loc + ] + <> line + + reportResult r@BuildPlanCheckPartial {} loc = + prettyWarn $ + fillSep + [ flow "Partially matches" + , pretty $ PrettyRawSnapshotLocation loc + ] + <> blankLine + <> indent 4 (string (show r)) + + reportResult r@BuildPlanCheckFail {} loc = + prettyWarn $ + fillSep + [ flow "Rejected" + , pretty $ PrettyRawSnapshotLocation loc + ] + <> blankLine + <> indent 4 (string (show r)) showItems :: [String] -> Text showItems items = T.concat (map formatItem items) - where - formatItem item = T.concat - [ " - " - , T.pack item - , "\n" - ] + where + formatItem item = T.concat + [ " - " + , T.pack item + , "\n" + ] showPackageFlags :: PackageName -> Map FlagName Bool -> Text showPackageFlags pkg fl = - if not $ Map.null fl then - T.concat - [ " - " - , T.pack $ packageNameString pkg - , ": " - , T.pack $ intercalate ", " - $ map formatFlags (Map.toList fl) - , "\n" - ] + if not $ Map.null fl + then + T.concat + [ " - " + , T.pack $ packageNameString pkg + , ": " + , T.pack $ intercalate ", " + $ map formatFlags (Map.toList fl) + , "\n" + ] else "" - where - formatFlags (f, v) = show f ++ " = " ++ show v + where + formatFlags (f, v) = show f ++ " = " ++ show v showMapPackages :: Map PackageName a -> Text showMapPackages mp = showItems $ map packageNameString $ Map.keys mp showCompilerErrors :: - Map PackageName (Map FlagName Bool) - -> DepErrors - -> ActualCompiler - -> Text + Map PackageName (Map FlagName Bool) + -> DepErrors + -> ActualCompiler + -> Text showCompilerErrors flags errs compiler = - T.concat - [ compilerVersionText compiler - , " cannot be used for these packages:\n" - , showMapPackages $ Map.unions (Map.elems (fmap deNeededBy errs)) - , showDepErrors flags errs -- TODO only in debug mode - ] + T.concat + [ compilerVersionText compiler + , " cannot be used for these packages:\n" + , showMapPackages $ Map.unions (Map.elems (fmap deNeededBy errs)) + , showDepErrors flags errs -- TODO only in debug mode + ] showDepErrors :: Map PackageName (Map FlagName Bool) -> DepErrors -> Text showDepErrors flags errs = - T.concat - [ T.concat $ map formatError (Map.toList errs) - , if T.null flagVals then "" - else "Using package flags:\n" <> flagVals - ] - where - formatError (depName, DepError mversion neededBy) = T.concat - [ showDepVersion depName mversion - , T.concat (map showRequirement (Map.toList neededBy)) - ] - - showDepVersion depName mversion = T.concat - [ T.pack $ packageNameString depName - , case mversion of - Nothing -> " not found" - Just version -> T.concat - [ " version " - , T.pack $ versionString version - , " found" - ] - , "\n" + T.concat + [ T.concat $ map formatError (Map.toList errs) + , if T.null flagVals then "" + else "Using package flags:\n" <> flagVals + ] + where + formatError (depName, DepError mversion neededBy) = T.concat + [ showDepVersion depName mversion + , T.concat (map showRequirement (Map.toList neededBy)) + ] + + showDepVersion depName mversion = T.concat + [ T.pack $ packageNameString depName + , case mversion of + Nothing -> " not found" + Just version -> T.concat + [ " version " + , T.pack $ versionString version + , " found" ] - - showRequirement (user, range) = T.concat - [ " - " - , T.pack $ packageNameString user - , " requires " - , T.pack $ display range - , "\n" - ] - - flagVals = T.concat (map showFlags userPkgs) - userPkgs = Map.keys $ Map.unions (Map.elems (fmap deNeededBy errs)) - showFlags pkg = maybe "" (showPackageFlags pkg) (Map.lookup pkg flags) + , "\n" + ] + + showRequirement (user, range) = T.concat + [ " - " + , T.pack $ packageNameString user + , " requires " + , T.pack $ display range + , "\n" + ] + + flagVals = T.concat (map showFlags userPkgs) + userPkgs = Map.keys $ Map.unions (Map.elems (fmap deNeededBy errs)) + showFlags pkg = maybe "" (showPackageFlags pkg) (Map.lookup pkg flags) diff --git a/src/Stack/CLI.hs b/src/Stack/CLI.hs index 814f663cca..276b586e4c 100644 --- a/src/Stack/CLI.hs +++ b/src/Stack/CLI.hs @@ -692,8 +692,8 @@ interpreterHandler currentDir args f = do -- interpreter error message and exclude the command related error messages. errorCombine = if pathSeparator `elem` firstArg - then overrideErrorHelp - else vcatErrorHelp + then overrideErrorHelp + else vcatErrorHelp overrideErrorHelp h1 h2 = h2 { helpError = helpError h1 } diff --git a/src/Stack/Clean.hs b/src/Stack/Clean.hs index f92b626392..e57bc76384 100644 --- a/src/Stack/Clean.hs +++ b/src/Stack/Clean.hs @@ -55,8 +55,8 @@ data CleanOpts -- | Type representing Stack's cleaning commands. data CleanCommand - = Clean - | Purge + = Clean + | Purge -- | Function underlying the @stack clean@ command. cleanCmd :: CleanOpts -> RIO Runner () diff --git a/src/Stack/ComponentFile.hs b/src/Stack/ComponentFile.hs index 41617e74c4..b69bd34d34 100644 --- a/src/Stack/ComponentFile.hs +++ b/src/Stack/ComponentFile.hs @@ -390,26 +390,25 @@ findCandidate dirs name = do -> IO [Path Abs File] makeDirCandidates haskellPreprocessorExts dir = case name of - DotCabalMain fp -> resolveCandidate dir fp - DotCabalFile fp -> resolveCandidate dir fp - DotCabalCFile fp -> resolveCandidate dir fp - DotCabalModule mn -> do - let perExt ext = - resolveCandidate - dir (Cabal.toFilePath mn ++ "." ++ T.unpack ext) - withHaskellExts <- mapM perExt haskellFileExts - withPPExts <- mapM perExt haskellPreprocessorExts - pure $ - case (concat withHaskellExts, concat withPPExts) of - -- If we have exactly 1 Haskell extension and exactly - -- 1 preprocessor extension, assume the former file is - -- generated from the latter - -- - -- See https://github.com/commercialhaskell/stack/issues/4076 - ([_], [y]) -> [y] - - -- Otherwise, return everything - (xs, ys) -> xs ++ ys + DotCabalMain fp -> resolveCandidate dir fp + DotCabalFile fp -> resolveCandidate dir fp + DotCabalCFile fp -> resolveCandidate dir fp + DotCabalModule mn -> do + let perExt ext = + resolveCandidate + dir (Cabal.toFilePath mn ++ "." ++ T.unpack ext) + withHaskellExts <- mapM perExt haskellFileExts + withPPExts <- mapM perExt haskellPreprocessorExts + pure $ + case (concat withHaskellExts, concat withPPExts) of + -- If we have exactly 1 Haskell extension and exactly + -- 1 preprocessor extension, assume the former file is + -- generated from the latter + -- + -- See https://github.com/commercialhaskell/stack/issues/4076 + ([_], [y]) -> [y] + -- Otherwise, return everything + (xs, ys) -> xs ++ ys resolveCandidate dir = fmap maybeToList . resolveDirFile dir -- | Log that we couldn't find a candidate, but there are @@ -558,10 +557,11 @@ componentBuildDir cabalVer component distDir CBench name -> buildDir distDir componentNameToDir name -- Internal helper to define resolveFileOrWarn and resolveDirOrWarn -resolveOrWarn :: Text - -> (Path Abs Dir -> String -> RIO GetPackageFileContext (Maybe a)) - -> FilePath.FilePath - -> RIO GetPackageFileContext (Maybe a) +resolveOrWarn :: + Text + -> (Path Abs Dir -> String -> RIO GetPackageFileContext (Maybe a)) + -> FilePath.FilePath + -> RIO GetPackageFileContext (Maybe a) resolveOrWarn subject resolver path = do cwd <- liftIO getCurrentDir file <- asks ctxFile diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs index c18d3ad290..53d63ee4a5 100644 --- a/src/Stack/Config.hs +++ b/src/Stack/Config.hs @@ -401,7 +401,7 @@ configFromConfigMonoid Nothing -> liftIO getNumProcessors Just i -> pure i let configConcurrentTests = fromFirst True configMonoidConcurrentTests - let configTemplateParams = configMonoidTemplateParameters + configTemplateParams = configMonoidTemplateParameters configScmInit = getFirst configMonoidScmInit configCabalConfigOpts = coerce configMonoidCabalConfigOpts configGhcOptionsByName = coerce configMonoidGhcOptionsByName @@ -570,8 +570,7 @@ getDefaultLocalProgramsBase configStackRoot configPlatform override = Nothing -> throwM $ ParseAbsolutePathException "LOCALAPPDATA" t Just lad -> - pure $ lad relDirUpperPrograms - relDirStackProgName + pure $ lad relDirUpperPrograms relDirStackProgName Nothing -> pure defaultBase _ -> pure defaultBase where @@ -987,7 +986,8 @@ getExtraConfigs userConfigPath = do -- 'ParseConfigFileException' when there's a decoding error. loadConfigYaml :: HasLogFunc env - => (Value -> Yaml.Parser (WithJSONWarnings a)) -> Path Abs File -> RIO env a + => (Value -> Yaml.Parser (WithJSONWarnings a)) + -> Path Abs File -> RIO env a loadConfigYaml parser path = do eres <- loadYaml parser path case eres of diff --git a/src/Stack/New.hs b/src/Stack/New.hs index 62ad9e607b..b37657a19d 100644 --- a/src/Stack/New.hs +++ b/src/Stack/New.hs @@ -3,11 +3,11 @@ -- | Types and functions related to Stack's @new@ command. module Stack.New - ( NewOpts (..) - , TemplateName - , newCmd - , new - ) where + ( NewOpts (..) + , TemplateName + , newCmd + , new + ) where import Control.Monad.Trans.Writer.Strict ( execWriterT ) import Data.Aeson as A