Replace.hs

{-# OPTIONS_GHC -Wall #-}

{- | Commands that replace strings in text files, such as placeholders for
the git revision of a document.

These operate on text files, such as flat LibreOffice files (@.fodt@,
@.fods@, @.fodg@), markdown, HTML and SVG. They do not apply to zipped
LibreOffice files (@.odt@), which can be converted to flat files with
'Document.Build.LibreOffice.libreofficeFlat'.
-}
module Document.Build.Replace (
  replaceText,
  replaceStrings,
  requireStrings,
  xmlEscape,
) where

import Control.Monad.Trans.Class (lift)
import Data.Bifunctor (bimap)
import Data.List.NonEmpty (nonEmpty)
import Data.Text (Text)
import qualified Data.Text as Text
import Document.Build.Build (Command, failBuild, requireInput)
import Document.Build.Error (BuildError (..), ReviewBuildError)
import Document.Build.File (readUtf8, writeUtf8)

{- $setup
>>> :set -XOverloadedStrings
-}

{- | Replace every occurrence of the first string of each pair with the
second. The pairs are applied in order, so a later pair also applies to the
replacements made by an earlier pair. A pair whose first string is empty is
skipped.

>>> replaceText [("${NAME}", "Tony"), ("${DATE}", "2026-10-09")] "${NAME} wrote this on ${DATE}, ${NAME}"
"Tony wrote this on 2026-10-09, Tony"

>>> replaceText [("", "x")] "abc"
"abc"

>>> replaceText [("a", "b"), ("b", "c")] "ab"
"cc"

@since 0.1.0.0
-}
replaceText :: [(Text, Text)] -> Text -> Text
replaceText = foldr (\(a, b) k -> k . if Text.null a then id else Text.replace a b) id
{-# INLINE replaceText #-}

{- | Replace strings in the file being operated on, as with 'replaceText',
writing the result to a file path, and return the file path. The file is read
and written as UTF-8.

The output file path may be the same as the input file path.

@since 0.1.0.0
-}
replaceStrings :: (ReviewBuildError e) => [(String, String)] -> FilePath -> Command e FilePath
replaceStrings rs o =
  do
    i <- requireInput
    lift (readUtf8 i >>= writeUtf8 o . replaceText (fmap (bimap Text.pack Text.pack) rs))

{- | Fail with 'StringsMissing' unless the file being operated on contains
every one of the given strings.

@since 0.1.0.0
-}
requireStrings :: (ReviewBuildError e) => [String] -> Command e ()
requireStrings xs =
  do
    i <- requireInput
    t <- lift (readUtf8 i)
    maybe
      (pure ())
      (lift . failBuild . StringsMissing i)
      (nonEmpty (filter (\x -> not (Text.pack x `Text.isInfixOf` t)) xs))

{- | Escape a string for XML text or an attribute value. Use this for
replacement strings in XML files, such as flat LibreOffice files.

>>> xmlEscape "Tony <tony@example.com> & \"friends\""
"Tony &lt;tony@example.com&gt; &amp; &quot;friends&quot;"

@since 0.1.0.0
-}
xmlEscape :: String -> String
xmlEscape =
  concatMap
    ( \c ->
        case c of
          '&' -> "&amp;"
          '<' -> "&lt;"
          '>' -> "&gt;"
          '"' -> "&quot;"
          '\'' -> "&apos;"
          _ -> [c]
    )