1a45250 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Org reader: unify keyword handling

1a45250Albert Krewinkel6 years ago

doc/org.md+4−4

compare with master

unifiedsplit

@@ -14,13 +14,13 @@ The following export keywords are supported:

15- AUTHOR: comma-separated list of author(s); fully supported.

17−- CREATOR: output generator; passed as metadata entry, but

17+- CREATOR: output generator; passed as plain-text metadata entry

18− ignored by most output formats.

18+ `creator`, but not used by any default templates.

20- DATE: creation or publication date; well supported by pandoc.

22−- EMAIL: author email address; passed as metadata entry, but not

22+- EMAIL: author email address; passed as plain-text metadata

23− included in most output formats.

23+ field `email`, but not used by any default templates.

25- LANGUAGE: currently unsupported; use `#+LANG:` instead.

src/Text/Pandoc/Readers/Org/Meta.hs+67−75

@@ -22,7 +22,7 @@ import Text.Pandoc.Readers.Org.Inlines

22import Text.Pandoc.Readers.Org.ParserState

23import Text.Pandoc.Readers.Org.Parsing

25−import Text.Pandoc.Builder (Blocks, Inlines, ToMetaValue)

25+import Text.Pandoc.Builder (Blocks, Inlines)

26import qualified Text.Pandoc.Builder as B

27import Text.Pandoc.Class.PandocMonad (PandocMonad)

28import Text.Pandoc.Definition

@@ -57,13 +57,13 @@ removeMeta key meta' =

57-- The order, in which blocks are tried, makes sure that we're not looking at

58-- the beginning of a block, so we don't need to check for it

59metaLine :: PandocMonad m => OrgParser m Blocks

60−metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)

60+metaLine = mempty <$ metaLineStart <* keywordLine

62−declarationLine :: PandocMonad m => OrgParser m ()

62+keywordLine :: PandocMonad m => OrgParser m ()

63−declarationLine = try $ do

63+keywordLine = try $ do

64 key <- T.toLower <$> metaKey

65− case Map.lookup key exportSettingHandlers of

65+ case Map.lookup key keywordHandlers of

66− Nothing -> () <$ anyLine

66+ Nothing -> () <$ anyLine -- discard unknown lines

67 Just hd -> hd

69metaKey :: Monad m => OrgParser m Text

@@ -71,33 +71,55 @@ metaKey = T.toLower <$> many1Char (noneOf ": \n\r")

71 <* char ':'

72 <* skipSpaces

74+infix 0 ~~>

75+(~~>) :: a -> b -> (a, b)

76+a ~~> b = (a, b)

77+

74−exportSettingHandlers :: PandocMonad m => Map Text (OrgParser m ())

78+keywordHandlers :: PandocMonad m => Map Text (OrgParser m ())

75−exportSettingHandlers = Map.fromList

79+keywordHandlers = Map.fromList

80+ [ "author" ~~> lineOfInlines `parseThen` collectLines "author"

76− [ ("result" , fmap pure anyLine `parseThen` discard)

81+ , "creator" ~~> fmap pure anyLine `parseThen` B.setMeta "creator"

77− -- Common settings

82+ , "date" ~~> lineOfInlines `parseThen` B.setMeta "date"

78− , ("author" , lineOfInlines `parseThen` collectLines "author")

83+ , "description" ~~> lineOfInlines `parseThen` collectLines "description"

79− , ("date" , lineOfInlines `parseThen` setField "date")

84+ , "email" ~~> fmap pure anyLine `parseThen` B.setMeta "email"

85+ , "exclude_tags" ~~> tagList >>= updateState . setExcludedTags

86+ , "header-includes" ~~>

80− , ("description", lineOfInlines `parseThen` collectLines "description")

87+ lineOfInlines `parseThen` collectLines "header-includes"

81− , ("keywords" , lineOfInlines `parseThen` collectLines "keywords")

88+ -- HTML-specifix export settings

89+ , "html_head" ~~>

90+ metaExportSnippet "html" `parseThen` collectAsList "header-includes"

91+ , "html_head_extra" ~~>

92+ metaExportSnippet "html" `parseThen` collectAsList "header-includes"

82− , ("subtitle" , lineOfInlines `parseThen` collectLines "subtitle")

93+ , "institute" ~~> lineOfInlines `parseThen` collectLines "institute"

94+ -- topic keywords

83− , ("title" , lineOfInlines `parseThen` collectLines "title")

95+ , "keywords" ~~> lineOfInlines `parseThen` collectLines "keywords"

84− -- LaTeX

96+ -- LaTeX-specific export settings

85− , ("latex_class" , fmap pure anyLine `parseThen` setField "documentclass")

97+ , "latex_class" ~~> fmap pure anyLine `parseThen` B.setMeta "documentclass"

98+ , "latex_class_options" ~~>

86− , ("latex_class_options", (pure . T.filter (`notElem` ("[]" :: String)) <$> anyLine)

99+ (pure . T.filter (`notElem` ("[]" :: String)) <$> anyLine)

87− `parseThen` setField "classoption")

100+ `parseThen` B.setMeta "classoption"

88− , ("latex_header" , metaExportSnippet "latex" `parseThen`

101+ , "latex_header" ~~>

89− collectAsList "header-includes")

102+ metaExportSnippet "latex" `parseThen` collectAsList "header-includes"

90− , ("latex_header_extra", metaExportSnippet "latex" `parseThen`

103+ , "latex_header_extra" ~~>

91− collectAsList "header-includes")

104+ metaExportSnippet "latex" `parseThen` collectAsList "header-includes"

92− -- HTML

105+ -- link and macro

93− , ("html_head" , metaExportSnippet "html" `parseThen`

106+ , "link" ~~> addLinkFormatter

94− collectAsList "header-includes")

107+ , "macro" ~~> macroDefinition >>= updateState . registerMacro

95− , ("html_head_extra", metaExportSnippet "html" `parseThen`

108+ -- pandoc-specific way to include references in the bibliography

96− collectAsList "header-includes")

109+ , "nocite" ~~> lineOfInlines `parseThen` collectLines "nocite"

110+ -- compact way to set export settings

111+ , "options" ~~> exportSettings

97− -- pandoc-specific

112+ -- pandoc-specific way to configure emphasis recognition

98− , ("nocite" , lineOfInlines `parseThen` collectLines "nocite")

113+ , "pandoc-emphasis-post" ~~> emphChars >>= updateState . setEmphasisPostChar

114+ , "pandoc-emphasis-pre" ~~> emphChars >>= updateState . setEmphasisPreChar

115+ -- result markers (ignored)

116+ , "result" ~~> void anyLine

117+ , "select_tags" ~~> tagList >>= updateState . setSelectedTags

118+ , "seq_todo" ~~> todoSequence >>= updateState . registerTodoSequence

99− , ("header-includes", lineOfInlines `parseThen` collectLines "header-includes")

119+ , "subtitle" ~~> lineOfInlines `parseThen` collectLines "subtitle"

100− , ("institute" , lineOfInlines `parseThen` collectLines "institute")

120+ , "title" ~~> lineOfInlines `parseThen` collectLines "title"

121+ , "todo" ~~> todoSequence >>= updateState . registerTodoSequence

122+ , "typ_todo" ~~> todoSequence >>= updateState . registerTodoSequence

101 ]

123 ]

102

124

103parseThen :: PandocMonad m

125parseThen :: PandocMonad m

@@ -109,9 +131,6 @@ parseThen p modMeta = do

109 meta <- orgStateMeta <$> getState

131 meta <- orgStateMeta <$> getState

110 updateState (\st -> st { orgStateMeta = modMeta <$> value <*> meta })

132 updateState (\st -> st { orgStateMeta = modMeta <$> value <*> meta })

111

133

112−discard :: a -> Meta -> Meta

113−discard = const id

114−

115collectLines :: Text -> Inlines -> Meta -> Meta

134collectLines :: Text -> Inlines -> Meta -> Meta

116collectLines key value meta =

135collectLines key value meta =

117 let value' = appendValue meta (B.toList value)

136 let value' = appendValue meta (B.toList value)

@@ -146,51 +165,25 @@ collectAsList key value meta =

146 Just x -> [x]

165 Just x -> [x]

147 _ -> []

166 _ -> []

148

167

149−setField :: ToMetaValue a => Text -> a -> Meta -> Meta

150−setField field value meta = B.setMeta field (B.toMetaValue value) meta

151−

152-- | Read an format specific meta definition

168-- | Read an format specific meta definition

153metaExportSnippet :: Monad m => Text -> OrgParser m (F Inlines)

169metaExportSnippet :: Monad m => Text -> OrgParser m (F Inlines)

154metaExportSnippet format = pure . B.rawInline format <$> anyLine

170metaExportSnippet format = pure . B.rawInline format <$> anyLine

155

171

156−--

172+-- | Parse a link type definition (like @wp https://en.wikipedia.org/wiki/@).

157−-- export options

158−--

159−optionLine :: PandocMonad m => OrgParser m ()

160−optionLine = try $ do

161− key <- metaKey

162− case key of

163− "link" -> parseLinkFormat >>= uncurry addLinkFormat

164− "options" -> exportSettings

165− "todo" -> todoSequence >>= updateState . registerTodoSequence

166− "seq_todo" -> todoSequence >>= updateState . registerTodoSequence

167− "typ_todo" -> todoSequence >>= updateState . registerTodoSequence

168− "macro" -> macroDefinition >>= updateState . registerMacro

169− "exclude_tags" -> tagList >>= updateState . setExcludedTags

170− "select_tags" -> tagList >>= updateState . setSelectedTags

171− "pandoc-emphasis-pre" -> emphChars >>= updateState . setEmphasisPreChar

172− "pandoc-emphasis-post" -> emphChars >>= updateState . setEmphasisPostChar

173− _ -> mzero

174−

175−addLinkFormat :: Monad m => Text

176− -> (Text -> Text)

177− -> OrgParser m ()

178−addLinkFormat key formatter = updateState $ \s ->

179− let fs = orgStateLinkFormatters s

180− in s{ orgStateLinkFormatters = Map.insert key formatter fs }

181−

182−parseLinkFormat :: Monad m => OrgParser m (Text, Text -> Text)

173+addLinkFormatter :: Monad m => OrgParser m ()

183−parseLinkFormat = try $ do

174+addLinkFormatter = try $ do

184 linkType <- T.cons <$> letter <*> manyChar (alphaNum <|> oneOf "-_") <* skipSpaces

175 linkType <- T.cons <$> letter <*> manyChar (alphaNum <|> oneOf "-_") <* skipSpaces

185− linkSubst <- parseFormat

176+ formatter <- parseFormat

186− return (linkType, linkSubst)

177+ updateState $ \s ->

178+ let fs = orgStateLinkFormatters s

179+ in s{ orgStateLinkFormatters = Map.insert linkType formatter fs }

187

180

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

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

189-- parser.

182-- parser.

190parseFormat :: Monad m => OrgParser m (Text -> Text)

183parseFormat :: Monad m => OrgParser m (Text -> Text)

191parseFormat = try $ replacePlain <|> replaceUrl <|> justAppend

184parseFormat = try $ replacePlain <|> replaceUrl <|> justAppend

192 where

185 where

193− -- inefficient, but who cares

186+ -- inefficient

194 replacePlain = try $ (\x -> T.concat . flip intersperse x)

187 replacePlain = try $ (\x -> T.concat . flip intersperse x)

195 <$> sequence [tillSpecifier 's', rest]

188 <$> sequence [tillSpecifier 's', rest]

196 replaceUrl = try $ (\x -> T.concat . flip intersperse x . T.pack . urlEncode . T.unpack)

189 replaceUrl = try $ (\x -> T.concat . flip intersperse x . T.pack . urlEncode . T.unpack)

@@ -229,6 +222,7 @@ setEmphasisPostChar csMb st =

229 let postChars = fromMaybe (orgStateEmphasisPostChars defaultOrgParserState) csMb

222 let postChars = fromMaybe (orgStateEmphasisPostChars defaultOrgParserState) csMb

230 in st { orgStateEmphasisPostChars = postChars }

223 in st { orgStateEmphasisPostChars = postChars }

231

224

225+-- | Parses emphasis border character like @".,?!"@

232emphChars :: Monad m => OrgParser m (Maybe [Char])

226emphChars :: Monad m => OrgParser m (Maybe [Char])

233emphChars = do

227emphChars = do

234 skipSpaces

228 skipSpaces

@@ -239,16 +233,14 @@ lineOfInlines = do

239 updateLastPreCharPos

233 updateLastPreCharPos

240 trimInlinesF . mconcat <$> manyTill inline newline

234 trimInlinesF . mconcat <$> manyTill inline newline

241

235

242−--

236+-- | Parses ToDo sequences / keywords like @TODO DOING | DONE@.

243−-- ToDo Sequences and Keywords

244−--

245todoSequence :: Monad m => OrgParser m TodoSequence

237todoSequence :: Monad m => OrgParser m TodoSequence

246todoSequence = try $ do

238todoSequence = try $ do

247 todoKws <- todoKeywords

239 todoKws <- todoKeywords

248 doneKws <- optionMaybe $ todoDoneSep *> todoKeywords

240 doneKws <- optionMaybe $ todoDoneSep *> todoKeywords

249 newline

241 newline

250− -- There must be at least one DONE keyword. The last TODO keyword is taken if

242+ -- There must be at least one DONE keyword. The last TODO keyword is

251− -- necessary.

243+ -- taken if necessary.

252 case doneKws of

244 case doneKws of

253 Just done -> return $ keywordsToSequence todoKws done

245 Just done -> return $ keywordsToSequence todoKws done

254 Nothing -> case reverse todoKws of

246 Nothing -> case reverse todoKws of

test/Tests/Readers/Org/Meta.hs+56−48

@@ -113,21 +113,21 @@ tests =

113 Pandoc (setMeta "institute" ("ACME Inc." :: Inlines) nullMeta) mempty

114

115 , testGroup "LaTeX"

116− [ "LaTeX_headers options are translated to header-includes" =:

116+ [ "LATEX_HEADER" =:

117 "#+LaTeX_header: \\usepackage{tikz}" =?>

118 let latexInlines = rawInline "latex" "\\usepackage{tikz}"

119 inclList = MetaList [MetaInlines (toList latexInlines)]

120 meta = setMeta "header-includes" inclList nullMeta

121 in Pandoc meta mempty

122

123− , "LATEX_HEADER_EXTRA values are translated to header-includes" =:

123+ , "LATEX_HEADER_EXTRA" =:

124 "#+LATEX_HEADER_EXTRA: \\usepackage{calc}" =?>

125 let latexInlines = rawInline "latex" "\\usepackage{calc}"

126 inclList = toMetaValue [latexInlines]

127 in Pandoc (setMeta "header-includes" inclList nullMeta) mempty

128

129 , testGroup "LaTeX_CLASS"

130− [ "LaTeX_class option is translated to documentclass" =:

130+ [ "stored as documentclass" =:

131 "#+LATEX_CLASS: article" =?>

132 let meta = setMeta "documentclass" (MetaString "article") nullMeta

133 in Pandoc meta mempty

@@ -140,7 +140,7 @@ tests =

140 in Pandoc meta mempty

141 ]

142

143− , "LaTeX_class_options is translated to classoption" =:

143+ , "LATEX_CLASS_OPTIONS as classoption" =:

144 "#+LATEX_CLASS_OPTIONS: [a4paper]" =?>

145 let meta = setMeta "classoption" (MetaString "a4paper") nullMeta

146 in Pandoc meta mempty

@@ -166,6 +166,58 @@ tests =

166 ]

167 ]

168

169+ , testGroup "Non-export keywords"

170+ [ testGroup "#+LINK"

171+ [ "Link abbreviation" =:

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

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

174+ ] =?>

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

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

177+

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

179+ T.unlines [ "[[zl:non-sense][Non-sense articles]]"

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

181+ ] =?>

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

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

184+

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

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

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

188+ ] =?>

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

190+

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

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

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

194+ ] =?>

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

196+ ]

197+

198+ , testGroup "emphasis config"

199+ [ "Changing pre and post chars for emphasis" =:

200+ T.unlines [ "#+pandoc-emphasis-pre: \"[)\""

201+ , "#+pandoc-emphasis-post: \"]\\n\""

202+ , "([/emph/])*foo*"

203+ ] =?>

204+ para ("([" <> emph "emph" <> "])" <> strong "foo")

205+

206+ , "setting an invalid value restores the default" =:

207+ T.unlines [ "#+pandoc-emphasis-pre: \"[\""

208+ , "#+pandoc-emphasis-post: \"]\""

209+ , "#+pandoc-emphasis-pre:"

210+ , "#+pandoc-emphasis-post:"

211+ , "[/noemph/]"

212+ ] =?>

213+ para "[/noemph/]"

214+ ]

215+

216+ , "Unknown keyword" =:

217+ "#+UNKNOWN_KEYWORD: Chumbawamba" =?>

218+ Pandoc nullMeta mempty

219+ ]

220+

169 , "Properties drawer" =:

221 , "Properties drawer" =:

170 T.unlines [ " :PROPERTIES:"

222 T.unlines [ " :PROPERTIES:"

171 , " :setting: foo"

223 , " :setting: foo"

@@ -220,48 +272,4 @@ tests =

220 ] =?>

272 ] =?>

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

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

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

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

223−

224− , "Link abbreviation" =:

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

226− , "[[wp:Org_mode][Wikipedia on Org-mode]]"

227− ] =?>

228− para (link "https://en.wikipedia.org/wiki/Org_mode" ""

229− ("Wikipedia" <> space <> "on" <> space <> "Org-mode"))

230−

231− , "Link abbreviation, defined after first use" =:

232− T.unlines [ "[[zl:non-sense][Non-sense articles]]"

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

234− ] =?>

235− para (link "http://zeitlens.com/tags/non-sense.html" ""

236− ("Non-sense" <> space <> "articles"))

237−

238− , "Link abbreviation, URL encoded arguments" =:

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

240− , "[[expl:Hello, World!][Moin!]]"

241− ] =?>

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

243−

244− , "Link abbreviation, append arguments" =:

245− T.unlines [ "#+link: expl http://example.com/"

246− , "[[expl:foo][bar]]"

247− ] =?>

248− para (link "http://example.com/foo" "" "bar")

249−

250− , testGroup "emphasis config"

251− [ "Changing pre and post chars for emphasis" =:

252− T.unlines [ "#+pandoc-emphasis-pre: \"[)\""

253− , "#+pandoc-emphasis-post: \"]\\n\""

254− , "([/emph/])*foo*"

255− ] =?>

256− para ("([" <> emph "emph" <> "])" <> strong "foo")

257−

258− , "setting an invalid value restores the default" =:

259− T.unlines [ "#+pandoc-emphasis-pre: \"[\""

260− , "#+pandoc-emphasis-post: \"]\""

261− , "#+pandoc-emphasis-pre:"

262− , "#+pandoc-emphasis-post:"

263− , "[/noemph/]"

264− ] =?>

265− para "[/noemph/]"

266− ]

267 ]

275 ]