From 42cbc71bbc19c444d0acf9cb0709dfe568539dbd Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Fri, 10 Jun 2022 17:37:12 +0200
Subject: [PATCH] Allow placing custom readers and writers in data subdir
(#8112)
* PandocMonad: add new function `findFileWithDataFallback` [API Change]
* Custom readers: allow files to be placed in "readers" data dir
* Custom writers: allow files to be placed in "writers" data dir
---
pandoc.cabal | 1 -
src/Text/Pandoc/Class/PandocMonad.hs | 45 ++++++++++++++-------
src/Text/Pandoc/Filter.hs | 12 ++++--
src/Text/Pandoc/Filter/Path.hs | 35 -----------------
src/Text/Pandoc/Readers/Custom.hs | 8 ++--
src/Text/Pandoc/Writers/Custom.hs | 59 +++++++++++++++-------------
6 files changed, 74 insertions(+), 86 deletions(-)
delete mode 100644 src/Text/Pandoc/Filter/Path.hs
diff --git a/pandoc.cabal b/pandoc.cabal
index 83a3a7def..533acec99 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -662,7 +662,6 @@ library
Text.Pandoc.Filter.Environment,
Text.Pandoc.Filter.JSON,
Text.Pandoc.Filter.Lua,
- Text.Pandoc.Filter.Path,
Text.Pandoc.Parsing.Capabilities,
Text.Pandoc.Parsing.Citations,
Text.Pandoc.Parsing.General,
diff --git a/src/Text/Pandoc/Class/PandocMonad.hs b/src/Text/Pandoc/Class/PandocMonad.hs
index 235e10e40..6660db286 100644
--- a/src/Text/Pandoc/Class/PandocMonad.hs
+++ b/src/Text/Pandoc/Class/PandocMonad.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -52,6 +53,7 @@ module Text.Pandoc.Class.PandocMonad
, setTranslations
, translateTerm
, makeCanonical
+ , findFileWithDataFallback
, getTimestamp
) where
@@ -604,21 +606,9 @@ readDataFile fname = do
-- | Read metadata file from the working directory or, if not found there, from
-- the metadata subdirectory of the user data directory.
readMetadataFile :: PandocMonad m => FilePath -> m B.ByteString
-readMetadataFile fname = do
- existsInWorkingDir <- fileExists fname
- if existsInWorkingDir
- then readFileStrict fname
- else do
- dataDir <- checkUserDataDir fname
- case dataDir of
- Nothing ->
- throwError $ PandocCouldNotFindMetadataFileError $ T.pack fname
- Just userDir -> do
- let path = userDir </> "metadata" </> fname
- existsInUserDir <- fileExists path
- if existsInUserDir
- then readFileStrict path
- else throwError $ PandocCouldNotFindMetadataFileError $ T.pack fname
+readMetadataFile fname = findFileWithDataFallback "metadata" fname >>= \case
+ Nothing -> throwError $ PandocCouldNotFindMetadataFileError (T.pack fname)
+ Just metadataFile -> readFileStrict metadataFile
-- | Read file from from the default data files.
readDefaultDataFile :: PandocMonad m => FilePath -> m B.ByteString
@@ -668,6 +658,31 @@ withPaths (p:ps) action fp =
catchError ((p </> fp,) <$> action (p </> fp))
(\_ -> withPaths ps action fp)
+-- | Returns @fp@ if the file exists in the current directory; otherwise
+-- searches for the data file relative to @/subdir/@. Returns @Nothing@
+-- if neither file exists.
+findFileWithDataFallback :: PandocMonad m
+ => FilePath -- ^ subdir
+ -> FilePath -- ^ fp
+ -> m (Maybe FilePath)
+findFileWithDataFallback subdir fp = do
+ -- First we check to see if the file is found. If not, and if it's not
+ -- an absolute path, we check to see whether it's in @userdir/@. If
+ -- not, we leave it unchanged.
+ existsInWorkingDir <- fileExists fp
+ if existsInWorkingDir
+ then return $ Just fp
+ else do
+ mbDataDir <- checkUserDataDir fp
+ case mbDataDir of
+ Nothing -> return Nothing
+ Just datadir -> do
+ let datafp = datadir </> subdir </> fp
+ existsInDataDir <- fileExists datafp
+ return $ if existsInDataDir
+ then Just datafp
+ else Nothing
+
-- | Traverse tree, filling media bag for any images that
-- aren't already in the media bag.
fillMediaBag :: PandocMonad m => Pandoc -> m Pandoc
diff --git a/src/Text/Pandoc/Filter.hs b/src/Text/Pandoc/Filter.hs
index 905bf3786..7185fd1e0 100644
--- a/src/Text/Pandoc/Filter.hs
+++ b/src/Text/Pandoc/Filter.hs
@@ -20,15 +20,16 @@ module Text.Pandoc.Filter
import System.CPUTime (getCPUTime)
import Data.Aeson
+import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
-import Text.Pandoc.Class (report, getVerbosity, PandocMonad)
+import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback, getVerbosity,
+ report)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Filter.Environment (Environment (..))
import Text.Pandoc.Logging
import Text.Pandoc.Citeproc (processCitations)
import qualified Text.Pandoc.Filter.JSON as JSONFilter
import qualified Text.Pandoc.Filter.Lua as LuaFilter
-import qualified Text.Pandoc.Filter.Path as Path
import qualified Data.Text as T
import System.FilePath (takeExtension)
import Control.Applicative ((<|>))
@@ -99,6 +100,9 @@ applyFilters fenv filters args d = do
-- | Expand paths of filters, searching the data directory.
expandFilterPath :: (PandocMonad m, MonadIO m) => Filter -> m Filter
-expandFilterPath (LuaFilter fp) = LuaFilter <$> Path.expandFilterPath fp
-expandFilterPath (JSONFilter fp) = JSONFilter <$> Path.expandFilterPath fp
+expandFilterPath (LuaFilter fp) = LuaFilter <$> filterPath fp
+expandFilterPath (JSONFilter fp) = JSONFilter <$> filterPath fp
expandFilterPath CiteprocFilter = return CiteprocFilter
+
+filterPath :: PandocMonad m => FilePath -> m FilePath
+filterPath fp = fromMaybe fp <$> findFileWithDataFallback "filters" fp
diff --git a/src/Text/Pandoc/Filter/Path.hs b/src/Text/Pandoc/Filter/Path.hs
deleted file mode 100644
index 97de04f04..000000000
--- a/src/Text/Pandoc/Filter/Path.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-{- |
- Module : Text.Pandoc.Filter.Path
- Copyright : Copyright (C) 2006-2022 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley@edu>
- Stability : alpha
- Portability : portable
-
-Expand paths of filters, searching the data directory.
--}
-module Text.Pandoc.Filter.Path
- ( expandFilterPath
- ) where
-
-import Text.Pandoc.Class.PandocMonad (PandocMonad, fileExists, getUserDataDir)
-import System.FilePath ((</>), isRelative)
-
- -- First we check to see if a filter is found. If not, and if it's
- -- not an absolute path, we check to see whether it's in `userdir/filters`.
- -- If not, we leave it unchanged.
-expandFilterPath :: PandocMonad m => FilePath -> m FilePath
-expandFilterPath fp = do
- mbDatadir <- getUserDataDir
- fpExists <- fileExists fp
- if fpExists
- then return fp
- else case mbDatadir of
- Just datadir | isRelative fp -> do
- let filterPath = datadir </> "filters" </> fp
- filterPathExists <- fileExists filterPath
- if filterPathExists
- then return filterPath
- else return fp
- _ -> return fp
diff --git a/src/Text/Pandoc/Readers/Custom.hs b/src/Text/Pandoc/Readers/Custom.hs
index 195ad6cf4..37959574e 100644
--- a/src/Text/Pandoc/Readers/Custom.hs
+++ b/src/Text/Pandoc/Readers/Custom.hs
@@ -14,10 +14,11 @@ Supports custom parsers written in Lua which produce a Pandoc AST.
module Text.Pandoc.Readers.Custom ( readCustom ) where
import Control.Exception
import Control.Monad (when)
-import HsLua as Lua hiding (Operation (Div))
import Control.Monad.IO.Class (MonadIO)
+import Data.Maybe (fromMaybe)
+import HsLua as Lua hiding (Operation (Div))
import Text.Pandoc.Definition
-import Text.Pandoc.Class (PandocMonad, report)
+import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback, report)
import Text.Pandoc.Logging
import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
import Text.Pandoc.Lua.PandocLua
@@ -31,9 +32,10 @@ readCustom :: (PandocMonad m, MonadIO m, ToSources s)
=> FilePath -> ReaderOptions -> s -> m Pandoc
readCustom luaFile opts srcs = do
let globals = [ PANDOC_SCRIPT_FILE luaFile ]
+ luaFile' <- fromMaybe luaFile <$> findFileWithDataFallback "readers" luaFile
res <- runLua $ do
setGlobals globals
- stat <- dofileTrace luaFile
+ stat <- dofileTrace luaFile'
-- check for error in lua script (later we'll change the return type
-- to handle this more gracefully):
when (stat /= Lua.OK)
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index 80f161c8a..b7c99a155 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -12,10 +12,11 @@ a Lua writer.
module Text.Pandoc.Writers.Custom ( writeCustom ) where
import Control.Exception
import Control.Monad ((<=<))
+import Data.Maybe (fromMaybe)
import Data.Text (Text)
import HsLua
import Control.Monad.IO.Class (MonadIO)
-import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback)
import Text.Pandoc.Definition (Pandoc (..))
import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
import Text.Pandoc.Options (WriterOptions)
@@ -25,31 +26,33 @@ import qualified Text.Pandoc.Lua.Writer.Classic as Classic
-- | Convert Pandoc to custom markup.
writeCustom :: (PandocMonad m, MonadIO m)
=> FilePath -> WriterOptions -> Pandoc -> m Text
-writeCustom luaFile opts doc = either throw pure <=< runLua $ do
- setGlobals [ PANDOC_DOCUMENT doc
- , PANDOC_SCRIPT_FILE luaFile
- , PANDOC_WRITER_OPTIONS opts
- ]
- dofileTrace luaFile >>= \case
- OK -> pure ()
- _ -> throwErrorAsException
- -- Most classic writers contain code that throws an error if a global
- -- is not present. This would break our check for the existence of a
- -- "Writer" function. We resort to raw access for that reason, but
- -- could also catch the error instead.
- let rawgetglobal x = do
- pushglobaltable
- pushName x
- rawget (nth 2) <* remove (nth 2) -- remove global table
+writeCustom luaFile opts doc = do
+ luaFile' <- fromMaybe luaFile <$> findFileWithDataFallback "writers" luaFile
+ either throw pure <=< runLua $ do
+ setGlobals [ PANDOC_DOCUMENT doc
+ , PANDOC_SCRIPT_FILE luaFile'
+ , PANDOC_WRITER_OPTIONS opts
+ ]
+ dofileTrace luaFile' >>= \case
+ OK -> pure ()
+ _ -> throwErrorAsException
+ -- Most classic writers contain code that throws an error if a global
+ -- is not present. This would break our check for the existence of a
+ -- "Writer" function. We resort to raw access for that reason, but
+ -- could also catch the error instead.
+ let rawgetglobal x = do
+ pushglobaltable
+ pushName x
+ rawget (nth 2) <* remove (nth 2) -- remove global table
- rawgetglobal "Writer" >>= \case
- TypeNil -> do
- pop 1 -- remove nil
- Classic.runCustom opts doc
- _ -> do
- -- Writer on top of the stack. Call it with document and writer
- -- options as arguments.
- push doc
- push opts
- callTrace 2 1
- forcePeek $ peekText top
+ rawgetglobal "Writer" >>= \case
+ TypeNil -> do
+ pop 1 -- remove nil
+ Classic.runCustom opts doc
+ _ -> do
+ -- Writer on top of the stack. Call it with document and writer
+ -- options as arguments.
+ push doc
+ push opts
+ callTrace 2 1
+ forcePeek $ peekText top