git.iko.soy/typeable/pandoc
on master help sign in
links, specialchars
a00323cYan Pas
src/Text/Pandoc/Readers/Man.hs+65−39
compare with master
unifiedsplit
@@ -67,7 +67,7 @@ data MacroKind = KTitle
67
67
68data ManToken = MStr String FontKind
68data ManToken = MStr String FontKind
69 | MLine [(String, FontKind)]
69 | MLine [(String, FontKind)]
70− | MLink String Target
70+ | MMaybeLink String
71 | MEmptyLine
71 | MEmptyLine
72 | MHeader Int String
72 | MHeader Int String
73 | MMacro MacroKind [String]
73 | MMacro MacroKind [String]
@@ -166,40 +166,26 @@ lexMacro = do
166 macroName <- many1 (letter <|> oneOf ['\\', '"'])
166 macroName <- many1 (letter <|> oneOf ['\\', '"'])
167 args <- lexArgs
167 args <- lexArgs
168 let joinedArgs = concat $ intersperse " " args
168 let joinedArgs = concat $ intersperse " " args
169+ let knownMacro mkind = MMacro mkind args
169
170
170 let tok = case macroName of
171 let tok = case macroName of
171 x | x `elem` ["\\\"", "\\#"] -> MComment joinedArgs
172 x | x `elem` ["\\\"", "\\#"] -> MComment joinedArgs
172− "TH" -> MMacro KTitle args
173+ "TH" -> knownMacro KTitle
173− "TP" -> MMacro KTab []
174+ "TP" -> knownMacro KTab
174− "PP" -> MMacro KTabEnd []
175+ "RE" -> knownMacro KTabEnd
175− "nf" -> MMacro KCodeBlStart []
176+ "nf" -> knownMacro KCodeBlStart
176− "fi" -> MMacro KCodeBlEnd []
177+ "fi" -> knownMacro KCodeBlEnd
177− x | x `elem` ["B", "BR"] -> MStr joinedArgs Bold -- "BR" is often used as a link to another man
178+ "B" -> MStr joinedArgs Bold
179+ "BR" -> MMaybeLink joinedArgs
178 x | x `elem` ["BI", "IB"] -> MStr joinedArgs ItalicBold
180 x | x `elem` ["BI", "IB"] -> MStr joinedArgs ItalicBold
179 x | x `elem` ["I", "IR", "RI"] -> MStr joinedArgs Italic
181 x | x `elem` ["I", "IR", "RI"] -> MStr joinedArgs Italic
180 "SH" -> MHeader 2 joinedArgs
182 "SH" -> MHeader 2 joinedArgs
181− "sp" -> MEmptyLine
183+ x | x `elem` [ "P", "PP", "LP", "sp"] -> MEmptyLine
182 _ -> MUnknownMacro macroName args
184 _ -> MUnknownMacro macroName args
183 return tok
185 return tok
184
186
185 where
187 where
186
188
187− linkToMan :: String -> Maybe Block
188− linkToMan txt = case runParser linkParser () "" txt of
189− Right lnk -> Just $ Plain [lnk]
190− Left _ -> Nothing
191− where
192− linkParser :: Parsec String () Inline
193− linkParser = do
194− mpage <- many1 alphaNum
195− space
196− char '('
197− mansect <- digit
198− char ')'
199− -- assuming man pages are generated from Linux-like repository
200− let manurl pagename section = "../"++section++"/"++pagename++"."++section
201− return $ Link nullAttr [Str txt] (manurl mpage [mansect], mpage)
202−
203 lexArgs :: PandocMonad m => ManLexer m [String]
189 lexArgs :: PandocMonad m => ManLexer m [String]
204 lexArgs = do
190 lexArgs = do
205 eolOpt <- optionMaybe $ char '\n'
191 eolOpt <- optionMaybe $ char '\n'
@@ -226,6 +212,7 @@ lexMacro = do
226 quotedChar :: PandocMonad m => ManLexer m Char
212 quotedChar :: PandocMonad m => ManLexer m Char
227 quotedChar = noneOf "\"\n" <|> try (string "\"\"" >> return '"')
213 quotedChar = noneOf "\"\n" <|> try (string "\"\"" >> return '"')
228
214
215+-- TODO handle more cases
229escapeLexer :: PandocMonad m => ManLexer m EscapeThing
216escapeLexer :: PandocMonad m => ManLexer m EscapeThing
230escapeLexer = do
217escapeLexer = do
231 char '\\'
218 char '\\'
@@ -233,23 +220,38 @@ escapeLexer = do
233 where
220 where
234
221
235 escChar :: PandocMonad m => ManLexer m EscapeThing
222 escChar :: PandocMonad m => ManLexer m EscapeThing
236− escChar = choice [ char '-' >> return (EChar '-')
223+ escChar =
224+ let skipChars = ['%', '{', '}', '&']
225+ subsChars = [ ("-", '-'), (" ", ' '), ("\\", '\\'), ("[lq]", '“'), ("[rq]", '”')
226+ , ("[em]", '—'), ("[en]", '–') ]
227+ substitute :: PandocMonad m => (String,Char) -> ManLexer m EscapeThing
228+ substitute (from,to) = try $ string from >> return (EChar to)
229+ others = [ oneOf skipChars >> return ENothing
237− , oneOf ['%', '{', '}'] >> return ENothing
230+ , char '[' >> many alphaNum >> char ']' >> return ENothing
238 ]
231 ]
232+ in choice $ (substitute <$> subsChars) ++ others
239
233
240 escFont :: PandocMonad m => ManLexer m EscapeThing
234 escFont :: PandocMonad m => ManLexer m EscapeThing
241 escFont = do
235 escFont = do
242 char 'f'
236 char 'f'
243− font <- choice [ char 'B' >> return Bold
237+ font <- choice [ letterFont
244− , char 'I' >> return Italic
245− , (char 'P' <|> anyChar) >> return Regular
246 , char '(' >> anyChar >> anyChar >> return Regular
238 , char '(' >> anyChar >> anyChar >> return Regular
239+ , try (char '[' >> letterFont >>= \f -> char ']' >> return f)
247− , string "[]" >> return Regular
240+ , try $ string "[BI]" >> return ItalicBold
248− , char '[' >> many1 letter >> char ']' >> return Regular
241+ , char '[' >> many letter >> char ']' >> return Regular
249 ]
242 ]
250 modifyState (\r -> r {fontKind = font})
243 modifyState (\r -> r {fontKind = font})
251 return $ EFont font
244 return $ EFont font
252
245
246+ where
247+
248+ letterFont :: PandocMonad m => ManLexer m FontKind
249+ letterFont = choice [
250+ char 'B' >> return Bold
251+ , char 'I' >> return Italic
252+ , char 'P' >> return Regular
253+ ]
254+
253lexLine :: PandocMonad m => ManLexer m ManToken
255lexLine :: PandocMonad m => ManLexer m ManToken
254lexLine = do
256lexLine = do
255 lnparts <- many1 (esc <|> linePart)
257 lnparts <- many1 (esc <|> linePart)
@@ -301,10 +303,10 @@ mline = msatisfy isMLine where
301 isMLine (MLine _) = True
303 isMLine (MLine _) = True
302 isMLine _ = False
304 isMLine _ = False
303
305
304−mlink :: PandocMonad m => ManParser m ManToken
306+mmaybeLink :: PandocMonad m => ManParser m ManToken
305−mlink = msatisfy isMLink where
307+mmaybeLink = msatisfy isMMaybeLink where
306− isMLink (MLink _ _) = True
308+ isMMaybeLink (MMaybeLink _) = True
307− isMLink _ = False
309+ isMMaybeLink _ = False
308
310
309memplyLine :: PandocMonad m => ManParser m ManToken
311memplyLine :: PandocMonad m => ManParser m ManToken
310memplyLine = msatisfy isMEmptyLine where
312memplyLine = msatisfy isMEmptyLine where
@@ -379,7 +381,7 @@ strToInline s ItalicBold = Strong [Emph [Str s]]
379
381
380parsePara :: PandocMonad m => ManParser m Block
382parsePara :: PandocMonad m => ManParser m Block
381parsePara = do
383parsePara = do
382− inls <- many1 (strInl <|> lineInl <|> comment)
384+ inls <- many1 (strInl <|> lineInl <|> linkInl <|> comment)
383 let withspaces = intersperse [Str " "] inls
385 let withspaces = intersperse [Str " "] inls
384 return $ Para (concat withspaces)
386 return $ Para (concat withspaces)
385
387
@@ -395,6 +397,29 @@ parsePara = do
395 (MLine fragments) <- mline
397 (MLine fragments) <- mline
396 return $ fmap (\(s,f) -> strToInline s f) fragments
398 return $ fmap (\(s,f) -> strToInline s f) fragments
397
399
400+ linkInl :: PandocMonad m => ManParser m [Inline]
401+ linkInl = do
402+ (MMaybeLink txt) <- mmaybeLink
403+ let inls = case runParser linkParser () "" txt of
404+ Right lnk -> lnk
405+ Left _ -> [Strong [Str txt]]
406+ return inls
407+
408+ where
409+
410+ -- assuming man pages are generated from Linux-like repository
411+ linkParser :: Parsec String () [Inline]
412+ linkParser = do
413+ mpage <- many1 alphaNum
414+ space
415+ char '('
416+ mansect <- digit
417+ char ')'
418+ other <- many anyChar
419+ let manurl pagename section = "../"++section++"/"++pagename++"."++section
420+ return $ [ Link nullAttr [Strong [Str mpage]] (manurl mpage [mansect], mpage)
421+ , Strong [Str $ " ("++[mansect] ++ ")", Str other]]
422+
398 comment :: PandocMonad m => ManParser m [Inline]
423 comment :: PandocMonad m => ManParser m [Inline]
399 comment = mcomment >> return []
424 comment = mcomment >> return []
400
425
@@ -402,7 +427,7 @@ parsePara = do
402parseCodeBlock :: PandocMonad m => ManParser m Block
427parseCodeBlock :: PandocMonad m => ManParser m Block
403parseCodeBlock = do
428parseCodeBlock = do
404 mmacro KCodeBlStart
429 mmacro KCodeBlStart
405− toks <- many (mstr <|> mline <|> mlink <|> memplyLine <|> munknownMacro <|> mcomment)
430+ toks <- many (mstr <|> mline <|> mmaybeLink <|> memplyLine <|> munknownMacro <|> mcomment)
406 mmacro KCodeBlEnd
431 mmacro KCodeBlEnd
407 return $ CodeBlock nullAttr (intercalate "\n" . catMaybes $ extractText <$> toks)
432 return $ CodeBlock nullAttr (intercalate "\n" . catMaybes $ extractText <$> toks)
408
433
@@ -410,8 +435,8 @@ parseCodeBlock = do
410
435
411 extractText :: ManToken -> Maybe String
436 extractText :: ManToken -> Maybe String
412 extractText (MStr s _) = Just s
437 extractText (MStr s _) = Just s
413− extractText (MLine ss) = Just . intercalate " " $ map fst ss
438+ extractText (MLine ss) = Just . concat $ map fst ss -- TODO maybe unwords?
414− extractText (MLink s _) = Just s
439+ extractText (MMaybeLink s) = Just s
415 extractText MEmptyLine = Just "" -- string are intercalated with '\n', this prevents double '\n'
440 extractText MEmptyLine = Just "" -- string are intercalated with '\n', this prevents double '\n'
416 extractText _ = Nothing
441 extractText _ = Nothing
417
442
@@ -420,5 +445,6 @@ parseHeader = do
420 (MHeader lvl s) <- mheader
445 (MHeader lvl s) <- mheader
421 return $ Header lvl nullAttr [Str s]
446 return $ Header lvl nullAttr [Str s]
422
447
448+-- In case of weird man file it will be parsed succesfully
423parseSkipMacro :: PandocMonad m => ManParser m Block
449parseSkipMacro :: PandocMonad m => ManParser m Block
424parseSkipMacro = mmacroAny >> return Null
450parseSkipMacro = mmacroAny >> return Null