From 5a81c914e700af75a0626ac7c7b2e318fb0aa039 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Thu, 1 Dec 2016 18:35:05 -0500
Subject: Remove reader from PandocPure.
Make it all state. This will make it easier to set things.
---
src/Text/Pandoc/Class.hs | 93 ++++++++++++++++++++++--------------------------
1 file changed, 43 insertions(+), 50 deletions(-)
(limited to 'src')
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 49c2b788e..18f22a41b 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -34,7 +34,6 @@ Typeclass for pandoc readers and writers, allowing both IO and pure instances.
module Text.Pandoc.Class ( PandocMonad(..)
, CommonState(..)
, PureState(..)
- , PureEnv(..)
, getPOSIXTime
, getZonedTime
, warn
@@ -86,7 +85,6 @@ import System.FilePath ((</>))
import qualified System.FilePath.Glob as IO (glob)
import qualified System.Directory as IO (getModificationTime)
import Control.Monad.State hiding (fail)
-import Control.Monad.Reader hiding (fail)
import Control.Monad.Except hiding (fail)
import Data.Word (Word8)
import Data.Default
@@ -250,12 +248,30 @@ data PureState = PureState { stStdGen :: StdGen
-- contain every
-- element at most
-- once, e.g. [1..]
+ , envEnv :: [(String, String)]
+ , envTime :: UTCTime
+ , envTimeZone :: TimeZone
+ , envReferenceDocx :: Archive
+ , envReferenceODT :: Archive
+ , envFiles :: FileTree
+ , envUserDataDir :: FileTree
+ , envCabalDataDir :: FileTree
+ , envFontFiles :: [FilePath]
}
instance Default PureState where
def = PureState { stStdGen = mkStdGen 1848
, stWord8Store = [1..]
, stUniqStore = [1..]
+ , envEnv = [("USER", "pandoc-user")]
+ , envTime = posixSecondsToUTCTime 0
+ , envTimeZone = utc
+ , envReferenceDocx = emptyArchive
+ , envReferenceODT = emptyArchive
+ , envFiles = mempty
+ , envUserDataDir = mempty
+ , envCabalDataDir = mempty
+ , envFontFiles = []
}
data FileInfo = FileInfo { infoFileMTime :: UTCTime
, infoFileContents :: B.ByteString
@@ -267,38 +283,13 @@ newtype FileTree = FileTree {unFileTree :: M.Map FilePath FileInfo}
getFileInfo :: FilePath -> FileTree -> Maybe FileInfo
getFileInfo fp tree = M.lookup fp $ unFileTree tree
-data PureEnv = PureEnv { envEnv :: [(String, String)]
- , envTime :: UTCTime
- , envTimeZone :: TimeZone
- , envReferenceDocx :: Archive
- , envReferenceODT :: Archive
- , envFiles :: FileTree
- , envUserDataDir :: FileTree
- , envCabalDataDir :: FileTree
- , 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 PureEnv where
- def = PureEnv { envEnv = [("USER", "pandoc-user")]
- , envTime = posixSecondsToUTCTime 0
- , envTimeZone = utc
- , envReferenceDocx = emptyArchive
- , envReferenceODT = emptyArchive
- , envFiles = mempty
- , envUserDataDir = mempty
- , envCabalDataDir = mempty
- , envFontFiles = []
- }
newtype PandocPure a = PandocPure {
unPandocPure :: ExceptT PandocError
- (ReaderT PureEnv (StateT CommonState (State PureState))) a
+ (StateT CommonState (State PureState)) a
} deriving ( Functor
, Applicative
, Monad
- , MonadReader PureEnv
, MonadState CommonState
, MonadError PandocError
)
@@ -306,38 +297,40 @@ newtype PandocPure a = PandocPure {
runPure :: PandocPure a -> Either PandocError a
runPure x = flip evalState def $
flip evalStateT def $
- flip runReaderT def $
runExceptT $
unPandocPure x
+-- setPureState :: PureState -> PandocPure ()
+-- setPureState st = PandocPure $ lift $ lift $ lift $ put st
+
instance PandocMonad PandocPure where
- lookupEnv s = do
- env <- asks envEnv
+ lookupEnv s = PandocPure $ do
+ env <- lift $ lift $ gets envEnv
return (lookup s env)
- getCurrentTime = asks envTime
+ getCurrentTime = PandocPure $ lift $ lift $ gets envTime
- getCurrentTimeZone = asks envTimeZone
+ getCurrentTimeZone = PandocPure $ lift $ lift $ gets envTimeZone
- getDefaultReferenceDocx _ = asks envReferenceDocx
+ getDefaultReferenceDocx _ = PandocPure $ lift $ lift $ gets envReferenceDocx
- getDefaultReferenceODT _ = asks envReferenceODT
+ getDefaultReferenceODT _ = PandocPure $ lift $ lift $ gets envReferenceODT
newStdGen = PandocPure $ do
- g <- lift $ lift $ lift $ gets stStdGen
+ g <- lift $ lift $ gets stStdGen
let (_, nxtGen) = next g
- lift $ lift $ lift $ modify $ \st -> st { stStdGen = nxtGen }
+ lift $ lift $ modify $ \st -> st { stStdGen = nxtGen }
return g
newUniqueHash = PandocPure $ do
- uniqs <- lift $ lift $ lift $ gets stUniqStore
+ uniqs <- lift $ lift $ gets stUniqStore
case uniqs of
u : us -> do
- lift $ lift $ lift $ modify $ \st -> st { stUniqStore = us }
+ lift $ lift $ modify $ \st -> st { stUniqStore = us }
return u
_ -> M.fail "uniq store ran out of elements"
- readFileLazy fp = do
- fps <- asks envFiles
+ readFileLazy fp = PandocPure $ do
+ fps <- lift $ lift $ gets envFiles
case infoFileContents <$> getFileInfo fp fps of
Just bs -> return (BL.fromStrict bs)
Nothing -> throwError $ PandocFileReadError fp
@@ -348,14 +341,14 @@ instance PandocMonad PandocPure where
readDataFile Nothing fname = do
let fname' = if fname == "MANUAL.txt" then fname else "data" </> fname
BL.toStrict <$> (readFileLazy fname')
- readDataFile (Just userDir) fname = do
- userDirFiles <- asks envUserDataDir
+ readDataFile (Just userDir) fname = PandocPure $ do
+ userDirFiles <- lift $ lift $ gets envUserDataDir
case infoFileContents <$> (getFileInfo (userDir </> fname) userDirFiles) of
Just bs -> return bs
- Nothing -> readDataFile Nothing fname
+ Nothing -> unPandocPure $ readDataFile Nothing fname
fail = M.fail
- fetchItem _ fp = do
- fps <- asks envFiles
+ fetchItem _ fp = PandocPure $ do
+ fps <- lift $ lift $ gets envFiles
case infoFileContents <$> (getFileInfo fp fps) of
Just bs -> return (Right (bs, getMimeType fp))
Nothing -> return (Left $ E.toException $ PandocFileReadError fp)
@@ -365,12 +358,12 @@ instance PandocMonad PandocPure where
Nothing -> fetchItem sourceUrl nm
Just (mime, bs) -> return (Right (B.concat $ BL.toChunks bs, Just mime))
- glob s = do
- fontFiles <- asks envFontFiles
+ glob s = PandocPure $ do
+ fontFiles <- lift $ lift $ gets envFontFiles
return (filter (match (compile s)) fontFiles)
- getModificationTime fp = do
- fps <- asks envFiles
+ getModificationTime fp = PandocPure $ do
+ fps <- lift $ lift $ gets envFiles
case infoFileMTime <$> (getFileInfo fp fps) of
Just tm -> return tm
Nothing -> throwError $ PandocFileReadError fp
--
cgit v1.2.3