@@ -46,10 +46,8 @@ import Text.Pandoc.Readers.TeXMath (readTeXMath)
4646import Text.HTML.TagSoup (renderTags, parseTags, isTagText, Tag(..))
4747import Network.URI (isAbsoluteURI)
4848import Data.Default
49−import Data.Yaml (Value(Object,String,Array,Bool,Number))
50−import qualified Data.HashMap.Strict as H
51−import qualified Data.Vector as V
52−import qualified Data.Text as T
49+import qualified Data.Map as M
50+import Control.Applicative ((<$>))
5351
5452type Notes = [[Block]]
5553type Refs = [([Inline], Target)]
@@ -113,21 +111,34 @@ plainTitleBlock tit auths dat =
113111 (hcat (intersperse (text "; ") auths)) <> cr <>
114112 dat <> cr
115113
116−yamlTitleBlock :: Value -> Doc
117−yamlTitleBlock v = "---" $$ (jsonToYaml v) $$ "..."
118−
119−jsonToYaml :: Value -> Doc
120−jsonToYaml (Object hashmap) =
121− vcat (map (\(k,v) ->
122− text (T.unpack k) <> ":" <> space <> jsonToYaml v) $ H.toList hashmap)
123−jsonToYaml (Array vec) =
124− cr <> vcat (map (\v -> hang 2 "- " (jsonToYaml v)) $ V.toList vec)
125−jsonToYaml (String s)
126− | "\n" `T.isInfixOf` s = hang 2 ("|" <> cr) $ text $ T.unpack s
127− | otherwise = text $ "'" ++ substitute "'" "''" (T.unpack s) ++ "'"
128−jsonToYaml (Bool b) = text $ show b
129−jsonToYaml (Number n) = text $ show n
130−jsonToYaml _ = empty
114+yamlTitleBlock :: WriterOptions -> Meta -> State WriterState Doc
115+yamlTitleBlock opts (Meta metamap) = do
116+ m <- jsonToYaml opts (MetaMap metamap)
117+ return $ "---" $$ m $$ "..."
118+
119+jsonToYaml :: WriterOptions -> MetaValue -> State WriterState Doc
120+jsonToYaml opts (MetaMap metamap) = vcat
121+ <$> mapM (\(k,v) -> ((text k <> ":") <>) <$>
122+ case v of
123+ (MetaList _) -> (cr <>) <$> jsonToYaml opts v
124+ (MetaMap _) -> ((cr <>) . nest 2) <$> jsonToYaml opts v
125+ _ -> (space <> ) <$> jsonToYaml opts v)
126+ (M.toList metamap)
127+jsonToYaml opts (MetaList xs) = vcat
128+ <$> mapM (\v -> hang 2 "- " <$> (jsonToYaml opts v)) xs
129+jsonToYaml _ (MetaString s)
130+ | '\n' `elem` s = return $ hang 2 ("|" <> cr) $ text s
131+ | otherwise = return $ text $ "'" ++ substitute "'" "''" s ++ "'"
132+jsonToYaml opts (MetaInlines ils) =
133+ inlineListToMarkdown opts ils >>= jsonToYaml opts . MetaString . render' opts
134+jsonToYaml opts (MetaBlocks bs) =
135+ blockListToMarkdown opts bs >>= jsonToYaml opts . MetaString . render' opts
136+
137+render' :: WriterOptions -> Doc -> String
138+render' opts = render colwidth
139+ where colwidth = if writerWrapText opts
140+ then Just $ writerColumns opts
141+ else Nothing
131142
132143-- | Return markdown representation of document.
133144pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String
@@ -135,25 +146,22 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
135146 title' <- inlineListToMarkdown opts $ docTitle meta
136147 authors' <- mapM (inlineListToMarkdown opts) $ docAuthors meta
137148 date' <- inlineListToMarkdown opts $ docDate meta
138− let colwidth = if writerWrapText opts
139− then Just $ writerColumns opts
140− else Nothing
141149 metadata <- metaToJSON
142− (fmap (render colwidth) . blockListToMarkdown opts)
143− (fmap (render colwidth) . inlineListToMarkdown opts)
150+ (fmap (render' opts) . blockListToMarkdown opts)
151+ (fmap (render' opts) . inlineListToMarkdown opts)
144152 (writerVariables opts)
145153 meta
146154 isPlain <- gets stPlain
147− let titleblock = case True of
155+ titleblock <- case True of
148156 _ | isPlain ->
149− plainTitleBlock title' authors' date'
157+ return $ plainTitleBlock title' authors' date'
150158 | isEnabled Ext_yaml_title_block opts ->
151− yamlTitleBlock metadata
159+ yamlTitleBlock opts meta
152160 | isEnabled Ext_pandoc_title_block opts ->
153− pandocTitleBlock title' authors' date'
161+ return $ pandocTitleBlock title' authors' date'
154162 | isEnabled Ext_mmd_title_block opts ->
155− mmdTitleBlock title' authors' date'
156− | otherwise -> empty
163+ return $ mmdTitleBlock title' authors' date'
164+ | otherwise -> return empty
157165 let headerBlocks = filter isHeaderBlock blocks
158166 let toc = if writerTableOfContents opts
159167 then tableOfContents opts headerBlocks
@@ -163,16 +171,14 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
163171 notes' <- notesToMarkdown opts (reverse $ stNotes st)
164172 st' <- get -- note that the notes may contain refs
165173 refs' <- refsToMarkdown opts (reverse $ stRefs st')
166− let render' :: Doc -> String
167− render' = render colwidth
168− let main = render' $ body <>
174+ let main = render' opts $ body <>
169175 (if isEmpty notes' then empty else blankline <> notes') <>
170176 (if isEmpty refs' then empty else blankline <> refs')
171− let context = defField "toc" (render' toc)
177+ let context = defField "toc" (render' opts toc)
172178 $ defField "body" main
173179 $ (if not (null (docTitle meta) && null (docAuthors meta)
174180 && null (docDate meta))
175− then defField "titleblock" (render' titleblock)
181+ then defField "titleblock" (render' opts titleblock)
176182 else id)
177183 $ metadata
178184 if writerStandalone opts