From 961fac2a822e97f292fa5ac60576da4d52e93d9f Mon Sep 17 00:00:00 2001 From: Joshua Simmons Date: Thu, 31 Aug 2017 16:59:36 -0700 Subject: [PATCH 1/2] bring back prettyInfoS and prettyDebugS --- src/Stack/Coverage.hs | 12 ++++++------ src/Stack/PrettyPrint.hs | 38 ++++++++++++++------------------------ 2 files changed, 20 insertions(+), 30 deletions(-) diff --git a/src/Stack/Coverage.hs b/src/Stack/Coverage.hs index d2d9c62a9e..cf76b05c12 100644 --- a/src/Stack/Coverage.hs +++ b/src/Stack/Coverage.hs @@ -130,7 +130,7 @@ generateHpcReport pkgDir package tests = do Just includeName -> ["--include", includeName ++ ":"] Nothing -> [] mreportPath <- generateHpcReportInternal tixSrc reportDir report extraArgs extraArgs - forM_ mreportPath (displayReportPath report) + forM_ mreportPath (displayReportPath report . display) generateHpcReportInternal :: HasEnvConfig env => Path Abs File -> Path Abs Dir -> Text -> [String] -> [String] @@ -267,7 +267,7 @@ generateHpcReportForTargets opts = do then do prettyInfo $ "Opening" <+> display reportPath <+> "in the browser." void $ liftIO $ openBrowser (toFilePath reportPath) - else displayReportPath report reportPath + else displayReportPath report (display reportPath) generateHpcUnifiedReport :: HasEnvConfig env => RIO env () generateHpcUnifiedReport = do @@ -292,7 +292,7 @@ generateHpcUnifiedReport = do else do let report = "unified report" mreportPath <- generateUnionReport report reportDir tixFiles - forM_ mreportPath (displayReportPath report) + forM_ mreportPath (displayReportPath report . display) generateUnionReport :: HasEnvConfig env => Text -> Path Abs Dir -> [Path Abs File] @@ -439,10 +439,10 @@ findPackageFieldForBuiltPackage pkgDir pkgId field = do _ -> return $ Left $ "Multiple files matching " <> T.pack (pkgIdStr ++ "-*.conf") <> " found in " <> T.pack (toFilePath inplaceDir) <> ". Maybe try 'stack clean' on this package?" -displayReportPath :: (HasAnsiAnn (Ann a), Display a, HasRunner env) - => Text -> a -> RIO env () +displayReportPath :: (HasRunner env) + => Text -> AnsiDoc -> RIO env () displayReportPath report reportPath = - prettyInfo $ "The" <+> fromString (T.unpack report) <+> "is available at" <+> display reportPath + prettyInfo $ "The" <+> fromString (T.unpack report) <+> "is available at" <+> reportPath findExtraTixFiles :: HasEnvConfig env => RIO env [Path Abs File] findExtraTixFiles = do diff --git a/src/Stack/PrettyPrint.hs b/src/Stack/PrettyPrint.hs index e2a51db7a9..f382cc650a 100644 --- a/src/Stack/PrettyPrint.hs +++ b/src/Stack/PrettyPrint.hs @@ -11,7 +11,7 @@ module Stack.PrettyPrint -- * Logging based on pretty-print typeclass , prettyDebug, prettyInfo, prettyWarn, prettyError , prettyDebugL, prettyInfoL, prettyWarnL, prettyErrorL - , prettyWarnS, prettyErrorS + , prettyDebugS, prettyInfoS, prettyWarnS, prettyErrorS -- * Semantic styling functions -- | These are preferred to styling or colors directly, so that we can -- encourage consistency. @@ -62,16 +62,12 @@ prettyWith level f = logOther level <=< displayWithColor . f -- Note: I think keeping this section aligned helps spot errors, might be -- worth keeping the alignment in place. -prettyDebugWith, prettyInfoWith - :: (HasCallStack, HasRunner env, Display b, HasAnsiAnn (Ann b), - MonadReader env m, MonadLogger m) - => (a -> b) -> a -> m () -prettyDebugWith = prettyWith LevelDebug -prettyInfoWith = prettyWith LevelInfo -prettyWarnWith, prettyErrorWith +prettyDebugWith, prettyInfoWith, prettyWarnWith, prettyErrorWith :: (HasCallStack, HasRunner env, MonadReader env m, MonadLogger m) => (a -> Doc AnsiAnn) -> a -> m () +prettyDebugWith = prettyWith LevelDebug +prettyInfoWith = prettyWith LevelInfo prettyWarnWith f = prettyWith LevelWarn ((line <>) . (styleWarning "Warning:" <+>) . indentAfterLabel . f) @@ -79,36 +75,30 @@ prettyErrorWith f = prettyWith LevelError ((line <>) . (styleError "Error:" <+>) . indentAfterLabel . f) -prettyDebug, prettyInfo - :: (HasCallStack, HasRunner env, Display b, HasAnsiAnn (Ann b), - MonadReader env m, MonadLogger m) - => b -> m () -prettyDebug = prettyDebugWith id -prettyInfo = prettyInfoWith id - -prettyWarn, prettyError +prettyDebug, prettyInfo, prettyWarn, prettyError :: (HasCallStack, HasRunner env, MonadReader env m, MonadLogger m) => Doc AnsiAnn -> m () +prettyDebug = prettyDebugWith id +prettyInfo = prettyInfoWith id prettyWarn = prettyWarnWith id prettyError = prettyErrorWith id -prettyDebugL, prettyInfoL - :: (HasCallStack, HasRunner env, HasAnsiAnn a, MonadReader env m, MonadLogger m) - => [Doc a] -> m () -prettyDebugL = prettyDebugWith fillSep -prettyInfoL = prettyInfoWith fillSep - -prettyWarnL, prettyErrorL +prettyDebugL, prettyInfoL, prettyWarnL, prettyErrorL :: (HasCallStack, HasRunner env, MonadReader env m, MonadLogger m) => [Doc AnsiAnn] -> m () +prettyDebugL = prettyDebugWith fillSep +prettyInfoL = prettyInfoWith fillSep prettyWarnL = prettyWarnWith fillSep prettyErrorL = prettyErrorWith fillSep -prettyWarnS, prettyErrorS +prettyDebugS, prettyInfoS, prettyWarnS, prettyErrorS :: (HasCallStack, HasRunner env, MonadReader env m, MonadLogger m) => String -> m () +prettyDebugS = prettyDebugWith flow +prettyInfoS = prettyInfoWith flow prettyWarnS = prettyWarnWith flow prettyErrorS = prettyErrorWith flow + -- End of aligned section -- | Use after a label and before the rest of what's being labelled for From 24db832460619c8bd3d9beac32f1c30bb520598e Mon Sep 17 00:00:00 2001 From: Joshua Simmons Date: Thu, 31 Aug 2017 17:09:43 -0700 Subject: [PATCH 2/2] pretty up s/S/Upgrade --- src/Stack/Upgrade.hs | 42 ++++++++++++++++++++++++------------------ 1 file changed, 24 insertions(+), 18 deletions(-) diff --git a/src/Stack/Upgrade.hs b/src/Stack/Upgrade.hs index 122b7afbd0..7e9bb662c1 100644 --- a/src/Stack/Upgrade.hs +++ b/src/Stack/Upgrade.hs @@ -26,6 +26,7 @@ import Stack.Build import Stack.Config import Stack.Fetch import Stack.PackageIndex +import Stack.PrettyPrint import Stack.Setup import Stack.Types.PackageIdentifier import Stack.Types.PackageIndex @@ -116,9 +117,11 @@ upgrade gConfigMonoid mresolver builtHash (UpgradeOpts mbo mso) = -- See #2977 - if --git or --git-repo is specified, do source upgrade. (_, Just so@(SourceOpts (Just _))) -> source so (Just bo, Just so) -> binary bo `catchAny` \e -> do - logWarn "Exception occured when trying to perform binary upgrade:" - logWarn $ T.pack $ show e - logWarn "Falling back to source upgrade" + prettyWarnL + [ flow "Exception occured when trying to perform binary upgrade:" + , fromString . show $ e + , line <> flow "Falling back to source upgrade" + ] source so where @@ -141,28 +144,30 @@ binaryUpgrade (BinaryOpts mplatform force' mver morg mrepo) = do isNewer <- case mdownloadVersion of Nothing -> do - logError "Unable to determine upstream version from Github metadata" - unless force $ - logError "Rerun with --force-download to force an upgrade" + prettyErrorL $ + flow "Unable to determine upstream version from Github metadata" + : + [ line <> flow "Rerun with --force-download to force an upgrade" + | not force] return False Just downloadVersion -> do - logInfo $ T.concat - [ "Current Stack version: " - , versionText stackVersion - , ", available download version: " - , versionText downloadVersion + prettyInfoL + [ flow "Current Stack version:" + , display stackVersion <> "," + , flow "available download version:" + , display downloadVersion ] return $ downloadVersion > stackVersion toUpgrade <- case (force, isNewer) of (False, False) -> do - logInfo "Skipping binary upgrade, you are already running the most recent version" + prettyInfoS "Skipping binary upgrade, you are already running the most recent version" return False (True, False) -> do - logInfo "Forcing binary upgrade" + prettyInfoS "Forcing binary upgrade" return True (_, True) -> do - logInfo "Newer version detected, downloading" + prettyInfoS "Newer version detected, downloading" return True when toUpgrade $ do config <- view configL @@ -191,16 +196,17 @@ sourceUpgrade gConfigMonoid mresolver builtHash (SourceOpts gitRepo) = [] -> throwString $ "No commits found for branch " ++ branch ++ " on repo " ++ repo x:_ -> return x when (isNothing builtHash) $ - logWarn $ "Information about the commit this version of stack was " + prettyWarnS $ + "Information about the commit this version of stack was " <> "built from is not available due to how it was built. " <> "Will continue by assuming an upgrade is needed " <> "because we have no information to the contrary." if builtHash == Just latestCommit then do - logInfo "Already up-to-date, no upgrade required" + prettyInfoS "Already up-to-date, no upgrade required" return Nothing else do - logInfo "Cloning stack" + prettyInfoS "Cloning stack" -- NOTE: "--recursive" was added after v1.0.0 (and before the -- next release). This means that we can't use submodules in -- the stack repo until we're comfortable with "stack upgrade @@ -221,7 +227,7 @@ sourceUpgrade gConfigMonoid mresolver builtHash (SourceOpts gitRepo) = let version = Data.List.maximum versions if version <= fromCabalVersion (mkVersion' Paths.version) then do - logInfo "Already at latest version, no upgrade required" + prettyInfoS "Already at latest version, no upgrade required" return Nothing else do let ident = PackageIdentifier $(mkPackageName "stack") version