git.iko.soy/typeable/pandoc
on master help sign in
Muse reader: add openTag and closeTag functions
1feb62cAlexander Krotov
src/Text/Pandoc/Readers/Muse.hs+19−18
@@ -179,16 +179,22 @@ someUntil p end = first <$> ((:) <$> p) <*> manyUntil p end
179
179
180-- ** HTML parsers
180-- ** HTML parsers
181
181
182+openTag :: PandocMonad m => String -> MuseParser m Attr
183+openTag tag = do
184+ (TagOpen _ attr, _) <- htmlTag(~== TagOpen tag [])
185+ return $ htmlAttrToPandoc attr
186+
187+closeTag :: PandocMonad m => String -> MuseParser m ()
188+closeTag tag = void $ htmlTag (~== TagClose tag)
189+
182-- | Parse HTML tag, returning its attributes and literal contents.
190-- | Parse HTML tag, returning its attributes and literal contents.
183htmlElement :: PandocMonad m
191htmlElement :: PandocMonad m
184 => String -- ^ Tag name
192 => String -- ^ Tag name
185 -> MuseParser m (Attr, String)
193 -> MuseParser m (Attr, String)
186htmlElement tag = try $ do
194htmlElement tag = try $ do
187− (TagOpen _ attr, _) <- htmlTag (~== TagOpen tag [])
195+ attr <- openTag tag
188− content <- manyTill anyChar endtag
196+ content <- manyTill anyChar $ closeTag tag
189− return (htmlAttrToPandoc attr, content)
197+ return (attr, content)
190− where
191− endtag = void $ htmlTag (~== TagClose tag)
192
198
193htmlBlock :: PandocMonad m
199htmlBlock :: PandocMonad m
194 => String -- ^ Tag name
200 => String -- ^ Tag name
@@ -213,13 +219,11 @@ parseHtmlContent :: PandocMonad m
213parseHtmlContent tag = try $ do
219parseHtmlContent tag = try $ do
214 many spaceChar
220 many spaceChar
215 pos <- getPosition
221 pos <- getPosition
216− (TagOpen _ attr, _) <- htmlTag (~== TagOpen tag [])
222+ attr <- openTag tag
217 manyTill spaceChar eol
223 manyTill spaceChar eol
218− content <- parseBlocksTill $ try $ count (sourceColumn pos - 1) spaceChar >> endtag
224+ content <- parseBlocksTill $ try $ count (sourceColumn pos - 1) spaceChar >> closeTag tag
219 manyTill spaceChar eol -- closing tag must be followed by optional whitespace and newline
225 manyTill spaceChar eol -- closing tag must be followed by optional whitespace and newline
220− return (htmlAttrToPandoc attr, content)
226+ return (attr, content)
221− where
222− endtag = void $ htmlTag (~== TagClose tag)
223
227
224-- ** Directive parsers
228-- ** Directive parsers
225
229
@@ -423,13 +427,12 @@ exampleTag = try $ do
423literalTag :: PandocMonad m => MuseParser m (F Blocks)
427literalTag :: PandocMonad m => MuseParser m (F Blocks)
424literalTag = try $ do
428literalTag = try $ do
425 many spaceChar
429 many spaceChar
426− (TagOpen _ attr, _) <- htmlTag (~== TagOpen "literal" [])
430+ attr <- openTag "literal"
427 manyTill spaceChar eol
431 manyTill spaceChar eol
428− content <- manyTill anyChar endtag
432+ content <- manyTill anyChar $ closeTag "literal"
429 manyTill spaceChar eol
433 manyTill spaceChar eol
430− return $ return $ rawBlock (htmlAttrToPandoc attr, content)
434+ return $ return $ rawBlock (attr, content)
431 where
435 where
432− endtag = void $ htmlTag (~== TagClose "literal")
433 -- FIXME: Emacs Muse inserts <literal> without style into all output formats, but we assume HTML
436 -- FIXME: Emacs Muse inserts <literal> without style into all output formats, but we assume HTML
434 format (_, _, kvs) = fromMaybe "html" $ lookup "style" kvs
437 format (_, _, kvs) = fromMaybe "html" $ lookup "style" kvs
435 rawBlock (attrs, content) = B.rawBlock (format attrs) $ rchop $ intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop content
438 rawBlock (attrs, content) = B.rawBlock (format attrs) $ rchop $ intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop content
@@ -480,14 +483,12 @@ verseTag :: PandocMonad m => MuseParser m (F Blocks)
480verseTag = try $ do
483verseTag = try $ do
481 many spaceChar
484 many spaceChar
482 pos <- getPosition
485 pos <- getPosition
483− (TagOpen _ _, _) <- htmlTag (~== TagOpen "verse" [])
486+ openTag "verse"
484 manyTill spaceChar eol
487 manyTill spaceChar eol
485 let indent = count (sourceColumn pos - 1) spaceChar
488 let indent = count (sourceColumn pos - 1) spaceChar
486− content <- sequence <$> manyTill (indent >> verseLine) (try $ indent >> endtag)
489+ content <- sequence <$> manyTill (indent >> verseLine) (try $ indent >> closeTag "verse")
487 manyTill spaceChar eol
490 manyTill spaceChar eol
488 return $ B.lineBlock <$> content
491 return $ B.lineBlock <$> content
489− where
490− endtag = void $ htmlTag (~== TagClose "verse")
491
492
492-- | Parse @\<comment>@ tag.
493-- | Parse @\<comment>@ tag.
493commentTag :: PandocMonad m => MuseParser m (F Blocks)
494commentTag :: PandocMonad m => MuseParser m (F Blocks)