    {- |
    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 :: forall (m :: * -> *) a.
    (PandocMonad m, MonadIO m) =>
    [FilePath] -> PandocPure a -> m a
    sandbox [FilePath]
    files PandocPure a
    action = do
      tree <- IO FileTree -> m FileTree
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO FileTree -> m FileTree) -> IO FileTree -> m FileTree
    forall a b. (a -> b) -> a -> b
    $ (FileTree -> FilePath -> IO FileTree)
    -> FileTree -> [FilePath] -> IO FileTree
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM FileTree -> FilePath -> IO FileTree
    addToFileTree FileTree
    forall a. Monoid a => a
    mempty [FilePath]
    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 :: forall (m :: * -> *) a.
    (PandocMonad m, MonadIO m) =>
    FileTree -> PandocPure a -> m a
    sandboxWithFileTree FileTree
    tree PandocPure a
    action = do
      oldState <- m CommonState
    forall (m :: * -> *). PandocMonad m => m CommonState
    getCommonState
      case runPure (do putCommonState oldState
                       modifyPureState $ \PureState
    ps -> PureState
    ps{ stFiles = tree }
                       result <- action
                       st <- getCommonState
                       return (st, result)) of
              Left PandocError
    e -> PandocError -> m a
    forall a. PandocError -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError PandocError
    e
              Right (CommonState
    st, a
    result) -> do
                CommonState -> m ()
    forall (m :: * -> *). PandocMonad m => CommonState -> m ()
    putCommonState CommonState
    st
                let verbosity :: Verbosity
    verbosity = CommonState -> Verbosity
    stVerbosity CommonState
    st
                -- emit warnings, since these are not printed in runPure
                let newMessages :: [LogMessage]
    newMessages = [LogMessage] -> [LogMessage]
    forall a. [a] -> [a]
    reverse ([LogMessage] -> [LogMessage]) -> [LogMessage] -> [LogMessage]
    forall a b. (a -> b) -> a -> b
    $ Int -> [LogMessage] -> [LogMessage]
    forall a. Int -> [a] -> [a]
    take
                      ([LogMessage] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (CommonState -> [LogMessage]
    stLog CommonState
    st) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [LogMessage] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (CommonState -> [LogMessage]
    stLog CommonState
    oldState)) (CommonState -> [LogMessage]
    stLog CommonState
    st)
                (LogMessage -> m ()) -> [LogMessage] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ LogMessage -> m ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    logOutput
                  ((LogMessage -> Bool) -> [LogMessage] -> [LogMessage]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Verbosity
    verbosity) (Verbosity -> Bool)
    -> (LogMessage -> Verbosity) -> LogMessage -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LogMessage -> Verbosity
    messageVerbosity) [LogMessage]
    newMessages)
                a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    result