bring back prettyInfoS and prettyDebugS

commercialhaskell · Sep 1, 2017 · 961fac2 · 961fac2
1 parent ab76696
commit 961fac2
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 30 deletions.
diff --git 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
@@ -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,53 +62,43 @@ 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)
 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