aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Writers/JATS.hs29
1 files changed, 14 insertions, 15 deletions
diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs
index fe5a36d13..8824eeb24 100644
--- a/src/Text/Pandoc/Writers/JATS.hs
+++ b/src/Text/Pandoc/Writers/JATS.hs
@@ -159,6 +159,17 @@ listItemToJATS opts mbmarker item = do
maybe empty (\lbl -> inTagsIndented "label" (text lbl)) mbmarker
$$ contents
+imageMimeType :: String -> [(String, String)] -> (String, String)
+imageMimeType src kvs =
+ let mbMT = getMimeType src
+ maintype = fromMaybe "image" $
+ lookup "mimetype" kvs `mplus`
+ (takeWhile (/='/') <$> mbMT)
+ subtype = fromMaybe "" $
+ lookup "mime-subtype" kvs `mplus`
+ ((drop 1 . dropWhile (/='/')) <$> mbMT)
+ in (maintype, subtype)
+
-- | Convert a Pandoc block element to JATS.
blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m Doc
blockToJATS _ Null = return empty
@@ -191,33 +202,21 @@ blockToJATS opts (Plain lst) = blockToJATS opts (Para lst)
blockToJATS opts (Para [Image (ident,_,kvs) txt
(src,'f':'i':'g':':':tit)]) = do
alt <- inlinesToJATS opts txt
+ let (maintype, subtype) = imageMimeType src kvs
let capt = if null txt
then empty
else inTagsSimple "caption" alt
let attr = [("id", ident) | not (null ident)] ++
[(k,v) | (k,v) <- kvs, k `elem` ["fig-type", "orientation",
"position", "specific-use"]]
- let mbMT = getMimeType src
- let maintype = fromMaybe "image" $
- lookup "mimetype" kvs `mplus`
- (takeWhile (/='/') <$> mbMT)
- let subtype = fromMaybe "" $
- lookup "mime-subtype" kvs `mplus`
- ((drop 1 . dropWhile (/='/')) <$> mbMT)
let graphicattr = [("mimetype",maintype),
- ("mime-subtype",drop 1 subtype),
+ ("mime-subtype",subtype),
("xlink:href",src), -- do we need to URL escape this?
("xlink:title",tit)]
return $ inTags True "fig" attr $
capt $$ selfClosingTag "graphic" graphicattr
blockToJATS _ (Para [Image (ident,_,kvs) _ (src, tit)]) = do
- let mbMT = getMimeType src
- let maintype = fromMaybe "image" $
- lookup "mimetype" kvs `mplus`
- (takeWhile (/='/') <$> mbMT)
- let subtype = fromMaybe "" $
- lookup "mime-subtype" kvs `mplus`
- ((drop 1 . dropWhile (/='/')) <$> mbMT)
+ let (maintype, subtype) = imageMimeType src kvs
let attr = [("id", ident) | not (null ident)] ++
[("mimetype", maintype),
("mime-subtype", subtype),