diff options
author | Jesse Rosenthal <jrosenthal@jhu.edu> | 2016-11-27 15:29:46 -0500 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2017-01-25 17:07:40 +0100 |
commit | 2fc47ceebf5ec4e93e7a4395939c2da5248e1ef6 (patch) | |
tree | 78181e1d12f1444e4c89c15fc712e294ab518dd9 | |
parent | cc7191b3b17ce7c7010a021bf685753ed2019aa6 (diff) | |
download | pandoc-2fc47ceebf5ec4e93e7a4395939c2da5248e1ef6.tar.gz |
Class: Add MediaBag to MonadState.
-rw-r--r-- | src/Text/Pandoc/Class.hs | 24 |
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) } |