content: {- |
  Module      : Text.Pandoc.Class.Sandbox
  Copyright   : Copyright (C) 2021-2024 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
    , sandboxWithFileTree
    )
  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
    tree <- liftIO $ foldM addToFileTree mempty files
    sandboxWithFileTree tree action
  
  -- | 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 an ersatz file system which will be available for
  -- reading.
  sandboxWithFileTree :: (PandocMonad m, MonadIO m)
                      => FileTree -> PandocPure a -> m a
  sandboxWithFileTree tree action = do
    oldState <- getCommonState
    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
  