Text.Pandoc.Filter: Generalize type of applyFilters...

from PandocIO to any instance of MonadIO and PandocMonad.
[API change]

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