Merge https://github.com/jgm/pandoc

5 files changed, 72 insertions, 2 deletions

diff --git a/src/Text/Pandoc/Class/IO.hs b/src/Text/Pandoc/Class/IO.hs
index f4cfc8682..305f07a01 100644
--- a/src/Text/Pandoc/Class/IO.hs
+++ b/src/Text/Pandoc/Class/IO.hs
@@ -30,6 +30,7 @@ module Text.Pandoc.Class.IO
   , openURL
   , readFileLazy
   , readFileStrict
+  , readStdinStrict
   , extractMedia
  ) where
 
@@ -158,6 +159,11 @@ readFileLazy s = liftIOError BL.readFile s
 readFileStrict :: (PandocMonad m, MonadIO m) => FilePath -> m B.ByteString
 readFileStrict s = liftIOError B.readFile s
 
+-- | Read the strict ByteString contents from stdin, raising
+-- an error on failure.
+readStdinStrict :: (PandocMonad m, MonadIO m) => m B.ByteString
+readStdinStrict = liftIOError (const B.getContents) "stdin"
+
 -- | Return a list of paths that match a glob, relative to the working
 -- directory. See 'System.FilePath.Glob' for the glob syntax.
 glob :: (PandocMonad m, MonadIO m) => String -> m [FilePath]
diff --git a/src/Text/Pandoc/Class/PandocIO.hs b/src/Text/Pandoc/Class/PandocIO.hs
index 63cb94155..61ee1f1c6 100644
--- a/src/Text/Pandoc/Class/PandocIO.hs
+++ b/src/Text/Pandoc/Class/PandocIO.hs
@@ -29,6 +29,7 @@ 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)
@@ -45,6 +46,9 @@ newtype PandocIO a = PandocIO {
              , Functor
              , Applicative
              , Monad
+             , MonadCatch
+             , MonadMask
+             , MonadThrow
              , MonadError PandocError
              )
 
@@ -58,6 +62,7 @@ instance PandocMonad PandocIO where
   openURL = IO.openURL
   readFileLazy = IO.readFileLazy
   readFileStrict = IO.readFileStrict
+  readStdinStrict = IO.readStdinStrict
 
   glob = IO.glob
   fileExists = IO.fileExists
@@ -70,5 +75,5 @@ instance PandocMonad PandocIO where
   logOutput = IO.logOutput
 
 -- | Extract media from the mediabag into a directory.
-extractMedia :: FilePath -> Pandoc -> PandocIO Pandoc
+extractMedia :: (PandocMonad m, MonadIO m) => FilePath -> Pandoc -> m Pandoc
 extractMedia = IO.extractMedia
diff --git a/src/Text/Pandoc/Class/PandocMonad.hs b/src/Text/Pandoc/Class/PandocMonad.hs
index 439aec071..c15ce6444 100644
--- a/src/Text/Pandoc/Class/PandocMonad.hs
+++ b/src/Text/Pandoc/Class/PandocMonad.hs
@@ -117,6 +117,9 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m)
   -- | Read the strict ByteString contents from a file path,
   -- raising an error on failure.
   readFileStrict :: FilePath -> m B.ByteString
+  -- | Read the contents of stdin as a strict ByteString, raising
+  -- an error on failure.
+  readStdinStrict :: m B.ByteString
   -- | Return a list of paths that match a glob, relative to
   -- the working directory.  See 'System.FilePath.Glob' for
   -- the glob syntax.
@@ -451,7 +454,7 @@ getDefaultReferenceDocx = do
                "word/theme/theme1.xml"]
   let toLazy = BL.fromChunks . (:[])
   let pathToEntry path = do
-        epochtime <- floor . utcTimeToPOSIXSeconds <$> getCurrentTime
+        epochtime <- floor . utcTimeToPOSIXSeconds <$> getTimestamp
         contents <- toLazy <$> readDataFile ("docx/" ++ path)
         return $ toEntry path epochtime contents
   datadir <- getUserDataDir
@@ -674,6 +677,7 @@ instance (MonadTrans t, PandocMonad m, Functor (t m),
   openURL = lift . openURL
   readFileLazy = lift . readFileLazy
   readFileStrict = lift . readFileStrict
+  readStdinStrict = lift readStdinStrict
   glob = lift . glob
   fileExists = lift . fileExists
   getDataFileName = lift . getDataFileName
@@ -691,6 +695,7 @@ instance {-# OVERLAPS #-} PandocMonad m => PandocMonad (ParsecT s st m) where
   openURL = lift . openURL
   readFileLazy = lift . readFileLazy
   readFileStrict = lift . readFileStrict
+  readStdinStrict = lift readStdinStrict
   glob = lift . glob
   fileExists = lift . fileExists
   getDataFileName = lift . getDataFileName
diff --git a/src/Text/Pandoc/Class/PandocPure.hs b/src/Text/Pandoc/Class/PandocPure.hs
index 23c941839..290a6d97c 100644
--- a/src/Text/Pandoc/Class/PandocPure.hs
+++ b/src/Text/Pandoc/Class/PandocPure.hs
@@ -64,6 +64,7 @@ data PureState = PureState
   , stReferencePptx :: Archive
   , stReferenceODT :: Archive
   , stFiles :: FileTree
+  , stStdin :: B.ByteString
   , stUserDataFiles :: FileTree
   , stCabalDataFiles :: FileTree
   }
@@ -80,6 +81,7 @@ instance Default PureState where
         , stReferencePptx = emptyArchive
         , stReferenceODT = emptyArchive
         , stFiles = mempty
+        , stStdin = mempty
         , stUserDataFiles = mempty
         , stCabalDataFiles = mempty
         }
@@ -193,6 +195,8 @@ instance PandocMonad PandocPure where
       Just bs -> return bs
       Nothing -> throwError $ PandocResourceNotFound $ T.pack fp
 
+  readStdinStrict = getsPureState stStdin
+
   glob s = do
     FileTree ftmap <- getsPureState stFiles
     return $ filter (match (compile s)) $ M.keys ftmap
diff --git a/src/Text/Pandoc/Class/Sandbox.hs b/src/Text/Pandoc/Class/Sandbox.hs
new file mode 100644
index 000000000..8bc0f1e77
--- /dev/null
+++ b/src/Text/Pandoc/Class/Sandbox.hs
@@ -0,0 +1,50 @@
+{- |
+Module      : Text.Pandoc.Class.Sandbox
+Copyright   : Copyright (C) 2021 John MacFarlane
+License     : GNU GPL, version 2 or above
+
+Maintainer  : John MacFarlane (<jgm@berkeley.edu>)
+Stability   : alpha
+Portability : portable
+
+This module provides a way to run PandocMonad actions in a sandbox
+(pure context, with no IO allowed and access only to designated files).
+-}
+
+module Text.Pandoc.Class.Sandbox
+  ( sandbox )
+where
+
+import Control.Monad (foldM)
+import Control.Monad.Except (throwError)
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import Text.Pandoc.Class.PandocMonad
+import Text.Pandoc.Class.PandocPure
+import Text.Pandoc.Class.CommonState (CommonState(..))
+import Text.Pandoc.Logging (messageVerbosity)
+
+-- | Lift a PandocPure action into any instance of PandocMonad.
+-- The main computation is done purely, but CommonState is preserved
+-- continuously, and warnings are emitted after the action completes.
+-- The parameter is a list of FilePaths which will be added to the
+-- ersatz file system and be available for reading.
+sandbox :: (PandocMonad m, MonadIO m) => [FilePath] -> PandocPure a -> m a
+sandbox files action = do
+  oldState <- getCommonState
+  tree <- liftIO $ foldM addToFileTree mempty files
+  case runPure (do putCommonState oldState
+                   modifyPureState $ \ps -> ps{ stFiles = tree }
+                   result <- action
+                   st <- getCommonState
+                   return (st, result)) of
+          Left e -> throwError e
+          Right (st, result) -> do
+            putCommonState st
+            let verbosity = stVerbosity st
+            -- emit warnings, since these are not printed in runPure
+            let newMessages = reverse $ take
+                  (length (stLog st) - length (stLog oldState)) (stLog st)
+            mapM_ logOutput
+              (filter ((<= verbosity) . messageVerbosity) newMessages)
+            return result
+