pandoc-3.0: src/Text/Pandoc/Readers/Roff.hs
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{- |
Module : Text.Pandoc.Readers.Roff
Copyright : Copyright (C) 2018-2020 Yan Pashkovsky and John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : Yan Pashkovsky <yanp.bugz@gmail.com>
Stability : WIP
Portability : portable
Tokenizer for roff formats (man, ms).
-}
module Text.Pandoc.Readers.Roff
( FontSpec(..)
, defaultFontSpec
, LinePart(..)
, Arg
, TableOption
, CellFormat(..)
, TableRow
, RoffToken(..)
, RoffTokens(..)
, linePartsToText
, lexRoff
)
where
import Safe (lastDef)
import Control.Monad (void, mzero, mplus, guard)
import Control.Monad.Except (throwError)
import Text.Pandoc.Class.PandocMonad
(getResourcePath, readFileFromDirs, PandocMonad(..), report)
import Data.Char (isLower, toLower, toUpper, chr, isAscii, isAlphaNum)
import Data.Default (Default)
import qualified Data.Map as M
import Data.List (intercalate)
import qualified Data.Text as T
import Text.Pandoc.Logging (LogMessage(..))
import Text.Pandoc.Options
import Text.Pandoc.Parsing
import Text.Pandoc.Shared (safeRead)
import Text.Pandoc.RoffChar (characterCodes, combiningAccents)
import qualified Data.Sequence as Seq
import qualified Data.Foldable as Foldable
import qualified Data.Text.Normalize as Normalize
-- import Debug.Trace (traceShowId)
--
-- Data Types
--
data FontSpec = FontSpec{ fontBold :: Bool
, fontItalic :: Bool
, fontMonospace :: Bool
} deriving (Show, Eq, Ord)
defaultFontSpec :: FontSpec
defaultFontSpec = FontSpec False False False
data LinePart = RoffStr T.Text
| Font FontSpec
| MacroArg Int
deriving Show
type Arg = [LinePart]
type TableOption = (T.Text, T.Text)
data CellFormat =
CellFormat
{ columnType :: Char
, pipePrefix :: Bool
, pipeSuffix :: Bool
, columnSuffixes :: [T.Text]
} deriving (Show, Eq, Ord)
type TableRow = ([CellFormat], [RoffTokens])
data RoffToken = TextLine [LinePart]
| EmptyLine
| ControlLine T.Text [Arg] SourcePos
| Tbl [TableOption] [TableRow] SourcePos
deriving Show
newtype RoffTokens = RoffTokens { unRoffTokens :: Seq.Seq RoffToken }
deriving (Show, Semigroup, Monoid)
singleTok :: RoffToken -> RoffTokens
singleTok t = RoffTokens (Seq.singleton t)
data RoffMode = NormalMode
| CopyMode
deriving Show
data RoffState = RoffState { customMacros :: M.Map T.Text RoffTokens
, prevFont :: FontSpec
, currentFont :: FontSpec
, tableTabChar :: Char
, roffMode :: RoffMode
, lastExpression :: Maybe Bool
, afterConditional :: Bool
} deriving Show
instance Default RoffState where
def = RoffState { customMacros = M.fromList
$ map (\(n, s) ->
(n, singleTok
(TextLine [RoffStr s])))
[ ("Tm", "\x2122")
, ("lq", "\x201C")
, ("rq", "\x201D")
, ("R", "\x00AE") ]
, prevFont = defaultFontSpec
, currentFont = defaultFontSpec
, tableTabChar = '\t'
, roffMode = NormalMode
, lastExpression = Nothing
, afterConditional = False
}
type RoffLexer m = ParsecT Sources RoffState m
--
-- Lexer: T.Text -> RoffToken
--
eofline :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s u m ()
eofline = void newline <|> eof <|> () <$ lookAhead (string "\\}")
spacetab :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s u m Char
spacetab = char ' ' <|> char '\t'
characterCodeMap :: M.Map T.Text Char
characterCodeMap =
M.fromList $ map (\(x,y) -> (y,x)) characterCodes
combiningAccentsMap :: M.Map T.Text Char
combiningAccentsMap =
M.fromList $ map (\(x,y) -> (y,x)) combiningAccents
escape :: PandocMonad m => RoffLexer m [LinePart]
escape = try $ do
backslash
escapeGlyph <|> escapeNormal
escapeGlyph :: PandocMonad m => RoffLexer m [LinePart]
escapeGlyph = do
c <- lookAhead (oneOf ['[','('])
escapeArg >>= resolveGlyph c
resolveGlyph :: PandocMonad m => Char -> T.Text -> RoffLexer m [LinePart]
resolveGlyph delimChar glyph = do
let cs = T.replace "_u" " u" glyph -- unicode glyphs separated by _
(case T.words cs of
[] -> mzero
[s] -> case M.lookup s characterCodeMap `mplus` readUnicodeChar s of
Nothing -> mzero
Just c -> return [RoffStr $ T.singleton c]
(s:ss) -> do
basechar <- case M.lookup s characterCodeMap `mplus`
readUnicodeChar s of
Nothing ->
case T.unpack s of
[ch] | isAscii ch && isAlphaNum ch ->
return ch
_ -> mzero
Just c -> return c
let addAccents [] xs = return $ Normalize.normalize Normalize.NFC $
T.reverse xs
addAccents (a:as) xs =
case M.lookup a combiningAccentsMap `mplus` readUnicodeChar a of
Just x -> addAccents as $ T.cons x xs
Nothing -> mzero
addAccents ss (T.singleton basechar) >>= \xs -> return [RoffStr xs])
<|> case delimChar of
'[' -> escUnknown ("\\[" <> glyph <> "]")
'(' -> escUnknown ("\\(" <> glyph)
'\'' -> escUnknown ("\\C'" <> glyph <> "'")
_ -> Prelude.fail "resolveGlyph: unknown glyph delimiter"
readUnicodeChar :: T.Text -> Maybe Char
readUnicodeChar t = case T.uncons t of
Just ('u', cs) | T.length cs > 3 -> chr <$> safeRead ("0x" <> cs)
_ -> Nothing
escapeNormal :: PandocMonad m => RoffLexer m [LinePart]
escapeNormal = do
c <- noneOf "{}"
optional expandString
case c of
' ' -> return [RoffStr " "]
'"' -> mempty <$ skipMany (satisfy (/='\n')) -- line comment
'#' -> mempty <$ manyTill anyChar newline
'%' -> return mempty -- optional hyphenation
'&' -> return mempty -- nonprintable zero-width
')' -> return mempty -- nonprintable zero-width
'*' -> escString
',' -> return mempty -- to fix spacing after roman
'-' -> return [RoffStr "-"]
'.' -> return [RoffStr "."]
'/' -> return mempty -- to fix spacing before roman
'0' -> return [RoffStr "\x2007"] -- digit-width space
':' -> return mempty -- zero-width break
'A' -> quoteArg >>= checkDefined
'B' -> escIgnore 'B' [quoteArg]
'C' -> quoteArg >>= resolveGlyph '\''
'D' -> escIgnore 'D' [quoteArg]
'E' -> do
mode <- roffMode <$> getState
case mode of
CopyMode -> return mempty
NormalMode -> return [RoffStr "\\"]
'H' -> escIgnore 'H' [quoteArg]
'L' -> escIgnore 'L' [quoteArg]
'M' -> escIgnore 'M' [escapeArg, countChar 1 (satisfy (/='\n'))]
'N' -> escIgnore 'N' [quoteArg]
'O' -> escIgnore 'O' [countChar 1 (oneOf ['0','1'])]
'R' -> escIgnore 'R' [quoteArg]
'S' -> escIgnore 'S' [quoteArg]
'V' -> escIgnore 'V' [escapeArg, countChar 1 alphaNum]
'X' -> escIgnore 'X' [quoteArg]
'Y' -> escIgnore 'Y' [escapeArg, countChar 1 (satisfy (/='\n'))]
'Z' -> escIgnore 'Z' [quoteArg]
'\'' -> return [RoffStr "'"]
'\n' -> return mempty -- line continuation
'^' -> return [RoffStr "\x200A"] -- 1/12 em space
'_' -> return [RoffStr "_"]
'`' -> return [RoffStr "`"]
'a' -> return mempty -- "non-interpreted leader character"
'b' -> escIgnore 'b' [quoteArg]
'c' -> return mempty -- interrupt text processing
'd' -> escIgnore 'd' [] -- forward down 1/2em
'e' -> return [RoffStr "\\"]
'f' -> escFont
'g' -> escIgnore 'g' [escapeArg, countChar 1 (satisfy (/='\n'))]
'h' -> escIgnore 'h' [quoteArg]
'k' -> escIgnore 'k' [escapeArg, countChar 1 (satisfy (/='\n'))]
'l' -> escIgnore 'l' [quoteArg]
'm' -> escIgnore 'm' [escapeArg, countChar 1 (satisfy (/='\n'))]
'n' -> escIgnore 'm' [escapeArg, countChar 1 (satisfy (/='\n'))]
'o' -> escIgnore 'o' [quoteArg]
'p' -> escIgnore 'p' []
'r' -> escIgnore 'r' []
's' -> escIgnore 's' [escapeArg, signedNumber]
't' -> return [RoffStr "\t"]
'u' -> escIgnore 'u' []
'v' -> escIgnore 'v' [quoteArg]
'w' -> escIgnore 'w' [quoteArg]
'x' -> escIgnore 'x' [quoteArg]
'z' -> escIgnore 'z' [countChar 1 anyChar]
'|' -> return [RoffStr "\x2006"] --1/6 em space
'~' -> return [RoffStr "\160"] -- nonbreaking space
'\\' -> do
mode <- roffMode <$> getState
case mode of
CopyMode -> char '\\'
NormalMode -> return '\\'
return [RoffStr "\\"]
_ -> return [RoffStr $ T.singleton c]
-- man 7 groff: "If a backslash is followed by a character that
-- does not constitute a defined escape sequence, the backslash
-- is silently ignored and the character maps to itself."
escIgnore :: PandocMonad m
=> Char
-> [RoffLexer m T.Text]
-> RoffLexer m [LinePart]
escIgnore c argparsers = do
pos <- getPosition
arg <- snd <$> withRaw (choice argparsers) <|> return ""
report $ SkippedContent ("\\" <> T.cons c arg) pos
return mempty
escUnknown :: PandocMonad m => T.Text -> RoffLexer m [LinePart]
escUnknown s = do
pos <- getPosition
report $ SkippedContent s pos
return [RoffStr "\xFFFD"]
signedNumber :: PandocMonad m => RoffLexer m T.Text
signedNumber = try $ do
sign <- option "" ("-" <$ char '-' <|> "" <$ char '+')
ds <- many1Char digit
return (sign <> ds)
-- Parses: [..] or (..
escapeArg :: PandocMonad m => RoffLexer m T.Text
escapeArg = choice
[ char '[' *> optional expandString *>
manyTillChar (noneOf ['\n',']']) (char ']')
, char '(' *> optional expandString *>
countChar 2 (satisfy (/='\n'))
]
expandString :: PandocMonad m => RoffLexer m ()
expandString = try $ do
pos <- getPosition
char '\\'
char '*'
cs <- escapeArg <|> countChar 1 anyChar
s <- linePartsToText <$> resolveText cs pos
addToInput s
-- Parses: '..'
quoteArg :: PandocMonad m => RoffLexer m T.Text
quoteArg = char '\'' *> manyTillChar (noneOf ['\n','\'']) (char '\'')
escFont :: PandocMonad m => RoffLexer m [LinePart]
escFont = do
font <- escapeArg <|> countChar 1 alphaNum
font' <- if T.null font || font == "P"
then prevFont <$> getState
else return $ foldr processFontLetter defaultFontSpec $ T.unpack font
updateState $ \st -> st{ prevFont = currentFont st
, currentFont = font' }
return [Font font']
where
processFontLetter c fs
| isLower c = processFontLetter (toUpper c) fs
processFontLetter 'B' fs = fs{ fontBold = True }
processFontLetter 'I' fs = fs{ fontItalic = True }
processFontLetter 'C' fs = fs{ fontMonospace = True }
processFontLetter _ fs = fs -- do nothing
-- separate function from lexMacro since real man files sometimes do not
-- follow the rules
lexComment :: PandocMonad m => RoffLexer m RoffTokens
lexComment = do
try $ string ".\\\""
skipMany $ noneOf "\n"
eofline
return mempty
lexMacro :: PandocMonad m => RoffLexer m RoffTokens
lexMacro = do
pos <- getPosition
st <- getState
guard $ sourceColumn pos == 1 || afterConditional st
char '.' <|> char '\''
skipMany spacetab
macroName <- manyChar (satisfy isAlphaNum)
case macroName of
"nop" -> return mempty
"ie" -> lexConditional "ie"
"if" -> lexConditional "if"
"el" -> lexConditional "el"
"while" -> lexConditional "while"
-- this doesn't get the semantics right but
-- avoids parse errors
_ -> do
args <- lexArgs
case macroName of
"" -> return mempty
"TS" -> lexTable pos
"de" -> lexMacroDef args
"de1" -> lexMacroDef args
"ds" -> lexStringDef args
"ds1" -> lexStringDef args
"sp" -> return $ singleTok EmptyLine
"so" -> lexIncludeFile args
_ -> resolveMacro macroName args pos
lexTable :: PandocMonad m => SourcePos -> RoffLexer m RoffTokens
lexTable pos = do
skipMany lexComment
spaces
opts <- try tableOptions <|> [] <$ optional (char ';')
case lookup "tab" opts of
Just (T.uncons -> Just (c, _)) -> updateState $ \st -> st{ tableTabChar = c }
_ -> updateState $ \st -> st{ tableTabChar = '\t' }
spaces
skipMany lexComment
spaces
rows <- lexTableRows
morerows <- many $ try $ do
string ".T&"
skipMany spacetab
newline
lexTableRows
string ".TE"
skipMany spacetab
eofline
return $ singleTok $ Tbl opts (rows <> concat morerows) pos
lexTableRows :: PandocMonad m => RoffLexer m [TableRow]
lexTableRows = do
aligns <- tableFormatSpec
spaces
skipMany $ lexComment
<|> try (mempty <$ (string ".sp" >> skipMany spaceChar >> newline))
spaces
rows <- many (notFollowedBy (try (string ".TE") <|> try (string ".T&")) >>
tableRow)
return $ zip aligns rows
tableCell :: PandocMonad m => RoffLexer m RoffTokens
tableCell = do
pos <- getPosition
(enclosedCell <|> simpleCell) >>= lexRoff pos . T.pack
where
enclosedCell = do
try (string "T{")
manyTill anyChar (try (string "T}"))
simpleCell = do
tabChar <- tableTabChar <$> getState
many (notFollowedBy (char tabChar <|> newline) >> anyChar)
tableRow :: PandocMonad m => RoffLexer m [RoffTokens]
tableRow = do
tabChar <- tableTabChar <$> getState
c <- tableCell
cs <- many $ try (char tabChar >> tableCell)
skipMany spacetab
eofline
skipMany lexComment
return (c:cs)
tableOptions :: PandocMonad m => RoffLexer m [TableOption]
tableOptions = many1 tableOption <* spaces <* char ';'
tableOption :: PandocMonad m => RoffLexer m TableOption
tableOption = do
k <- many1Char letter
v <- option "" $ try $ do
skipMany spacetab
char '('
manyTillChar anyChar (char ')')
skipMany spacetab
optional (char ',' >> skipMany spacetab)
return (k,v)
tableFormatSpec :: PandocMonad m => RoffLexer m [[CellFormat]]
tableFormatSpec = do
first <- tableFormatSpecLine
rest <- many $ try $ (newline <|> char ',') *> tableFormatSpecLine
let speclines = first:rest
spaces
char '.'
return $ speclines <> repeat (lastDef [] speclines) -- last line is default
tableFormatSpecLine :: PandocMonad m => RoffLexer m [CellFormat]
tableFormatSpecLine =
many1 $ skipMany spacetab *> tableColFormat <* skipMany spacetab
tableColFormat :: PandocMonad m => RoffLexer m CellFormat
tableColFormat = do
pipePrefix' <- option False
$ True <$ try (string "|" <* notFollowedBy spacetab)
c <- oneOf ['a','A','c','C','l','L','n','N','r','R','s','S','^','_','-',
'=','|']
suffixes <- many $ try (skipMany spacetab *> countChar 1 digit) <|>
(do x <- oneOf ['b','B','d','D','e','E','f','F','i','I','m','M',
'p','P','t','T','u','U','v','V','w','W','x','X', 'z','Z']
num <- case toLower x of
'w' -> many1 digit <|>
(do char '('
xs <- manyTill anyChar (char ')')
return ("(" <> xs <> ")")) <|>
return ""
'f' -> count 1 alphaNum <* skipMany spacetab
'm' -> count 1 alphaNum <* skipMany spacetab
_ -> return ""
return $ T.pack $ x : num)
pipeSuffix' <- option False $ True <$ string "|"
return $ CellFormat
{ columnType = c
, pipePrefix = pipePrefix'
, pipeSuffix = pipeSuffix'
, columnSuffixes = suffixes }
-- We don't fully handle the conditional. But we do
-- include everything under '.ie n', which occurs commonly
-- in man pages.
lexConditional :: PandocMonad m => T.Text -> RoffLexer m RoffTokens
lexConditional mname = do
pos <- getPosition
skipMany spacetab
mbtest <- if mname == "el"
then fmap not . lastExpression <$> getState
else expression
skipMany spacetab
st <- getState -- save state, so we can reset it
ifPart <- do
optional $ try $ char '\\' >> newline
lexGroup
<|> do updateState $ \s -> s{ afterConditional = True }
t <- manToken
updateState $ \s -> s{ afterConditional = False }
return t
case mbtest of
Nothing -> do
setState st -- reset state, so we don't record macros in skipped section
report $ SkippedContent (T.cons '.' mname) pos
return mempty
Just True -> return ifPart
Just False -> do
setState st
return mempty
expression :: PandocMonad m => RoffLexer m (Maybe Bool)
expression = do
raw <- charsInBalanced '(' ')' (T.singleton <$> (satisfy (/= '\n')))
<|> many1Char nonspaceChar
returnValue $
case raw of
"1" -> Just True
"n" -> Just True -- nroff mode
"t" -> Just False -- troff mode
_ -> Nothing
where
returnValue v = do
updateState $ \st -> st{ lastExpression = v }
return v
lexGroup :: PandocMonad m => RoffLexer m RoffTokens
lexGroup = do
groupstart
mconcat <$> manyTill manToken groupend
where
groupstart = try $ string "\\{" <* optional (try (string "\\\n"))
groupend = try $ string "\\}"
lexIncludeFile :: PandocMonad m => [Arg] -> RoffLexer m RoffTokens
lexIncludeFile args = do
pos <- getPosition
case args of
(f:_) -> do
let fp = linePartsToText f
dirs <- getResourcePath
result <- readFileFromDirs dirs $ T.unpack fp
case result of
Nothing -> report $ CouldNotLoadIncludeFile fp pos
Just s -> addToInput s
return mempty
[] -> return mempty
resolveMacro :: PandocMonad m
=> T.Text -> [Arg] -> SourcePos -> RoffLexer m RoffTokens
resolveMacro macroName args pos = do
macros <- customMacros <$> getState
case M.lookup macroName macros of
Nothing -> return $ singleTok $ ControlLine macroName args pos
Just ts -> do
let fillLP (MacroArg i) zs =
case drop (i - 1) args of
[] -> zs
(ys:_) -> ys <> zs
fillLP z zs = z : zs
let fillMacroArg (TextLine lineparts) =
TextLine (foldr fillLP [] lineparts)
fillMacroArg x = x
return $ RoffTokens . fmap fillMacroArg . unRoffTokens $ ts
lexStringDef :: PandocMonad m => [Arg] -> RoffLexer m RoffTokens
lexStringDef args = do -- string definition
case args of
[] -> Prelude.fail "No argument to .ds"
(x:ys) -> do
let ts = singleTok $ TextLine (intercalate [RoffStr " " ] ys)
let stringName = linePartsToText x
updateState $ \st ->
st{ customMacros = M.insert stringName ts (customMacros st) }
return mempty
lexMacroDef :: PandocMonad m => [Arg] -> RoffLexer m RoffTokens
lexMacroDef args = do -- macro definition
updateState $ \st -> st{ roffMode = CopyMode }
(macroName, stopMacro) <-
case args of
(x : y : _) -> return (linePartsToText x, linePartsToText y)
-- optional second arg
(x:_) -> return (linePartsToText x, ".")
[] -> Prelude.fail "No argument to .de"
let stop = try $ do
char '.' <|> char '\''
skipMany spacetab
textStr stopMacro
_ <- lexArgs
return ()
ts <- mconcat <$> manyTill manToken stop
updateState $ \st ->
st{ customMacros = M.insert macroName ts (customMacros st)
, roffMode = NormalMode }
return mempty
lexArgs :: PandocMonad m => RoffLexer m [Arg]
lexArgs = do
args <- many $ try oneArg
skipMany spacetab
eofline
return args
where
oneArg :: PandocMonad m => RoffLexer m [LinePart]
oneArg = do
skipMany $ try $ string "\\\n" -- continuation line
try quotedArg <|> plainArg
-- try, because there are some erroneous files, e.g. linux/bpf.2
plainArg :: PandocMonad m => RoffLexer m [LinePart]
plainArg = do
skipMany spacetab
mconcat <$> many1 (macroArg <|> escape <|> regularText <|> unescapedQuote)
where
unescapedQuote = char '"' >> return [RoffStr "\""]
quotedArg :: PandocMonad m => RoffLexer m [LinePart]
quotedArg = do
skipMany spacetab
char '"'
xs <- mconcat <$>
many (macroArg <|> escape <|> regularText
<|> spaceTabChar <|> escapedQuote)
char '"'
return xs
where
escapedQuote = try $ do
char '"'
char '"'
return [RoffStr "\""]
checkDefined :: PandocMonad m => T.Text -> RoffLexer m [LinePart]
checkDefined name = do
macros <- customMacros <$> getState
case M.lookup name macros of
Just _ -> return [RoffStr "1"]
Nothing -> return [RoffStr "0"]
escString :: PandocMonad m => RoffLexer m [LinePart]
escString = try $ do
pos <- getPosition
(do cs <- escapeArg <|> countChar 1 anyChar
resolveText cs pos)
<|> mempty <$ char 'S'
-- strings and macros share namespace
resolveText :: PandocMonad m
=> T.Text -> SourcePos -> RoffLexer m [LinePart]
resolveText stringname pos = do
RoffTokens ts <- resolveMacro stringname [] pos
case Foldable.toList ts of
[TextLine xs] -> return xs
_ -> do
report $ SkippedContent ("unknown string " <> stringname) pos
return mempty
lexLine :: PandocMonad m => RoffLexer m RoffTokens
lexLine = do
mode <- roffMode <$> getState
case mode of
CopyMode -> optional $ try $ string "\\&"
NormalMode -> return ()
lnparts <- mconcat <$> many1 linePart
eofline
go lnparts
where -- return empty line if we only have empty strings;
-- this can happen if the line just contains \f[C], for example.
go [] = return mempty
go (RoffStr "" : xs) = go xs
go xs = return $ singleTok $ TextLine xs
linePart :: PandocMonad m => RoffLexer m [LinePart]
linePart = macroArg <|> escape <|>
regularText <|> quoteChar <|> spaceTabChar
backslash :: PandocMonad m => RoffLexer m ()
backslash = do
char '\\'
mode <- roffMode <$> getState
case mode of
-- experimentally, it seems you don't always need to double
-- the backslash in macro defs. It's essential with \\$1,
-- but not with \\f[I]. So we make the second one optional.
CopyMode -> optional $ char '\\'
NormalMode -> return ()
macroArg :: PandocMonad m => RoffLexer m [LinePart]
macroArg = try $ do
pos <- getPosition
backslash
char '$'
x <- escapeArg <|> countChar 1 digit
case safeRead x of
Just i -> return [MacroArg i]
Nothing -> do
report $ SkippedContent ("illegal macro argument " <> x) pos
return []
regularText :: PandocMonad m => RoffLexer m [LinePart]
regularText = do
s <- many1Char $ noneOf "\n\r\t \\\""
return [RoffStr s]
quoteChar :: PandocMonad m => RoffLexer m [LinePart]
quoteChar = do
char '"'
return [RoffStr "\""]
spaceTabChar :: PandocMonad m => RoffLexer m [LinePart]
spaceTabChar = do
c <- spacetab
return [RoffStr $ T.singleton c]
lexEmptyLine :: PandocMonad m => RoffLexer m RoffTokens
lexEmptyLine = newline >> return (singleTok EmptyLine)
manToken :: PandocMonad m => RoffLexer m RoffTokens
manToken = lexComment <|> lexMacro <|> lexLine <|> lexEmptyLine
linePartsToText :: [LinePart] -> T.Text
linePartsToText = mconcat . map go
where
go (RoffStr s) = s
go _ = mempty
-- | Tokenize a string as a sequence of roff tokens.
lexRoff :: PandocMonad m => SourcePos -> T.Text -> m RoffTokens
lexRoff pos txt = do
eithertokens <- readWithM (do setPosition pos
mconcat <$> many manToken) def txt
case eithertokens of
Left e -> throwError e
Right tokenz -> return tokenz