@@ -46,8 +46,10 @@ import Text.Pandoc.Readers.TeXMath (readTeXMath)
4646import Text.HTML.TagSoup (renderTags, parseTags, isTagText, Tag(..))
4747import Network.URI (isAbsoluteURI)
4848import Data.Default
49−import qualified Data.Map as M
50−import Control.Applicative ((<$>))
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
5153
5254type Notes = [[Block]]
5355type Refs = [([Inline], Target)]
@@ -111,34 +113,21 @@ plainTitleBlock tit auths dat =
111113 (hcat (intersperse (text "; ") auths)) <> cr <>
112114 dat <> cr
113115
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
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
142131
143132-- | Return markdown representation of document.
144133pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String
@@ -146,22 +135,25 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
146135 title' <- inlineListToMarkdown opts $ docTitle meta
147136 authors' <- mapM (inlineListToMarkdown opts) $ docAuthors meta
148137 date' <- inlineListToMarkdown opts $ docDate meta
138+ let colwidth = if writerWrapText opts
139+ then Just $ writerColumns opts
140+ else Nothing
149141 metadata <- metaToJSON
150− (fmap (render' opts) . blockListToMarkdown opts)
151− (fmap (render' opts) . inlineListToMarkdown opts)
142+ (fmap (render colwidth) . blockListToMarkdown opts)
143+ (fmap (render colwidth) . inlineListToMarkdown opts)
152144 (writerVariables opts)
153145 meta
154146 isPlain <- gets stPlain
155− titleblock <- case True of
147+ let titleblock = case True of
156148 _ | isPlain ->
157− return $ plainTitleBlock title' authors' date'
149+ plainTitleBlock title' authors' date'
158150 | isEnabled Ext_yaml_title_block opts ->
159− yamlTitleBlock opts meta
151+ yamlTitleBlock metadata
160152 | isEnabled Ext_pandoc_title_block opts ->
161− return $ pandocTitleBlock title' authors' date'
153+ pandocTitleBlock title' authors' date'
162154 | isEnabled Ext_mmd_title_block opts ->
163− return $ mmdTitleBlock title' authors' date'
164− | otherwise -> return empty
155+ mmdTitleBlock title' authors' date'
156+ | otherwise -> empty
165157 let headerBlocks = filter isHeaderBlock blocks
166158 let toc = if writerTableOfContents opts
167159 then tableOfContents opts headerBlocks
@@ -171,14 +163,16 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
171163 notes' <- notesToMarkdown opts (reverse $ stNotes st)
172164 st' <- get -- note that the notes may contain refs
173165 refs' <- refsToMarkdown opts (reverse $ stRefs st')
174− let main = render' opts $ body <>
166+ let render' :: Doc -> String
167+ render' = render colwidth
168+ let main = render' $ body <>
175169 (if isEmpty notes' then empty else blankline <> notes') <>
176170 (if isEmpty refs' then empty else blankline <> refs')
177− let context = defField "toc" (render' opts toc)
171+ let context = defField "toc" (render' toc)
178172 $ defField "body" main
179173 $ (if not (null (docTitle meta) && null (docAuthors meta)
180174 && null (docDate meta))
181− then defField "titleblock" (render' opts titleblock)
175+ then defField "titleblock" (render' titleblock)
182176 else id)
183177 $ metadata
184178 if writerStandalone opts