diff options
| author | John MacFarlane <jgm@berkeley.edu> | 2021-08-22 21:38:55 -0700 |
|---|---|---|
| committer | John MacFarlane <jgm@berkeley.edu> | 2021-08-24 22:18:14 -0700 |
| commit | 0efbfb33ada6166eb53c5effb1b80393647a1c40 (patch) | |
| tree | 5bc5a4959c3f9dc4540a27a5ad12eae8b9c95b2f | |
| parent | 65e78dac74d29e70db883930eaa384598a23855b (diff) | |
| download | pandoc-0efbfb33ada6166eb53c5effb1b80393647a1c40.tar.gz | |
Text.Pandoc.Filter: Generalize type of applyFilters...
from PandocIO to any instance of MonadIO and PandocMonad.
[API change]
| -rw-r--r-- | src/Text/Pandoc/Class/PandocSandboxed.hs | 79 | ||||
| -rw-r--r-- | src/Text/Pandoc/Filter.hs | 10 | ||||
| -rw-r--r-- | src/Text/Pandoc/Filter/Lua.hs | 11 |
3 files changed, 91 insertions, 9 deletions
diff --git a/src/Text/Pandoc/Class/PandocSandboxed.hs b/src/Text/Pandoc/Class/PandocSandboxed.hs new file mode 100644 index 000000000..61ee1f1c6 --- /dev/null +++ b/src/Text/Pandoc/Class/PandocSandboxed.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{- | +Module : Text.Pandoc.Class.PandocIO +Copyright : Copyright (C) 2016-2020 Jesse Rosenthal, John MacFarlane +License : GNU GPL, version 2 or above + +Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu> +Stability : alpha +Portability : portable + +This module defines @'PandocIO'@, an IO-based instance of the +@'PandocMonad'@ type class. File, data, and network access all are run +using IO operators. +-} +module Text.Pandoc.Class.PandocIO + ( PandocIO(..) + , runIO + , runIOorExplode + , extractMedia + ) where + +import Control.Monad.Except (ExceptT, MonadError, runExceptT) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.State (StateT, evalStateT, lift, get, put) +import Data.Default (Default (def)) +import Text.Pandoc.Class.CommonState (CommonState (..)) +import Text.Pandoc.Class.PandocMonad +import Text.Pandoc.Definition +import Text.Pandoc.Error +import qualified Text.Pandoc.Class.IO as IO +import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) + +-- | Evaluate a 'PandocIO' operation. +runIO :: PandocIO a -> IO (Either PandocError a) +runIO ma = flip evalStateT def $ runExceptT $ unPandocIO ma + +-- | Evaluate a 'PandocIO' operation, handling any errors +-- by exiting with an appropriate message and error status. +runIOorExplode :: PandocIO a -> IO a +runIOorExplode ma = runIO ma >>= handleError + +newtype PandocIO a = PandocIO { + unPandocIO :: ExceptT PandocError (StateT CommonState IO) a + } deriving ( MonadIO + , Functor + , Applicative + , Monad + , MonadCatch + , MonadMask + , MonadThrow + , MonadError PandocError + ) + +instance PandocMonad PandocIO where + lookupEnv = IO.lookupEnv + getCurrentTime = IO.getCurrentTime + getCurrentTimeZone = IO.getCurrentTimeZone + newStdGen = IO.newStdGen + newUniqueHash = IO.newUniqueHash + + openURL = IO.openURL + readFileLazy = IO.readFileLazy + readFileStrict = IO.readFileStrict + readStdinStrict = IO.readStdinStrict + + glob = IO.glob + fileExists = IO.fileExists + getDataFileName = IO.getDataFileName + getModificationTime = IO.getModificationTime + + getCommonState = PandocIO $ lift get + putCommonState = PandocIO . lift . put + + logOutput = IO.logOutput + +-- | Extract media from the mediabag into a directory. +extractMedia :: (PandocMonad m, MonadIO m) => FilePath -> Pandoc -> m Pandoc +extractMedia = IO.extractMedia diff --git a/src/Text/Pandoc/Filter.hs b/src/Text/Pandoc/Filter.hs index 1209ceeb7..c2f522109 100644 --- a/src/Text/Pandoc/Filter.hs +++ b/src/Text/Pandoc/Filter.hs @@ -21,8 +21,7 @@ module Text.Pandoc.Filter import System.CPUTime (getCPUTime) import Data.Aeson.TH (deriveJSON, defaultOptions) import GHC.Generics (Generic) -import Text.Pandoc.Class.PandocIO (PandocIO) -import Text.Pandoc.Class.PandocMonad (report, getVerbosity) +import Text.Pandoc.Class (report, getVerbosity, PandocMonad) import Text.Pandoc.Definition (Pandoc) import Text.Pandoc.Options (ReaderOptions) import Text.Pandoc.Logging @@ -66,11 +65,12 @@ instance FromYAML Filter where _ -> JSONFilter fp) node -- | Modify the given document using a filter. -applyFilters :: ReaderOptions +applyFilters :: (PandocMonad m, MonadIO m) + => ReaderOptions -> [Filter] -> [String] -> Pandoc - -> PandocIO Pandoc + -> m Pandoc applyFilters ropts filters args d = do expandedFilters <- mapM expandFilterPath filters foldM applyFilter d expandedFilters @@ -92,7 +92,7 @@ applyFilters ropts filters args d = do toMilliseconds picoseconds = picoseconds `div` 1000000000 -- | Expand paths of filters, searching the data directory. -expandFilterPath :: Filter -> PandocIO Filter +expandFilterPath :: (PandocMonad m, MonadIO m) => Filter -> m Filter expandFilterPath (LuaFilter fp) = LuaFilter <$> Path.expandFilterPath fp expandFilterPath (JSONFilter fp) = JSONFilter <$> Path.expandFilterPath fp expandFilterPath CiteprocFilter = return CiteprocFilter diff --git a/src/Text/Pandoc/Filter/Lua.hs b/src/Text/Pandoc/Filter/Lua.hs index c238e53d9..4e264261b 100644 --- a/src/Text/Pandoc/Filter/Lua.hs +++ b/src/Text/Pandoc/Filter/Lua.hs @@ -14,7 +14,8 @@ module Text.Pandoc.Filter.Lua (apply) where import Control.Exception (throw) import Control.Monad ((>=>)) import qualified Data.Text as T -import Text.Pandoc.Class.PandocIO (PandocIO) +import Text.Pandoc.Class (PandocMonad) +import Control.Monad.Trans (MonadIO) import Text.Pandoc.Definition (Pandoc) import Text.Pandoc.Error (PandocError (PandocFilterError, PandocLuaError)) import Text.Pandoc.Lua (Global (..), runLua, runFilterFile, setGlobals) @@ -23,11 +24,12 @@ import Text.Pandoc.Options (ReaderOptions) -- | Run the Lua filter in @filterPath@ for a transformation to the -- target format (first element in args). Pandoc uses Lua init files to -- setup the Lua interpreter. -apply :: ReaderOptions +apply :: (PandocMonad m, MonadIO m) + => ReaderOptions -> [String] -> FilePath -> Pandoc - -> PandocIO Pandoc + -> m Pandoc apply ropts args fp doc = do let format = case args of (x:_) -> x @@ -39,7 +41,8 @@ apply ropts args fp doc = do ] runFilterFile fp doc -forceResult :: FilePath -> Either PandocError Pandoc -> PandocIO Pandoc +forceResult :: (PandocMonad m, MonadIO m) + => FilePath -> Either PandocError Pandoc -> m Pandoc forceResult fp eitherResult = case eitherResult of Right x -> return x Left err -> throw . PandocFilterError (T.pack fp) $ case err of |