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.
This commit is contained in:
John MacFarlane
2023-06-27 11:15:31 -07:00
parent 67970d244e
commit e0bea476bf
5 changed files with 29 additions and 26 deletions
+4 -3
View File
@@ -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
+5 -4
View File
@@ -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`))
+11 -10
View File
@@ -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 []
+6 -6
View File
@@ -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.
+3 -3
View File
@@ -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)