[#213] Do not print trailing whitespaces

Problem: bats tests are not space sensetive
Solution: remove trailing spaces from xrefcheck output
(see next problems), remove `--ignore-trailing-space`
from `assert_diff`

Problem: there are lines containing only spaces in
xrefcheck's output, because `Fmt.indentF` "indents"
empty lines too.
Solution: add `Xrefcheck.Util.Interpolate.interpolateIndentF`
function that is not indenting empty lines.
Same for `Fmt.blockListF` and `Fmt.blockListF'`.
Those functions are not adding trailing newlines, so it's
easier to use it in interpolation blocks.

Problem: when there is a current file link `[a](#b)`, it is
printed like
```
- text: "a"
- link: (trailing space here)
- anchor: b
```
Solution: like with anchors, print `link: -` instead

.hlint.yaml

@@ -110,3 +110,15 @@
     name: "Avoid style function that ignore ColorMode"
     lhs: 'System.Console.Pretty.style'
     rhs: 'Xrefcheck.Util.Colorize.styleIfNeeded'
+- warn:
+    name: "Avoid functions that generate extra trailing newlines/whitespaces"
+    lhs: 'Fmt.indentF'
+    rhs: 'Xrefcheck.Util.Interpolate.interpolateIndentF'
+- warn:
+    name: "Avoid functions that generate extra trailing newlines/whitespaces"
+    lhs: 'Fmt.blockListF'
+    rhs: 'Xrefcheck.Util.Interpolate.interpolateBlockListF'
+- warn:
+    name: "Avoid functions that generate extra trailing newlines/whitespaces"
+    lhs: "Fmt.blockListF'"
+    rhs: "Xrefcheck.Util.Interpolate.interpolateBlockListF'"

package.yaml

@@ -146,7 +146,6 @@ tests:
       - xrefcheck
       - bytestring
       - directory
-      - fmt
       - http-types
       - o-clock
       - regex-tdfa
@@ -159,6 +158,7 @@ tests:
       - uri-bytestring
       - yaml
       - reflection
+      - nyan-interpolation
 
   ftp-tests:
     main: Main.hs

src/Xrefcheck/Command.hs

@@ -11,7 +11,7 @@ import Universum
 
 import Data.Reflection (give)
 import Data.Yaml (decodeFileEither, prettyPrintParseException)
-import Fmt (blockListF', build, fmt, fmtLn, indentF)
+import Fmt (build, fmt, fmtLn)
 import System.Console.Pretty (supportsPretty)
 import System.Directory (doesFileExist)
 import Text.Interpolation.Nyan
@@ -75,10 +75,10 @@ defaultAction Options{..} = do
       fmt [int||
       === Repository data ===
 
-      #{indentF 2 (build repoInfo)}\
+      #{interpolateIndentF 2 (build repoInfo)}
       |]
 
-    unless (null scanErrs) . reportScanErrs $ sortBy (compare `on` seFile) scanErrs
+    whenJust (nonEmpty $ sortBy (compare `on` seFile) scanErrs) $ reportScanErrs
 
     verifyRes <- allowRewrite showProgressBar $ \rw -> do
       let fullConfig = config
@@ -88,7 +88,7 @@ defaultAction Options{..} = do
     case verifyErrors verifyRes of
       Nothing | null scanErrs -> fmtLn "All repository links are valid."
       Nothing -> exitFailure
-      Just (toList -> verifyErrs) -> do
+      Just verifyErrs -> do
         unless (null scanErrs) $ fmt "\n"
         reportVerifyErrs verifyErrs
         exitFailure
@@ -97,7 +97,7 @@ defaultAction Options{..} = do
       [int||
       === Scan errors found ===
 
-      #{indentF 2 (blockListF' "➥ " build errs)}\
+      #{interpolateIndentF 2 (interpolateBlockListF' "➥ " build errs)}
       Scan errors dumped, #{length errs} in total.
       |]
 
@@ -105,6 +105,6 @@ defaultAction Options{..} = do
       [int||
       === Invalid references found ===
 
-      #{indentF 2 (blockListF' "➥ " build errs)}\
+      #{interpolateIndentF 2 (interpolateBlockListF' "➥ " build errs)}
       Invalid references dumped, #{length errs} in total.
       |]

src/Xrefcheck/Config.hs

@@ -18,9 +18,9 @@ import Data.ByteString qualified as BS
 import Data.Map qualified as Map
 import Data.Yaml (FromJSON (..), decodeEither', prettyPrintParseException, withText)
 import Instances.TH.Lift ()
+import Text.Interpolation.Nyan
 import Text.Regex.TDFA qualified as R
 import Text.Regex.TDFA.ByteString ()
-import Text.Interpolation.Nyan
 
 import Time (KnownRatName, Second, Time (..), unitsP)
 

src/Xrefcheck/Core.hs

@@ -15,14 +15,13 @@ import Control.Lens (makeLenses)
 import Data.Aeson (FromJSON (..), withText)
 import Data.Char (isAlphaNum)
 import Data.Char qualified as C
+import Data.Default (Default (..))
 import Data.DList (DList)
 import Data.DList qualified as DList
-import Data.Default (Default (..))
 import Data.List qualified as L
-import Data.Map qualified as M
 import Data.Reflection (Given)
 import Data.Text qualified as T
-import Fmt (Buildable (..), blockListF, blockListF', indentF)
+import Fmt (Buildable (..))
 import System.FilePath (isPathSeparator, pathSeparator)
 import Text.Interpolation.Nyan
 import Time (Second, Time)
@@ -146,7 +145,7 @@ instance Given ColorMode => Buildable Reference where
     [int||
     reference #{paren . build $ locationType rLink} #{rPos}:
       - text: #s{rName}
-      - link: #{rLink}
+      - link: #{if null rLink then "-" else rLink}
       - anchor: #{rAnchor ?: styleIfNeeded Faint "-"}
     |]
 
@@ -175,20 +174,21 @@ instance Given ColorMode => Buildable FileInfo where
   build FileInfo{..} =
     [int||
     - references:
-    #{indentF 4 $ blockListF _fiReferences}\
+    #{ interpolateIndentF 4 $ maybe "none" interpolateBlockListF (nonEmpty _fiReferences) }
     - anchors:
-    #{indentF 4 $ blockListF _fiAnchors}\
+    #{ interpolateIndentF 4 $ maybe "none" interpolateBlockListF (nonEmpty _fiAnchors) }
     |]
 
 instance Given ColorMode => Buildable RepoInfo where
-  build (RepoInfo m _) =
-    blockListF' "⮚" buildFileReport (mapMaybe sequence $ M.toList m)
+  build (RepoInfo (nonEmpty . mapMaybe sequence . toPairs -> Just m) _) =
+    interpolateBlockListF' "⮚" buildFileReport m
     where
       buildFileReport (name, info) =
         [int||
         #{colorIfNeeded Cyan $ name}:
         #{info}
         |]
+  build _ = "No scannable files found."
 
 -----------------------------------------------------------
 -- Analysing

src/Xrefcheck/Scanners/Markdown.hs

@@ -25,13 +25,13 @@ import Control.Lens (_Just, makeLenses, makeLensesFor, (.=))
 import Control.Monad.Trans.Writer.CPS (Writer, runWriter, tell)
 import Data.Aeson (FromJSON (..), genericParseJSON)
 import Data.ByteString.Lazy qualified as BSL
-import Data.DList qualified as DList
 import Data.Default (def)
+import Data.DList qualified as DList
 import Data.Text qualified as T
 import Data.Text.Lazy qualified as LT
-import Fmt (Buildable (..), blockListF, nameF)
-import Text.Interpolation.Nyan
+import Fmt (Buildable (..), nameF)
 import Text.HTML.TagSoup
+import Text.Interpolation.Nyan
 
 import Xrefcheck.Core
 import Xrefcheck.Scan
@@ -50,7 +50,8 @@ defGithubMdConfig = MarkdownConfig
   }
 
 instance Buildable Node where
-  build (Node _mpos ty subs) = nameF (show ty) $ blockListF subs
+  build (Node _mpos ty mSubs) = nameF (show ty) $
+    maybe "[]" interpolateBlockListF (nonEmpty mSubs)
 
 toPosition :: Maybe PosInfo -> Position
 toPosition = Position . \case

src/Xrefcheck/Util.hs

@@ -13,6 +13,7 @@ module Xrefcheck.Util
   , posixTimeToTimeSecond
   , utcTimeToTimeSecond
   , module Xrefcheck.Util.Colorize
+  , module Xrefcheck.Util.Interpolate
   ) where
 
 import Universum
@@ -30,6 +31,7 @@ import System.FilePath (dropTrailingPathSeparator, normalise)
 import Time (Second, Time (..), sec)
 
 import Xrefcheck.Util.Colorize
+import Xrefcheck.Util.Interpolate
 
 paren :: Builder -> Builder
 paren a

src/Xrefcheck/Util/Interpolate.hs

@@ -0,0 +1,81 @@
+{- SPDX-FileCopyrightText: 2018-2019 Serokell <https://serokell.io>
+ -
+ - SPDX-License-Identifier: MPL-2.0
+ -}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+module Xrefcheck.Util.Interpolate
+  ( -- $notes
+    interpolateIndentF
+  , interpolateBlockListF
+  , interpolateBlockListF'
+  )
+  where
+
+import Universum
+
+import Data.Text.Lazy qualified as TL
+import Data.Text.Lazy.Builder (fromLazyText, toLazyText)
+import Fmt (Buildable, Builder, blockListF, blockListF', indentF)
+
+{- $notes
+The `blockListF` and `indentF` frunctions from @fmt@ add a trailing newline, which makes them unsuitable for string interpolation.
+Consider this case:
+> [int||
+> aaa
+> #{indentF 2 "bbb"}
+> ccc
+> |]
+One would reasonably expect this to produce:
+> aaa
+>   bbb
+> ccc
+But, in reality, it produces:
+> aaa
+>   bbb
+>
+> ccc
+This module introduces versions of these functions that do not produce a trailing newline
+and can therefore be safely used in string interpolation.
+-}
+
+{-# HLINT ignore "Avoid functions that generate extra trailing newlines/whitespaces" #-}
+
+-- | Like @Fmt.indentF@, but strips trailing spaces and does not add a trailing newline.
+--
+-- >>> import Fmt
+-- >>> indentF 2 "a\n\nb"
+-- "  a\n  \n  b\n"
+--
+-- >>> interpolateIndentF 2 "a\n\nb"
+-- "  a\n\n  b"
+interpolateIndentF :: HasCallStack => Int -> Builder -> Builder
+interpolateIndentF n b = (case TL.last (toLazyText b) of
+  '\n' -> id
+  _ ->  stripLastNewline) $ stripTrailingSpaces $ indentF n b
+  -- strips newline added by indentF
+
+-- | Like @Fmt.blockListF'@, but strips trailing spaces and does not add a trailing newline.
+interpolateBlockListF' :: HasCallStack => Text -> (a -> Builder) -> NonEmpty a -> Builder
+interpolateBlockListF' =  stripLastNewline . stripTrailingSpaces ... blockListF'
+
+-- | Like @Fmt.blockListF@, but strips trailing spaces and does not add a trailing newline.
+interpolateBlockListF :: HasCallStack => Buildable a => NonEmpty a -> Builder
+interpolateBlockListF = stripLastNewline . stripTrailingSpaces . blockListF
+
+-- remove trailing whitespace from all lines.
+-- Note: output always ends with newline (adds trailing newline if there wasn't one).
+stripTrailingSpaces :: Builder -> Builder
+stripTrailingSpaces
+  = fromLazyText
+  . TL.unlines
+  . map (TL.stripEnd)
+  . TL.lines
+  . toLazyText
+
+stripLastNewline :: HasCallStack => Builder -> Builder
+stripLastNewline
+  = fromLazyText
+  . fromMaybe (error "stripLastNewline: expected newline to strip")
+  . TL.stripSuffix "\n"
+  . toLazyText

src/Xrefcheck/Verify.hs

@@ -45,7 +45,7 @@ import Data.Text.Metrics (damerauLevenshteinNorm)
 import Data.Time (UTCTime, defaultTimeLocale, formatTime, readPTime, rfc822DateFormat)
 import Data.Time.Clock.POSIX (getPOSIXTime)
 import Data.Traversable (for)
-import Fmt (Buildable (..), indentF, listF, maybeF, nameF, blockListF)
+import Fmt (Buildable (..), maybeF, nameF)
 import GHC.Exts qualified as Exts
 import GHC.Read (Read (readPrec))
 import Network.FTP.Client
@@ -88,9 +88,6 @@ newtype VerifyResult e = VerifyResult [e]
 deriving newtype instance Semigroup (VerifyResult e)
 deriving newtype instance Monoid (VerifyResult e)
 
-instance Buildable e => Buildable (VerifyResult e) where
-  build vr = maybe "ok" listF (verifyErrors vr)
-
 verifyOk :: VerifyResult e -> Bool
 verifyOk (VerifyResult errors) = null errors
 
@@ -151,25 +148,25 @@ instance Given ColorMode => Buildable VerifyError where
          #{file}
       |]
 
-    AnchorDoesNotExist anchor similar
-      | null similar ->
+    AnchorDoesNotExist anchor similar -> case nonEmpty similar of
+      Nothing ->
         [int||
         ⛀  Anchor '#{anchor}' is not present
         |]
-      | otherwise ->
+      Just otherAnchors ->
         [int||
         ⛀  Anchor '#{anchor}' is not present, did you mean:
-        #{indentF 4 $ blockListF similar}\
+        #{interpolateIndentF 4 $ interpolateBlockListF otherAnchors}
         |]
 
     AmbiguousAnchorRef file anchor fileAnchors ->
       [int||
       ⛀  Ambiguous reference to anchor '#{anchor}'
-         In file #{file}
-         It could refer to either:
-      #{indentF 4 $ blockListF fileAnchors}
-          Use of ambiguous anchors is discouraged because the target
-          can change silently while the document containing it evolves.
+        In file #{file}
+        It could refer to either:
+      #{interpolateIndentF 4 $ interpolateBlockListF fileAnchors}
+        Use of ambiguous anchors is discouraged because the target
+        can change silently while the document containing it evolves.
       |]
 
     ExternalResourceInvalidUri err ->
@@ -180,7 +177,7 @@ instance Given ColorMode => Buildable VerifyError where
     ExternalResourceUriConversionError err ->
       [int||
       ⛂  Invalid URI
-      #{indentF 4 . build $ displayException err}
+      #{interpolateIndentF 4 . build $ displayException err}
       |]
 
     ExternalResourceInvalidUrl Nothing ->

tests/Test/Xrefcheck/TooManyRequestsSpec.hs

@@ -13,11 +13,11 @@ import Data.CaseInsensitive qualified as CI
 import Data.Map qualified as M
 import Data.Time (addUTCTime, defaultTimeLocale, formatTime, getCurrentTime, rfc822DateFormat)
 import Data.Time.Clock.POSIX (getPOSIXTime)
-import Fmt (indentF, pretty, unlinesF)
 import Network.HTTP.Types (Status (..), ok200, serviceUnavailable503, tooManyRequests429)
 import Network.HTTP.Types.Header (hRetryAfter)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (assertBool, testCase, (@?=))
+import Text.Interpolation.Nyan
 import Time (sec, (-:-))
 import Web.Firefly (ToResponse (toResponse), getMethod, route, run)
 
@@ -162,18 +162,20 @@ test_tooManyRequests = testGroup "429 response tests"
     checkLinkAndProgressWithServer mock link progress vrExpectation =
       E.bracket (forkIO mock) killThread $ \_ -> do
         (result, progRes) <- verifyLink link
-        flip assertBool (result == vrExpectation) . pretty $ unlinesF
-          [ "Verification results differ: expected"
-          , indentF 2 (show vrExpectation)
-          , "but got"
-          , indentF 2 (show result)
-          ]
-        flip assertBool (progRes `progEquiv` progress) . pretty $ unlinesF
-          [ "Expected the progress bar state to be"
-          , indentF 2 (show progress)
-          , "but got"
-          , indentF 2 (show progRes)
-          ]
+        flip assertBool (result == vrExpectation) $
+          [int||
+          Verification results differ: expected
+          #{interpolateIndentF 2 (show vrExpectation)}
+          but got
+          #{interpolateIndentF 2 (show result)}
+          |]
+        flip assertBool (progRes `progEquiv` progress) $
+          [int||
+          Expected the progress bar state to be
+          #{interpolateIndentF 2 (show progress)}
+          but got
+          #{interpolateIndentF 2 (show progRes)}
+          |]
       where
         -- | Check whether the two @Progress@ values are equal up to similarity of their essential
         -- components, ignoring the comparison of @pTaskTimestamp@s, which is done to prevent test

tests/Test/Xrefcheck/TrailingSlashSpec.hs

@@ -7,16 +7,17 @@ module Test.Xrefcheck.TrailingSlashSpec where
 
 import Universum
 
-import Fmt (blockListF, pretty, unlinesF)
 import System.Directory (doesFileExist)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (assertFailure, testCase)
+import Text.Interpolation.Nyan
 
 import Xrefcheck.Config
 import Xrefcheck.Core
 import Xrefcheck.Progress
 import Xrefcheck.Scan
 import Xrefcheck.Scanners.Markdown
+import Xrefcheck.Util
 
 test_slash :: TestTree
 test_slash = testGroup "Trailing forward slash detection" $
@@ -33,12 +34,12 @@ test_slash = testGroup "Trailing forward slash detection" $
           return $ if predicate
                     then Right ()
                     else Left filePath)
-        if null nonExistentFiles
-        then pass
-        else assertFailure $ pretty $ unlinesF
-          [ "Expected all filepaths to be valid, but these filepaths do not exist:"
-          , blockListF nonExistentFiles
-          ]
+        whenJust (nonEmpty nonExistentFiles) $ \files ->
+          assertFailure
+            [int||
+            Expected all filepaths to be valid, but these filepaths do not exist:
+            #{interpolateBlockListF files}
+            |]
   where
     roots :: [FilePath]
     roots =

tests/golden/check-anchors/check-anchors.bats

@@ -17,18 +17,17 @@ assert_diff - <<EOF
   ➥  In file ambiguous-anchors/a.md
      bad reference (current file) at src:16:1-43:
        - text: "ambiguous anchor in this file"
-       - link:
+       - link: -
        - anchor: some-text
 
      ⛀  Ambiguous reference to anchor 'some-text'
-        In file ambiguous-anchors/a.md
-        It could refer to either:
+       In file ambiguous-anchors/a.md
+       It could refer to either:
          - some-text (header I) at src:6:1-11
          - some-text (header I) at src:8:1-15
          - some-text (header II) at src:12:1-12
-
-         Use of ambiguous anchors is discouraged because the target
-         can change silently while the document containing it evolves.
+       Use of ambiguous anchors is discouraged because the target
+       can change silently while the document containing it evolves.
 
   ➥  In file ambiguous-anchors/b.md
      bad reference (relative) at src:7:1-48:
@@ -37,14 +36,13 @@ assert_diff - <<EOF
        - anchor: some-text
 
      ⛀  Ambiguous reference to anchor 'some-text'
-        In file ambiguous-anchors/a.md
-        It could refer to either:
+       In file ambiguous-anchors/a.md
+       It could refer to either:
          - some-text (header I) at src:6:1-11
          - some-text (header I) at src:8:1-15
          - some-text (header II) at src:12:1-12
-
-         Use of ambiguous anchors is discouraged because the target
-         can change silently while the document containing it evolves.
+       Use of ambiguous anchors is discouraged because the target
+       can change silently while the document containing it evolves.
 
 Invalid references dumped, 2 in total.
 EOF
@@ -58,7 +56,7 @@ assert_diff - <<EOF
   ➥  In file non-existing-anchors/a.md
      bad reference (current file) at src:12:1-13:
        - text: "broken"
-       - link:
+       - link: -
        - anchor: h3
 
      ⛀  Anchor 'h3' is not present, did you mean:
@@ -68,7 +66,7 @@ assert_diff - <<EOF
   ➥  In file non-existing-anchors/a.md
      bad reference (current file) at src:14:1-18:
        - text: "broken"
-       - link:
+       - link: -
        - anchor: heading
 
      ⛀  Anchor 'heading' is not present, did you mean:
@@ -77,7 +75,7 @@ assert_diff - <<EOF
   ➥  In file non-existing-anchors/a.md
      bad reference (current file) at src:16:1-31:
        - text: "broken"
-       - link:
+       - link: -
        - anchor: really-unique-anchor
 
      ⛀  Anchor 'really-unique-anchor' is not present

tests/golden/check-autolinks/check-autolinks.bats

@@ -25,7 +25,7 @@ assert_diff - <<EOF
             - link: http://www.commonmark.org
             - anchor: -
     - anchors:
-        []
+        none
 
 All repository links are valid.
 EOF

tests/golden/check-images/expected.gold

@@ -27,7 +27,7 @@
             - link: ./4.png
             - anchor: -
     - anchors:
-        []
+        none
 
 === Invalid references found ===
 

tests/golden/check-local-refs/expected1.gold

@@ -3,7 +3,7 @@
   ➥  In file dir1/dir2/d2f1.md
      bad reference (current file) at src:9:1-18:
        - text: "bad-cf-ref"
-       - link:
+       - link: -
        - anchor: bad
 
      ⛀  Anchor 'bad' is not present

tests/golden/check-local-refs/expected2.gold

@@ -3,7 +3,7 @@
   ➥  In file dir1/dir2/d2f1.md
      bad reference (current file) at src:9:1-18:
        - text: "bad-cf-ref"
-       - link:
+       - link: -
        - anchor: bad
 
      ⛀  Anchor 'bad' is not present

tests/golden/check-local-refs/expected3.gold

@@ -3,7 +3,7 @@
   ➥  In file dir1/dir2/d2f1.md
      bad reference (current file) at src:9:1-18:
        - text: "bad-cf-ref"
-       - link:
+       - link: -
        - anchor: bad
 
      ⛀  Anchor 'bad' is not present

tests/golden/helpers.bash

@@ -67,6 +67,5 @@ assert_diff() {
   : "{output_file?}"
 
   diff $output_file $1 \
-    --ignore-tab-expansion \
-    --ignore-trailing-space
+    --ignore-tab-expansion
 }