blob: 8bc0f1e77a2c27910cc606d1e20d83223a04084b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
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
|
