git.iko.soy/typeable/pandoc
on master help sign in
Org reader: Support more types of '#+BEGIN_<type>' blocks

Support for standard org-blocks is improved. The parser now handles "HTML", "LATEX", "ASCII", "EXAMPLE", "QUOTE" and "VERSE" blocks in a sensible fashion.

commit6d6724cf2c6ae6bcc0df312c476e45644c972a85 authorAlbert Krewinkel <tarleb@moltkeplatz.de> dateThu 17 Apr 2014, 18:09 (13 years ago) parent0672f58
2 files changed+108−30
compare with master
unifiedsplit
src/Text/Pandoc/Readers/Org.hs+34−7 tests/Tests/Readers/Org.hs+74−23
src/Text/Pandoc/Readers/Org.hs+34−7
@@ -37,6 +37,7 @@ import Text.Pandoc.Options
3737import qualified Text.Pandoc.Parsing as P
3838import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF
3939 , newline, orderedListMarker
40+ , parseFromString
4041 , updateLastStrPos )
4142import Text.Pandoc.Shared (compactify')
4243
@@ -47,7 +48,7 @@ import Control.Monad (foldM, guard, liftM, liftM2, when)
4748import Control.Monad.Reader (Reader, runReader, ask, asks)
4849import Data.Char (toLower)
4950import Data.Default
50−import Data.List (isPrefixOf, isSuffixOf)
51+import Data.List (intersperse, isPrefixOf, isSuffixOf)
5152import Data.Maybe (listToMaybe, fromMaybe)
5253import Data.Monoid (Monoid, mconcat, mempty, mappend)
5354
@@ -156,6 +157,16 @@ addToNotesTable note = do
156157 oldnotes <- orgStateNotes' <$> getState
157158 updateState $ \s -> s{ orgStateNotes' = note:oldnotes }
158159
160+-- The version Text.Pandoc.Parsing cannot be used, as we need additional parts
161+-- of the state saved and restored.
162+parseFromString :: OrgParser a -> String -> OrgParser a
163+parseFromString parser str' = do
164+ oldLastPreCharPos <- orgStateLastPreCharPos <$> getState
165+ updateState $ \s -> s{ orgStateLastPreCharPos = Nothing }
166+ result <- P.parseFromString parser str'
167+ updateState $ \s -> s{ orgStateLastPreCharPos = oldLastPreCharPos }
168+ return result
169+
159170
160171--
161172-- Adaptions and specializations of parsing utilities
@@ -218,13 +229,27 @@ block = choice [ mempty <$ blanklines
218229orgBlock :: OrgParser (F Blocks)
219230orgBlock = try $ do
220231 (indent, blockType, args) <- blockHeader
221− blockStr <- rawBlockContent indent blockType
232+ content <- rawBlockContent indent blockType
233+ contentBlocks <- parseFromString parseBlocks (content ++ "\n")
222234 let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ]
223235 case blockType of
224236 "comment" -> return mempty
225− "src" -> return . return $ B.codeBlockWith ("", classArgs, []) blockStr
226− _ -> fmap (B.divWith ("", [blockType], []))
227− <$> parseFromString parseBlocks blockStr
237+ "src" -> returnF $ B.codeBlockWith ("", classArgs, []) content
238+ "html" -> returnF $ B.rawBlock "html" content
239+ "latex" -> returnF $ B.rawBlock "latex" content
240+ "ascii" -> returnF $ B.rawBlock "ascii" content
241+ "example" -> returnF $ exampleCode content
242+ "quote" -> return $ B.blockQuote <$> contentBlocks
243+ "verse" -> parseVerse content
244+ _ -> return $ B.divWith ("", [blockType], []) <$> contentBlocks
245+ where
246+ returnF :: a -> OrgParser (F a)
247+ returnF = return . return
248+
249+ parseVerse :: String -> OrgParser (F Blocks)
250+ parseVerse cs =
251+ fmap B.para . mconcat . intersperse (pure B.linebreak)
252+ <$> mapM (parseFromString parseInlines) (lines cs)
228253
229254blockHeader :: OrgParser (Int, String, [String])
230255blockHeader = (,,) <$> blockIndent
@@ -270,8 +295,10 @@ commaEscaped cs = cs
270295
271296example :: OrgParser (F Blocks)
272297example = try $ do
273− body <- unlines <$> many1 exampleLine
274− return . return $ B.codeBlockWith ("", ["example"], []) body
298+ return . return . exampleCode =<< unlines <$> many1 exampleLine
299+
300+exampleCode :: String -> Blocks
301+exampleCode = B.codeBlockWith ("", ["example"], [])
275302
276303exampleLine :: OrgParser String
277304exampleLine = try $ string ": " *> anyLine
tests/Tests/Readers/Org.hs+74−23
@@ -363,29 +363,6 @@ tests =
363363 , "#+END_COMMENT"] =?>
364364 (mempty::Blocks)
365365
366− , "Source Block in Text" =:
367− unlines [ "Low German greeting"
368− , " #+BEGIN_SRC haskell"
369− , " main = putStrLn greeting"
370− , " where greeting = \"moin\""
371− , " #+END_SRC" ] =?>
372− let attr' = ("", ["haskell"], [])
373− code' = "main = putStrLn greeting\n" ++
374− " where greeting = \"moin\"\n"
375− in mconcat [ para $ spcSep [ "Low", "German", "greeting" ]
376− , codeBlockWith attr' code'
377− ]
378−
379− , "Source Block" =:
380− unlines [ " #+BEGIN_SRC haskell"
381− , " main = putStrLn greeting"
382− , " where greeting = \"moin\""
383− , " #+END_SRC" ] =?>
384− let attr' = ("", ["haskell"], [])
385− code' = "main = putStrLn greeting\n" ++
386− " where greeting = \"moin\"\n"
387− in codeBlockWith attr' code'
388−
389366 , "Figure" =:
390367 unlines [ "#+caption: A very courageous man."
391368 , "#+name: goodguy"
@@ -661,4 +638,78 @@ tests =
661638 , [ plain "2" , plain mempty , plain mempty ]
662639 ]
663640 ]
641+
642+ , testGroup "Blocks"
643+ [ "Source block" =:
644+ unlines [ " #+BEGIN_SRC haskell"
645+ , " main = putStrLn greeting"
646+ , " where greeting = \"moin\""
647+ , " #+END_SRC" ] =?>
648+ let attr' = ("", ["haskell"], [])
649+ code' = "main = putStrLn greeting\n" ++
650+ " where greeting = \"moin\"\n"
651+ in codeBlockWith attr' code'
652+
653+ , "Source block between paragraphs" =:
654+ unlines [ "Low German greeting"
655+ , " #+BEGIN_SRC haskell"
656+ , " main = putStrLn greeting"
657+ , " where greeting = \"Moin!\""
658+ , " #+END_SRC" ] =?>
659+ let attr' = ("", ["haskell"], [])
660+ code' = "main = putStrLn greeting\n" ++
661+ " where greeting = \"Moin!\"\n"
662+ in mconcat [ para $ spcSep [ "Low", "German", "greeting" ]
663+ , codeBlockWith attr' code'
664+ ]
665+
666+ , "Example block" =:
667+ unlines [ "#+begin_example"
668+ , "A chosen representation of"
669+ , "a rule."
670+ , "#+eND_exAMPle"
671+ ] =?>
672+ codeBlockWith ("", ["example"], [])
673+ "A chosen representation of\na rule.\n"
674+
675+ , "HTML block" =:
676+ unlines [ "#+BEGIN_HTML"
677+ , "<aside>HTML5 is pretty nice.</aside>"
678+ , "#+END_HTML"
679+ ] =?>
680+ rawBlock "html" "<aside>HTML5 is pretty nice.</aside>\n"
681+
682+ , "Quote block" =:
683+ unlines [ "#+BEGIN_QUOTE"
684+ , "/Niemand/ hat die Absicht, eine Mauer zu errichten!"
685+ , "#+END_QUOTE"
686+ ] =?>
687+ blockQuote (para (spcSep [ emph "Niemand", "hat", "die", "Absicht,"
688+ , "eine", "Mauer", "zu", "errichten!"
689+ ]))
690+
691+ , "Verse block" =:
692+ unlines [ "The first lines of Goethe's /Faust/:"
693+ , "#+begin_verse"
694+ , "Habe nun, ach! Philosophie,"
695+ , "Juristerei und Medizin,"
696+ , "Und leider auch Theologie!"
697+ , "Durchaus studiert, mit heißem Bemühn."
698+ , "#+end_verse"
699+ ] =?>
700+ mconcat
701+ [ para $ spcSep [ "The", "first", "lines", "of"
702+ , "Goethe's", emph "Faust" <> ":"]
703+ , para $ mconcat
704+ [ spcSep [ "Habe", "nun,", "ach!", "Philosophie," ]
705+ , linebreak
706+ , spcSep [ "Juristerei", "und", "Medizin," ]
707+ , linebreak
708+ , spcSep [ "Und", "leider", "auch", "Theologie!" ]
709+ , linebreak
710+ , spcSep [ "Durchaus", "studiert,", "mit", "heißem", "Bemühn." ]
711+ ]
712+ ]
713+
714+ ]
664715 ]