git.iko.soy/typeable/pandoc
on master help sign in
Class: Add MediaBag to MonadState.
2fc47ceJesse Rosenthal
src/Text/Pandoc/Class.hs+18−6
compare with master
unifiedsplit
@@ -56,13 +56,14 @@ import qualified Text.Pandoc.Shared as IO ( fetchItem
56 , getDefaultReferenceODT
56 , getDefaultReferenceODT
57 , warn
57 , warn
58 , readDataFile)
58 , readDataFile)
59−import Text.Pandoc.MediaBag (MediaBag, lookupMedia)
60import Text.Pandoc.Compat.Time (UTCTime)
59import Text.Pandoc.Compat.Time (UTCTime)
61import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)
60import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)
62import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds
61import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds
63 , posixSecondsToUTCTime
62 , posixSecondsToUTCTime
64 , POSIXTime )
63 , POSIXTime )
65import Text.Pandoc.MIME (MimeType, getMimeType)
64import Text.Pandoc.MIME (MimeType, getMimeType)
65+import Text.Pandoc.MediaBag (MediaBag)
66+import qualified Text.Pandoc.MediaBag as MB
66import qualified Data.ByteString as B
67import qualified Data.ByteString as B
67import qualified Data.ByteString.Lazy as BL
68import qualified Data.ByteString.Lazy as BL
68import qualified Control.Exception as E
69import qualified Control.Exception as E
@@ -100,6 +101,7 @@ class (Functor m, Applicative m, Monad m, MonadError PandocExecutionError m) =>
100 getWarnings :: m [String]
101 getWarnings :: m [String]
101 fail :: String -> m b
102 fail :: String -> m b
102 glob :: String -> m [FilePath]
103 glob :: String -> m [FilePath]
104+ insertMedia :: FilePath -> Maybe MimeType -> BL.ByteString -> m ()
103
105
104--Some functions derived from Primitives:
106--Some functions derived from Primitives:
105
107
@@ -114,11 +116,14 @@ data PandocExecutionError = PandocFileReadError FilePath
114 deriving (Show, Typeable)
116 deriving (Show, Typeable)
115
117
116-- Nothing in this for now, but let's put it there anyway.
118-- Nothing in this for now, but let's put it there anyway.
117−data PandocStateIO = PandocStateIO { ioStWarnings :: [String] }
119+data PandocStateIO = PandocStateIO { ioStWarnings :: [String]
120+ , ioStMediaBag :: MediaBag
118− deriving Show
121+ } deriving Show
119
122
120instance Default PandocStateIO where
123instance Default PandocStateIO where
121− def = PandocStateIO { ioStWarnings = [] }
124+ def = PandocStateIO { ioStWarnings = []
125+ , ioStMediaBag = mempty
126+ }
122
127
123runIO :: PandocIO a -> IO (Either PandocExecutionError a)
128runIO :: PandocIO a -> IO (Either PandocExecutionError a)
124runIO ma = flip evalStateT def $ runExceptT $ unPandocIO ma
129runIO ma = flip evalStateT def $ runExceptT $ unPandocIO ma
@@ -134,7 +139,7 @@ runIOorExplode ma = do
134
139
135newtype PandocIO a = PandocIO {
140newtype PandocIO a = PandocIO {
136 unPandocIO :: ExceptT PandocExecutionError (StateT PandocStateIO IO) a
141 unPandocIO :: ExceptT PandocExecutionError (StateT PandocStateIO IO) a
137− } deriving (MonadIO, Functor, Applicative, Monad, MonadError PandocExecutionError)
142+ } deriving (MonadIO, Functor, Applicative, Monad, MonadState PandocStateIO, MonadError PandocExecutionError)
138
143
139instance PandocMonad PandocIO where
144instance PandocMonad PandocIO where
140 lookupEnv = liftIO . IO.lookupEnv
145 lookupEnv = liftIO . IO.lookupEnv
@@ -162,6 +167,8 @@ instance PandocMonad PandocIO where
162 liftIO $ IO.warn msg
167 liftIO $ IO.warn msg
163 getWarnings = gets ioStWarnings
168 getWarnings = gets ioStWarnings
164 glob = liftIO . IO.glob
169 glob = liftIO . IO.glob
170+ insertMedia fp mime bs =
171+ modify $ \st -> st{ioStMediaBag = MB.insertMedia fp mime bs (ioStMediaBag st) }
165
172
166data TestState = TestState { stStdGen :: StdGen
173data TestState = TestState { stStdGen :: StdGen
167 , stWord8Store :: [Word8] -- should be
174 , stWord8Store :: [Word8] -- should be
@@ -173,6 +180,7 @@ data TestState = TestState { stStdGen :: StdGen
173 -- contain every
180 -- contain every
174 -- element at most
181 -- element at most
175 -- once, e.g. [1..]
182 -- once, e.g. [1..]
183+ , stMediaBag :: MediaBag
176 }
184 }
177
185
178instance Default TestState where
186instance Default TestState where
@@ -180,6 +188,7 @@ instance Default TestState where
180 , stWord8Store = [1..]
188 , stWord8Store = [1..]
181 , stWarnings = []
189 , stWarnings = []
182 , stUniqStore = [1..]
190 , stUniqStore = [1..]
191+ , stMediaBag = mempty
183 }
192 }
184
193
185data TestEnv = TestEnv { envEnv :: [(String, String)]
194data TestEnv = TestEnv { envEnv :: [(String, String)]
@@ -264,7 +273,7 @@ instance PandocMonad PandocPure where
264 Nothing -> return (Left $ E.toException $ PandocFileReadError fp)
273 Nothing -> return (Left $ E.toException $ PandocFileReadError fp)
265
274
266 fetchItem' media sourceUrl nm = do
275 fetchItem' media sourceUrl nm = do
267− case lookupMedia nm media of
276+ case MB.lookupMedia nm media of
268 Nothing -> fetchItem sourceUrl nm
277 Nothing -> fetchItem sourceUrl nm
269 Just (mime, bs) -> return (Right (B.concat $ BL.toChunks bs, Just mime))
278 Just (mime, bs) -> return (Right (B.concat $ BL.toChunks bs, Just mime))
270
279
@@ -275,3 +284,6 @@ instance PandocMonad PandocPure where
275 glob s = do
284 glob s = do
276 fontFiles <- asks envFontFiles
285 fontFiles <- asks envFontFiles
277 return (filter (match (compile s)) fontFiles)
286 return (filter (match (compile s)) fontFiles)
287+
288+ insertMedia fp mime bs =
289+ modify $ \st -> st{stMediaBag = MB.insertMedia fp mime bs (stMediaBag st) }