git.iko.soy/typeable/pandoc
on master help sign in
links, specialchars
commita00323cbbe8946208f06e9b752d26cb4cae8b9a9 authorYan Pas <yanp.bugz@gmail.com> dateSun 20 May 2018, 15:37 (8 years ago) parent9e3eba6
1 file changed+65−39
src/Text/Pandoc/Readers/Man.hs+65−39
src/Text/Pandoc/Readers/Man.hs+65−39
@@ -67,7 +67,7 @@ data MacroKind = KTitle
6767
6868data ManToken = MStr String FontKind
6969 | MLine [(String, FontKind)]
70− | MLink String Target
70+ | MMaybeLink String
7171 | MEmptyLine
7272 | MHeader Int String
7373 | MMacro MacroKind [String]
@@ -166,40 +166,26 @@ lexMacro = do
166166 macroName <- many1 (letter <|> oneOf ['\\', '"'])
167167 args <- lexArgs
168168 let joinedArgs = concat $ intersperse " " args
169+ let knownMacro mkind = MMacro mkind args
169170
170171 let tok = case macroName of
171172 x | x `elem` ["\\\"", "\\#"] -> MComment joinedArgs
172− "TH" -> MMacro KTitle args
173− "TP" -> MMacro KTab []
174− "PP" -> MMacro KTabEnd []
175− "nf" -> MMacro KCodeBlStart []
176− "fi" -> MMacro KCodeBlEnd []
177− x | x `elem` ["B", "BR"] -> MStr joinedArgs Bold -- "BR" is often used as a link to another man
173+ "TH" -> knownMacro KTitle
174+ "TP" -> knownMacro KTab
175+ "RE" -> knownMacro KTabEnd
176+ "nf" -> knownMacro KCodeBlStart
177+ "fi" -> knownMacro KCodeBlEnd
178+ "B" -> MStr joinedArgs Bold
179+ "BR" -> MMaybeLink joinedArgs
178180 x | x `elem` ["BI", "IB"] -> MStr joinedArgs ItalicBold
179181 x | x `elem` ["I", "IR", "RI"] -> MStr joinedArgs Italic
180182 "SH" -> MHeader 2 joinedArgs
181− "sp" -> MEmptyLine
183+ x | x `elem` [ "P", "PP", "LP", "sp"] -> MEmptyLine
182184 _ -> MUnknownMacro macroName args
183185 return tok
184186
185187 where
186188
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−
203189 lexArgs :: PandocMonad m => ManLexer m [String]
204190 lexArgs = do
205191 eolOpt <- optionMaybe $ char '\n'
@@ -226,6 +212,7 @@ lexMacro = do
226212 quotedChar :: PandocMonad m => ManLexer m Char
227213 quotedChar = noneOf "\"\n" <|> try (string "\"\"" >> return '"')
228214
215+-- TODO handle more cases
229216escapeLexer :: PandocMonad m => ManLexer m EscapeThing
230217escapeLexer = do
231218 char '\\'
@@ -233,23 +220,38 @@ escapeLexer = do
233220 where
234221
235222 escChar :: PandocMonad m => ManLexer m EscapeThing
236− escChar = choice [ char '-' >> return (EChar '-')
237− , oneOf ['%', '{', '}'] >> return ENothing
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
230+ , char '[' >> many alphaNum >> char ']' >> return ENothing
238231 ]
232+ in choice $ (substitute <$> subsChars) ++ others
239233
240234 escFont :: PandocMonad m => ManLexer m EscapeThing
241235 escFont = do
242236 char 'f'
243− font <- choice [ char 'B' >> return Bold
244− , char 'I' >> return Italic
245− , (char 'P' <|> anyChar) >> return Regular
237+ font <- choice [ letterFont
246238 , char '(' >> anyChar >> anyChar >> return Regular
247− , string "[]" >> return Regular
248− , char '[' >> many1 letter >> char ']' >> return Regular
239+ , try (char '[' >> letterFont >>= \f -> char ']' >> return f)
240+ , try $ string "[BI]" >> return ItalicBold
241+ , char '[' >> many letter >> char ']' >> return Regular
249242 ]
250243 modifyState (\r -> r {fontKind = font})
251244 return $ EFont font
252245
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+
253255lexLine :: PandocMonad m => ManLexer m ManToken
254256lexLine = do
255257 lnparts <- many1 (esc <|> linePart)
@@ -301,10 +303,10 @@ mline = msatisfy isMLine where
301303 isMLine (MLine _) = True
302304 isMLine _ = False
303305
304−mlink :: PandocMonad m => ManParser m ManToken
305−mlink = msatisfy isMLink where
306− isMLink (MLink _ _) = True
307− isMLink _ = False
306+mmaybeLink :: PandocMonad m => ManParser m ManToken
307+mmaybeLink = msatisfy isMMaybeLink where
308+ isMMaybeLink (MMaybeLink _) = True
309+ isMMaybeLink _ = False
308310
309311memplyLine :: PandocMonad m => ManParser m ManToken
310312memplyLine = msatisfy isMEmptyLine where
@@ -379,7 +381,7 @@ strToInline s ItalicBold = Strong [Emph [Str s]]
379381
380382parsePara :: PandocMonad m => ManParser m Block
381383parsePara = do
382− inls <- many1 (strInl <|> lineInl <|> comment)
384+ inls <- many1 (strInl <|> lineInl <|> linkInl <|> comment)
383385 let withspaces = intersperse [Str " "] inls
384386 return $ Para (concat withspaces)
385387
@@ -395,6 +397,29 @@ parsePara = do
395397 (MLine fragments) <- mline
396398 return $ fmap (\(s,f) -> strToInline s f) fragments
397399
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+
398423 comment :: PandocMonad m => ManParser m [Inline]
399424 comment = mcomment >> return []
400425
@@ -402,7 +427,7 @@ parsePara = do
402427parseCodeBlock :: PandocMonad m => ManParser m Block
403428parseCodeBlock = do
404429 mmacro KCodeBlStart
405− toks <- many (mstr <|> mline <|> mlink <|> memplyLine <|> munknownMacro <|> mcomment)
430+ toks <- many (mstr <|> mline <|> mmaybeLink <|> memplyLine <|> munknownMacro <|> mcomment)
406431 mmacro KCodeBlEnd
407432 return $ CodeBlock nullAttr (intercalate "\n" . catMaybes $ extractText <$> toks)
408433
@@ -410,8 +435,8 @@ parseCodeBlock = do
410435
411436 extractText :: ManToken -> Maybe String
412437 extractText (MStr s _) = Just s
413− extractText (MLine ss) = Just . intercalate " " $ map fst ss
414− extractText (MLink s _) = Just s
438+ extractText (MLine ss) = Just . concat $ map fst ss -- TODO maybe unwords?
439+ extractText (MMaybeLink s) = Just s
415440 extractText MEmptyLine = Just "" -- string are intercalated with '\n', this prevents double '\n'
416441 extractText _ = Nothing
417442
@@ -420,5 +445,6 @@ parseHeader = do
420445 (MHeader lvl s) <- mheader
421446 return $ Header lvl nullAttr [Str s]
422447
448+-- In case of weird man file it will be parsed succesfully
423449parseSkipMacro :: PandocMonad m => ManParser m Block
424450parseSkipMacro = mmacroAny >> return Null