diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/JATS.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/JATS.hs | 71 |
1 files changed, 38 insertions, 33 deletions
diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index 23e57663b..ffeceb1c2 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Writers.JATS @@ -23,6 +24,7 @@ import Data.List (partition, isPrefixOf) import qualified Data.Map as M import Data.Maybe (fromMaybe) import Data.Time (toGregorian, Day, parseTimeM, defaultTimeLocale, formatTime) +import qualified Data.Text as T import Data.Text (Text) import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Definition @@ -31,9 +33,10 @@ import Text.Pandoc.Logging import Text.Pandoc.MIME (getMimeType) import Text.Pandoc.Walk (walk) import Text.Pandoc.Options -import Text.Pandoc.Pretty +import Text.DocLayout import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate) +import Text.DocTemplates (Context(..), Val(..), TemplateTarget(..)) import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared import Text.Pandoc.XML @@ -44,7 +47,7 @@ data JATSVersion = JATS1_1 deriving (Eq, Show) data JATSState = JATSState - { jatsNotes :: [(Int, Doc)] } + { jatsNotes :: [(Int, Doc Text)] } type JATS a = StateT JATSState (ReaderT JATSVersion a) @@ -65,54 +68,56 @@ docToJATS opts (Pandoc meta blocks) = do let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing - let render' :: Doc -> Text - render' = render colwidth -- The numbering here follows LaTeX's internal numbering let startLvl = case writerTopLevelDivision opts of TopLevelPart -> -1 TopLevelChapter -> 0 TopLevelSection -> 1 TopLevelDefault -> 1 - metadata <- metaToJSON opts - (fmap (render' . vcat) . + metadata <- metaToContext opts + (fmap vcat . mapM (elementToJATS opts startLvl) . hierarchicalize) - (fmap render' . inlinesToJATS opts) + (fmap chomp . inlinesToJATS opts) meta - main <- (render' . vcat) <$> - mapM (elementToJATS opts startLvl) elements + main <- vcat <$> mapM (elementToJATS opts startLvl) elements notes <- reverse . map snd <$> gets jatsNotes backs <- mapM (elementToJATS opts startLvl) backElements let fns = if null notes then mempty else inTagsIndented "fn-group" $ vcat notes - let back = render' $ vcat backs $$ fns - let date = case getField "date" metadata -- an object - `mplus` - (getField "date" metadata >>= parseDate) of - Nothing -> mempty + let back = vcat backs $$ fns + let date = + case getField "date" metadata of + Nothing -> NullVal + Just (SimpleVal (x :: Doc Text)) -> + case parseDate (T.unpack $ toText x) of + Nothing -> NullVal Just day -> let (y,m,d) = toGregorian day - in M.insert ("year" :: String) (show y) - $ M.insert "month" (show m) - $ M.insert "day" (show d) + in MapVal $ Context + $ M.insert ("year" :: Text) (SimpleVal $ text $ show y) + $ M.insert "month" (SimpleVal $ text $ show m) + $ M.insert "day" (SimpleVal $ text $ show d) $ M.insert "iso-8601" - (formatTime defaultTimeLocale "%F" day) + (SimpleVal $ text $ + formatTime defaultTimeLocale "%F" day) $ mempty + Just x -> x let context = defField "body" main $ defField "back" back - $ resetField ("date" :: String) date + $ resetField "date" date $ defField "mathml" (case writerHTMLMathMethod opts of MathML -> True _ -> False) metadata - return $ - (if writerPreferAscii opts then toEntities else id) $ + return $ render colwidth $ + (if writerPreferAscii opts then fmap toEntities else id) $ case writerTemplate opts of Nothing -> main Just tpl -> renderTemplate tpl context -- | Convert an Element to JATS. -elementToJATS :: PandocMonad m => WriterOptions -> Int -> Element -> JATS m Doc +elementToJATS :: PandocMonad m => WriterOptions -> Int -> Element -> JATS m (Doc Text) elementToJATS opts _ (Blk block) = blockToJATS opts block elementToJATS opts lvl (Sec _ _num (id',_,kvs) title elements) = do let idAttr = [("id", writerIdentifierPrefix opts ++ id') | not (null id')] @@ -124,14 +129,14 @@ elementToJATS opts lvl (Sec _ _num (id',_,kvs) title elements) = do inTagsSimple "title" title' $$ vcat contents -- | Convert a list of Pandoc blocks to JATS. -blocksToJATS :: PandocMonad m => WriterOptions -> [Block] -> JATS m Doc +blocksToJATS :: PandocMonad m => WriterOptions -> [Block] -> JATS m (Doc Text) blocksToJATS = wrappedBlocksToJATS (const False) wrappedBlocksToJATS :: PandocMonad m => (Block -> Bool) -> WriterOptions -> [Block] - -> JATS m Doc + -> JATS m (Doc Text) wrappedBlocksToJATS needsWrap opts = fmap vcat . mapM wrappedBlockToJATS where @@ -150,13 +155,13 @@ plainToPara x = x -- | Convert a list of pairs of terms and definitions into a list of -- JATS varlistentrys. deflistItemsToJATS :: PandocMonad m - => WriterOptions -> [([Inline],[[Block]])] -> JATS m Doc + => WriterOptions -> [([Inline],[[Block]])] -> JATS m (Doc Text) deflistItemsToJATS opts items = vcat <$> mapM (uncurry (deflistItemToJATS opts)) items -- | Convert a term and a list of blocks into a JATS varlistentry. deflistItemToJATS :: PandocMonad m - => WriterOptions -> [Inline] -> [[Block]] -> JATS m Doc + => WriterOptions -> [Inline] -> [[Block]] -> JATS m (Doc Text) deflistItemToJATS opts term defs = do term' <- inlinesToJATS opts term def' <- wrappedBlocksToJATS (not . isPara) @@ -168,7 +173,7 @@ deflistItemToJATS opts term defs = do -- | Convert a list of lists of blocks to a list of JATS list items. listItemsToJATS :: PandocMonad m - => WriterOptions -> Maybe [String] -> [[Block]] -> JATS m Doc + => WriterOptions -> Maybe [String] -> [[Block]] -> JATS m (Doc Text) listItemsToJATS opts markers items = case markers of Nothing -> vcat <$> mapM (listItemToJATS opts Nothing) items @@ -176,7 +181,7 @@ listItemsToJATS opts markers items = -- | Convert a list of blocks into a JATS list item. listItemToJATS :: PandocMonad m - => WriterOptions -> Maybe String -> [Block] -> JATS m Doc + => WriterOptions -> Maybe String -> [Block] -> JATS m (Doc Text) listItemToJATS opts mbmarker item = do contents <- wrappedBlocksToJATS (not . isParaOrList) opts (walk demoteHeaderAndRefs item) @@ -218,7 +223,7 @@ codeAttr (ident,classes,kvs) = (lang, attr) lang = languageFor classes -- | Convert a Pandoc block element to JATS. -blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m Doc +blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m (Doc Text) blockToJATS _ Null = return empty -- Bibliography reference: blockToJATS opts (Div ('r':'e':'f':'-':_,_,_) [Para lst]) = @@ -341,7 +346,7 @@ tableRowToJATS :: PandocMonad m => WriterOptions -> Bool -> [[Block]] - -> JATS m Doc + -> JATS m (Doc Text) tableRowToJATS opts isHeader cols = (inTagsIndented "tr" . vcat) <$> mapM (tableItemToJATS opts isHeader) cols @@ -349,7 +354,7 @@ tableItemToJATS :: PandocMonad m => WriterOptions -> Bool -> [Block] - -> JATS m Doc + -> JATS m (Doc Text) tableItemToJATS opts isHeader [Plain item] = inTags False (if isHeader then "th" else "td") [] <$> inlinesToJATS opts item @@ -358,7 +363,7 @@ tableItemToJATS opts isHeader item = mapM (blockToJATS opts) item -- | Convert a list of inline elements to JATS. -inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m Doc +inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m (Doc Text) inlinesToJATS opts lst = hcat <$> mapM (inlineToJATS opts) (fixCitations lst) where fixCitations [] = [] @@ -374,7 +379,7 @@ inlinesToJATS opts lst = hcat <$> mapM (inlineToJATS opts) (fixCitations lst) fixCitations (x:xs) = x : fixCitations xs -- | Convert an inline element to JATS. -inlineToJATS :: PandocMonad m => WriterOptions -> Inline -> JATS m Doc +inlineToJATS :: PandocMonad m => WriterOptions -> Inline -> JATS m (Doc Text) inlineToJATS _ (Str str) = return $ text $ escapeStringForXML str inlineToJATS opts (Emph lst) = inTagsSimple "italic" <$> inlinesToJATS opts lst |