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

@@ -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,

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

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

src/Text/Pandoc/Filter/Path.hs

@@ -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

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)

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