git.iko.soy/typeable/pandoc
on master help sign in
Muse reader: document implementation
2bc5fb6Alexander Krotov
src/Text/Pandoc/Readers/Muse.hs+136−93
compare with master
unifiedsplit
@@ -84,24 +84,21 @@ data MuseState = MuseState { museMeta :: F Meta -- ^ Document metadata
84 , museLastStrPos :: Maybe SourcePos -- ^ Position after last str parsed
84 , museLastStrPos :: Maybe SourcePos -- ^ Position after last str parsed
85 , museLogMessages :: [LogMessage]
85 , museLogMessages :: [LogMessage]
86 , museNotes :: M.Map String (SourcePos, F Blocks)
86 , museNotes :: M.Map String (SourcePos, F Blocks)
87− , museInLink :: Bool
87+ , museInLink :: Bool -- ^ True when parsing a link description to avoid nested links
88− , museInPara :: Bool
88+ , museInPara :: Bool -- ^ True when looking for a paragraph terminator
89 }
89 }
90
90
91instance Default MuseState where
91instance Default MuseState where
92− def = defaultMuseState
93−
94−defaultMuseState :: MuseState
95−defaultMuseState = MuseState { museMeta = return nullMeta
92+ def = MuseState { museMeta = return nullMeta
96− , museOptions = def
93+ , museOptions = def
97− , museHeaders = M.empty
94+ , museHeaders = M.empty
98− , museIdentifierList = Set.empty
95+ , museIdentifierList = Set.empty
99− , museLastStrPos = Nothing
96+ , museLastStrPos = Nothing
100− , museLogMessages = []
97+ , museLogMessages = []
101− , museNotes = M.empty
98+ , museNotes = M.empty
102− , museInLink = False
99+ , museInLink = False
103− , museInPara = False
100+ , museInPara = False
104− }
101+ }
105
102
106type MuseParser = ParserT String MuseState
103type MuseParser = ParserT String MuseState
107
104
@@ -124,10 +121,7 @@ instance HasLogMessages MuseState where
124 addLogMessage m s = s{ museLogMessages = m : museLogMessages s }
121 addLogMessage m s = s{ museLogMessages = m : museLogMessages s }
125 getLogMessages = reverse . museLogMessages
122 getLogMessages = reverse . museLogMessages
126
123
127−--
124+-- | Parse Muse document
128−-- main parser
129−--
130−
131parseMuse :: PandocMonad m => MuseParser m Pandoc
125parseMuse :: PandocMonad m => MuseParser m Pandoc
132parseMuse = do
126parseMuse = do
133 many directive
127 many directive
@@ -139,14 +133,56 @@ parseMuse = do
139 reportLogMessages
133 reportLogMessages
140 return doc
134 return doc
141
135
142−--
143−-- utility functions
136+-- * Utility functions
144−--
137+
138+commonPrefix :: String -> String -> String
139+commonPrefix _ [] = []
140+commonPrefix [] _ = []
141+commonPrefix (x:xs) (y:ys)
142+ | x == y = x : commonPrefix xs ys
143+ | otherwise = []
144+
145+-- | Trim up to one newline from the beginning of the string.
146+lchop :: String -> String
147+lchop s = case s of
148+ '\n':ss -> ss
149+ _ -> s
150+
151+-- | Trim up to one newline from the end of the string.
152+rchop :: String -> String
153+rchop = reverse . lchop . reverse
154+
155+dropSpacePrefix :: [String] -> [String]
156+dropSpacePrefix lns =
157+ map (drop maxIndent) lns
158+ where flns = filter (not . all (== ' ')) lns
159+ maxIndent = if null flns then maximum (map length lns) else length $ takeWhile (== ' ') $ foldl1 commonPrefix flns
160+
161+atStart :: PandocMonad m => MuseParser m a -> MuseParser m a
162+atStart p = do
163+ pos <- getPosition
164+ st <- getState
165+ guard $ museLastStrPos st /= Just pos
166+ p
167+
168+-- * Parsers
145
169
170+-- | Parse end-of-line, which can be either a newline or end-of-file.
146eol :: Stream s m Char => ParserT s st m ()
171eol :: Stream s m Char => ParserT s st m ()
147eol = void newline <|> eof
172eol = void newline <|> eof
148
173
174+someUntil :: (Stream s m t)
175+ => ParserT s u m a
176+ -> ParserT s u m b
177+ -> ParserT s u m ([a], b)
178+someUntil p end = first <$> ((:) <$> p) <*> manyUntil p end
179+
180+-- ** HTML parsers
181+
182+-- | Parse HTML tag, returning its attributes and literal contents.
149−htmlElement :: PandocMonad m => String -> MuseParser m (Attr, String)
183+htmlElement :: PandocMonad m
184+ => String -- ^ Tag name
185+ -> MuseParser m (Attr, String)
150htmlElement tag = try $ do
186htmlElement tag = try $ do
151 (TagOpen _ attr, _) <- htmlTag (~== TagOpen tag [])
187 (TagOpen _ attr, _) <- htmlTag (~== TagOpen tag [])
152 content <- manyTill anyChar endtag
188 content <- manyTill anyChar endtag
@@ -154,13 +190,16 @@ htmlElement tag = try $ do
154 where
190 where
155 endtag = void $ htmlTag (~== TagClose tag)
191 endtag = void $ htmlTag (~== TagClose tag)
156
192
157−htmlBlock :: PandocMonad m => String -> MuseParser m (Attr, String)
193+htmlBlock :: PandocMonad m
194+ => String -- ^ Tag name
195+ -> MuseParser m (Attr, String)
158htmlBlock tag = try $ do
196htmlBlock tag = try $ do
159 many spaceChar
197 many spaceChar
160 res <- htmlElement tag
198 res <- htmlElement tag
161 manyTill spaceChar eol
199 manyTill spaceChar eol
162 return res
200 return res
163
201
202+-- | Convert HTML attributes to Pandoc 'Attr'
164htmlAttrToPandoc :: [Attribute String] -> Attr
203htmlAttrToPandoc :: [Attribute String] -> Attr
165htmlAttrToPandoc attrs = (ident, classes, keyvals)
204htmlAttrToPandoc attrs = (ident, classes, keyvals)
166 where
205 where
@@ -169,7 +208,8 @@ htmlAttrToPandoc attrs = (ident, classes, keyvals)
169 keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]
208 keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]
170
209
171parseHtmlContent :: PandocMonad m
210parseHtmlContent :: PandocMonad m
211+ => String -- ^ Tag name
172− => String -> MuseParser m (Attr, F Blocks)
212+ -> MuseParser m (Attr, F Blocks)
173parseHtmlContent tag = try $ do
213parseHtmlContent tag = try $ do
174 many spaceChar
214 many spaceChar
175 pos <- getPosition
215 pos <- getPosition
@@ -181,29 +221,7 @@ parseHtmlContent tag = try $ do
181 where
221 where
182 endtag = void $ htmlTag (~== TagClose tag)
222 endtag = void $ htmlTag (~== TagClose tag)
183
223
184−commonPrefix :: String -> String -> String
185−commonPrefix _ [] = []
186−commonPrefix [] _ = []
187−commonPrefix (x:xs) (y:ys)
188− | x == y = x : commonPrefix xs ys
189− | otherwise = []
190−
191−atStart :: PandocMonad m => MuseParser m a -> MuseParser m a
192−atStart p = do
193− pos <- getPosition
194− st <- getState
195− guard $ museLastStrPos st /= Just pos
196− p
197−
198−someUntil :: (Stream s m t)
199− => ParserT s u m a
200− -> ParserT s u m b
201− -> ParserT s u m ([a], b)
202−someUntil p end = first <$> ((:) <$> p) <*> manyUntil p end
203−
204−--
205−-- directive parsers
224+-- ** Directive parsers
206−--
207
225
208-- While not documented, Emacs Muse allows "-" in directive name
226-- While not documented, Emacs Muse allows "-" in directive name
209parseDirectiveKey :: PandocMonad m => MuseParser m String
227parseDirectiveKey :: PandocMonad m => MuseParser m String
@@ -234,9 +252,7 @@ directive = do
234 where translateKey "cover" = "cover-image"
252 where translateKey "cover" = "cover-image"
235 translateKey x = x
253 translateKey x = x
236
254
237−--
238−-- block parsers
255+-- ** Block parsers
239−--
240
256
241parseBlocks :: PandocMonad m
257parseBlocks :: PandocMonad m
242 => MuseParser m (F Blocks)
258 => MuseParser m (F Blocks)
@@ -329,6 +345,7 @@ blockElements = do
329 , commentTag
345 , commentTag
330 ]
346 ]
331
347
348+-- | Parse a line comment, starting with @;@ in the first column.
332comment :: PandocMonad m => MuseParser m (F Blocks)
349comment :: PandocMonad m => MuseParser m (F Blocks)
333comment = try $ do
350comment = try $ do
334 char ';'
351 char ';'
@@ -336,6 +353,7 @@ comment = try $ do
336 eol
353 eol
337 return mempty
354 return mempty
338
355
356+-- | Parse a horizontal rule, consisting of 4 or more @\'-\'@ characters.
339separator :: PandocMonad m => MuseParser m (F Blocks)
357separator :: PandocMonad m => MuseParser m (F Blocks)
340separator = try $ do
358separator = try $ do
341 string "----"
359 string "----"
@@ -344,6 +362,7 @@ separator = try $ do
344 eol
362 eol
345 return $ return B.horizontalRule
363 return $ return B.horizontalRule
346
364
365+-- | Parse a heading.
347header :: PandocMonad m => MuseParser m (F Blocks)
366header :: PandocMonad m => MuseParser m (F Blocks)
348header = try $ do
367header = try $ do
349 anchorId <- option "" $ try (parseAnchor <* manyTill spaceChar eol)
368 anchorId <- option "" $ try (parseAnchor <* manyTill spaceChar eol)
@@ -355,6 +374,8 @@ header = try $ do
355 attr <- registerHeader (anchorId, [], []) (runF content def)
374 attr <- registerHeader (anchorId, [], []) (runF content def)
356 return $ B.headerWith attr level <$> content
375 return $ B.headerWith attr level <$> content
357
376
377+-- | Parse an example between @{{{@ and @}}}@.
378+-- It is an Amusewiki extension influenced by Creole wiki, as described in @Text::Amuse@ documentation.
358example :: PandocMonad m => MuseParser m (F Blocks)
379example :: PandocMonad m => MuseParser m (F Blocks)
359example = try $ do
380example = try $ do
360 string "{{{"
381 string "{{{"
@@ -362,27 +383,14 @@ example = try $ do
362 contents <- manyTill anyChar $ try (optional blankline >> string "}}}")
383 contents <- manyTill anyChar $ try (optional blankline >> string "}}}")
363 return $ return $ B.codeBlock contents
384 return $ return $ B.codeBlock contents
364
385
365−-- Trim up to one newline from the beginning of the string.
386+-- | Parse an @\<example>@ tag.
366−lchop :: String -> String
367−lchop s = case s of
368− '\n':ss -> ss
369− _ -> s
370−
371−-- Trim up to one newline from the end of the string.
372−rchop :: String -> String
373−rchop = reverse . lchop . reverse
374−
375−dropSpacePrefix :: [String] -> [String]
376−dropSpacePrefix lns =
377− map (drop maxIndent) lns
378− where flns = filter (not . all (== ' ')) lns
379− maxIndent = if null flns then maximum (map length lns) else length $ takeWhile (== ' ') $ foldl1 commonPrefix flns
380−
381exampleTag :: PandocMonad m => MuseParser m (F Blocks)
387exampleTag :: PandocMonad m => MuseParser m (F Blocks)
382exampleTag = try $ do
388exampleTag = try $ do
383 (attr, contents) <- htmlBlock "example"
389 (attr, contents) <- htmlBlock "example"
384 return $ return $ B.codeBlockWith attr $ rchop $ intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop contents
390 return $ return $ B.codeBlockWith attr $ rchop $ intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop contents
385
391
392+-- | Parse a @\<literal>@ tag as a raw block.
393+-- For 'RawInline' @\<literal>@ parser, see 'inlineLiteralTag'.
386literalTag :: PandocMonad m => MuseParser m (F Blocks)
394literalTag :: PandocMonad m => MuseParser m (F Blocks)
387literalTag = try $ do
395literalTag = try $ do
388 many spaceChar
396 many spaceChar
@@ -397,30 +405,36 @@ literalTag = try $ do
397 format (_, _, kvs) = fromMaybe "html" $ lookup "style" kvs
405 format (_, _, kvs) = fromMaybe "html" $ lookup "style" kvs
398 rawBlock (attrs, content) = B.rawBlock (format attrs) $ rchop $ intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop content
406 rawBlock (attrs, content) = B.rawBlock (format attrs) $ rchop $ intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop content
399
407
400−-- <center> tag is ignored
408+-- | Parse @\<center>@ tag.
409+-- Currently it is ignored as Pandoc cannot represent centered blocks.
401centerTag :: PandocMonad m => MuseParser m (F Blocks)
410centerTag :: PandocMonad m => MuseParser m (F Blocks)
402centerTag = snd <$> parseHtmlContent "center"
411centerTag = snd <$> parseHtmlContent "center"
403
412
404−-- <right> tag is ignored
413+-- | Parse @\<right>@ tag.
414+-- Currently it is ignored as Pandoc cannot represent centered blocks.
405rightTag :: PandocMonad m => MuseParser m (F Blocks)
415rightTag :: PandocMonad m => MuseParser m (F Blocks)
406rightTag = snd <$> parseHtmlContent "right"
416rightTag = snd <$> parseHtmlContent "right"
407
417
418+-- | Parse @\<quote>@ tag.
408quoteTag :: PandocMonad m => MuseParser m (F Blocks)
419quoteTag :: PandocMonad m => MuseParser m (F Blocks)
409quoteTag = fmap B.blockQuote . snd <$> parseHtmlContent "quote"
420quoteTag = fmap B.blockQuote . snd <$> parseHtmlContent "quote"
410
421
422+-- | Parse @\<div>@ tag.
411−-- <div> tag is supported by Emacs Muse, but not Amusewiki 2.025
423+-- @\<div>@ tag is supported by Emacs Muse, but not Amusewiki 2.025.
412divTag :: PandocMonad m => MuseParser m (F Blocks)
424divTag :: PandocMonad m => MuseParser m (F Blocks)
413divTag = do
425divTag = do
414 (attrs, content) <- parseHtmlContent "div"
426 (attrs, content) <- parseHtmlContent "div"
415 return $ B.divWith attrs <$> content
427 return $ B.divWith attrs <$> content
416
428
429+-- | Parse @\<biblio>@ tag, the result is the same as @\<div class="biblio">@.
417−-- <biblio> tag is supported by Amusewiki only
430+-- @\<biblio>@ tag is supported only in Text::Amuse mode.
418biblioTag :: PandocMonad m => MuseParser m (F Blocks)
431biblioTag :: PandocMonad m => MuseParser m (F Blocks)
419biblioTag = do
432biblioTag = do
420 guardEnabled Ext_amuse
433 guardEnabled Ext_amuse
421 fmap (B.divWith ("", ["biblio"], [])) . snd <$> parseHtmlContent "biblio"
434 fmap (B.divWith ("", ["biblio"], [])) . snd <$> parseHtmlContent "biblio"
422
435
436+-- | Parse @\<play>@ tag, the result is the same as @\<div class="play">@.
423−-- <play> tag is supported by Amusewiki only
437+-- @\<play>@ tag is supported only in Text::Amuse mode.
424playTag :: PandocMonad m => MuseParser m (F Blocks)
438playTag :: PandocMonad m => MuseParser m (F Blocks)
425playTag = do
439playTag = do
426 guardEnabled Ext_amuse
440 guardEnabled Ext_amuse
@@ -437,17 +451,19 @@ verseLines = do
437 lns <- many verseLine
451 lns <- many verseLine
438 return $ B.lineBlock <$> sequence lns
452 return $ B.lineBlock <$> sequence lns
439
453
454+-- | Parse @\<verse>@ tag.
440verseTag :: PandocMonad m => MuseParser m (F Blocks)
455verseTag :: PandocMonad m => MuseParser m (F Blocks)
441verseTag = do
456verseTag = do
442 (_, content) <- htmlBlock "verse"
457 (_, content) <- htmlBlock "verse"
443 parseFromString verseLines (intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop content)
458 parseFromString verseLines (intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop content)
444
459
460+-- | Parse @\<comment>@ tag.
445commentTag :: PandocMonad m => MuseParser m (F Blocks)
461commentTag :: PandocMonad m => MuseParser m (F Blocks)
446commentTag = htmlBlock "comment" >> return mempty
462commentTag = htmlBlock "comment" >> return mempty
447
463
448−-- Indented paragraph is either center, right or quote
464+-- | Parse a paragraph.
449paraUntil :: PandocMonad m
465paraUntil :: PandocMonad m
450− => MuseParser m a
466+ => MuseParser m a -- ^ Terminator parser
451 -> MuseParser m (F Blocks, a)
467 -> MuseParser m (F Blocks, a)
452paraUntil end = do
468paraUntil end = do
453 state <- getState
469 state <- getState
@@ -514,19 +530,18 @@ blanklineVerseLine = try $ do
514 blankline
530 blankline
515 pure mempty
531 pure mempty
516
532
533+-- | Parse a line block indicated by @\'>\'@ characters.
517lineBlock :: PandocMonad m => MuseParser m (F Blocks)
534lineBlock :: PandocMonad m => MuseParser m (F Blocks)
518lineBlock = try $ do
535lineBlock = try $ do
519 col <- sourceColumn <$> getPosition
536 col <- sourceColumn <$> getPosition
520 lns <- (blanklineVerseLine <|> lineVerseLine) `sepBy1'` try (indentWith (col - 1))
537 lns <- (blanklineVerseLine <|> lineVerseLine) `sepBy1'` try (indentWith (col - 1))
521 return $ B.lineBlock <$> sequence lns
538 return $ B.lineBlock <$> sequence lns
522
539
523−--
540+-- *** List parsers
524−-- lists
525−--
526
541
527bulletListItemsUntil :: PandocMonad m
542bulletListItemsUntil :: PandocMonad m
528− => Int
543+ => Int -- ^ Indentation
529− -> MuseParser m a
544+ -> MuseParser m a -- ^ Terminator parser
530 -> MuseParser m ([F Blocks], a)
545 -> MuseParser m ([F Blocks], a)
531bulletListItemsUntil indent end = try $ do
546bulletListItemsUntil indent end = try $ do
532 char '-'
547 char '-'
@@ -537,6 +552,7 @@ bulletListItemsUntil indent end = try $ do
537 Left ee -> return ([x], ee)
552 Left ee -> return ([x], ee)
538 Right (xs, ee) -> return (x:xs, ee)
553 Right (xs, ee) -> return (x:xs, ee)
539
554
555+-- | Parse a bullet list.
540bulletListUntil :: PandocMonad m
556bulletListUntil :: PandocMonad m
541 => MuseParser m a
557 => MuseParser m a
542 -> MuseParser m (F Blocks, a)
558 -> MuseParser m (F Blocks, a)
@@ -585,6 +601,7 @@ orderedListItemsUntil indent style end =
585 Left ee -> return ([x], ee)
601 Left ee -> return ([x], ee)
586 Right (xs, ee) -> return (x:xs, ee)
602 Right (xs, ee) -> return (x:xs, ee)
587
603
604+-- | Parse an ordered list.
588orderedListUntil :: PandocMonad m
605orderedListUntil :: PandocMonad m
589 => MuseParser m a
606 => MuseParser m a
590 -> MuseParser m (F Blocks, a)
607 -> MuseParser m (F Blocks, a)
@@ -629,8 +646,9 @@ definitionListItemsUntil indent end =
629 Left ee -> return ([xx], ee)
646 Left ee -> return ([xx], ee)
630 Right (xs, ee) -> return (xx:xs, ee)
647 Right (xs, ee) -> return (xx:xs, ee)
631
648
649+-- | Parse a definition list.
632definitionListUntil :: PandocMonad m
650definitionListUntil :: PandocMonad m
633− => MuseParser m a
651+ => MuseParser m a -- ^ Terminator parser
634 -> MuseParser m (F Blocks, a)
652 -> MuseParser m (F Blocks, a)
635definitionListUntil end = try $ do
653definitionListUntil end = try $ do
636 many spaceChar
654 many spaceChar
@@ -640,15 +658,14 @@ definitionListUntil end = try $ do
640 first (fmap B.definitionList . sequence) <$> definitionListItemsUntil indent end
658 first (fmap B.definitionList . sequence) <$> definitionListItemsUntil indent end
641
659
642anyListUntil :: PandocMonad m
660anyListUntil :: PandocMonad m
643− => MuseParser m a
661+ => MuseParser m a -- ^ Terminator parser
644 -> MuseParser m (F Blocks, a)
662 -> MuseParser m (F Blocks, a)
645anyListUntil end =
663anyListUntil end =
646 bulletListUntil end <|> orderedListUntil end <|> definitionListUntil end
664 bulletListUntil end <|> orderedListUntil end <|> definitionListUntil end
647
665
648−--
666+-- *** Table parsers
649−-- tables
650−--
651
667
668+-- | Internal Muse table representation.
652data MuseTable = MuseTable
669data MuseTable = MuseTable
653 { museTableCaption :: Inlines
670 { museTableCaption :: Inlines
654 , museTableHeaders :: [[Blocks]]
671 , museTableHeaders :: [[Blocks]]
@@ -698,6 +715,7 @@ elementsToTable :: [MuseTableElement] -> F MuseTable
698elementsToTable = foldM museAppendElement emptyTable
715elementsToTable = foldM museAppendElement emptyTable
699 where emptyTable = MuseTable mempty mempty mempty mempty
716 where emptyTable = MuseTable mempty mempty mempty mempty
700
717
718+-- | Parse a table.
701table :: PandocMonad m => MuseParser m (F Blocks)
719table :: PandocMonad m => MuseParser m (F Blocks)
702table = try $ fmap museToPandocTable <$> (elementsToTable <$> tableElements)
720table = try $ fmap museToPandocTable <$> (elementsToTable <$> tableElements)
703
721
@@ -707,31 +725,35 @@ tableParseElement = tableParseHeader
707 <|> tableParseFooter
725 <|> tableParseFooter
708 <|> tableParseCaption
726 <|> tableParseCaption
709
727
710−tableParseRow :: PandocMonad m => Int -> MuseParser m (F [Blocks])
728+tableParseRow :: PandocMonad m
729+ => Int -- ^ Number of separator characters
730+ -> MuseParser m (F [Blocks])
711tableParseRow n = try $ do
731tableParseRow n = try $ do
712 fields <- tableCell `sepBy2` fieldSep
732 fields <- tableCell `sepBy2` fieldSep
713 return $ sequence fields
733 return $ sequence fields
714 where p `sepBy2` sep = (:) <$> p <*> many1 (sep >> p)
734 where p `sepBy2` sep = (:) <$> p <*> many1 (sep >> p)
715 fieldSep = many1 spaceChar >> count n (char '|') >> (void (many1 spaceChar) <|> void (lookAhead newline))
735 fieldSep = many1 spaceChar >> count n (char '|') >> (void (many1 spaceChar) <|> void (lookAhead newline))
716
736
737+-- | Parse a table header row.
717tableParseHeader :: PandocMonad m => MuseParser m MuseTableElement
738tableParseHeader :: PandocMonad m => MuseParser m MuseTableElement
718tableParseHeader = MuseHeaderRow <$> tableParseRow 2
739tableParseHeader = MuseHeaderRow <$> tableParseRow 2
719
740
741+-- | Parse a table body row.
720tableParseBody :: PandocMonad m => MuseParser m MuseTableElement
742tableParseBody :: PandocMonad m => MuseParser m MuseTableElement
721tableParseBody = MuseBodyRow <$> tableParseRow 1
743tableParseBody = MuseBodyRow <$> tableParseRow 1
722
744
745+-- | Parse a table footer row.
723tableParseFooter :: PandocMonad m => MuseParser m MuseTableElement
746tableParseFooter :: PandocMonad m => MuseParser m MuseTableElement
724tableParseFooter = MuseFooterRow <$> tableParseRow 3
747tableParseFooter = MuseFooterRow <$> tableParseRow 3
725
748
749+-- | Parse table caption.
726tableParseCaption :: PandocMonad m => MuseParser m MuseTableElement
750tableParseCaption :: PandocMonad m => MuseParser m MuseTableElement
727tableParseCaption = try $ do
751tableParseCaption = try $ do
728 many spaceChar
752 many spaceChar
729 string "|+"
753 string "|+"
730 MuseCaption <$> (trimInlinesF . mconcat <$> many1Till inline (string "+|"))
754 MuseCaption <$> (trimInlinesF . mconcat <$> many1Till inline (string "+|"))
731
755
732−--
733−-- inline parsers
756+-- ** Inline parsers
734−--
735
757
736inlineList :: PandocMonad m => [MuseParser m (F Inlines)]
758inlineList :: PandocMonad m => [MuseParser m (F Inlines)]
737inlineList = [ whitespace
759inlineList = [ whitespace
@@ -761,6 +783,7 @@ inlineList = [ whitespace
761inline :: PandocMonad m => MuseParser m (F Inlines)
783inline :: PandocMonad m => MuseParser m (F Inlines)
762inline = endline <|> choice inlineList <?> "inline"
784inline = endline <|> choice inlineList <?> "inline"
763
785
786+-- | Parse a soft break.
764endline :: PandocMonad m => MuseParser m (F Inlines)
787endline :: PandocMonad m => MuseParser m (F Inlines)
765endline = try $ do
788endline = try $ do
766 newline
789 newline
@@ -779,6 +802,7 @@ anchor = try $ do
779 skipMany spaceChar <|> void newline
802 skipMany spaceChar <|> void newline
780 return $ return $ B.spanWith (anchorId, [], []) mempty
803 return $ return $ B.spanWith (anchorId, [], []) mempty
781
804
805+-- | Parse a footnote reference.
782footnote :: PandocMonad m => MuseParser m (F Inlines)
806footnote :: PandocMonad m => MuseParser m (F Inlines)
783footnote = try $ do
807footnote = try $ do
784 ref <- noteMarker
808 ref <- noteMarker
@@ -796,6 +820,7 @@ whitespace = try $ do
796 skipMany1 spaceChar
820 skipMany1 spaceChar
797 return $ return B.space
821 return $ return B.space
798
822
823+-- | Parse @\<br>@ tag.
799br :: PandocMonad m => MuseParser m (F Inlines)
824br :: PandocMonad m => MuseParser m (F Inlines)
800br = try $ do
825br = try $ do
801 string "<br>"
826 string "<br>"
@@ -811,42 +836,54 @@ enclosedInlines :: (PandocMonad m, Show a, Show b)
811enclosedInlines start end = try $
836enclosedInlines start end = try $
812 trimInlinesF . mconcat <$> (enclosed (atStart start) end inline <* notFollowedBy (satisfy isLetter))
837 trimInlinesF . mconcat <$> (enclosed (atStart start) end inline <* notFollowedBy (satisfy isLetter))
813
838
839+-- | Parse an inline tag, such as @\<em>@ and @\<strong>@.
814inlineTag :: PandocMonad m
840inlineTag :: PandocMonad m
815− => String
841+ => String -- ^ Tag name
816 -> MuseParser m (F Inlines)
842 -> MuseParser m (F Inlines)
817inlineTag tag = try $ do
843inlineTag tag = try $ do
818 htmlTag (~== TagOpen tag [])
844 htmlTag (~== TagOpen tag [])
819 mconcat <$> manyTill inline (void $ htmlTag (~== TagClose tag))
845 mconcat <$> manyTill inline (void $ htmlTag (~== TagClose tag))
820
846
821−strongTag :: PandocMonad m => MuseParser m (F Inlines)
847+-- | Parse strong inline markup, indicated by @**@.
822−strongTag = fmap B.strong <$> inlineTag "strong"
823−
824strong :: PandocMonad m => MuseParser m (F Inlines)
848strong :: PandocMonad m => MuseParser m (F Inlines)
825strong = fmap B.strong <$> emphasisBetween (string "**")
849strong = fmap B.strong <$> emphasisBetween (string "**")
826
850
851+-- | Parse emphasis inline markup, indicated by @*@.
827emph :: PandocMonad m => MuseParser m (F Inlines)
852emph :: PandocMonad m => MuseParser m (F Inlines)
828emph = fmap B.emph <$> emphasisBetween (char '*')
853emph = fmap B.emph <$> emphasisBetween (char '*')
829
854
855+-- | Parse underline inline markup, indicated by @_@.
856+-- Supported only in Emacs Muse mode, not Text::Amuse.
830underlined :: PandocMonad m => MuseParser m (F Inlines)
857underlined :: PandocMonad m => MuseParser m (F Inlines)
831underlined = do
858underlined = do
832 guardDisabled Ext_amuse -- Supported only by Emacs Muse
859 guardDisabled Ext_amuse -- Supported only by Emacs Muse
833 fmap underlineSpan <$> emphasisBetween (char '_')
860 fmap underlineSpan <$> emphasisBetween (char '_')
834
861
862+-- | Parse @\<strong>@ tag.
863+strongTag :: PandocMonad m => MuseParser m (F Inlines)
864+strongTag = fmap B.strong <$> inlineTag "strong"
865+
866+-- | Parse @\<em>@ tag.
835emphTag :: PandocMonad m => MuseParser m (F Inlines)
867emphTag :: PandocMonad m => MuseParser m (F Inlines)
836emphTag = fmap B.emph <$> inlineTag "em"
868emphTag = fmap B.emph <$> inlineTag "em"
837
869
870+-- | Parse @\<sup>@ tag.
838superscriptTag :: PandocMonad m => MuseParser m (F Inlines)
871superscriptTag :: PandocMonad m => MuseParser m (F Inlines)
839superscriptTag = fmap B.superscript <$> inlineTag "sup"
872superscriptTag = fmap B.superscript <$> inlineTag "sup"
840
873
874+-- | Parse @\<sub>@ tag.
841subscriptTag :: PandocMonad m => MuseParser m (F Inlines)
875subscriptTag :: PandocMonad m => MuseParser m (F Inlines)
842subscriptTag = fmap B.subscript <$> inlineTag "sub"
876subscriptTag = fmap B.subscript <$> inlineTag "sub"
843
877
878+-- | Parse @\<del>@ tag.
844strikeoutTag :: PandocMonad m => MuseParser m (F Inlines)
879strikeoutTag :: PandocMonad m => MuseParser m (F Inlines)
845strikeoutTag = fmap B.strikeout <$> inlineTag "del"
880strikeoutTag = fmap B.strikeout <$> inlineTag "del"
846
881
882+-- | Parse @\<verbatim>@ tag.
847verbatimTag :: PandocMonad m => MuseParser m (F Inlines)
883verbatimTag :: PandocMonad m => MuseParser m (F Inlines)
848verbatimTag = return . B.text . snd <$> htmlElement "verbatim"
884verbatimTag = return . B.text . snd <$> htmlElement "verbatim"
849
885
886+-- | Parse @\<class>@ tag.
850classTag :: PandocMonad m => MuseParser m (F Inlines)
887classTag :: PandocMonad m => MuseParser m (F Inlines)
851classTag = do
888classTag = do
852 (TagOpen _ attrs, _) <- htmlTag (~== TagOpen "class" [])
889 (TagOpen _ attrs, _) <- htmlTag (~== TagOpen "class" [])
@@ -854,11 +891,13 @@ classTag = do
854 let classes = maybe [] words $ lookup "name" attrs
891 let classes = maybe [] words $ lookup "name" attrs
855 return $ B.spanWith ("", classes, []) <$> mconcat res
892 return $ B.spanWith ("", classes, []) <$> mconcat res
856
893
894+-- | Parse "~~" as nonbreaking space.
857nbsp :: PandocMonad m => MuseParser m (F Inlines)
895nbsp :: PandocMonad m => MuseParser m (F Inlines)
858nbsp = try $ do
896nbsp = try $ do
859 string "~~"
897 string "~~"
860 return $ return $ B.str "\160"
898 return $ return $ B.str "\160"
861
899
900+-- | Parse code markup, indicated by @\'=\'@ characters.
862code :: PandocMonad m => MuseParser m (F Inlines)
901code :: PandocMonad m => MuseParser m (F Inlines)
863code = try $ do
902code = try $ do
864 atStart $ char '='
903 atStart $ char '='
@@ -869,13 +908,16 @@ code = try $ do
869 notFollowedBy $ satisfy isLetter
908 notFollowedBy $ satisfy isLetter
870 return $ return $ B.code contents
909 return $ return $ B.code contents
871
910
911+-- | Parse @\<code>@ tag.
872codeTag :: PandocMonad m => MuseParser m (F Inlines)
912codeTag :: PandocMonad m => MuseParser m (F Inlines)
873codeTag = return . uncurry B.codeWith <$> htmlElement "code"
913codeTag = return . uncurry B.codeWith <$> htmlElement "code"
874
914
915+-- | Parse @\<math>@ tag.
875−-- <math> tag is an Emacs Muse extension enabled by (require 'muse-latex2png)
916+-- @\<math>@ tag is an Emacs Muse extension enabled by @(require 'muse-latex2png)@
876mathTag :: PandocMonad m => MuseParser m (F Inlines)
917mathTag :: PandocMonad m => MuseParser m (F Inlines)
877mathTag = return . B.math . snd <$> htmlElement "math"
918mathTag = return . B.math . snd <$> htmlElement "math"
878
919
920+-- | Parse inline @\<literal>@ tag as a raw inline.
879inlineLiteralTag :: PandocMonad m => MuseParser m (F Inlines)
921inlineLiteralTag :: PandocMonad m => MuseParser m (F Inlines)
880inlineLiteralTag =
922inlineLiteralTag =
881 (return . rawInline) <$> htmlElement "literal"
923 (return . rawInline) <$> htmlElement "literal"
@@ -890,6 +932,7 @@ str = return . B.str <$> many1 alphaNum <* updateLastStrPos
890symbol :: PandocMonad m => MuseParser m (F Inlines)
932symbol :: PandocMonad m => MuseParser m (F Inlines)
891symbol = return . B.str <$> count 1 nonspaceChar
933symbol = return . B.str <$> count 1 nonspaceChar
892
934
935+-- | Parse a link or image.
893link :: PandocMonad m => MuseParser m (F Inlines)
936link :: PandocMonad m => MuseParser m (F Inlines)
894link = try $ do
937link = try $ do
895 st <- getState
938 st <- getState