diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Text/Pandoc/Class/PandocMonad.hs | 45 | ||||
| -rw-r--r-- | src/Text/Pandoc/Filter.hs | 12 | ||||
| -rw-r--r-- | src/Text/Pandoc/Filter/Path.hs | 35 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Custom.hs | 8 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Custom.hs | 59 |
5 files changed, 74 insertions, 85 deletions
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 |