@@ -36,6 +36,7 @@ module Text.Pandoc.Readers.Roff
3636 , FontSpec(..)
3737 , defaultFontSpec
3838 , LinePart(..)
39+ , LineParts(..)
3940 , Arg
4041 , TableOption
4142 , CellFormat(..)
@@ -56,7 +57,7 @@ import Text.Pandoc.Class
5657import Data.Char (isHexDigit, chr, ord, isAscii, isAlphaNum, isSpace)
5758import Data.Default (Default)
5859import qualified Data.Map as M
59−import Data.List (intercalate, isSuffixOf)
60+import Data.List (intersperse, isSuffixOf)
6061import qualified Data.Text as T
6162import Text.Pandoc.Logging (LogMessage(..))
6263import Text.Pandoc.Options
@@ -91,7 +92,13 @@ data LinePart = RoffStr String
9192 | MacroArg Int
9293 deriving Show
9394
94−type Arg = [LinePart]
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
95102
96103type TableOption = (String, String)
97104
@@ -105,7 +112,7 @@ data CellFormat =
105112
106113type TableRow = ([CellFormat], [RoffTokens])
107114
108−data RoffToken = MLine [LinePart]
115+data RoffToken = MLine LineParts
109116 | MEmptyLine
110117 | MMacro MacroKind [Arg] SourcePos
111118 | MTable [TableOption] [TableRow] SourcePos
@@ -127,7 +134,7 @@ instance Default RoffState where
127134 def = RoffState { customMacros = M.fromList
128135 $ map (\(n, s) ->
129136 (n, singleTok
130− (MLine [RoffStr s])))
137+ (MLine $ singleLinePart $ RoffStr s)))
131138 [ ("Tm", "\x2122")
132139 , ("lq", "\x201C")
133140 , ("rq", "\x201D")
@@ -157,7 +164,7 @@ combiningAccentsMap :: M.Map String Char
157164combiningAccentsMap =
158165 M.fromList $ map (\(x,y) -> (y,x)) combiningAccents
159166
160−escape :: PandocMonad m => RoffLexer m (Seq LinePart)
167+escape :: PandocMonad m => RoffLexer m (LineParts)
161168escape = do
162169 char '\\'
163170 c <- anyChar
@@ -177,18 +184,18 @@ escape = do
177184 ':' -> return mempty
178185 '0' -> return mempty
179186 'c' -> return mempty
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
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
192199 _ -> escUnknown ['\\',c]
193200
194201 where
@@ -196,7 +203,7 @@ escape = do
196203 twoCharGlyph = do
197204 cs <- count 2 anyChar
198205 case M.lookup cs characterCodeMap of
199− Just c -> return $ Seq.singleton $ RoffStr [c]
206+ Just c -> return $ singleLinePart $ RoffStr [c]
200207 Nothing -> escUnknown ('\\':'(':cs)
201208
202209 bracketedGlyph = unicodeGlyph <|> charGlyph
@@ -207,7 +214,7 @@ escape = do
207214 [] -> mzero
208215 [s] -> case M.lookup s characterCodeMap of
209216 Nothing -> mzero
210− Just c -> return $ Seq.singleton $ RoffStr [c]
217+ Just c -> return $ singleLinePart $ RoffStr [c]
211218 (s:ss) -> do
212219 basechar <- case M.lookup cs characterCodeMap of
213220 Nothing ->
@@ -224,12 +231,12 @@ escape = do
224231 Just x -> addAccents as (x:xs)
225232 Nothing -> mzero
226233 addAccents ss [basechar] >>= \xs ->
227− return (Seq.singleton $ RoffStr xs))
234+ return (singleLinePart $ RoffStr xs))
228235 <|> escUnknown ("\\[" ++ cs ++ "]")
229236
230237 unicodeGlyph = try $ do
231238 xs <- ucharCode `sepBy1` (char '_') <* char ']'
232− return $ Seq.singleton $ RoffStr xs
239+ return $ singleLinePart $ RoffStr xs
233240
234241 ucharCode = try $ do
235242 char 'u'
@@ -240,20 +247,20 @@ escape = do
240247 Nothing -> mzero
241248 Just c -> return c
242249
243− escUnknown :: PandocMonad m => String -> RoffLexer m (Seq LinePart)
250+ escUnknown :: PandocMonad m => String -> RoffLexer m (LineParts)
244251 escUnknown s = do
245252 pos <- getPosition
246253 report $ SkippedContent ("Unknown escape sequence " ++ s) pos
247− return $ Seq.singleton $ RoffStr "\xFFFD"
254+ return $ singleLinePart $ RoffStr "\xFFFD"
248255
249256-- \s-1 \s0
250−escFontSize :: PandocMonad m => RoffLexer m (Seq LinePart)
257+escFontSize :: PandocMonad m => RoffLexer m (LineParts)
251258escFontSize = do
252259 let sign = option "" $ ("-" <$ char '-' <|> "" <$ char '+')
253260 let toFontSize xs =
254261 case safeRead xs of
255262 Nothing -> mzero
256− Just n -> return $ Seq.singleton $ FontSize n
263+ Just n -> return $ singleLinePart $ FontSize n
257264 choice
258265 [ do char '('
259266 s <- sign
@@ -269,7 +276,7 @@ escFontSize = do
269276 toFontSize (s ++ ds)
270277 ]
271278
272−escFont :: PandocMonad m => RoffLexer m (Seq LinePart)
279+escFont :: PandocMonad m => RoffLexer m (LineParts)
273280escFont = do
274281 font <- choice
275282 [ digit >> return defaultFontSpec
@@ -279,7 +286,7 @@ escFont = do
279286 ]
280287 modifyState $ \st -> st{ prevFont = currentFont st
281288 , currentFont = font }
282− return $ Seq.singleton $ Font font
289+ return $ singleLinePart $ Font font
283290
284291lettersFont :: PandocMonad m => RoffLexer m FontSpec
285292lettersFont = try $ do
@@ -496,10 +503,10 @@ resolveMacro macroName args pos = do
496503 let fillLP (MacroArg i) zs =
497504 case drop (i - 1) args of
498505 [] -> zs
499− (ys:_) -> ys ++ zs
500− fillLP z zs = z : zs
501− let fillMacroArg (MLine lineparts) =
502− MLine (foldr fillLP [] lineparts)
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))
503510 fillMacroArg x = x
504511 return $ RoffTokens . fmap fillMacroArg . unRoffTokens $ ts
505512
@@ -508,7 +515,8 @@ lexStringDef args = do -- string definition
508515 case args of
509516 [] -> fail "No argument to .ds"
510517 (x:ys) -> do
511− let ts = singleTok $ MLine (intercalate [RoffStr " " ] ys)
518+ let ts = singleTok $ MLine $ mconcat
519+ $ intersperse (singleLinePart $ RoffStr " " ) ys
512520 let stringName = linePartsToString x
513521 modifyState $ \st ->
514522 st{ customMacros = M.insert stringName ts (customMacros st) }
@@ -538,24 +546,24 @@ lexArgs = do
538546 args <- many $ try oneArg
539547 skipMany spacetab
540548 eofline
541− return $ map Foldable.toList args
549+ return args
542550
543551 where
544552
545− oneArg :: PandocMonad m => RoffLexer m (Seq LinePart)
553+ oneArg :: PandocMonad m => RoffLexer m (LineParts)
546554 oneArg = do
547555 skipMany $ try $ string "\\\n" -- continuation line
548556 try quotedArg <|> plainArg
549557 -- try, because there are some erroneous files, e.g. linux/bpf.2
550558
551− plainArg :: PandocMonad m => RoffLexer m (Seq LinePart)
559+ plainArg :: PandocMonad m => RoffLexer m (LineParts)
552560 plainArg = do
553561 skipMany spacetab
554562 mconcat <$> many1 (macroArg <|> escape <|> regularText <|> unescapedQuote)
555563 where
556− unescapedQuote = char '"' >> return (Seq.singleton $ RoffStr "\"")
564+ unescapedQuote = char '"' >> return (singleLinePart $ RoffStr "\"")
557565
558− quotedArg :: PandocMonad m => RoffLexer m (Seq LinePart)
566+ quotedArg :: PandocMonad m => RoffLexer m (LineParts)
559567 quotedArg = do
560568 skipMany spacetab
561569 char '"'
@@ -568,9 +576,9 @@ lexArgs = do
568576 escapedQuote = try $ do
569577 char '"'
570578 char '"'
571− return $ Seq.singleton $ RoffStr "\""
579+ return $ singleLinePart $ RoffStr "\""
572580
573−escStar :: PandocMonad m => RoffLexer m (Seq LinePart)
581+escStar :: PandocMonad m => RoffLexer m (LineParts)
574582escStar = try $ do
575583 pos <- getPosition
576584 c <- anyChar
@@ -591,46 +599,46 @@ escStar = try $ do
591599 resolveString stringname pos = do
592600 RoffTokens ts <- resolveMacro stringname [] pos
593601 case Foldable.toList ts of
594− [MLine xs] -> return $ Seq.fromList xs
602+ [MLine xs] -> return xs
595603 _ -> do
596604 report $ SkippedContent ("unknown string " ++ stringname) pos
597605 return mempty
598606
599607lexLine :: PandocMonad m => RoffLexer m RoffTokens
600608lexLine = do
601− lnparts <- Foldable.toList . mconcat <$> many1 linePart
609+ lnparts <- mconcat <$> many1 linePart
602610 eofline
603− go lnparts
604− where -- return empty line if we only have empty strings;
611+ go (unLineParts lnparts)
612+ where -- return mempty if we only have empty strings;
605613 -- this can happen if the line just contains \f[C], for example.
606− go [] = return mempty
607− go (RoffStr "" : xs) = go xs
608− go xs = return $ singleTok $ MLine xs
614+ go Seq.Empty = return mempty
615+ go ((RoffStr "") Seq.:<| xs) = go xs
616+ go xs = return $ singleTok $ MLine (LineParts xs)
609617
610−linePart :: PandocMonad m => RoffLexer m (Seq LinePart)
618+linePart :: PandocMonad m => RoffLexer m (LineParts)
611619linePart = macroArg <|> escape <|>
612620 regularText <|> quoteChar <|> spaceTabChar
613621
614−macroArg :: PandocMonad m => RoffLexer m (Seq LinePart)
622+macroArg :: PandocMonad m => RoffLexer m (LineParts)
615623macroArg = try $ do
616624 string "\\\\$"
617625 x <- digit
618− return $ Seq.singleton $ MacroArg $ ord x - ord '0'
626+ return $ singleLinePart $ MacroArg $ ord x - ord '0'
619627
620−regularText :: PandocMonad m => RoffLexer m (Seq LinePart)
628+regularText :: PandocMonad m => RoffLexer m (LineParts)
621629regularText = do
622630 s <- many1 $ noneOf "\n\r\t \\\""
623− return $ Seq.singleton $ RoffStr s
631+ return $ singleLinePart $ RoffStr s
624632
625−quoteChar :: PandocMonad m => RoffLexer m (Seq LinePart)
633+quoteChar :: PandocMonad m => RoffLexer m (LineParts)
626634quoteChar = do
627635 char '"'
628− return $ Seq.singleton $ RoffStr "\""
636+ return $ singleLinePart $ RoffStr "\""
629637
630−spaceTabChar :: PandocMonad m => RoffLexer m (Seq LinePart)
638+spaceTabChar :: PandocMonad m => RoffLexer m (LineParts)
631639spaceTabChar = do
632640 c <- spacetab
633− return $ Seq.singleton $ RoffStr [c]
641+ return $ singleLinePart $ RoffStr [c]
634642
635643lexEmptyLine :: PandocMonad m => RoffLexer m RoffTokens
636644lexEmptyLine = newline >> return (singleTok MEmptyLine)
@@ -638,8 +646,8 @@ lexEmptyLine = newline >> return (singleTok MEmptyLine)
638646manToken :: PandocMonad m => RoffLexer m RoffTokens
639647manToken = lexComment <|> lexMacro <|> lexLine <|> lexEmptyLine
640648
641−linePartsToString :: [LinePart] -> String
642−linePartsToString = mconcat . map go
649+linePartsToString :: LineParts -> String
650+linePartsToString = Foldable.foldMap go . unLineParts
643651 where
644652 go (RoffStr s) = s
645653 go _ = mempty