dc77d36 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Revert "Roff tokenizer: use Seq for lineparts rather than lists."

dc77d36John MacFarlane8 years ago

src/Text/Pandoc/Readers/Roff.hs+42−44

compare with master

unifiedsplit

@@ -66,7 +66,6 @@ import Text.Parsec hiding (tokenPrim)

66import qualified Text.Parsec as Parsec

67import Text.Pandoc.RoffChar (characterCodes, combiningAccents)

68import qualified Data.Sequence as Seq

69−import Data.Sequence (Seq)

70import qualified Data.Foldable as Foldable

69import qualified Data.Foldable as Foldable

71import qualified Data.Text.Normalize as Normalize

70import qualified Data.Text.Normalize as Normalize

@@ -111,7 +110,7 @@ data RoffToken = MLine [LinePart]

111 | MTable [TableOption] [TableRow] SourcePos

110 | MTable [TableOption] [TableRow] SourcePos

112 deriving Show

111 deriving Show

113

112

114−newtype RoffTokens = RoffTokens { unRoffTokens :: Seq RoffToken }

113+newtype RoffTokens = RoffTokens { unRoffTokens :: Seq.Seq RoffToken }

115 deriving (Show, Semigroup, Monoid)

114 deriving (Show, Semigroup, Monoid)

116

115

117singleTok :: RoffToken -> RoffTokens

116singleTok :: RoffToken -> RoffTokens

@@ -157,7 +156,7 @@ combiningAccentsMap :: M.Map String Char

157combiningAccentsMap =

156combiningAccentsMap =

158 M.fromList $ map (\(x,y) -> (y,x)) combiningAccents

157 M.fromList $ map (\(x,y) -> (y,x)) combiningAccents

159

158

160−escape :: PandocMonad m => RoffLexer m (Seq LinePart)

159+escape :: PandocMonad m => RoffLexer m [LinePart]

161escape = do

160escape = do

162 char '\\'

161 char '\\'

163 c <- anyChar

162 c <- anyChar

@@ -177,18 +176,18 @@ escape = do

177 ':' -> return mempty

176 ':' -> return mempty

178 '0' -> return mempty

177 '0' -> return mempty

179 'c' -> return mempty

178 'c' -> return mempty

180− '-' -> return $ Seq.singleton $ RoffStr "-"

179+ '-' -> return [RoffStr "-"]

181− '_' -> return $ Seq.singleton $ RoffStr "_"

180+ '_' -> return [RoffStr "_"]

182− ' ' -> return $ Seq.singleton $ RoffStr " "

181+ ' ' -> return [RoffStr " "]

183− '\\' -> return $ Seq.singleton $ RoffStr "\\"

182+ '\\' -> return [RoffStr "\\"]

184− 't' -> return $ Seq.singleton $ RoffStr "\t"

183+ 't' -> return [RoffStr "\t"]

185− 'e' -> return $ Seq.singleton $ RoffStr "\\"

184+ 'e' -> return [RoffStr "\\"]

186− '`' -> return $ Seq.singleton $ RoffStr "`"

185+ '`' -> return [RoffStr "`"]

187− '^' -> return $ Seq.singleton $ RoffStr " "

186+ '^' -> return [RoffStr " "]

188− '|' -> return $ Seq.singleton $ RoffStr " "

187+ '|' -> return [RoffStr " "]

189− '\'' -> return $ Seq.singleton $ RoffStr "`"

188+ '\'' -> return [RoffStr "`"]

190− '.' -> return $ Seq.singleton $ RoffStr "`"

189+ '.' -> return [RoffStr "`"]

191− '~' -> return $ Seq.singleton $ RoffStr "\160" -- nonbreaking space

190+ '~' -> return [RoffStr "\160"] -- nonbreaking space

192 _ -> escUnknown ['\\',c]

191 _ -> escUnknown ['\\',c]

193

192

194 where

193 where

@@ -196,7 +195,7 @@ escape = do

196 twoCharGlyph = do

195 twoCharGlyph = do

197 cs <- count 2 anyChar

196 cs <- count 2 anyChar

198 case M.lookup cs characterCodeMap of

197 case M.lookup cs characterCodeMap of

199− Just c -> return $ Seq.singleton $ RoffStr [c]

198+ Just c -> return [RoffStr [c]]

200 Nothing -> escUnknown ('\\':'(':cs)

199 Nothing -> escUnknown ('\\':'(':cs)

201

200

202 bracketedGlyph = unicodeGlyph <|> charGlyph

201 bracketedGlyph = unicodeGlyph <|> charGlyph

@@ -207,7 +206,7 @@ escape = do

207 [] -> mzero

206 [] -> mzero

208 [s] -> case M.lookup s characterCodeMap of

207 [s] -> case M.lookup s characterCodeMap of

209 Nothing -> mzero

208 Nothing -> mzero

210− Just c -> return $ Seq.singleton $ RoffStr [c]

209+ Just c -> return [RoffStr [c]]

211 (s:ss) -> do

210 (s:ss) -> do

212 basechar <- case M.lookup cs characterCodeMap of

211 basechar <- case M.lookup cs characterCodeMap of

213 Nothing ->

212 Nothing ->

@@ -223,13 +222,12 @@ escape = do

223 case M.lookup a combiningAccentsMap of

222 case M.lookup a combiningAccentsMap of

224 Just x -> addAccents as (x:xs)

223 Just x -> addAccents as (x:xs)

225 Nothing -> mzero

224 Nothing -> mzero

226− addAccents ss [basechar] >>= \xs ->

225+ addAccents ss [basechar] >>= \xs -> return [RoffStr xs])

227− return (Seq.singleton $ RoffStr xs))

228 <|> escUnknown ("\\[" ++ cs ++ "]")

226 <|> escUnknown ("\\[" ++ cs ++ "]")

229

227

230 unicodeGlyph = try $ do

228 unicodeGlyph = try $ do

231 xs <- ucharCode `sepBy1` (char '_') <* char ']'

229 xs <- ucharCode `sepBy1` (char '_') <* char ']'

232− return $ Seq.singleton $ RoffStr xs

230+ return [RoffStr xs]

233

231

234 ucharCode = try $ do

232 ucharCode = try $ do

235 char 'u'

233 char 'u'

@@ -240,20 +238,20 @@ escape = do

240 Nothing -> mzero

238 Nothing -> mzero

241 Just c -> return c

239 Just c -> return c

242

240

243− escUnknown :: PandocMonad m => String -> RoffLexer m (Seq LinePart)

241+ escUnknown :: PandocMonad m => String -> RoffLexer m [LinePart]

244 escUnknown s = do

242 escUnknown s = do

245 pos <- getPosition

243 pos <- getPosition

246 report $ SkippedContent ("Unknown escape sequence " ++ s) pos

244 report $ SkippedContent ("Unknown escape sequence " ++ s) pos

247− return $ Seq.singleton $ RoffStr "\xFFFD"

245+ return [RoffStr "\xFFFD"]

248

246

249-- \s-1 \s0

247-- \s-1 \s0

250−escFontSize :: PandocMonad m => RoffLexer m (Seq LinePart)

248+escFontSize :: PandocMonad m => RoffLexer m [LinePart]

251escFontSize = do

249escFontSize = do

252 let sign = option "" $ ("-" <$ char '-' <|> "" <$ char '+')

250 let sign = option "" $ ("-" <$ char '-' <|> "" <$ char '+')

253 let toFontSize xs =

251 let toFontSize xs =

254 case safeRead xs of

252 case safeRead xs of

255 Nothing -> mzero

253 Nothing -> mzero

256− Just n -> return $ Seq.singleton $ FontSize n

254+ Just n -> return [FontSize n]

257 choice

255 choice

258 [ do char '('

256 [ do char '('

259 s <- sign

257 s <- sign

@@ -269,7 +267,7 @@ escFontSize = do

269 toFontSize (s ++ ds)

267 toFontSize (s ++ ds)

270 ]

268 ]

271

269

272−escFont :: PandocMonad m => RoffLexer m (Seq LinePart)

270+escFont :: PandocMonad m => RoffLexer m [LinePart]

273escFont = do

271escFont = do

274 font <- choice

272 font <- choice

275 [ digit >> return defaultFontSpec

273 [ digit >> return defaultFontSpec

@@ -279,7 +277,7 @@ escFont = do

279 ]

277 ]

280 modifyState $ \st -> st{ prevFont = currentFont st

278 modifyState $ \st -> st{ prevFont = currentFont st

281 , currentFont = font }

279 , currentFont = font }

282− return $ Seq.singleton $ Font font

280+ return [Font font]

283

281

284lettersFont :: PandocMonad m => RoffLexer m FontSpec

282lettersFont :: PandocMonad m => RoffLexer m FontSpec

285lettersFont = try $ do

283lettersFont = try $ do

@@ -538,24 +536,24 @@ lexArgs = do

538 args <- many $ try oneArg

536 args <- many $ try oneArg

539 skipMany spacetab

537 skipMany spacetab

540 eofline

538 eofline

541− return $ map Foldable.toList args

539+ return args

542

540

543 where

541 where

544

542

545− oneArg :: PandocMonad m => RoffLexer m (Seq LinePart)

543+ oneArg :: PandocMonad m => RoffLexer m [LinePart]

546 oneArg = do

544 oneArg = do

547 skipMany $ try $ string "\\\n" -- continuation line

545 skipMany $ try $ string "\\\n" -- continuation line

548 try quotedArg <|> plainArg

546 try quotedArg <|> plainArg

549 -- try, because there are some erroneous files, e.g. linux/bpf.2

547 -- try, because there are some erroneous files, e.g. linux/bpf.2

550

548

551− plainArg :: PandocMonad m => RoffLexer m (Seq LinePart)

549+ plainArg :: PandocMonad m => RoffLexer m [LinePart]

552 plainArg = do

550 plainArg = do

553 skipMany spacetab

551 skipMany spacetab

554 mconcat <$> many1 (macroArg <|> escape <|> regularText <|> unescapedQuote)

552 mconcat <$> many1 (macroArg <|> escape <|> regularText <|> unescapedQuote)

555 where

553 where

556− unescapedQuote = char '"' >> return (Seq.singleton $ RoffStr "\"")

554+ unescapedQuote = char '"' >> return [RoffStr "\""]

557

555

558− quotedArg :: PandocMonad m => RoffLexer m (Seq LinePart)

556+ quotedArg :: PandocMonad m => RoffLexer m [LinePart]

559 quotedArg = do

557 quotedArg = do

560 skipMany spacetab

558 skipMany spacetab

561 char '"'

559 char '"'

@@ -568,9 +566,9 @@ lexArgs = do

568 escapedQuote = try $ do

566 escapedQuote = try $ do

569 char '"'

567 char '"'

570 char '"'

568 char '"'

571− return $ Seq.singleton $ RoffStr "\""

569+ return [RoffStr "\""]

572

570

573−escStar :: PandocMonad m => RoffLexer m (Seq LinePart)

571+escStar :: PandocMonad m => RoffLexer m [LinePart]

574escStar = try $ do

572escStar = try $ do

575 pos <- getPosition

573 pos <- getPosition

576 c <- anyChar

574 c <- anyChar

@@ -591,14 +589,14 @@ escStar = try $ do

591 resolveString stringname pos = do

589 resolveString stringname pos = do

592 RoffTokens ts <- resolveMacro stringname [] pos

590 RoffTokens ts <- resolveMacro stringname [] pos

593 case Foldable.toList ts of

591 case Foldable.toList ts of

594− [MLine xs] -> return $ Seq.fromList xs

592+ [MLine xs] -> return xs

595 _ -> do

593 _ -> do

596 report $ SkippedContent ("unknown string " ++ stringname) pos

594 report $ SkippedContent ("unknown string " ++ stringname) pos

597 return mempty

595 return mempty

598

596

599lexLine :: PandocMonad m => RoffLexer m RoffTokens

597lexLine :: PandocMonad m => RoffLexer m RoffTokens

600lexLine = do

598lexLine = do

601− lnparts <- Foldable.toList . mconcat <$> many1 linePart

599+ lnparts <- mconcat <$> many1 linePart

602 eofline

600 eofline

603 go lnparts

601 go lnparts

604 where -- return empty line if we only have empty strings;

602 where -- return empty line if we only have empty strings;

@@ -607,30 +605,30 @@ lexLine = do

607 go (RoffStr "" : xs) = go xs

605 go (RoffStr "" : xs) = go xs

608 go xs = return $ singleTok $ MLine xs

606 go xs = return $ singleTok $ MLine xs

609

607

610−linePart :: PandocMonad m => RoffLexer m (Seq LinePart)

608+linePart :: PandocMonad m => RoffLexer m [LinePart]

611linePart = macroArg <|> escape <|>

609linePart = macroArg <|> escape <|>

612 regularText <|> quoteChar <|> spaceTabChar

610 regularText <|> quoteChar <|> spaceTabChar

613

611

614−macroArg :: PandocMonad m => RoffLexer m (Seq LinePart)

612+macroArg :: PandocMonad m => RoffLexer m [LinePart]

615macroArg = try $ do

613macroArg = try $ do

616 string "\\\\$"

614 string "\\\\$"

617 x <- digit

615 x <- digit

618− return $ Seq.singleton $ MacroArg $ ord x - ord '0'

616+ return [MacroArg $ ord x - ord '0']

619

617

620−regularText :: PandocMonad m => RoffLexer m (Seq LinePart)

618+regularText :: PandocMonad m => RoffLexer m [LinePart]

621regularText = do

619regularText = do

622 s <- many1 $ noneOf "\n\r\t \\\""

620 s <- many1 $ noneOf "\n\r\t \\\""

623− return $ Seq.singleton $ RoffStr s

621+ return [RoffStr s]

624

622

625−quoteChar :: PandocMonad m => RoffLexer m (Seq LinePart)

623+quoteChar :: PandocMonad m => RoffLexer m [LinePart]

626quoteChar = do

624quoteChar = do

627 char '"'

625 char '"'

628− return $ Seq.singleton $ RoffStr "\""

626+ return [RoffStr "\""]

629

627

630−spaceTabChar :: PandocMonad m => RoffLexer m (Seq LinePart)

628+spaceTabChar :: PandocMonad m => RoffLexer m [LinePart]

631spaceTabChar = do

629spaceTabChar = do

632 c <- spacetab

630 c <- spacetab

633− return $ Seq.singleton $ RoffStr [c]

631+ return [RoffStr [c]]

634

632

635lexEmptyLine :: PandocMonad m => RoffLexer m RoffTokens

633lexEmptyLine :: PandocMonad m => RoffLexer m RoffTokens

636lexEmptyLine = newline >> return (singleTok MEmptyLine)

634lexEmptyLine = newline >> return (singleTok MEmptyLine)