aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJesse Rosenthal <jrosenthal@jhu.edu>2016-11-27 15:29:46 -0500
committerJohn MacFarlane <jgm@berkeley.edu>2017-01-25 17:07:40 +0100
commit2fc47ceebf5ec4e93e7a4395939c2da5248e1ef6 (patch)
tree78181e1d12f1444e4c89c15fc712e294ab518dd9
parentcc7191b3b17ce7c7010a021bf685753ed2019aa6 (diff)
downloadpandoc-2fc47ceebf5ec4e93e7a4395939c2da5248e1ef6.tar.gz
Class: Add MediaBag to MonadState.
-rw-r--r--src/Text/Pandoc/Class.hs24
1 files changed, 18 insertions, 6 deletions
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 899e18776..7de927bcc 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -56,13 +56,14 @@ import qualified Text.Pandoc.Shared as IO ( fetchItem
, getDefaultReferenceODT
, warn
, readDataFile)
-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
, posixSecondsToUTCTime
, POSIXTime )
import Text.Pandoc.MIME (MimeType, getMimeType)
+import Text.Pandoc.MediaBag (MediaBag)
+import qualified Text.Pandoc.MediaBag as MB
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Control.Exception as E
@@ -100,6 +101,7 @@ class (Functor m, Applicative m, Monad m, MonadError PandocExecutionError m) =>
getWarnings :: m [String]
fail :: String -> m b
glob :: String -> m [FilePath]
+ insertMedia :: FilePath -> Maybe MimeType -> BL.ByteString -> m ()
--Some functions derived from Primitives:
@@ -114,11 +116,14 @@ data PandocExecutionError = PandocFileReadError FilePath
deriving (Show, Typeable)
-- Nothing in this for now, but let's put it there anyway.
-data PandocStateIO = PandocStateIO { ioStWarnings :: [String] }
- deriving Show
+data PandocStateIO = PandocStateIO { ioStWarnings :: [String]
+ , ioStMediaBag :: MediaBag
+ } deriving Show
instance Default PandocStateIO where
- def = PandocStateIO { ioStWarnings = [] }
+ def = PandocStateIO { ioStWarnings = []
+ , ioStMediaBag = mempty
+ }
runIO :: PandocIO a -> IO (Either PandocExecutionError a)
runIO ma = flip evalStateT def $ runExceptT $ unPandocIO ma
@@ -134,7 +139,7 @@ runIOorExplode ma = do
newtype PandocIO a = PandocIO {
unPandocIO :: ExceptT PandocExecutionError (StateT PandocStateIO IO) a
- } deriving (MonadIO, Functor, Applicative, Monad, MonadError PandocExecutionError)
+ } deriving (MonadIO, Functor, Applicative, Monad, MonadState PandocStateIO, MonadError PandocExecutionError)
instance PandocMonad PandocIO where
lookupEnv = liftIO . IO.lookupEnv
@@ -162,6 +167,8 @@ instance PandocMonad PandocIO where
liftIO $ IO.warn msg
getWarnings = gets ioStWarnings
glob = liftIO . IO.glob
+ insertMedia fp mime bs =
+ modify $ \st -> st{ioStMediaBag = MB.insertMedia fp mime bs (ioStMediaBag st) }
data TestState = TestState { stStdGen :: StdGen
, stWord8Store :: [Word8] -- should be
@@ -173,6 +180,7 @@ data TestState = TestState { stStdGen :: StdGen
-- contain every
-- element at most
-- once, e.g. [1..]
+ , stMediaBag :: MediaBag
}
instance Default TestState where
@@ -180,6 +188,7 @@ instance Default TestState where
, stWord8Store = [1..]
, stWarnings = []
, stUniqStore = [1..]
+ , stMediaBag = mempty
}
data TestEnv = TestEnv { envEnv :: [(String, String)]
@@ -264,7 +273,7 @@ instance PandocMonad PandocPure where
Nothing -> return (Left $ E.toException $ PandocFileReadError fp)
fetchItem' media sourceUrl nm = do
- case lookupMedia nm media of
+ case MB.lookupMedia nm media of
Nothing -> fetchItem sourceUrl nm
Just (mime, bs) -> return (Right (B.concat $ BL.toChunks bs, Just mime))
@@ -275,3 +284,6 @@ instance PandocMonad PandocPure where
glob s = do
fontFiles <- asks envFontFiles
return (filter (match (compile s)) fontFiles)
+
+ insertMedia fp mime bs =
+ modify $ \st -> st{stMediaBag = MB.insertMedia fp mime bs (stMediaBag st) }