Class: Functions for dealing with PureState

There are two states in PandocPure, but it is only easy to deal with
CommonState. In the past, to do state monad operations on
PureState (the state specific to PandocPure) you had to add (lift
. lift) to the monadic operation and then rewrap in the newtype. This
adds four functions ({get,gets,put,modify}PureState) corresponding to
normal state monad operations. This allows the user to modify
PureState in PandocPure without worrying about where it sits in the
monad stack or rewrapping the newtype.

1 files changed, 42 insertions, 23 deletions

diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 0307407ac..d81d3b68b 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -34,6 +34,10 @@ Typeclass for pandoc readers and writers, allowing both IO and pure instances.
 module Text.Pandoc.Class ( PandocMonad(..)
                          , CommonState(..)
                          , PureState(..)
+                         , getPureState
+                         , getsPureState
+                         , putPureState
+                         , modifyPureState
                          , getPOSIXTime
                          , getZonedTime
                          , warning
@@ -266,6 +270,21 @@ instance Default PureState where
                   , stCabalDataDir = mempty
                   , stFontFiles = []
                   }
+
+
+getPureState :: PandocPure PureState
+getPureState = PandocPure $ lift $ lift $ get
+
+getsPureState :: (PureState -> a) -> PandocPure a
+getsPureState f = f <$> getPureState
+
+putPureState :: PureState -> PandocPure ()
+putPureState ps= PandocPure $ lift $ lift $ put ps
+
+modifyPureState :: (PureState -> PureState) -> PandocPure ()
+modifyPureState f = PandocPure $ lift $ lift $ modify f
+  
+        
 data FileInfo = FileInfo { infoFileMTime :: UTCTime
                          , infoFileContents :: B.ByteString
                          }
@@ -294,33 +313,33 @@ runPure x = flip evalState def $
             unPandocPure x
 
 instance PandocMonad PandocPure where
-  lookupEnv s = PandocPure $ do
-    env <- lift $ lift $ gets stEnv
+  lookupEnv s = do
+    env <- getsPureState stEnv
     return (lookup s env)
 
-  getCurrentTime = PandocPure $ lift $ lift $ gets stTime
+  getCurrentTime = getsPureState stTime
 
-  getCurrentTimeZone = PandocPure $ lift $ lift $ gets stTimeZone
+  getCurrentTimeZone = getsPureState stTimeZone
 
-  getDefaultReferenceDocx _ = PandocPure $ lift $ lift $ gets stReferenceDocx
+  getDefaultReferenceDocx _ = getsPureState stReferenceDocx
 
-  getDefaultReferenceODT _ = PandocPure $ lift $ lift $ gets stReferenceODT
+  getDefaultReferenceODT _ = getsPureState stReferenceODT
 
-  newStdGen = PandocPure $ do
-    g <- lift $ lift $ gets stStdGen
+  newStdGen = do
+    g <- getsPureState stStdGen
     let (_, nxtGen) = next g
-    lift $ lift $ modify $ \st -> st { stStdGen = nxtGen }
+    modifyPureState $ \st -> st { stStdGen = nxtGen }
     return g
 
-  newUniqueHash = PandocPure $ do
-    uniqs <- lift $ lift $ gets stUniqStore
+  newUniqueHash = do
+    uniqs <- getsPureState stUniqStore
     case uniqs of
       u : us -> do
-        lift $ lift $ modify $ \st -> st { stUniqStore = us }
+        modifyPureState $ \st -> st { stUniqStore = us }
         return u
       _ -> M.fail "uniq store ran out of elements"
-  readFileLazy fp = PandocPure $ do
-    fps <- lift $ lift $ gets stFiles
+  readFileLazy fp = do
+    fps <- getsPureState stFiles
     case infoFileContents <$> getFileInfo fp fps of
       Just bs -> return (BL.fromStrict bs)
       Nothing -> throwError $ PandocFileReadError fp
@@ -331,14 +350,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 = PandocPure $ do
-    userDirFiles <- lift $ lift $ gets stUserDataDir
+  readDataFile (Just userDir) fname = do
+    userDirFiles <- getsPureState stUserDataDir
     case infoFileContents <$> (getFileInfo (userDir </> fname) userDirFiles) of
       Just bs -> return bs
-      Nothing -> unPandocPure $ readDataFile Nothing fname
+      Nothing -> readDataFile Nothing fname
   fail = M.fail
-  fetchItem _ fp = PandocPure $ do
-    fps <- lift $ lift $ gets stFiles
+  fetchItem _ fp = do
+    fps <- getsPureState stFiles
     case infoFileContents <$> (getFileInfo fp fps) of
       Just bs -> return (Right (bs, getMimeType fp))
       Nothing -> return (Left $ E.toException $ PandocFileReadError fp)
@@ -348,12 +367,12 @@ instance PandocMonad PandocPure where
       Nothing -> fetchItem sourceUrl nm
       Just (mime, bs) -> return (Right (B.concat $ BL.toChunks bs, Just mime))
 
-  glob s = PandocPure $ do
-    fontFiles <- lift $ lift $ gets stFontFiles
+  glob s = do
+    fontFiles <- getsPureState stFontFiles
     return (filter (match (compile s)) fontFiles)
 
-  getModificationTime fp = PandocPure $ do
-    fps <- lift $ lift $ gets stFiles
+  getModificationTime fp = do
+    fps <- getsPureState stFiles
     case infoFileMTime <$> (getFileInfo fp fps) of
       Just tm -> return tm
       Nothing -> throwError $ PandocFileReadError fp