@@ -36,7 +36,6 @@ module Text.Pandoc.Readers.Roff
3636 , FontSpec(..)
3737 , defaultFontSpec
3838 , LinePart(..)
39− , LineParts(..)
4039 , Arg
4140 , TableOption
4241 , CellFormat(..)
@@ -57,7 +56,7 @@ import Text.Pandoc.Class
5756import Data.Char (isHexDigit, chr, ord, isAscii, isAlphaNum, isSpace)
5857import Data.Default (Default)
5958import qualified Data.Map as M
60−import Data.List (intersperse, isSuffixOf)
59+import Data.List (intercalate, isSuffixOf)
6160import qualified Data.Text as T
6261import Text.Pandoc.Logging (LogMessage(..))
6362import Text.Pandoc.Options
@@ -92,13 +91,7 @@ data LinePart = RoffStr String
9291 | MacroArg Int
9392 deriving Show
9493
95−newtype LineParts = LineParts { unLineParts :: Seq LinePart }
96− deriving (Show, Semigroup, Monoid)
97−
98−singleLinePart :: LinePart -> LineParts
99−singleLinePart t = LineParts (Seq.singleton t)
100−
101−type Arg = LineParts
94+type Arg = [LinePart]
10295
10396type TableOption = (String, String)
10497
@@ -112,7 +105,7 @@ data CellFormat =
112105
113106type TableRow = ([CellFormat], [RoffTokens])
114107
115−data RoffToken = MLine LineParts
108+data RoffToken = MLine [LinePart]
116109 | MEmptyLine
117110 | MMacro MacroKind [Arg] SourcePos
118111 | MTable [TableOption] [TableRow] SourcePos
@@ -134,7 +127,7 @@ instance Default RoffState where
134127 def = RoffState { customMacros = M.fromList
135128 $ map (\(n, s) ->
136129 (n, singleTok
137− (MLine $ singleLinePart $ RoffStr s)))
130+ (MLine [RoffStr s])))
138131 [ ("Tm", "\x2122")
139132 , ("lq", "\x201C")
140133 , ("rq", "\x201D")
@@ -164,7 +157,7 @@ combiningAccentsMap :: M.Map String Char
164157combiningAccentsMap =
165158 M.fromList $ map (\(x,y) -> (y,x)) combiningAccents
166159
167−escape :: PandocMonad m => RoffLexer m (LineParts)
160+escape :: PandocMonad m => RoffLexer m (Seq LinePart)
168161escape = do
169162 char '\\'
170163 c <- anyChar
@@ -184,18 +177,18 @@ escape = do
184177 ':' -> return mempty
185178 '0' -> return mempty
186179 'c' -> return mempty
187− '-' -> return $ singleLinePart $ RoffStr "-"
188− '_' -> return $ singleLinePart $ RoffStr "_"
189− ' ' -> return $ singleLinePart $ RoffStr " "
190− '\\' -> return $ singleLinePart $ RoffStr "\\"
191− 't' -> return $ singleLinePart $ RoffStr "\t"
192− 'e' -> return $ singleLinePart $ RoffStr "\\"
193− '`' -> return $ singleLinePart $ RoffStr "`"
194− '^' -> return $ singleLinePart $ RoffStr " "
195− '|' -> return $ singleLinePart $ RoffStr " "
196− '\'' -> return $ singleLinePart $ RoffStr "`"
197− '.' -> return $ singleLinePart $ RoffStr "`"
198− '~' -> return $ singleLinePart $ RoffStr "\160" -- nonbreaking space
180+ '-' -> return $ Seq.singleton $ RoffStr "-"
181+ '_' -> return $ Seq.singleton $ RoffStr "_"
182+ ' ' -> return $ Seq.singleton $ RoffStr " "
183+ '\\' -> return $ Seq.singleton $ RoffStr "\\"
184+ 't' -> return $ Seq.singleton $ RoffStr "\t"
185+ 'e' -> return $ Seq.singleton $ RoffStr "\\"
186+ '`' -> return $ Seq.singleton $ RoffStr "`"
187+ '^' -> return $ Seq.singleton $ RoffStr " "
188+ '|' -> return $ Seq.singleton $ RoffStr " "
189+ '\'' -> return $ Seq.singleton $ RoffStr "`"
190+ '.' -> return $ Seq.singleton $ RoffStr "`"
191+ '~' -> return $ Seq.singleton $ RoffStr "\160" -- nonbreaking space
199192 _ -> escUnknown ['\\',c]
200193
201194 where
@@ -203,7 +196,7 @@ escape = do
203196 twoCharGlyph = do
204197 cs <- count 2 anyChar
205198 case M.lookup cs characterCodeMap of
206− Just c -> return $ singleLinePart $ RoffStr [c]
199+ Just c -> return $ Seq.singleton $ RoffStr [c]
207200 Nothing -> escUnknown ('\\':'(':cs)
208201
209202 bracketedGlyph = unicodeGlyph <|> charGlyph
@@ -214,7 +207,7 @@ escape = do
214207 [] -> mzero
215208 [s] -> case M.lookup s characterCodeMap of
216209 Nothing -> mzero
217− Just c -> return $ singleLinePart $ RoffStr [c]
210+ Just c -> return $ Seq.singleton $ RoffStr [c]
218211 (s:ss) -> do
219212 basechar <- case M.lookup cs characterCodeMap of
220213 Nothing ->
@@ -231,12 +224,12 @@ escape = do
231224 Just x -> addAccents as (x:xs)
232225 Nothing -> mzero
233226 addAccents ss [basechar] >>= \xs ->
234− return (singleLinePart $ RoffStr xs))
227+ return (Seq.singleton $ RoffStr xs))
235228 <|> escUnknown ("\\[" ++ cs ++ "]")
236229
237230 unicodeGlyph = try $ do
238231 xs <- ucharCode `sepBy1` (char '_') <* char ']'
239− return $ singleLinePart $ RoffStr xs
232+ return $ Seq.singleton $ RoffStr xs
240233
241234 ucharCode = try $ do
242235 char 'u'
@@ -247,20 +240,20 @@ escape = do
247240 Nothing -> mzero
248241 Just c -> return c
249242
250− escUnknown :: PandocMonad m => String -> RoffLexer m (LineParts)
243+ escUnknown :: PandocMonad m => String -> RoffLexer m (Seq LinePart)
251244 escUnknown s = do
252245 pos <- getPosition
253246 report $ SkippedContent ("Unknown escape sequence " ++ s) pos
254− return $ singleLinePart $ RoffStr "\xFFFD"
247+ return $ Seq.singleton $ RoffStr "\xFFFD"
255248
256249-- \s-1 \s0
257−escFontSize :: PandocMonad m => RoffLexer m (LineParts)
250+escFontSize :: PandocMonad m => RoffLexer m (Seq LinePart)
258251escFontSize = do
259252 let sign = option "" $ ("-" <$ char '-' <|> "" <$ char '+')
260253 let toFontSize xs =
261254 case safeRead xs of
262255 Nothing -> mzero
263− Just n -> return $ singleLinePart $ FontSize n
256+ Just n -> return $ Seq.singleton $ FontSize n
264257 choice
265258 [ do char '('
266259 s <- sign
@@ -276,7 +269,7 @@ escFontSize = do
276269 toFontSize (s ++ ds)
277270 ]
278271
279−escFont :: PandocMonad m => RoffLexer m (LineParts)
272+escFont :: PandocMonad m => RoffLexer m (Seq LinePart)
280273escFont = do
281274 font <- choice
282275 [ digit >> return defaultFontSpec
@@ -286,7 +279,7 @@ escFont = do
286279 ]
287280 modifyState $ \st -> st{ prevFont = currentFont st
288281 , currentFont = font }
289− return $ singleLinePart $ Font font
282+ return $ Seq.singleton $ Font font
290283
291284lettersFont :: PandocMonad m => RoffLexer m FontSpec
292285lettersFont = try $ do
@@ -503,10 +496,10 @@ resolveMacro macroName args pos = do
503496 let fillLP (MacroArg i) zs =
504497 case drop (i - 1) args of
505498 [] -> zs
506− (LineParts ys:_) -> ys <> zs
507− fillLP z zs = z Seq.<| zs
508− let fillMacroArg (MLine (LineParts lineparts)) =
509− MLine (LineParts (foldr fillLP mempty lineparts))
499+ (ys:_) -> ys ++ zs
500+ fillLP z zs = z : zs
501+ let fillMacroArg (MLine lineparts) =
502+ MLine (foldr fillLP [] lineparts)
510503 fillMacroArg x = x
511504 return $ RoffTokens . fmap fillMacroArg . unRoffTokens $ ts
512505
@@ -515,8 +508,7 @@ lexStringDef args = do -- string definition
515508 case args of
516509 [] -> fail "No argument to .ds"
517510 (x:ys) -> do
518− let ts = singleTok $ MLine $ mconcat
519− $ intersperse (singleLinePart $ RoffStr " " ) ys
511+ let ts = singleTok $ MLine (intercalate [RoffStr " " ] ys)
520512 let stringName = linePartsToString x
521513 modifyState $ \st ->
522514 st{ customMacros = M.insert stringName ts (customMacros st) }
@@ -546,24 +538,24 @@ lexArgs = do
546538 args <- many $ try oneArg
547539 skipMany spacetab
548540 eofline
549− return args
541+ return $ map Foldable.toList args
550542
551543 where
552544
553− oneArg :: PandocMonad m => RoffLexer m (LineParts)
545+ oneArg :: PandocMonad m => RoffLexer m (Seq LinePart)
554546 oneArg = do
555547 skipMany $ try $ string "\\\n" -- continuation line
556548 try quotedArg <|> plainArg
557549 -- try, because there are some erroneous files, e.g. linux/bpf.2
558550
559− plainArg :: PandocMonad m => RoffLexer m (LineParts)
551+ plainArg :: PandocMonad m => RoffLexer m (Seq LinePart)
560552 plainArg = do
561553 skipMany spacetab
562554 mconcat <$> many1 (macroArg <|> escape <|> regularText <|> unescapedQuote)
563555 where
564− unescapedQuote = char '"' >> return (singleLinePart $ RoffStr "\"")
556+ unescapedQuote = char '"' >> return (Seq.singleton $ RoffStr "\"")
565557
566− quotedArg :: PandocMonad m => RoffLexer m (LineParts)
558+ quotedArg :: PandocMonad m => RoffLexer m (Seq LinePart)
567559 quotedArg = do
568560 skipMany spacetab
569561 char '"'
@@ -576,9 +568,9 @@ lexArgs = do
576568 escapedQuote = try $ do
577569 char '"'
578570 char '"'
579− return $ singleLinePart $ RoffStr "\""
571+ return $ Seq.singleton $ RoffStr "\""
580572
581−escStar :: PandocMonad m => RoffLexer m (LineParts)
573+escStar :: PandocMonad m => RoffLexer m (Seq LinePart)
582574escStar = try $ do
583575 pos <- getPosition
584576 c <- anyChar
@@ -599,46 +591,46 @@ escStar = try $ do
599591 resolveString stringname pos = do
600592 RoffTokens ts <- resolveMacro stringname [] pos
601593 case Foldable.toList ts of
602− [MLine xs] -> return xs
594+ [MLine xs] -> return $ Seq.fromList xs
603595 _ -> do
604596 report $ SkippedContent ("unknown string " ++ stringname) pos
605597 return mempty
606598
607599lexLine :: PandocMonad m => RoffLexer m RoffTokens
608600lexLine = do
609− lnparts <- mconcat <$> many1 linePart
601+ lnparts <- Foldable.toList . mconcat <$> many1 linePart
610602 eofline
611− go (unLineParts lnparts)
612− where -- return mempty if we only have empty strings;
603+ go lnparts
604+ where -- return empty line if we only have empty strings;
613605 -- this can happen if the line just contains \f[C], for example.
614− go Seq.Empty = return mempty
615− go ((RoffStr "") Seq.:<| xs) = go xs
616− go xs = return $ singleTok $ MLine (LineParts xs)
606+ go [] = return mempty
607+ go (RoffStr "" : xs) = go xs
608+ go xs = return $ singleTok $ MLine xs
617609
618−linePart :: PandocMonad m => RoffLexer m (LineParts)
610+linePart :: PandocMonad m => RoffLexer m (Seq LinePart)
619611linePart = macroArg <|> escape <|>
620612 regularText <|> quoteChar <|> spaceTabChar
621613
622−macroArg :: PandocMonad m => RoffLexer m (LineParts)
614+macroArg :: PandocMonad m => RoffLexer m (Seq LinePart)
623615macroArg = try $ do
624616 string "\\\\$"
625617 x <- digit
626− return $ singleLinePart $ MacroArg $ ord x - ord '0'
618+ return $ Seq.singleton $ MacroArg $ ord x - ord '0'
627619
628−regularText :: PandocMonad m => RoffLexer m (LineParts)
620+regularText :: PandocMonad m => RoffLexer m (Seq LinePart)
629621regularText = do
630622 s <- many1 $ noneOf "\n\r\t \\\""
631− return $ singleLinePart $ RoffStr s
623+ return $ Seq.singleton $ RoffStr s
632624
633−quoteChar :: PandocMonad m => RoffLexer m (LineParts)
625+quoteChar :: PandocMonad m => RoffLexer m (Seq LinePart)
634626quoteChar = do
635627 char '"'
636− return $ singleLinePart $ RoffStr "\""
628+ return $ Seq.singleton $ RoffStr "\""
637629
638−spaceTabChar :: PandocMonad m => RoffLexer m (LineParts)
630+spaceTabChar :: PandocMonad m => RoffLexer m (Seq LinePart)
639631spaceTabChar = do
640632 c <- spacetab
641− return $ singleLinePart $ RoffStr [c]
633+ return $ Seq.singleton $ RoffStr [c]
642634
643635lexEmptyLine :: PandocMonad m => RoffLexer m RoffTokens
644636lexEmptyLine = newline >> return (singleTok MEmptyLine)
@@ -646,8 +638,8 @@ lexEmptyLine = newline >> return (singleTok MEmptyLine)
646638manToken :: PandocMonad m => RoffLexer m RoffTokens
647639manToken = lexComment <|> lexMacro <|> lexLine <|> lexEmptyLine
648640
649−linePartsToString :: LineParts -> String
650−linePartsToString = Foldable.foldMap go . unLineParts
641+linePartsToString :: [LinePart] -> String
642+linePartsToString = mconcat . map go
651643 where
652644 go (RoffStr s) = s
653645 go _ = mempty