Lua: accept filename-contents pairs as env for `pandoc.read`

Key-value pairs, mapping from filename to contents, can be used to fill
the ersatz file system used in the reader sandbox.

2 files changed, 57 insertions, 11 deletions

diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Pandoc.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Pandoc.hs
index a9ad78d67..0cf1bd853 100644
--- a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Pandoc.hs
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -17,7 +17,7 @@ module Text.Pandoc.Lua.Module.Pandoc
 
 import Prelude hiding (read)
 import Control.Applicative ((<|>))
-import Control.Monad (forM_, when)
+import Control.Monad (foldM, forM_, when)
 import Control.Monad.Catch (catch, handle, throwM)
 import Control.Monad.Except (MonadError (throwError))
 import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
@@ -27,7 +27,10 @@ import Data.Proxy (Proxy (Proxy))
 import Data.Text.Encoding.Error (UnicodeException)
 import HsLua
 import System.Exit (ExitCode (..))
-import Text.Pandoc.Class (PandocMonad, sandbox)
+import Text.Pandoc.Class ( PandocMonad, FileInfo (..), FileTree
+                         , addToFileTree, getCurrentTime
+                         , insertInFileTree, sandboxWithFileTree
+                         )
 import Text.Pandoc.Definition
 import Text.Pandoc.Error (PandocError (..))
 import Text.Pandoc.Format (FlavoredFormat, parseFlavoredFormat)
@@ -256,8 +259,8 @@ functions =
             handle (failLua . show @UnicodeException) . unPandocLua $ do
               flvrd <- maybe (parseFlavoredFormat "markdown") pure mformatspec
               case mreadEnv of
-                Nothing    -> readAction flvrd
-                Just files -> sandbox files (readAction flvrd))
+                Nothing   -> readAction flvrd
+                Just tree -> sandboxWithFileTree tree (readAction flvrd))
     <#> parameter (\idx -> (Left  <$> peekByteString idx)
                        <|> (Right <$> peekSources idx))
           "string|Sources" "content" "text to parse"
@@ -265,11 +268,14 @@ functions =
                        "formatspec" "format and extensions")
     <#> opt (parameter peekReaderOptions "ReaderOptions" "reader_options"
              "reader options")
-    <#> opt (parameter peekReadEnv "table" "read_env" $ mconcat
-            [ "If the value is not given or `nil`, then the global environment "
-            , "is used. Passing a list of filenames causes the reader to be "
-            , "run in a sandbox. The given files are read from the file "
-            , "system and provided to the sandbox in a ersatz file system."
+    <#> opt (parameter peekReadEnv "table" "read_env" $ T.unlines
+            [ "If the value is not given or `nil`, then the global environment"
+            , "is used. Passing a list of filenames causes the reader to"
+            , "be run in a sandbox. The given files are read from the file"
+            , "system and provided to the sandbox via an ersatz file system."
+            , "The table can also contain mappings from filenames to"
+            , "contents, which will be used to populate the ersatz file"
+            , "system."
             ])
     =#> functionResult pushPandoc "Pandoc" "result document"
 
@@ -403,5 +409,22 @@ pushPipeError pipeErr = do
         return (NumResults 1)
 
 -- | Peek the environment in which the `read` function operates.
-peekReadEnv :: LuaError e => Peeker e [FilePath]
-peekReadEnv = peekList peekString
+peekReadEnv :: Peeker PandocError FileTree
+peekReadEnv idx = do
+  mtime <- liftLua . unPandocLua $ getCurrentTime
+
+  -- Add files from file system
+  files <- peekList peekString idx
+  tree1 <- liftLua $
+           foldM (\tree fp -> liftIO $ addToFileTree tree fp) mempty files
+
+  -- Add files from key-value pairs
+  let toFileInfo contents = FileInfo
+        { infoFileMTime = mtime
+        , infoFileContents = contents
+        }
+  pairs <- peekKeyValuePairs peekString (fmap toFileInfo . peekByteString) idx
+  let tree2 = foldr (uncurry insertInFileTree) tree1 pairs
+
+  -- Return ersatz file system.
+  pure tree2
diff --git a/pandoc-lua-engine/test/lua/module/pandoc.lua b/pandoc-lua-engine/test/lua/module/pandoc.lua
index b196d143c..18b3c64a9 100644
--- a/pandoc-lua-engine/test/lua/module/pandoc.lua
+++ b/pandoc-lua-engine/test/lua/module/pandoc.lua
@@ -325,6 +325,29 @@ return {
           pandoc.Blocks{pandoc.Para 'included'}
         )
       end),
+      test('sandbox files can be given as key-value pairs', function ()
+        local tex = '\\include{lua/module/include.tex}'
+        local files = {
+          ['lua/module/include.tex'] = 'Hello'
+        }
+        local doc = pandoc.read(tex, 'latex', nil, files)
+        assert.are_equal(
+          doc.blocks,
+          pandoc.Blocks{pandoc.Para 'Hello'}
+        )
+      end),
+      test('kv-pairs override contents read from file system', function ()
+        local tex = '\\include{lua/module/include.tex}'
+        local files = {
+          'lua/module/include.tex',
+          ['lua/module/include.tex'] = 'Hello'
+        }
+        local doc = pandoc.read(tex, 'latex', nil, files)
+        assert.are_equal(
+          doc.blocks,
+          pandoc.Blocks{pandoc.Para 'Hello'}
+        )
+      end),
     },
     group 'extensions' {
       test('string spec', function ()