6d6724c · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Org reader: Support more types of '#+BEGIN_<type>' blocks

6d6724cAlbert Krewinkel13 years ago

src/Text/Pandoc/Readers/Org.hs+34−7

compare with master

unifiedsplit

@@ -37,6 +37,7 @@ import Text.Pandoc.Options

37import qualified Text.Pandoc.Parsing as P

38import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF

39 , newline, orderedListMarker

40+ , parseFromString

40 , updateLastStrPos )

41 , updateLastStrPos )

41import Text.Pandoc.Shared (compactify')

42import Text.Pandoc.Shared (compactify')

@@ -47,7 +48,7 @@ import Control.Monad (foldM, guard, liftM, liftM2, when)

47import Control.Monad.Reader (Reader, runReader, ask, asks)

48import Control.Monad.Reader (Reader, runReader, ask, asks)

48import Data.Char (toLower)

49import Data.Char (toLower)

49import Data.Default

50import Data.Default

50−import Data.List (isPrefixOf, isSuffixOf)

51+import Data.List (intersperse, isPrefixOf, isSuffixOf)

51import Data.Maybe (listToMaybe, fromMaybe)

52import Data.Maybe (listToMaybe, fromMaybe)

52import Data.Monoid (Monoid, mconcat, mempty, mappend)

53import Data.Monoid (Monoid, mconcat, mempty, mappend)

@@ -156,6 +157,16 @@ addToNotesTable note = do

156 oldnotes <- orgStateNotes' <$> getState

157 oldnotes <- orgStateNotes' <$> getState

157 updateState $ \s -> s{ orgStateNotes' = note:oldnotes }

158 updateState $ \s -> s{ orgStateNotes' = note:oldnotes }

158

159

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+

159

170

160--

171--

161-- Adaptions and specializations of parsing utilities

172-- Adaptions and specializations of parsing utilities

@@ -218,13 +229,27 @@ block = choice [ mempty <$ blanklines

218orgBlock :: OrgParser (F Blocks)

229orgBlock :: OrgParser (F Blocks)

219orgBlock = try $ do

230orgBlock = try $ do

220 (indent, blockType, args) <- blockHeader

231 (indent, blockType, args) <- blockHeader

221− blockStr <- rawBlockContent indent blockType

232+ content <- rawBlockContent indent blockType

233+ contentBlocks <- parseFromString parseBlocks (content ++ "\n")

222 let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ]

234 let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ]

223 case blockType of

235 case blockType of

224 "comment" -> return mempty

236 "comment" -> return mempty

225− "src" -> return . return $ B.codeBlockWith ("", classArgs, []) 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

226− _ -> fmap (B.divWith ("", [blockType], []))

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)

227− <$> parseFromString parseBlocks blockStr

252+ <$> mapM (parseFromString parseInlines) (lines cs)

228

253

229blockHeader :: OrgParser (Int, String, [String])

254blockHeader :: OrgParser (Int, String, [String])

230blockHeader = (,,) <$> blockIndent

255blockHeader = (,,) <$> blockIndent

@@ -270,8 +295,10 @@ commaEscaped cs = cs

270

295

271example :: OrgParser (F Blocks)

296example :: OrgParser (F Blocks)

272example = try $ do

297example = try $ do

273− body <- unlines <$> many1 exampleLine

298+ return . return . exampleCode =<< unlines <$> many1 exampleLine

299+

300+exampleCode :: String -> Blocks

274− return . return $ B.codeBlockWith ("", ["example"], []) body

301+exampleCode = B.codeBlockWith ("", ["example"], [])

275

302

276exampleLine :: OrgParser String

303exampleLine :: OrgParser String

277exampleLine = try $ string ": " *> anyLine

304exampleLine = try $ string ": " *> anyLine

tests/Tests/Readers/Org.hs+74−23

@@ -363,29 +363,6 @@ tests =

363 , "#+END_COMMENT"] =?>

364 (mempty::Blocks)

365

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−

389 , "Figure" =:

366 , "Figure" =:

390 unlines [ "#+caption: A very courageous man."

367 unlines [ "#+caption: A very courageous man."

391 , "#+name: goodguy"

368 , "#+name: goodguy"

@@ -661,4 +638,78 @@ tests =

661 , [ plain "2" , plain mempty , plain mempty ]

638 , [ plain "2" , plain mempty , plain mempty ]

662 ]

639 ]

663 ]

640 ]

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+ ]

664 ]

715 ]