@@ -36,6 +36,7 @@ module Text.Pandoc.Readers.Man (readMan, testFile) where
3636import Prelude
3737import Control.Monad (liftM)
3838import Control.Monad.Except (throwError)
39+import Data.Char (isDigit, isUpper, isLower)
3940import Data.Default (Default)
4041import Data.Map (insert)
4142import Data.Maybe (catMaybes)
@@ -64,18 +65,18 @@ data MacroKind = KTitle
6465 | KCodeBlEnd
6566 | KTab
6667 | KTabEnd
68+ | KSubTab
6769 deriving (Show, Eq)
6870
69−-- TODO header strings
70−-- TODO remove MStr
71−-- TODO filter skipped content
72−data ManToken = MStr String FontKind
73− | MLine [(String, FontKind)]
71+type RoffStr = (String, FontKind)
72+
73+data ManToken = MStr RoffStr
74+ | MLine [RoffStr]
7475 | MMaybeLink String
7576 | MEmptyLine
76− | MHeader Int String
77− | MMacro MacroKind [String]
78− | MUnknownMacro String [String]
77+ | MHeader Int [RoffStr]
78+ | MMacro MacroKind [RoffStr]
79+ | MUnknownMacro String [RoffStr]
7980 | MComment String
8081 deriving Show
8182
@@ -152,7 +153,7 @@ lexMan = many (lexMacro <|> lexLine <|> lexEmptyLine)
152153
153154parseMan :: PandocMonad m => ManParser m Pandoc
154155parseMan = do
155− let parsers = [ parseBulletList, parseTitle, parsePara, parseSkippedContent
156+ let parsers = [ try parseBulletList, parseTitle, parsePara, parseSkippedContent
156157 , parseCodeBlock, parseHeader, parseSkipMacro]
157158 blocks <- many $ choice parsers
158159 parserst <- getState
@@ -212,13 +213,18 @@ escapeLexer = do
212213 , char 'P' >> return Regular
213214 ]
214215
216+currentFont :: PandocMonad m => ManLexer m FontKind
217+currentFont = do
218+ RoffState {fontKind = fk} <- getState
219+ return fk
220+
215221lexMacro :: PandocMonad m => ManLexer m ManToken
216222lexMacro = do
217223 char '.' <|> char '\''
218224 many spacetab
219225 macroName <- many1 (letter <|> oneOf ['\\', '"'])
220226 args <- lexArgs
221− let joinedArgs = unwords args
227+ let joinedArgs = unwords $ fst <$> args
222228 let knownMacro mkind = MMacro mkind args
223229
224230 let tok = case macroName of
@@ -227,21 +233,22 @@ lexMacro = do
227233 "IP" -> knownMacro KTab
228234 "TP" -> knownMacro KTab
229235 "RE" -> knownMacro KTabEnd
236+ "RS" -> knownMacro KSubTab
230237 "nf" -> knownMacro KCodeBlStart
231238 "fi" -> knownMacro KCodeBlEnd
232− "B" -> MStr joinedArgs Bold
239+ "B" -> MStr (joinedArgs,Bold)
233240 "BR" -> MMaybeLink joinedArgs
234− x | x `elem` ["BI", "IB"] -> MStr joinedArgs ItalicBold
235− x | x `elem` ["I", "IR", "RI"] -> MStr joinedArgs Italic
236− "SH" -> MHeader 2 joinedArgs
237− "SS" -> MHeader 3 joinedArgs
241+ x | x `elem` ["BI", "IB"] -> MStr (joinedArgs, ItalicBold)
242+ x | x `elem` ["I", "IR", "RI"] -> MStr (joinedArgs, Italic)
243+ "SH" -> MHeader 2 args
244+ "SS" -> MHeader 3 args
238245 x | x `elem` [ "P", "PP", "LP", "sp"] -> MEmptyLine
239246 _ -> MUnknownMacro macroName args
240247 return tok
241248
242249 where
243250
244− lexArgs :: PandocMonad m => ManLexer m [String]
251+ lexArgs :: PandocMonad m => ManLexer m [RoffStr]
245252 lexArgs = do
246253 args <- many oneArg
247254 eofline
@@ -249,20 +256,24 @@ lexMacro = do
249256
250257 where
251258
252− oneArg :: PandocMonad m => ManLexer m String
259+ oneArg :: PandocMonad m => ManLexer m RoffStr
253260 oneArg = do
254261 many1 spacetab
255262 quotedArg <|> plainArg
256263
257− plainArg :: PandocMonad m => ManLexer m String
258− plainArg = fmap catMaybes . many1 $ escChar <|> (Just <$> noneOf " \t\n")
264+ plainArg :: PandocMonad m => ManLexer m RoffStr
265+ plainArg = do
266+ arg <- many1 $ escChar <|> (Just <$> noneOf " \t\n")
267+ f <- currentFont
268+ return (catMaybes arg, f)
259269
260− quotedArg :: PandocMonad m => ManLexer m String
270+ quotedArg :: PandocMonad m => ManLexer m RoffStr
261271 quotedArg = do
262272 char '"'
263273 val <- catMaybes <$> many quotedChar
264274 char '"'
265− return val
275+ f <- currentFont
276+ return (val, f)
266277
267278 quotedChar :: PandocMonad m => ManLexer m (Maybe Char)
268279 quotedChar = escChar <|> (Just <$> noneOf "\"\n") <|> (Just <$> try (string "\"\"" >> return '"'))
@@ -295,11 +306,6 @@ lexLine = do
295306 lnpart <- many1 $ noneOf "\n\\"
296307 font <- currentFont
297308 return $ Just (lnpart, font)
298−
299− currentFont :: PandocMonad m => ManLexer m FontKind
300− currentFont = do
301− RoffState {fontKind = fk} <- getState
302− return fk
303309
304310
305311lexEmptyLine :: PandocMonad m => ManLexer m ManToken
@@ -313,11 +319,11 @@ msatisfy :: (Show t, Stream s m t) => (t -> Bool) -> ParserT s st m t
313319msatisfy predic = tokenPrim show nextPos testTok
314320 where
315321 testTok t = if predic t then Just t else Nothing
316− nextPos pos x _xs = updatePosString pos (show x)
322+ nextPos pos x _xs = updatePosString (setSourceLine pos $ sourceLine pos + (if predic x then 1 else 0)) (show x)
317323
318324mstr :: PandocMonad m => ManParser m ManToken
319325mstr = msatisfy isMStr where
320− isMStr (MStr _ _) = True
326+ isMStr (MStr _) = True
321327 isMStr _ = False
322328
323329mline :: PandocMonad m => ManParser m ManToken
@@ -371,7 +377,7 @@ parseTitle = do
371377 if null args
372378 then return Null
373379 else do
374− let mantitle = head args
380+ let mantitle = fst $ head args
375381 modifyState (changeTitle mantitle)
376382 return $ Header 1 nullAttr [Str mantitle]
377383 where
@@ -395,29 +401,32 @@ parseSkippedContent = do
395401 logMessage $ SkippedContent ("Unknown macro: " ++ mname) pos
396402 onToken _ = return ()
397403
398−strToInline :: String -> FontKind -> Inline
399−strToInline s Regular = Str s
400−strToInline s Italic = Emph [Str s]
401−strToInline s Bold = Strong [Str s]
402−strToInline s ItalicBold = Strong [Emph [Str s]]
404+strToInline :: RoffStr -> Inline
405+strToInline (s, Regular) = Str s
406+strToInline (s, Italic) = Emph [Str s]
407+strToInline (s, Bold) = Strong [Str s]
408+strToInline (s, ItalicBold) = Strong [Emph [Str s]]
403409
404410parsePara :: PandocMonad m => ManParser m Block
405−parsePara = do
411+parsePara = Para <$> parseInlines
412+
413+parseInlines :: PandocMonad m => ManParser m [Inline]
414+parseInlines = do
406415 inls <- many1 (strInl <|> lineInl <|> linkInl <|> comment)
407416 let withspaces = intersperse [Space] inls
408− return $ Para (concat withspaces)
417+ return $ concat withspaces
409418
410419 where
411420
412421 strInl :: PandocMonad m => ManParser m [Inline]
413422 strInl = do
414− (MStr str fk) <- mstr
415− return [strToInline str fk]
423+ (MStr rstr) <- mstr
424+ return [strToInline rstr]
416425
417426 lineInl :: PandocMonad m => ManParser m [Inline]
418427 lineInl = do
419428 (MLine fragments) <- mline
420− return $ fmap (\(s,f) -> strToInline s f) fragments
429+ return $ strToInline <$> fragments
421430
422431 linkInl :: PandocMonad m => ManParser m [Inline]
423432 linkInl = do
@@ -458,7 +467,7 @@ parseCodeBlock = do
458467 where
459468
460469 extractText :: ManToken -> Maybe String
461− extractText (MStr s _) = Just s
470+ extractText (MStr (s, _)) = Just s
462471 extractText (MLine ss) = Just . concat $ map fst ss -- TODO maybe unwords?
463472 extractText (MMaybeLink s) = Just s
464473 extractText MEmptyLine = Just "" -- string are intercalated with '\n', this prevents double '\n'
@@ -466,20 +475,43 @@ parseCodeBlock = do
466475
467476parseHeader :: PandocMonad m => ManParser m Block
468477parseHeader = do
469− (MHeader lvl s) <- mheader
470− return $ Header lvl nullAttr [Str s]
478+ (MHeader lvl ss) <- mheader
479+ return $ Header lvl nullAttr $ intersperse Space $ strToInline <$> ss
471480
472481parseBulletList :: PandocMonad m => ManParser m Block
473−parseBulletList = BulletList . map (: []) <$> many1 block
474−
475− where
476−
477− block :: PandocMonad m => ManParser m Block
478− block = do
479− mmacro KTab
480− pars <- parsePara
481− many $ mmacro KTabEnd
482− return pars
482+parseBulletList = BulletList <$> many1 paras where
483+
484+ macroIPInl :: [RoffStr] -> [Inline]
485+ macroIPInl (x:_:[]) = [strToInline x, Space]
486+ macroIPInl _ = []
487+
488+ listKind :: [RoffStr] -> Maybe ([[Block]] -> Block)
489+ listKind (((c:_), _):_:[]) =
490+ let params style = OrderedList (1, style, DefaultDelim)
491+ in Just $ case c of
492+ _ | isDigit c -> params Decimal
493+ _ | isUpper c -> params UpperAlpha
494+ _ | isLower c -> params LowerAlpha
495+ _ -> BulletList
496+
497+ listKind _ = Nothing
498+
499+ paras :: PandocMonad m => ManParser m [Block]
500+ paras = do
501+ (MMacro _ args) <- mmacro KTab
502+ let lk = listKind args
503+ inls <- parseInlines
504+ let macroinl = macroIPInl args
505+ let para = Plain $ macroinl ++ inls
506+ subls <- many sublist
507+ return $ para : subls
508+
509+ sublist :: PandocMonad m => ManParser m Block
510+ sublist = do
511+ mmacro KSubTab
512+ bl <- parseBulletList
513+ mmacro KTabEnd
514+ return bl
483515
484516-- In case of weird man file it will be parsed succesfully
485517parseSkipMacro :: PandocMonad m => ManParser m Block