@@ -38,22 +38,22 @@ import Control.Monad (liftM, void)
3838import Control.Monad.Except (throwError)
3939import Data.Char (isDigit, isUpper, isLower)
4040import Data.Default (Default)
41−import Data.Functor (($>))
4241import Data.Map (insert)
43−import Data.Set (Set, singleton, fromList, toList)
42+import Data.Set (Set, singleton)
43+import qualified Data.Set as S (fromList, toList)
4444import Data.Maybe (catMaybes, fromMaybe, isNothing)
4545import Data.List (intersperse, intercalate)
4646import qualified Data.Text as T
4747
4848import Text.Pandoc.Class (PandocMonad(..))
49−import Text.Pandoc.Definition
49+import Text.Pandoc.Builder as B hiding (singleton)
5050import Text.Pandoc.Error (PandocError (PandocParsecError))
5151import Text.Pandoc.Logging (LogMessage(..))
5252import Text.Pandoc.Options
5353import Text.Pandoc.Parsing
5454import Text.Pandoc.Shared (crFilter)
55−import Text.Parsec hiding (tokenPrim)
56−import Text.Parsec.Char ()
55+import Text.Parsec hiding (tokenPrim, space)
56+import qualified Text.Parsec as Parsec
5757import Text.Parsec.Pos (updatePosString)
5858
5959--
@@ -158,14 +158,10 @@ parseMan :: PandocMonad m => ManParser m Pandoc
158158parseMan = do
159159 let parsers = [ try parseList, parseTitle, parsePara, parseSkippedContent
160160 , try parseCodeBlock, parseHeader, parseSkipMacro]
161− blocks <- many $ choice parsers
162− parserst <- getState
163− return $ Pandoc (stateMeta parserst) (filter (not . isNull) blocks)
164−
165− where
166−
167− isNull Null = True
168− isNull _ = False
161+ bs <- many $ choice parsers
162+ let (Pandoc _ blocks) = doc $ mconcat bs
163+ meta <- stateMeta <$> getState
164+ return $ Pandoc meta blocks
169165
170166eofline :: Stream s m Char => ParsecT s u m ()
171167eofline = void newline <|> eof
@@ -216,7 +212,7 @@ escapeLexer = do
216212 fs <- many letterFontKind
217213 many letter
218214 char ']'
219− return $ fromList fs
215+ return $ S.fromList fs
220216
221217 letterFontKind :: PandocMonad m => ManLexer m FontKind
222218 letterFontKind = choice [
@@ -240,7 +236,7 @@ currentFont = fontKind <$> getState
240236lexComment :: PandocMonad m => ManLexer m ManToken
241237lexComment = do
242238 try $ string ".\\\""
243− many space
239+ many Parsec.space
244240 body <- many $ noneOf "\n"
245241 char '\n'
246242 return $ MComment body
@@ -265,7 +261,7 @@ lexMacro = do
265261 "fi" -> knownMacro KCodeBlEnd
266262 "B" -> MStr (joinedArgs, singleton Bold)
267263 "BR" -> MMaybeLink joinedArgs
268− x | x `elem` ["BI", "IB"] -> MStr (joinedArgs, fromList [Italic, Bold])
264+ x | x `elem` ["BI", "IB"] -> MStr (joinedArgs, S.fromList [Italic, Bold])
269265 x | x `elem` ["I", "IR", "RI"] -> MStr (joinedArgs, singleton Italic)
270266 "SH" -> MHeader 2 args
271267 "SS" -> MHeader 3 args
@@ -403,15 +399,15 @@ mcomment = msatisfy isMComment where
403399-- ManToken -> Block functions
404400--
405401
406−parseTitle :: PandocMonad m => ManParser m Block
402+parseTitle :: PandocMonad m => ManParser m Blocks
407403parseTitle = do
408404 (MMacro _ args) <- mmacro KTitle
409405 if null args
410− then return Null
406+ then return mempty
411407 else do
412408 let mantitle = fst $ head args
413409 modifyState (changeTitle mantitle)
414− return $ Header 1 nullAttr [Str mantitle]
410+ return $ header 1 $ str mantitle
415411 where
416412 changeTitle title pst =
417413 let meta = stateMeta pst
@@ -419,11 +415,11 @@ parseTitle = do
419415 in
420416 pst {stateMeta = metaUp}
421417
422−parseSkippedContent :: PandocMonad m => ManParser m Block
418+parseSkippedContent :: PandocMonad m => ManParser m Blocks
423419parseSkippedContent = do
424420 tok <- munknownMacro <|> mcomment <|> memplyLine
425421 onToken tok
426− return Null
422+ return mempty
427423
428424 where
429425
@@ -433,50 +429,50 @@ parseSkippedContent = do
433429 logMessage $ SkippedContent ("Unknown macro: " ++ mname) pos
434430 onToken _ = return ()
435431
436−strToInline :: RoffStr -> Inline
437−strToInline (s, fonts) = inner $ toList fonts where
438− inner :: [FontKind] -> Inline
439− inner [] = Str s
440− inner (Bold:fs) = Strong [inner fs]
441− inner (Italic:fs) = Emph [inner fs]
432+strToInlines :: RoffStr -> Inlines
433+strToInlines (s, fonts) = inner $ S.toList fonts where
434+ inner :: [FontKind] -> Inlines
435+ inner [] = str s
436+ inner (Bold:fs) = strong $ inner fs
437+ inner (Italic:fs) = emph $ inner fs
442438
443439 -- Monospace goes after Bold and Italic in ordered set
444− inner (Monospace:_) = Code nullAttr s
440+ inner (Monospace:_) = code s
445441 inner (Regular:fs) = inner fs
446442
447−parsePara :: PandocMonad m => ManParser m Block
448−parsePara = Para <$> parseInlines
443+parsePara :: PandocMonad m => ManParser m Blocks
444+parsePara = para <$> parseInlines
449445
450−parseInlines :: PandocMonad m => ManParser m [Inline]
446+parseInlines :: PandocMonad m => ManParser m Inlines
451447parseInlines = do
452448 inls <- many1 (strInl <|> lineInl <|> linkInl <|> comment)
453− let withspaces = intersperse [Space] inls
454− return $ concat withspaces
449+ let withspaces = intersperse B.space inls
450+ return $ mconcat withspaces
455451
456452 where
457453
458− strInl :: PandocMonad m => ManParser m [Inline]
454+ strInl :: PandocMonad m => ManParser m Inlines
459455 strInl = do
460456 (MStr rstr) <- mstr
461− return [strToInline rstr]
457+ return $ strToInlines rstr
462458
463− lineInl :: PandocMonad m => ManParser m [Inline]
459+ lineInl :: PandocMonad m => ManParser m Inlines
464460 lineInl = do
465461 (MLine fragments) <- mline
466− return $ strToInline <$> fragments
462+ return $ mconcat $ strToInlines <$> fragments
467463
468− linkInl :: PandocMonad m => ManParser m [Inline]
464+ linkInl :: PandocMonad m => ManParser m Inlines
469465 linkInl = do
470466 (MMaybeLink txt) <- mmaybeLink
471467 let inls = case runParser linkParser () "" txt of
472468 Right lnk -> lnk
473− Left _ -> [Strong [Str txt]]
469+ Left _ -> strong $ str txt
474470 return inls
475471
476472 where
477473
478474 -- assuming man pages are generated from Linux-like repository
479− linkParser :: Parsec String () [Inline]
475+ linkParser :: Parsec String () Inlines
480476 linkParser = do
481477 mpage <- many1 (alphaNum <|> char '_')
482478 spacetab
@@ -485,21 +481,19 @@ parseInlines = do
485481 char ')'
486482 other <- many anyChar
487483 let manurl pagename section = "../"++section++"/"++pagename++"."++section
488− return $ [ Link nullAttr [Strong [Str mpage]] (manurl mpage [mansect], mpage)
489− , Strong [Str $ " ("++[mansect] ++ ")"
490− , Str other]
491− ]
484+ lnkInls = link (manurl mpage [mansect]) mpage (strong $ str mpage)
485+ return $ lnkInls <> strong (str (" ("++[mansect] ++ ")") <> str other)
492486
493− comment :: PandocMonad m => ManParser m [Inline]
494− comment = mcomment >> return []
487+ comment :: PandocMonad m => ManParser m Inlines
488+ comment = mcomment >> return mempty
495489
496490
497−parseCodeBlock :: PandocMonad m => ManParser m Block
491+parseCodeBlock :: PandocMonad m => ManParser m Blocks
498492parseCodeBlock = do
499493 mmacro KCodeBlStart
500494 toks <- many (mstr <|> mline <|> mmaybeLink <|> memplyLine <|> munknownMacro <|> mcomment)
501495 mmacro KCodeBlEnd
502− return $ CodeBlock nullAttr (intercalate "\n" . catMaybes $ extractText <$> toks)
496+ return $ codeBlock (intercalate "\n" . catMaybes $ extractText <$> toks)
503497
504498 where
505499
@@ -510,14 +504,14 @@ parseCodeBlock = do
510504 extractText MEmptyLine = Just "" -- string are intercalated with '\n', this prevents double '\n'
511505 extractText _ = Nothing
512506
513−parseHeader :: PandocMonad m => ManParser m Block
507+parseHeader :: PandocMonad m => ManParser m Blocks
514508parseHeader = do
515509 (MHeader lvl ss) <- mheader
516− return $ Header lvl nullAttr $ intersperse Space $ strToInline <$> ss
510+ return $ header lvl (mconcat $ intersperse B.space $ strToInlines <$> ss)
517511
518−type ListBuilder = [[Block]] -> Block
512+type ListBuilder = [Blocks] -> Blocks
519513
520−parseList :: PandocMonad m => ManParser m Block
514+parseList :: PandocMonad m => ManParser m Blocks
521515parseList = do
522516 xx <- many1 paras
523517 let bls = map snd xx
@@ -526,13 +520,13 @@ parseList = do
526520
527521 where
528522
529− macroIPInl :: [RoffStr] -> [Inline]
530− macroIPInl (x:_:[]) = [strToInline x, Space]
531− macroIPInl _ = []
523+ macroIPInl :: [RoffStr] -> Inlines
524+ macroIPInl (x:_:[]) = strToInlines x <> B.space
525+ macroIPInl _ = mempty
532526
533527 listKind :: [RoffStr] -> Maybe ListBuilder
534528 listKind (((c:_), _):_:[]) =
535− let params style = OrderedList (1, style, DefaultDelim)
529+ let params style = orderedListWith (1, style, DefaultDelim)
536530 in case c of
537531 _ | isDigit c -> Just $ params Decimal
538532 _ | isUpper c -> Just $ params UpperAlpha
@@ -541,18 +535,18 @@ parseList = do
541535
542536 listKind _ = Nothing
543537
544− paras :: PandocMonad m => ManParser m (ListBuilder, [Block])
538+ paras :: PandocMonad m => ManParser m (ListBuilder, Blocks)
545539 paras = do
546540 (MMacro _ args) <- mmacro KTab
547541 let lbuilderOpt = listKind args
548− lbuilder = fromMaybe BulletList lbuilderOpt
542+ lbuilder = fromMaybe bulletList lbuilderOpt
549543 macroinl = macroIPInl args
550544 inls <- parseInlines
551− let parainls = if isNothing lbuilderOpt then macroinl ++ inls else inls
552− subls <- many sublist
553− return $ (lbuilder, (Plain parainls) : subls)
545+ let parainls = if isNothing lbuilderOpt then macroinl <> inls else inls
546+ subls <- mconcat <$> many sublist
547+ return $ (lbuilder, plain parainls <> subls)
554548
555− sublist :: PandocMonad m => ManParser m Block
549+ sublist :: PandocMonad m => ManParser m Blocks
556550 sublist = do
557551 mmacro KSubTab
558552 bl <- parseList
@@ -560,5 +554,5 @@ parseList = do
560554 return bl
561555
562556-- In case of weird man file it will be parsed succesfully
563−parseSkipMacro :: PandocMonad m => ManParser m Block
564−parseSkipMacro = mmacroAny >> return Null
557+parseSkipMacro :: PandocMonad m => ManParser m Blocks
558+parseSkipMacro = mmacroAny >> mempty