{- 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'
  , interpolateUnlinesF
  )
  where

import Universum

import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder (fromLazyText, toLazyText)
import Fmt (Buildable, Builder, blockListF, blockListF', indentF, unlinesF)

{- $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 :: HasCallStack => Int -> Builder -> Builder
interpolateIndentF Int
n Builder
b = (case HasCallStack => Text -> Char
Text -> Char
TL.last (Builder -> Text
toLazyText Builder
b) of
  Char
'\n' -> Builder -> Builder
forall a. a -> a
id
  Char
_ ->  HasCallStack => Builder -> Builder
Builder -> Builder
stripLastNewline) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
stripTrailingSpaces (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder -> Builder
indentF Int
n Builder
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' :: forall a.
HasCallStack =>
Text -> (a -> Builder) -> NonEmpty a -> Builder
interpolateBlockListF' =  HasCallStack => Builder -> Builder
Builder -> Builder
stripLastNewline (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
stripTrailingSpaces (Builder -> Builder)
-> (Text -> (a -> Builder) -> NonEmpty a -> Builder)
-> Text
-> (a -> Builder)
-> NonEmpty a
-> Builder
forall a b c. SuperComposition a b c => a -> b -> c
... Text -> (a -> Builder) -> NonEmpty a -> Builder
forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF'

-- | Like @Fmt.blockListF@, but strips trailing spaces and does not add a trailing newline.
interpolateBlockListF :: HasCallStack => Buildable a => NonEmpty a -> Builder
interpolateBlockListF :: forall a. (HasCallStack, Buildable a) => NonEmpty a -> Builder
interpolateBlockListF = HasCallStack => Builder -> Builder
Builder -> Builder
stripLastNewline (Builder -> Builder)
-> (NonEmpty a -> Builder) -> NonEmpty a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
stripTrailingSpaces (Builder -> Builder)
-> (NonEmpty a -> Builder) -> NonEmpty a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF

-- | Like @Fmt.unlinesF@, but strips trailing spaces and does not add a trailing newline.
interpolateUnlinesF :: HasCallStack => Buildable a => NonEmpty a -> Builder
interpolateUnlinesF :: forall a. (HasCallStack, Buildable a) => NonEmpty a -> Builder
interpolateUnlinesF = HasCallStack => Builder -> Builder
Builder -> Builder
stripLastNewline (Builder -> Builder)
-> (NonEmpty a -> Builder) -> NonEmpty a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
stripTrailingSpaces (Builder -> Builder)
-> (NonEmpty a -> Builder) -> NonEmpty a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF

-- remove trailing whitespace from all lines.
-- Note: output always ends with newline (adds trailing newline if there wasn't one).
stripTrailingSpaces :: Builder -> Builder
stripTrailingSpaces :: Builder -> Builder
stripTrailingSpaces
  = Text -> Builder
fromLazyText
  (Text -> Builder) -> (Builder -> Text) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
TL.unlines
  ([Text] -> Text) -> (Builder -> [Text]) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text -> Text
TL.stripEnd)
  ([Text] -> [Text]) -> (Builder -> [Text]) -> Builder -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
TL.lines
  (Text -> [Text]) -> (Builder -> Text) -> Builder -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText

stripLastNewline :: HasCallStack => Builder -> Builder
stripLastNewline :: HasCallStack => Builder -> Builder
stripLastNewline
  = Text -> Builder
fromLazyText
  (Text -> Builder) -> (Builder -> Text) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Text
forall a. HasCallStack => Text -> a
error Text
"stripLastNewline: expected newline to strip")
  (Maybe Text -> Text) -> (Builder -> Maybe Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Maybe Text
TL.stripSuffix Text
"\n"
  (Text -> Maybe Text) -> (Builder -> Text) -> Builder -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText