Merge pull request #6629 from commercialhaskell/fix6628

Fix #6628 Treat consecutive line ends as a single blank line

.stan.toml

@@ -94,25 +94,25 @@
 
 # Anti-pattern: Data.ByteString.Char8.pack
 [[ignore]]
-  id = "OBS-STAN-0203-hTeu0Y-384:17"
+  id = "OBS-STAN-0203-hTeu0Y-389:17"
 # ✦ Description:   Usage of 'pack' function that doesn't handle Unicode characters
 # ✦ Category:      #AntiPattern
 # ✦ File:          src\Stack\Init.hs
 #
-#  383 ┃
-#  384 ┃   commentHelp = BC.pack .  intercalate "\n" . map commentLine
-#  385 ┃                 ^^^^^^^
+#  388 ┃
+#  389 ┃   commentHelp = BC.pack .  intercalate "\n" . map commentLine
+#  390 ┃                 ^^^^^^^
 
 # Anti-pattern: Data.ByteString.Char8.pack
 [[ignore]]
-  id = "OBS-STAN-0203-hTeu0Y-401:26"
+  id = "OBS-STAN-0203-hTeu0Y-406:26"
 # ✦ Description:   Usage of 'pack' function that doesn't handle Unicode characters
 # ✦ Category:      #AntiPattern
 # ✦ File:          src\Stack\Init.hs
 #
-#  400 ┃
-#  401 ┃         <> B.byteString (BC.pack $ concat
-#  402 ┃                          ^^^^^^^
+#  405 ┃
+#  406 ┃         <> B.byteString (BC.pack $ concat
+#  407 ┃                          ^^^^^^^
 
 # Anti-pattern: Data.ByteString.Char8.pack
 [[ignore]]

ChangeLog.md

@@ -10,6 +10,10 @@ Major changes:
 
 Behavior changes:
 
+* Stack interprets consecutive line ends in the value of the `user-message`
+  project-specific configuration option as a single blank line. Previously all
+  line ends were interpreted as white space.
+
 Other enhancements:
 
 Bug fixes:

doc/configure/yaml/project.md

@@ -286,6 +286,8 @@ loaded by Stack. It can serve as a reminder for the user to review the
 configuration and make any changes if needed. The user can delete this message
 if the generated configuration is acceptable.
 
+Consecutive line ends in the message are interpreted as a single blank line.
+
 For example, a user-message is inserted by `stack init` when it omits packages
 or adds external dependencies, namely:
 
@@ -297,7 +299,8 @@ user-message: |
   Warning (added by new or init): Specified snapshot could not satisfy all
   dependencies. Some external packages have been added as dependencies.
 
-  You can omit this message by removing it from stack.yaml
+  You can omit this message by removing it from the project-level configuration
+  file.
 ~~~
 
 ## custom-preprocessor-extensions

doc/tutorial/building_existing_projects.md

@@ -129,13 +129,23 @@ with the Cabal file name then `stack init` will refuse to continue.
 _User warnings_: When packages are excluded or external dependencies added Stack
 will show warnings every time the configuration file is loaded. You can suppress
 the warnings by editing the configuration file and removing the warnings from
-it. You may see something like this:
+it. If you command:
 
 ~~~text
 stack build
-Warning (added by new or init): Some packages were found to be incompatible
-with the snapshot and have been left commented out in the packages section.
-Warning (added by new or init): Specified snapshot could not satisfy all
-dependencies. Some external packages have been added as dependencies.
-You can suppress this message by removing it from stack.yaml
+~~~
+
+you may see something like this:
+
+~~~text
+Warning: Warnings (added by new or init): Some packages were found to be
+         incompatible with the snapshot and have been left commented out in the
+         packages section.
+
+         Warning (added by new or init): Specified snapshot could not satisfy
+         all dependencies. Some external packages have been added as
+         dependencies.
+
+        You can omit this message by removing it from the project-level
+        configuration file.
 ~~~

src/Stack/Config.hs

@@ -74,7 +74,7 @@ import           Path.IO
                    , getCurrentDir, getXdgDir, resolveDir, resolveDir'
                    , resolveFile, resolveFile'
                    )
-import           RIO.List ( unzip )
+import           RIO.List ( unzip, intersperse )
 import           RIO.Process
                    ( HasProcessContext (..), ProcessContext, augmentPathMap
                    , envVarsL
@@ -743,7 +743,7 @@ withBuildConfig inner = do
 
   (project', configFile) <- case config.project of
     PCProject (project, fp) -> do
-      forM_ project.userMsg prettyWarnS
+      forM_ project.userMsg prettyUserMessage
       pure (project, Right fp)
     PCNoProject extraDeps -> do
       p <-
@@ -860,6 +860,33 @@ withBuildConfig inner = do
       , curator = Nothing
       , dropPackages = mempty
       }
+  prettyUserMessage :: String -> RIO Config ()
+  prettyUserMessage userMsg = do
+    let userMsgs = map flow $ splitAtLineEnds userMsg
+        warningDoc = mconcat $ intersperse blankLine userMsgs
+    prettyWarn warningDoc
+   where
+    splitAtLineEnds = reverse . map reverse . go []
+     where
+      go :: [String] -> String -> [String]
+      go ss [] = ss
+      go ss s = case go' [] s of
+        ([], rest) -> go ss rest
+        (s', rest) -> go (s' : ss) rest
+      go' :: String -> String -> (String, String)
+      go' s [] = (s, [])
+      go' s [c] = (c:s, [])
+      go' s "\n\n" = (s, [])
+      go' s [c1, c2] = (c2:c1:s, [])
+      go' s ('\n':'\n':rest) = (s, stripLineEnds rest)
+      go' s ('\n':'\r':'\n':rest) = (s, stripLineEnds rest)
+      go' s ('\r':'\n':'\n':rest) = (s, stripLineEnds rest)
+      go' s ('\r':'\n':'\r':'\n':rest) = (s, stripLineEnds rest)
+      go' s (c:rest) = go' (c:s) rest
+      stripLineEnds :: String -> String
+      stripLineEnds ('\n':rest) = stripLineEnds rest
+      stripLineEnds ('\r':'\n':rest) = stripLineEnds rest
+      stripLineEnds rest = rest
 
 fillProjectWanted ::
      (HasLogFunc env, HasPantryConfig env, HasProcessContext env)

src/Stack/Init.hs

@@ -250,30 +250,35 @@ initProject currDir initOpts mASnapshot = do
     getDefaultSnapshot initOpts mASnapshot' pkgDirs
   let ignored = Map.difference bundle rbundle
       dupPkgMsg
-        | dupPkgs /= [] =
+        | dupPkgs /= [] = Just
             "Warning (added by new or init): Some packages were found to have \
-            \names conflicting with others and have been commented out in the \
-            \packages section.\n"
-        | otherwise = ""
+            \names\n\
+            \conflicting with others and have been commented out in the \
+            \packages section."
+        | otherwise = Nothing
       missingPkgMsg
-        | Map.size ignored > 0 =
+        | Map.size ignored > 0 = Just
             "Warning (added by new or init): Some packages were found to be \
-            \incompatible with the snapshot and have been left commented out \
-            \in the packages section.\n"
-        | otherwise = ""
+            \incompatible\n\
+            \with the snapshot and have been left commented out in the \
+            \packages section."
+        | otherwise = Nothing
       extraDepMsg
-        | Map.size extraDeps > 0 =
+        | Map.size extraDeps > 0 = Just
             "Warning (added by new or init): Specified snapshot could not \
-            \satisfy all dependencies. Some external packages have been added \
-            \as dependencies.\n"
-        | otherwise = ""
-      makeUserMsg msgs =
-        let msg = concat msgs
-        in  if msg /= ""
-              then
-                   msg
-                <> "You can omit this message by removing it from stack.yaml\n"
-              else ""
+            \satisfy all\n\
+            \dependencies. Some external packages have been added as \
+            \dependencies."
+        | otherwise = Nothing
+      removalMsg =
+        "You can omit this message by removing it from the project-level \
+        \configuration\n\
+        \file."
+      makeUserMsg mMsgs =
+        let msgs = catMaybes mMsgs
+        in  if null msgs
+              then Nothing
+              else Just $ intercalate "\n\n" (msgs <> [removalMsg]) <> "\n"
       userMsg = makeUserMsg [dupPkgMsg, missingPkgMsg, extraDepMsg]
       gpdByDir =
         Map.fromList [ (parent fp, gpd) | (fp, gpd) <- Map.elems bundle]
@@ -284,7 +289,7 @@ initProject currDir initOpts mASnapshot = do
       completePackageLocation
         (RPLIHackage (PackageIdentifierRevision n v CFILatest) Nothing)
   let project = Project
-        { userMsg = if userMsg == "" then Nothing else Just userMsg
+        { userMsg
         , packages = resolvedRelative <$> Map.elems rbundle
         , extraDeps = map toRawPL deps
         , flagsByPkg = removeSrcPkgDefaultFlags gpds flags