From fa0241592c0341c85246e94b5a0342ef3a301755 Mon Sep 17 00:00:00 2001
From: Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
Date: Thu, 14 Dec 2017 18:38:19 +1300
Subject: Deduplicate JATS writer image mime type code

---
 src/Text/Pandoc/Writers/JATS.hs | 29 ++++++++++++++---------------
 1 file changed, 14 insertions(+), 15 deletions(-)

(limited to 'src/Text/Pandoc/Writers/JATS.hs')

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),
-- 
cgit v1.2.3