8726eeb · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Org reader: Add support for custom link types

8726eebAlbert Krewinkel13 years ago

src/Text/Pandoc/Readers/Org.hs+60−8

compare with master

unifiedsplit

@@ -43,7 +43,7 @@ import Text.Pandoc.Shared (compactify', compactify'DL)

44import Control.Applicative ( Applicative, pure

45 , (<$>), (<$), (<*>), (<*), (*>), (<**>) )

46−import Control.Monad (foldM, guard, liftM, liftM2, when)

46+import Control.Monad (foldM, guard, liftM, liftM2, mzero, when)

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

48import Data.Char (isAlphaNum, toLower)

49import Data.Default

@@ -51,6 +51,7 @@ import Data.List (intersperse, isPrefixOf, isSuffixOf)

51import qualified Data.Map as M

52import Data.Maybe (listToMaybe, fromMaybe, isJust)

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

54+import Network.HTTP (urlEncode)

55-- | Parse org-mode string and return a Pandoc document.

56-- | Parse org-mode string and return a Pandoc document.

56readOrg :: ReaderOptions -- ^ Reader options

57readOrg :: ReaderOptions -- ^ Reader options

@@ -76,6 +77,8 @@ type OrgNoteTable = [OrgNoteRecord]

77type OrgBlockAttributes = M.Map String String

78type OrgBlockAttributes = M.Map String String

80+type OrgLinkFormatters = M.Map String (String -> String)

81+

79-- | Org-mode parser state

82-- | Org-mode parser state

80data OrgParserState = OrgParserState

83data OrgParserState = OrgParserState

81 { orgStateOptions :: ReaderOptions

84 { orgStateOptions :: ReaderOptions

@@ -86,6 +89,7 @@ data OrgParserState = OrgParserState

86 , orgStateLastForbiddenCharPos :: Maybe SourcePos

89 , orgStateLastForbiddenCharPos :: Maybe SourcePos

87 , orgStateLastPreCharPos :: Maybe SourcePos

90 , orgStateLastPreCharPos :: Maybe SourcePos

88 , orgStateLastStrPos :: Maybe SourcePos

91 , orgStateLastStrPos :: Maybe SourcePos

92+ , orgStateLinkFormatters :: OrgLinkFormatters

89 , orgStateMeta :: Meta

93 , orgStateMeta :: Meta

90 , orgStateMeta' :: F Meta

94 , orgStateMeta' :: F Meta

91 , orgStateNotes' :: OrgNoteTable

95 , orgStateNotes' :: OrgNoteTable

@@ -113,6 +117,7 @@ defaultOrgParserState = OrgParserState

113 , orgStateLastForbiddenCharPos = Nothing

117 , orgStateLastForbiddenCharPos = Nothing

114 , orgStateLastPreCharPos = Nothing

118 , orgStateLastPreCharPos = Nothing

115 , orgStateLastStrPos = Nothing

119 , orgStateLastStrPos = Nothing

120+ , orgStateLinkFormatters = M.empty

116 , orgStateMeta = nullMeta

121 , orgStateMeta = nullMeta

117 , orgStateMeta' = return nullMeta

122 , orgStateMeta' = return nullMeta

118 , orgStateNotes' = []

123 , orgStateNotes' = []

@@ -175,6 +180,13 @@ resetEmphasisNewlines :: OrgParser ()

175resetEmphasisNewlines = updateState $ \s ->

180resetEmphasisNewlines = updateState $ \s ->

176 s{ orgStateEmphasisNewlines = Nothing }

181 s{ orgStateEmphasisNewlines = Nothing }

177

182

183+addLinkFormat :: String

184+ -> (String -> String)

185+ -> OrgParser ()

186+addLinkFormat key formatter = updateState $ \s ->

187+ let fs = orgStateLinkFormatters s

188+ in s{ orgStateLinkFormatters = M.insert key formatter fs }

189+

178addToNotesTable :: OrgNoteRecord -> OrgParser ()

190addToNotesTable :: OrgNoteRecord -> OrgParser ()

179addToNotesTable note = do

191addToNotesTable note = do

180 oldnotes <- orgStateNotes' <$> getState

192 oldnotes <- orgStateNotes' <$> getState

@@ -423,7 +435,8 @@ specialLine :: OrgParser (F Blocks)

423specialLine = fmap return . try $ metaLine <|> commentLine

435specialLine = fmap return . try $ metaLine <|> commentLine

424

436

425metaLine :: OrgParser Blocks

437metaLine :: OrgParser Blocks

438+metaLine = try $ mempty

426−metaLine = try $ metaLineStart *> declarationLine

439+ <$ (metaLineStart *> (optionLine <|> declarationLine))

427

440

428commentLine :: OrgParser Blocks

441commentLine :: OrgParser Blocks

429commentLine = try $ commentLineStart *> anyLine *> pure mempty

442commentLine = try $ commentLineStart *> anyLine *> pure mempty

@@ -436,14 +449,14 @@ metaLineStart = try $ mappend <$> many spaceChar <*> string "#+"

436commentLineStart :: OrgParser String

449commentLineStart :: OrgParser String

437commentLineStart = try $ mappend <$> many spaceChar <*> string "# "

450commentLineStart = try $ mappend <$> many spaceChar <*> string "# "

438

451

439−declarationLine :: OrgParser Blocks

452+declarationLine :: OrgParser ()

440declarationLine = try $ do

453declarationLine = try $ do

441 key <- metaKey

454 key <- metaKey

442 inlinesF <- metaInlines

455 inlinesF <- metaInlines

443 updateState $ \st ->

456 updateState $ \st ->

444 let meta' = B.setMeta <$> pure key <*> inlinesF <*> pure nullMeta

457 let meta' = B.setMeta <$> pure key <*> inlinesF <*> pure nullMeta

445 in st { orgStateMeta' = orgStateMeta' st <> meta' }

458 in st { orgStateMeta' = orgStateMeta' st <> meta' }

446− return mempty

459+ return ()

447

460

448metaInlines :: OrgParser (F MetaValue)

461metaInlines :: OrgParser (F MetaValue)

449metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline

462metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline

@@ -453,6 +466,35 @@ metaKey = map toLower <$> many1 (noneOf ": \n\r")

453 <* char ':'

466 <* char ':'

454 <* skipSpaces

467 <* skipSpaces

455

468

469+optionLine :: OrgParser ()

470+optionLine = try $ do

471+ key <- metaKey

472+ case key of

473+ "link" -> parseLinkFormat >>= uncurry addLinkFormat

474+ _ -> mzero

475+

476+parseLinkFormat :: OrgParser ((String, String -> String))

477+parseLinkFormat = try $ do

478+ linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces

479+ linkSubst <- parseFormat

480+ return (linkType, linkSubst)

481+

482+-- | An ad-hoc, single-argument-only implementation of a printf-style format

483+-- parser.

484+parseFormat :: OrgParser (String -> String)

485+parseFormat = try $ do

486+ replacePlain <|> replaceUrl <|> justAppend

487+ where

488+ -- inefficient, but who cares

489+ replacePlain = try $ (\x -> concat . flip intersperse x)

490+ <$> sequence [tillSpecifier 's', rest]

491+ replaceUrl = try $ (\x -> concat . flip intersperse x . urlEncode)

492+ <$> sequence [tillSpecifier 'h', rest]

493+ justAppend = try $ (++) <$> rest

494+

495+ rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")

496+ tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))

497+

456--

498--

457-- Headers

499-- Headers

458--

500--

@@ -850,13 +892,15 @@ linkOrImage = explicitOrImageLink

850explicitOrImageLink :: OrgParser (F Inlines)

892explicitOrImageLink :: OrgParser (F Inlines)

851explicitOrImageLink = try $ do

893explicitOrImageLink = try $ do

852 char '['

894 char '['

853− src <- linkTarget

895+ srcF <- applyCustomLinkFormat =<< linkTarget

854 title <- enclosedRaw (char '[') (char ']')

896 title <- enclosedRaw (char '[') (char ']')

855 title' <- parseFromString (mconcat <$> many inline) title

897 title' <- parseFromString (mconcat <$> many inline) title

856 char ']'

898 char ']'

899+ return $ do

900+ src <- srcF

857− return $ if isImageFilename src && isImageFilename title

901+ if isImageFilename src && isImageFilename title

858− then pure $ B.link src "" $ B.image title mempty mempty

902+ then pure $ B.link src "" $ B.image title mempty mempty

859− else linkToInlinesF src =<< title'

903+ else linkToInlinesF src =<< title'

860

904

861selflinkOrImage :: OrgParser (F Inlines)

905selflinkOrImage :: OrgParser (F Inlines)

862selflinkOrImage = try $ do

906selflinkOrImage = try $ do

@@ -881,6 +925,14 @@ selfTarget = try $ char '[' *> linkTarget <* char ']'

881linkTarget :: OrgParser String

925linkTarget :: OrgParser String

882linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r[]")

926linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r[]")

883

927

928+applyCustomLinkFormat :: String -> OrgParser (F String)

929+applyCustomLinkFormat link = do

930+ let (linkType, rest) = break (== ':') link

931+ return $ do

932+ formatter <- M.lookup linkType <$> asksF orgStateLinkFormatters

933+ return $ maybe link ($ drop 1 rest) formatter

934+

935+

884linkToInlinesF :: String -> Inlines -> F Inlines

936linkToInlinesF :: String -> Inlines -> F Inlines

885linkToInlinesF s@('#':_) = pure . B.link s ""

937linkToInlinesF s@('#':_) = pure . B.link s ""

886linkToInlinesF s

938linkToInlinesF s

tests/Tests/Readers/Org.hs+26

@@ -304,6 +304,32 @@ tests =

304 ] =?>

305 (para (spanWith ("link-here", [], []) mempty <> "Target.") <>

306 para (emph ("See" <> space <> "here!")))

307+

308+ , "Link abbreviation" =:

309+ unlines [ "#+LINK: wp https://en.wikipedia.org/wiki/%s"

310+ , "[[wp:Org_mode][Wikipedia on Org-mode]]"

311+ ] =?>

312+ (para (link "https://en.wikipedia.org/wiki/Org_mode" ""

313+ ("Wikipedia" <> space <> "on" <> space <> "Org-mode")))

314+

315+ , "Link abbreviation, defined after first use" =:

316+ unlines [ "[[zl:non-sense][Non-sense articles]]"

317+ , "#+LINK: zl http://zeitlens.com/tags/%s.html"

318+ ] =?>

319+ (para (link "http://zeitlens.com/tags/non-sense.html" ""

320+ ("Non-sense" <> space <> "articles")))

321+

322+ , "Link abbreviation, URL encoded arguments" =:

323+ unlines [ "#+link: expl http://example.com/%h/foo"

324+ , "[[expl:Hello, World!][Moin!]]"

325+ ] =?>

326+ (para (link "http://example.com/Hello%2C%20World%21/foo" "" "Moin!"))

327+

328+ , "Link abbreviation, append arguments" =:

329+ unlines [ "#+link: expl http://example.com/"

330+ , "[[expl:foo][bar]]"

331+ ] =?>

332+ (para (link "http://example.com/foo" "" "bar"))

307 ]

333 ]

308

334

309 , testGroup "Basic Blocks" $

335 , testGroup "Basic Blocks" $