standardize how $pretty* stuff is aligned after labels

kadoban · kadoban · commit 0e7fe05b5ba0 · 2017-08-23T00:27:27.000-07:00
diff --git a/src/Stack/PrettyPrint.hs b/src/Stack/PrettyPrint.hs
@@ -28,6 +28,7 @@ module Stack.PrettyPrint
     , hsep, vsep, fillSep, sep, hcat, vcat, fillCat, cat, punctuate
     , fill, fillBreak
     , enclose, squotes, dquotes, parens, angles, braces, brackets
+    , indentAfterLabel
     ) where
 
 import           Stack.Prelude
@@ -65,12 +66,15 @@ prettyInfo = do
 prettyWarn :: Q Exp
 prettyWarn = do
     loc <- location
-    [e| monadLoggerLog loc "" LevelWarn <=< displayWithColor . (line <>) . (warningColor "Warning:" <+>) |]
+    [e| monadLoggerLog loc "" LevelWarn <=< displayWithColor . (line <>) . (warningColor "Warning:" <+>) . indentAfterLabel |]
 
 prettyError :: Q Exp
 prettyError = do
     loc <- location
-    [e| monadLoggerLog loc "" LevelError <=< displayWithColor . (line <>) . (errorColor "Error:" <+>) |]
+    [e| monadLoggerLog loc "" LevelError <=< displayWithColor . (line <>) . (errorColor "Error:" <+>) . indentAfterLabel |]
+
+indentAfterLabel :: Doc a -> Doc a
+indentAfterLabel = align
 
 debugBracket :: Q Exp
 debugBracket = do
diff --git a/src/main/Main.hs b/src/main/Main.hs
@@ -607,7 +607,7 @@ buildCmd opts go = do
 
 uninstallCmd :: [String] -> GlobalOpts -> IO ()
 uninstallCmd _ go = withConfigAndLock go $ do
-    $prettyError . align . fillSep . (++ [cmd])
+    $prettyError . fillSep . (++ [cmd])
                  . map fromString . concatMap words $
       ["stack does not manage installations in global locations.",
        "The only global mutation stack performs is executable copying.",
@@ -638,7 +638,7 @@ upgradeCmd upgradeOpts' go = withGlobalConfigAndLock go $
 -- | Upload to Hackage
 uploadCmd :: SDistOpts -> GlobalOpts -> IO ()
 uploadCmd (SDistOpts [] _ _ _ _ _) go =
-    withConfigAndLock go . $prettyError . align . sep $
+    withConfigAndLock go . $prettyError . sep $
         ["To upload the current package, please run",
          shellColor (fromString "stack upload ."),
          "(with the period at the end)"]
@@ -653,7 +653,7 @@ uploadCmd sdistOpts go = do
     withBuildConfigAndLock go $ \_ -> do
         unless (null invalid) $ do
             let invalidList = bulletedList $ map (fileColor . fromString) invalid
-            $prettyError . align . (<> (line <> invalidList))
+            $prettyError . (<> (line <> invalidList))
                          . sep . map fromString $
                 ["stack upload expects a list of sdist tarballs or cabal directories.",
                  "Can't find:"]
