68d388f · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Org reader: add :PROPERTIES: drawer support

68d388fAlbert Krewinkel10 years ago

src/Text/Pandoc/Readers/Org.hs+56−28

compare with master

unifiedsplit

@@ -284,7 +284,7 @@ block = choice [ mempty <$ blanklines

284 , orgBlock

285 , figure

286 , example

287− , drawer

287+ , genericDrawer

288 , specialLine

289 , header

290 , return <$> hline

@@ -582,26 +582,55 @@ exampleCode = B.codeBlockWith ("", ["example"], [])

582exampleLine :: OrgParser String

583exampleLine = try $ skipSpaces *> string ": " *> anyLine

584

585−-- Drawers for properties or a logbook

585+

586+--

587+-- Drawers

588+--

589+

590+-- | A generic drawer which has no special meaning for org-mode.

586−drawer :: OrgParser (F Blocks)

591+genericDrawer :: OrgParser (F Blocks)

587−drawer = try $ do

592+genericDrawer = try $ do

588 drawerStart

593 drawerStart

589 manyTill drawerLine (try drawerEnd)

594 manyTill drawerLine (try drawerEnd)

590 return mempty

595 return mempty

591

596

592drawerStart :: OrgParser String

597drawerStart :: OrgParser String

593drawerStart = try $

598drawerStart = try $

594− skipSpaces *> drawerName <* skipSpaces <* P.newline

599+ skipSpaces *> drawerName <* skipSpaces <* newline

595− where drawerName = try $ char ':' *> validDrawerName <* char ':'

600+ where drawerName = char ':' *> manyTill nonspaceChar (char ':')

596− validDrawerName = stringAnyCase "PROPERTIES"

597− <|> stringAnyCase "LOGBOOK"

598

601

599drawerLine :: OrgParser String

602drawerLine :: OrgParser String

600−drawerLine = try anyLine

603+drawerLine = anyLine

601

604

602drawerEnd :: OrgParser String

605drawerEnd :: OrgParser String

603drawerEnd = try $

606drawerEnd = try $

604− skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* P.newline

607+ skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* newline

608+

609+-- | Read a :PROPERTIES: drawer and return the key/value pairs contained

610+-- within.

611+propertiesDrawer :: OrgParser [(String, String)]

612+propertiesDrawer = try $ do

613+ drawerType <- drawerStart

614+ guard $ map toUpper drawerType == "PROPERTIES"

615+ manyTill property (try drawerEnd)

616+ where

617+ property :: OrgParser (String, String)

618+ property = try $ (,) <$> key <*> value

619+

620+ key :: OrgParser String

621+ key = try $ skipSpaces *> char ':' *> many1Till nonspaceChar (char ':')

622+

623+ value :: OrgParser String

624+ value = try $ skipSpaces *> manyTill anyChar (try $ skipSpaces *> P.newline)

625+

626+keyValuesToAttr :: [(String, String)] -> Attr

627+keyValuesToAttr kvs =

628+ let

629+ id' = fromMaybe mempty . lookup "id" $ kvs

630+ cls = fromMaybe mempty . lookup "class" $ kvs

631+ kvs' = filter (flip notElem ["id", "class"] . fst) kvs

632+ in

633+ (id', words cls, kvs')

605

634

606

635

607--

636--

@@ -700,29 +729,28 @@ parseFormat = try $ do

700-- | Headers

729-- | Headers

701header :: OrgParser (F Blocks)

730header :: OrgParser (F Blocks)

702header = try $ do

731header = try $ do

703− level <- headerStart

732+ level <- headerStart

704− title <- manyTill inline (lookAhead headerEnd)

733+ title <- manyTill inline (lookAhead $ optional headerTags <* P.newline)

705− tags <- headerEnd

734+ tags <- option [] headerTags

706− let inlns = trimInlinesF . mconcat $ title <> map tagToInlineF tags

735+ newline

707− st <- getState

736+ propAttr <- option nullAttr (keyValuesToAttr <$> propertiesDrawer)

708− let inlines = runF inlns st

737+ inlines <- runF (tagTitle title tags) <$> getState

709− attr <- registerHeader nullAttr inlines

738+ attr <- registerHeader propAttr inlines

710 return $ pure (B.headerWith attr level inlines)

739 return $ pure (B.headerWith attr level inlines)

711 where

740 where

741+ tagTitle :: [F Inlines] -> [String] -> F Inlines

742+ tagTitle title tags = trimInlinesF . mconcat $ title <> map tagToInlineF tags

743+

712 tagToInlineF :: String -> F Inlines

744 tagToInlineF :: String -> F Inlines

713 tagToInlineF t = return $ B.spanWith ("", ["tag"], [("data-tag-name", t)]) mempty

745 tagToInlineF t = return $ B.spanWith ("", ["tag"], [("data-tag-name", t)]) mempty

714

746

715−headerEnd :: OrgParser [String]

716−headerEnd = option [] headerTags <* newline

717−

718−headerTags :: OrgParser [String]

747+ headerTags :: OrgParser [String]

719−headerTags = try $

748+ headerTags = try $

720− skipSpaces

721− *> char ':'

722− *> many1 tag

723− <* skipSpaces

724− where tag = many1 (alphaNum <|> oneOf "@%#_")

749+ let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':'

725− <* char ':'

750+ in skipSpaces

751+ *> char ':'

752+ *> many1 tag

753+ <* skipSpaces

726

754

727headerStart :: OrgParser Int

755headerStart :: OrgParser Int

728headerStart = try $

756headerStart = try $

tests/Tests/Readers/Org.hs+14−5

@@ -412,17 +412,17 @@ tests =

412 ] =?>

413 para "Before" <> para "After"

414

415− , "Drawer start is the only text in first line of a drawer" =:

415+ , "Drawer markers must be the only text in the line" =:

416 unlines [ " :LOGBOOK: foo"

417− , " :END:"

417+ , " :END: bar"

418 ] =?>

419− para (":LOGBOOK:" <> space <> "foo" <> softbreak <> ":END:")

419+ para (":LOGBOOK: foo" <> softbreak <> ":END: bar")

420

421− , "Drawers with unknown names are just text" =:

421+ , "Drawers can be arbitrary" =:

422 unlines [ ":FOO:"

423 , ":END:"

424 ] =?>

425− para (":FOO:" <> softbreak <> ":END:")

425+ (mempty::Blocks)

426

427 , "Anchor reference" =:

428 unlines [ "<<link-here>> Target."

@@ -597,6 +597,15 @@ tests =

597 , headerWith ("but-this-is", [], []) 2 "But this is"

598 ]

599

600+ , "Preferences are treated as header attributes" =:

601+ unlines [ "* foo"

602+ , " :PROPERTIES:"

603+ , " :id: fubar"

604+ , " :bar: baz"

605+ , " :END:"

606+ ] =?>

607+ headerWith ("fubar", [], [("bar", "baz")]) 1 "foo"

608+

600 , "Paragraph starting with an asterisk" =:

609 , "Paragraph starting with an asterisk" =:

601 "*five" =?>

610 "*five" =?>

602 para "*five"

611 para "*five"