From e0bea476bf3932e32b2e15827dfded61fcd9e87a Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Tue, 27 Jun 2023 11:15:31 -0700
Subject: Use toTextM instead of toText when possible.

(That is, whenever we have the filename and are in a
PandocMonad instance.)

This will lead to more informative error messages for UTF8
encoding, indicating the file path and byte offset where the
error occurs. Closes #8884.
---
 src/Text/Pandoc/App.hs                |  7 ++++---
 src/Text/Pandoc/App/OutputSettings.hs |  9 +++++----
 src/Text/Pandoc/Citeproc.hs           | 21 +++++++++++----------
 src/Text/Pandoc/Templates.hs          | 12 ++++++------
 src/Text/Pandoc/Translations.hs       |  6 +++---
 5 files changed, 29 insertions(+), 26 deletions(-)

(limited to 'src/Text')

diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index 76828e9d8..6d2208785 100644
--- a/src/Text/Pandoc/App.hs
+++ b/src/Text/Pandoc/App.hs
@@ -366,10 +366,11 @@ configureCommonState datadir opts = do
 -- only affect the Markdown reader.
 readAbbreviations :: PandocMonad m => Maybe FilePath -> m (Set.Set Text)
 readAbbreviations mbfilepath =
-  Set.fromList . filter (not . T.null) . T.lines . UTF8.toText <$>
-  case mbfilepath of
+  (case mbfilepath of
     Nothing -> readDataFile "abbreviations"
-    Just f  -> readFileStrict f
+    Just f  -> readFileStrict f)
+    >>= fmap (Set.fromList . filter (not . T.null) . T.lines) .
+         toTextM (fromMaybe mempty mbfilepath)
 
 createPngFallbacks :: (PandocMonad m, MonadIO m) => Int -> m ()
 createPngFallbacks dpi = do
diff --git a/src/Text/Pandoc/App/OutputSettings.hs b/src/Text/Pandoc/App/OutputSettings.hs
index af5c0ddbc..7f5d844e4 100644
--- a/src/Text/Pandoc/App/OutputSettings.hs
+++ b/src/Text/Pandoc/App/OutputSettings.hs
@@ -47,7 +47,7 @@ import Text.Pandoc.Scripting (ScriptingEngine (engineLoadCustom),
 import qualified Text.Pandoc.UTF8 as UTF8
 
 readUtf8File :: PandocMonad m => FilePath -> m T.Text
-readUtf8File = fmap UTF8.toText . readFileStrict
+readUtf8File fp = readFileStrict fp >>= toTextM fp
 
 -- | Settings specifying how document output should be produced.
 data OutputSettings m = OutputSettings
@@ -174,7 +174,7 @@ optToOutputSettings scriptingEngine opts = do
                          (ListVal $ v : map toVal vs) ctxMap
               Nothing -> M.insert k (toVal vs) ctxMap
 
-  let getTextContents fp = UTF8.toText . fst <$> fetchItem (T.pack fp)
+  let getTextContents fp = (fst <$> fetchItem (T.pack fp)) >>= toTextM fp
 
   let setFilesVariableM k fps ctx = do
         xs <- mapM getTextContents fps
@@ -209,8 +209,9 @@ optToOutputSettings scriptingEngine opts = do
     >>=
     (\vars ->  if format == "dzslides"
                   then do
-                      dztempl <- UTF8.toText <$> readDataFile
-                                   ("dzslides" </> "template.html")
+                      dztempl <-
+                        let fp = "dzslides" </> "template.html"
+                         in readDataFile fp >>= toTextM fp
                       let dzline = "<!-- {{{{ dzslides core"
                       let dzcore = T.unlines
                                  $ dropWhile (not . (dzline `T.isPrefixOf`))
diff --git a/src/Text/Pandoc/Citeproc.hs b/src/Text/Pandoc/Citeproc.hs
index 4830c4ef0..9b3e38b65 100644
--- a/src/Text/Pandoc/Citeproc.hs
+++ b/src/Text/Pandoc/Citeproc.hs
@@ -24,7 +24,7 @@ import Text.Pandoc.Builder (Inlines, Many(..), deleteMeta, setMeta)
 import qualified Text.Pandoc.Builder as B
 import Text.Pandoc.Definition as Pandoc
 import Text.Pandoc.Class (PandocMonad(..), getResourcePath, getUserDataDir,
-                          fetchItem, report, setResourcePath)
+                          fetchItem, report, setResourcePath, toTextM)
 import Text.Pandoc.Data (readDataFile)
 import Text.Pandoc.Error (PandocError(..))
 import Text.Pandoc.Extensions (pandocExtensions)
@@ -32,7 +32,6 @@ import Text.Pandoc.Logging (LogMessage(..))
 import Text.Pandoc.Options (ReaderOptions(..))
 import Text.Pandoc.Shared (stringify, tshow)
 import Data.Containers.ListUtils (nubOrd)
-import qualified Text.Pandoc.UTF8 as UTF8
 import Text.Pandoc.Walk (query, walk, walkM)
 import Control.Applicative ((<|>))
 import Control.Monad.Except (catchError, throwError)
@@ -143,7 +142,8 @@ getStyle (Pandoc meta _) = do
 
   let getCslDefault = readDataFile "default.csl"
 
-  cslContents <- UTF8.toText <$> maybe getCslDefault (getFile ".csl") cslfile
+  cslContents <- maybe getCslDefault (getFile ".csl") cslfile >>=
+                   toTextM (maybe mempty T.unpack cslfile)
 
   let abbrevFile = lookupMeta "citation-abbreviations" meta >>= metaValueToText
 
@@ -161,8 +161,8 @@ getStyle (Pandoc meta _) = do
   let getParentStyle url = do
         -- first, try to retrieve the style locally, then use HTTP.
         let basename = T.takeWhileEnd (/='/') url
-        UTF8.toText <$>
-          catchError (getFile ".csl" basename) (\_ -> fst <$> fetchItem url)
+        catchError (getFile ".csl" basename) (\_ -> fst <$> fetchItem url)
+          >>= toTextM (T.unpack url)
 
   styleRes <- Citeproc.parseStyle getParentStyle cslContents
   case styleRes of
@@ -254,13 +254,14 @@ getRefs :: PandocMonad m
 getRefs locale format idpred mbfp raw = do
   let err' = throwError .
              PandocBibliographyError (fromMaybe mempty mbfp)
+  let fp = maybe mempty T.unpack mbfp
   case format of
     Format_bibtex ->
-      either (err' . tshow) return .
-        readBibtexString Bibtex locale idpred . UTF8.toText $ raw
+      toTextM fp raw >>=
+        either (err' . tshow) return . readBibtexString Bibtex locale idpred
     Format_biblatex ->
-      either (err' . tshow) return .
-        readBibtexString Biblatex locale idpred . UTF8.toText $ raw
+      toTextM fp raw >>=
+      either (err' . tshow) return . readBibtexString Biblatex locale idpred
     Format_json ->
       either (err' . T.pack)
              (return . filter (idpred . unItemId . referenceId)) .
@@ -272,7 +273,7 @@ getRefs locale format idpred mbfp raw = do
               raw
       return $ mapMaybe metaValueToReference rs
     Format_ris -> do
-      Pandoc meta _ <- readRIS def (UTF8.toText raw)
+      Pandoc meta _ <- toTextM fp raw >>= readRIS def
       case lookupMeta "references" meta of
         Just (MetaList rs) -> return $ mapMaybe metaValueToReference rs
         _ -> return []
diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs
index 108121872..433d1f720 100644
--- a/src/Text/Pandoc/Templates.hs
+++ b/src/Text/Pandoc/Templates.hs
@@ -44,9 +44,9 @@ import System.FilePath ((<.>), (</>), takeFileName)
 import Text.DocTemplates (Template, TemplateMonad(..), compileTemplate, renderTemplate)
 import Text.Pandoc.Class.CommonState (CommonState(..))
 import Text.Pandoc.Class.PandocMonad (PandocMonad, fetchItem,
-                                      getCommonState, modifyCommonState)
+                                      getCommonState, modifyCommonState,
+                                      toTextM)
 import Text.Pandoc.Data (readDataFile)
-import qualified Text.Pandoc.UTF8 as UTF8
 import Control.Monad.Except (catchError, throwError)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -66,14 +66,14 @@ newtype WithPartials m a = WithPartials { runWithPartials :: m a }
 
 instance PandocMonad m => TemplateMonad (WithDefaultPartials m) where
   getPartial fp = WithDefaultPartials $
-    UTF8.toText <$> readDataFile ("templates" </> takeFileName fp)
+    readDataFile ("templates" </> takeFileName fp) >>= toTextM fp
 
 instance PandocMonad m => TemplateMonad (WithPartials m) where
   getPartial fp = WithPartials $ getTemplate fp
 
 -- | Retrieve text for a template.
 getTemplate :: PandocMonad m => FilePath -> m Text
-getTemplate tp = UTF8.toText <$>
+getTemplate tp =
   ((do surl <- stSourceURL <$> getCommonState
        -- we don't want to look for templates remotely
        -- unless the full URL is specified:
@@ -91,7 +91,7 @@ getTemplate tp = UTF8.toText <$>
              PandocIOError _ ioe | isDoesNotExistError ioe ->
                 -- see #5987 on reason for takeFileName
                 readDataFile ("templates" </> takeFileName tp)
-             _ -> throwError e))
+             _ -> throwError e)) >>= toTextM tp
 
 -- | Get default template for the specified writer.
 getDefaultTemplate :: PandocMonad m
@@ -121,7 +121,7 @@ getDefaultTemplate format = do
        "commonmark_x"      -> getDefaultTemplate "commonmark"
        _        -> do
          let fname = "templates" </> "default" <.> T.unpack format
-         UTF8.toText <$> readDataFile fname
+         readDataFile fname >>= toTextM fname
 
 -- | Get and compile default template for the specified writer.
 -- Raise an error on compilation failure.
diff --git a/src/Text/Pandoc/Translations.hs b/src/Text/Pandoc/Translations.hs
index 6a93ced9e..84b5e6161 100644
--- a/src/Text/Pandoc/Translations.hs
+++ b/src/Text/Pandoc/Translations.hs
@@ -20,7 +20,7 @@ module Text.Pandoc.Translations (
                          )
 where
 import Text.Pandoc.Translations.Types
-import Text.Pandoc.Class (PandocMonad(..), CommonState(..), report)
+import Text.Pandoc.Class (PandocMonad(..), CommonState(..), toTextM, report)
 import Text.Pandoc.Data (readDataFile)
 import Text.Pandoc.Error (PandocError(..))
 import Text.Pandoc.Logging (LogMessage(..))
@@ -58,8 +58,8 @@ getTranslations = do
          let translationFile = "translations/" <> renderLang lang <> ".yaml"
          let fallbackFile = "translations/" <> langLanguage lang <> ".yaml"
          let getTrans fp = do
-               bs <- readDataFile fp
-               case readTranslations (UTF8.toText bs) of
+               txt <- readDataFile fp >>= toTextM fp
+               case readTranslations txt of
                     Left e   -> do
                       report $ CouldNotLoadTranslations (renderLang lang)
                         (T.pack fp <> ": " <> e)
-- 
cgit v1.2.3