@@ -37,18 +37,16 @@ module Text.Pandoc.Readers.Groff
3737 , defaultFontSpec
3838 , LinePart(..)
3939 , Arg
40− , ManToken(..)
41− , ManTokens(..)
42− , singleTok
43− , RoffState(..)
44− , ManLexer
45− , manToken
40+ , GroffToken(..)
41+ , GroffTokens(..)
4642 , linePartsToString
43+ , lexGroff
4744 )
4845where
4946
5047import Prelude
5148import Control.Monad (void, mzero, guard, when)
49+import Control.Monad.Except (throwError)
5250import Text.Pandoc.Class
5351 (getResourcePath, readFileFromDirs, PandocMonad(..), report)
5452import Data.Char (isHexDigit, chr, ord, isAscii, isAlphaNum, isSpace)
@@ -56,7 +54,6 @@ import Data.Default (Default)
5654import qualified Data.Map as M
5755import Data.List (intercalate, isSuffixOf)
5856import qualified Data.Text as T
59−import Text.Pandoc.Builder as B
6057import Text.Pandoc.Logging (LogMessage(..))
6158import Text.Pandoc.Options
6259import Text.Pandoc.Parsing
@@ -92,21 +89,22 @@ data LinePart = RoffStr String
9289type Arg = [LinePart]
9390
9491-- TODO parse tables (see man tbl)
95−data ManToken = MLine [LinePart]
92+data GroffToken = MLine [LinePart]
9693 | MEmptyLine
9794 | MMacro MacroKind [Arg] SourcePos
98− | MTable [Alignment] ManTokens [ManTokens] [[ManTokens]]
95+ | MTable [[String]] [[GroffTokens]] SourcePos
9996 deriving Show
10097
101−newtype ManTokens = ManTokens { unManTokens :: Seq.Seq ManToken }
98+newtype GroffTokens = GroffTokens { unGroffTokens :: Seq.Seq GroffToken }
10299 deriving (Show, Semigroup, Monoid)
103100
104−singleTok :: ManToken -> ManTokens
105−singleTok t = ManTokens (Seq.singleton t)
101+singleTok :: GroffToken -> GroffTokens
102+singleTok t = GroffTokens (Seq.singleton t)
106103
107−data RoffState = RoffState { customMacros :: M.Map String ManTokens
104+data RoffState = RoffState { customMacros :: M.Map String GroffTokens
108105 , prevFont :: FontSpec
109106 , currentFont :: FontSpec
107+ , tableTabChar :: Char
110108 } deriving Show
111109
112110instance Default RoffState where
@@ -120,12 +118,13 @@ instance Default RoffState where
120118 , ("R", "\x00AE") ]
121119 , prevFont = defaultFontSpec
122120 , currentFont = defaultFontSpec
121+ , tableTabChar = '\t'
123122 }
124123
125−type ManLexer m = ParserT [Char] RoffState m
124+type GroffLexer m = ParserT [Char] RoffState m
126125
127126--
128−-- Lexer: String -> ManToken
127+-- Lexer: String -> GroffToken
129128--
130129
131130eofline :: Stream s m Char => ParsecT s u m ()
@@ -142,7 +141,7 @@ combiningAccentsMap :: M.Map String Char
142141combiningAccentsMap =
143142 M.fromList $ map (\(x,y) -> (y,x)) combiningAccents
144143
145−escape :: PandocMonad m => ManLexer m [LinePart]
144+escape :: PandocMonad m => GroffLexer m [LinePart]
146145escape = do
147146 char '\\'
148147 c <- anyChar
@@ -224,14 +223,14 @@ escape = do
224223 Nothing -> mzero
225224 Just c -> return c
226225
227− escUnknown :: PandocMonad m => String -> ManLexer m [LinePart]
226+ escUnknown :: PandocMonad m => String -> GroffLexer m [LinePart]
228227 escUnknown s = do
229228 pos <- getPosition
230229 report $ SkippedContent ("Unknown escape sequence " ++ s) pos
231230 return [RoffStr "\xFFFD"]
232231
233232-- \s-1 \s0
234−escFontSize :: PandocMonad m => ManLexer m [LinePart]
233+escFontSize :: PandocMonad m => GroffLexer m [LinePart]
235234escFontSize = do
236235 let sign = option "" $ count 1 (oneOf "+-")
237236 let toFontSize xs =
@@ -253,7 +252,7 @@ escFontSize = do
253252 toFontSize (s ++ ds)
254253 ]
255254
256−escFont :: PandocMonad m => ManLexer m [LinePart]
255+escFont :: PandocMonad m => GroffLexer m [LinePart]
257256escFont = do
258257 font <- choice
259258 [ char 'S' >> return defaultFontSpec
@@ -267,7 +266,7 @@ escFont = do
267266 , currentFont = font }
268267 return [Font font]
269268
270−lettersFont :: PandocMonad m => ManLexer m FontSpec
269+lettersFont :: PandocMonad m => GroffLexer m FontSpec
271270lettersFont = try $ do
272271 char '['
273272 fs <- many letterFontKind
@@ -277,7 +276,7 @@ lettersFont = try $ do
277276 then prevFont <$> getState
278277 else return $ foldr ($) defaultFontSpec fs
279278
280−letterFontKind :: PandocMonad m => ManLexer m (FontSpec -> FontSpec)
279+letterFontKind :: PandocMonad m => GroffLexer m (FontSpec -> FontSpec)
281280letterFontKind = choice [
282281 oneOf ['B','b'] >> return (\fs -> fs{ fontBold = True })
283282 , oneOf ['I','i'] >> return (\fs -> fs { fontItalic = True })
@@ -288,7 +287,7 @@ letterFontKind = choice [
288287
289288-- separate function from lexMacro since real man files sometimes do not
290289-- follow the rules
291−lexComment :: PandocMonad m => ManLexer m ManTokens
290+lexComment :: PandocMonad m => GroffLexer m GroffTokens
292291lexComment = do
293292 try $ string ".\\\""
294293 many Parsec.space
@@ -296,18 +295,18 @@ lexComment = do
296295 char '\n'
297296 return mempty
298297
299−lexMacro :: PandocMonad m => ManLexer m ManTokens
298+lexMacro :: PandocMonad m => GroffLexer m GroffTokens
300299lexMacro = do
301300 pos <- getPosition
302301 char '.' <|> char '\''
303− many spacetab
302+ skipMany spacetab
304303 macroName <- many (satisfy (not . isSpace))
305304 case macroName of
306305 "nop" -> return mempty
307306 "ie" -> lexConditional
308307 "if" -> lexConditional
309308 "el" -> skipConditional
310− "TS" -> lexTable
309+ "TS" -> lexTable pos
311310
312311 _ -> do
313312 args <- lexArgs
@@ -323,30 +322,100 @@ lexMacro = do
323322 "so" -> lexIncludeFile args
324323 _ -> resolveMacro macroName args pos
325324
326−-- | TODO placeholder
327−lexTable :: PandocMonad m => ManLexer m ManTokens
328−lexTable = do
329− pos <- getPosition
330− manyTill anyLine (try (string ".TE" >> many spacetab >> eofline))
331− report $ SkippedContent "table" pos
332− return mempty
333−
325+lexTable :: PandocMonad m => SourcePos -> GroffLexer m GroffTokens
326+lexTable pos = do
327+ spaces
328+ optional tableOptions
329+ spaces
330+ aligns <- tableFormatSpec
331+ spaces
332+ rows <- manyTill tableRow (try (string ".TE" >> skipMany spacetab >> eofline))
333+ return $ singleTok $ MTable aligns rows pos
334+
335+tableCell :: PandocMonad m => GroffLexer m GroffTokens
336+tableCell = (enclosedCell <|> simpleCell) >>= lexGroff . T.pack
337+ where
338+ enclosedCell = do
339+ try (string "T{")
340+ manyTill anyChar (try (string "T}"))
341+ simpleCell = do
342+ tabChar <- tableTabChar <$> getState
343+ many1 (notFollowedBy (char tabChar <|> newline) >> anyChar)
344+
345+tableRow :: PandocMonad m => GroffLexer m [GroffTokens]
346+tableRow = do
347+ tabChar <- tableTabChar <$> getState
348+ c <- tableCell
349+ cs <- many $ try (char tabChar >> tableCell)
350+ skipMany spacetab
351+ eofline
352+ return (c:cs)
353+
354+tableOptions :: PandocMonad m => GroffLexer m ()
355+tableOptions = try $ do
356+ opts <- many1 tableOption <* spaces <* char ';'
357+ case lookup "tab" opts of
358+ Just (c:_) -> modifyState $ \st -> st{ tableTabChar = c }
359+ _ -> modifyState $ \st -> st{ tableTabChar = '\t' }
360+ return ()
361+
362+tableOption :: PandocMonad m => GroffLexer m (String, String)
363+tableOption = do
364+ k <- many1 letter
365+ v <- option "" $ do
366+ char '('
367+ manyTill anyChar (char ')')
368+ spaces
369+ optional (char ',')
370+ return (k,v)
371+
372+tableFormatSpec :: PandocMonad m => GroffLexer m [[String]]
373+tableFormatSpec = do
374+ speclines <- tableFormatSpecLine `sepBy1` (newline <|> char ',')
375+ char '.'
376+ return speclines
377+
378+tableFormatSpecLine :: PandocMonad m => GroffLexer m [String]
379+tableFormatSpecLine = do
380+ as <- many1 $ skipMany spacetab >> tableColFormat
381+ skipMany spacetab
382+ return as
383+
384+tableColFormat :: PandocMonad m => GroffLexer m String
385+tableColFormat = do
386+ pipePrefix <- option "" $ try $ string "|" <* notFollowedBy spacetab
387+ c <- oneOf ['a','A','c','C','l','L','n','N','r','R','s','S','^','_','-',
388+ '=','|']
389+ numsuffix <- option "" $ many1 digit
390+ suffixes <- many $ do
391+ x <- oneOf ['b','B','d','D','e','E','f','F','i','I','m','M',
392+ 'p','P','t','T','u','U','v','V','w','W','x','X', 'z','Z']
393+ num <- if x == 'w'
394+ then many1 digit <|>
395+ do char '('
396+ xs <- manyTill anyChar (char ')')
397+ return ("(" ++ xs ++ ")")
398+ else return ""
399+ return $ x : num
400+ pipeSuffix <- option "" $ string "|"
401+ return $ pipePrefix ++ (c : numsuffix ++ concat suffixes ++ pipeSuffix)
402+
334403-- We don't fully handle the conditional. But we do
335404-- include everything under '.ie n', which occurs commonly
336405-- in man pages. We always skip the '.el' part.
337−lexConditional :: PandocMonad m => ManLexer m ManTokens
406+lexConditional :: PandocMonad m => GroffLexer m GroffTokens
338407lexConditional = do
339408 skipMany spacetab
340409 lexNCond <|> skipConditional
341410
342411-- n means nroff mode
343−lexNCond :: PandocMonad m => ManLexer m ManTokens
412+lexNCond :: PandocMonad m => GroffLexer m GroffTokens
344413lexNCond = do
345414 char '\n'
346415 many1 spacetab
347416 lexGroup <|> manToken
348417
349−lexGroup :: PandocMonad m => ManLexer m ManTokens
418+lexGroup :: PandocMonad m => GroffLexer m GroffTokens
350419lexGroup = do
351420 groupstart
352421 mconcat <$> manyTill manToken groupend
@@ -354,14 +423,14 @@ lexGroup = do
354423 groupstart = try $ string "\\{\\" >> newline
355424 groupend = try $ string "\\}" >> eofline
356425
357−skipConditional :: PandocMonad m => ManLexer m ManTokens
426+skipConditional :: PandocMonad m => GroffLexer m GroffTokens
358427skipConditional = do
359428 rest <- anyLine
360429 when ("\\{\\" `isSuffixOf` rest) $
361430 void $ manyTill anyChar (try (string "\\}"))
362431 return mempty
363432
364−lexIncludeFile :: PandocMonad m => [Arg] -> ManLexer m ManTokens
433+lexIncludeFile :: PandocMonad m => [Arg] -> GroffLexer m GroffTokens
365434lexIncludeFile args = do
366435 pos <- getPosition
367436 case args of
@@ -376,7 +445,7 @@ lexIncludeFile args = do
376445 [] -> return mempty
377446
378447resolveMacro :: PandocMonad m
379− => String -> [Arg] -> SourcePos -> ManLexer m ManTokens
448+ => String -> [Arg] -> SourcePos -> GroffLexer m GroffTokens
380449resolveMacro macroName args pos = do
381450 macros <- customMacros <$> getState
382451 case M.lookup macroName macros of
@@ -390,9 +459,9 @@ resolveMacro macroName args pos = do
390459 let fillMacroArg (MLine lineparts) =
391460 MLine (foldr fillLP [] lineparts)
392461 fillMacroArg x = x
393− return $ ManTokens . fmap fillMacroArg . unManTokens $ ts
462+ return $ GroffTokens . fmap fillMacroArg . unGroffTokens $ ts
394463
395−lexStringDef :: PandocMonad m => [Arg] -> ManLexer m ManTokens
464+lexStringDef :: PandocMonad m => [Arg] -> GroffLexer m GroffTokens
396465lexStringDef args = do -- string definition
397466 case args of
398467 [] -> fail "No argument to .ds"
@@ -403,7 +472,7 @@ lexStringDef args = do -- string definition
403472 st{ customMacros = M.insert stringName ts (customMacros st) }
404473 return mempty
405474
406−lexMacroDef :: PandocMonad m => [Arg] -> ManLexer m ManTokens
475+lexMacroDef :: PandocMonad m => [Arg] -> GroffLexer m GroffTokens
407476lexMacroDef args = do -- macro definition
408477 (macroName, stopMacro) <-
409478 case args of
@@ -413,7 +482,7 @@ lexMacroDef args = do -- macro definition
413482 [] -> fail "No argument to .de"
414483 let stop = try $ do
415484 char '.' <|> char '\''
416− many spacetab
485+ skipMany spacetab
417486 string stopMacro
418487 _ <- lexArgs
419488 return ()
@@ -422,7 +491,7 @@ lexMacroDef args = do -- macro definition
422491 st{ customMacros = M.insert macroName ts (customMacros st) }
423492 return mempty
424493
425−lexArgs :: PandocMonad m => ManLexer m [Arg]
494+lexArgs :: PandocMonad m => GroffLexer m [Arg]
426495lexArgs = do
427496 args <- many $ try oneArg
428497 skipMany spacetab
@@ -431,20 +500,20 @@ lexArgs = do
431500
432501 where
433502
434− oneArg :: PandocMonad m => ManLexer m [LinePart]
503+ oneArg :: PandocMonad m => GroffLexer m [LinePart]
435504 oneArg = do
436505 skipMany $ try $ string "\\\n" -- continuation line
437506 try quotedArg <|> plainArg
438507 -- try, because there are some erroneous files, e.g. linux/bpf.2
439508
440− plainArg :: PandocMonad m => ManLexer m [LinePart]
509+ plainArg :: PandocMonad m => GroffLexer m [LinePart]
441510 plainArg = do
442511 skipMany spacetab
443512 mconcat <$> many1 (macroArg <|> escape <|> regularText <|> unescapedQuote)
444513 where
445514 unescapedQuote = char '"' >> return [RoffStr "\""]
446515
447− quotedArg :: PandocMonad m => ManLexer m [LinePart]
516+ quotedArg :: PandocMonad m => GroffLexer m [LinePart]
448517 quotedArg = do
449518 skipMany spacetab
450519 char '"'
@@ -459,7 +528,7 @@ lexArgs = do
459528 char '"'
460529 return [RoffStr "\""]
461530
462−escStar :: PandocMonad m => ManLexer m [LinePart]
531+escStar :: PandocMonad m => GroffLexer m [LinePart]
463532escStar = try $ do
464533 pos <- getPosition
465534 c <- anyChar
@@ -478,14 +547,14 @@ escStar = try $ do
478547
479548 -- strings and macros share namespace
480549 resolveString stringname pos = do
481− ManTokens ts <- resolveMacro stringname [] pos
550+ GroffTokens ts <- resolveMacro stringname [] pos
482551 case Foldable.toList ts of
483552 [MLine xs] -> return xs
484553 _ -> do
485554 report $ SkippedContent ("unknown string " ++ stringname) pos
486555 return mempty
487556
488−lexLine :: PandocMonad m => ManLexer m ManTokens
557+lexLine :: PandocMonad m => GroffLexer m GroffTokens
489558lexLine = do
490559 lnparts <- mconcat <$> many1 linePart
491560 eofline
@@ -496,35 +565,35 @@ lexLine = do
496565 go (RoffStr "" : xs) = go xs
497566 go xs = return $ singleTok $ MLine xs
498567
499−linePart :: PandocMonad m => ManLexer m [LinePart]
568+linePart :: PandocMonad m => GroffLexer m [LinePart]
500569linePart = macroArg <|> escape <|>
501570 regularText <|> quoteChar <|> spaceTabChar
502571
503−macroArg :: PandocMonad m => ManLexer m [LinePart]
572+macroArg :: PandocMonad m => GroffLexer m [LinePart]
504573macroArg = try $ do
505574 string "\\\\$"
506575 x <- digit
507576 return [MacroArg $ ord x - ord '0']
508577
509−regularText :: PandocMonad m => ManLexer m [LinePart]
578+regularText :: PandocMonad m => GroffLexer m [LinePart]
510579regularText = do
511580 s <- many1 $ noneOf "\n\r\t \\\""
512581 return [RoffStr s]
513582
514−quoteChar :: PandocMonad m => ManLexer m [LinePart]
583+quoteChar :: PandocMonad m => GroffLexer m [LinePart]
515584quoteChar = do
516585 char '"'
517586 return [RoffStr "\""]
518587
519−spaceTabChar :: PandocMonad m => ManLexer m [LinePart]
588+spaceTabChar :: PandocMonad m => GroffLexer m [LinePart]
520589spaceTabChar = do
521590 c <- spacetab
522591 return [RoffStr [c]]
523592
524−lexEmptyLine :: PandocMonad m => ManLexer m ManTokens
593+lexEmptyLine :: PandocMonad m => GroffLexer m GroffTokens
525594lexEmptyLine = char '\n' >> return (singleTok MEmptyLine)
526595
527−manToken :: PandocMonad m => ManLexer m ManTokens
596+manToken :: PandocMonad m => GroffLexer m GroffTokens
528597manToken = lexComment <|> lexMacro <|> lexLine <|> lexEmptyLine
529598
530599linePartsToString :: [LinePart] -> String
@@ -532,3 +601,11 @@ linePartsToString = mconcat . map go
532601 where
533602 go (RoffStr s) = s
534603 go _ = mempty
604+
605+-- | Tokenize a string as a sequence of groff tokens.
606+lexGroff :: PandocMonad m => T.Text -> m GroffTokens
607+lexGroff txt = do
608+ eithertokens <- readWithM (mconcat <$> many manToken) def (T.unpack txt)
609+ case eithertokens of
610+ Left e -> throwError e
611+ Right tokenz -> return tokenz