From b19f79f672c49322328584fa339215e4234d98af Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Thu, 24 Nov 2016 11:52:06 -0500
Subject: [PATCH] Add runPure function.
This requires a default environment. The state variables are pretty
straightforward. The env variables are a little trickier. I'm just
making most of them empty for now. Note that some of them (like
defaultReferenceDocx/ODT) will be coming out soon anyway.
---
src/Text/Pandoc/Class.hs | 32 +++++++++++++++++++++++++++++---
1 file changed, 29 insertions(+), 3 deletions(-)
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 0135ac6b3..64fd7e907 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -40,13 +40,14 @@ module Text.Pandoc.Class ( PandocMonad(..)
, PandocExecutionError(..)
, runIO
, runIOorExplode
+ , runPure
) where
import Prelude hiding (readFile, fail)
import qualified Control.Monad as M (fail)
-import System.Random (StdGen, next)
+import System.Random (StdGen, next, mkStdGen)
import qualified System.Random as IO (newStdGen)
-import Codec.Archive.Zip (Archive, fromArchive)
+import Codec.Archive.Zip (Archive, fromArchive, emptyArchive)
import Data.Unique (hashUnique)
import qualified Data.Unique as IO (newUnique)
import qualified Text.Pandoc.Shared as IO ( fetchItem
@@ -58,7 +59,9 @@ import qualified Text.Pandoc.Shared as IO ( fetchItem
import Text.Pandoc.MediaBag (MediaBag, lookupMedia)
import Text.Pandoc.Compat.Time (UTCTime)
import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)
-import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds, POSIXTime )
+import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds
+ , posixSecondsToUTCTime
+ , POSIXTime )
import Text.Pandoc.MIME (MimeType, getMimeType)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
@@ -164,6 +167,13 @@ data TestState = TestState { stStdGen :: StdGen
-- once, e.g. [1..]
}
+instance Default TestState where
+ def = TestState { stStdGen = mkStdGen 1848
+ , stWord8Store = [1..]
+ , stWarnings = []
+ , stUniqStore = [1..]
+ }
+
data TestEnv = TestEnv { envEnv :: [(String, String)]
, envTime :: UTCTime
, envReferenceDocx :: Archive
@@ -174,6 +184,19 @@ data TestEnv = TestEnv { envEnv :: [(String, String)]
, envFontFiles :: [FilePath]
}
+-- We have to figure this out a bit more. But let's put some empty
+-- values in for the time being.
+instance Default TestEnv where
+ def = TestEnv { envEnv = [("USER", "pandoc-user")]
+ , envTime = posixSecondsToUTCTime 0
+ , envReferenceDocx = emptyArchive
+ , envReferenceODT = emptyArchive
+ , envFiles = []
+ , envUserDataDir = []
+ , envCabalDataDir = []
+ , envFontFiles = []
+ }
+
instance E.Exception PandocExecutionError
newtype PandocPure a = PandocPure {
@@ -181,6 +204,9 @@ newtype PandocPure a = PandocPure {
(ReaderT TestEnv (State TestState)) a
} deriving (Functor, Applicative, Monad, MonadReader TestEnv, MonadState TestState, MonadError PandocExecutionError)
+runPure :: PandocPure a -> Either PandocExecutionError a
+runPure x = flip evalState def $ flip runReaderT def $ runExceptT $ unPandocPure x
+
instance PandocMonad PandocPure where
lookupEnv s = do
env <- asks envEnv