1561bf2 · typeable/pandoc

155escapeLexer :: PandocMonad m => ManLexer m String

156escapeLexer = do

157 char '\\'

158− twoCharGlyph <|> bracketedGlyph <|> escFont <|> escStar <|> escSingle

158+ twoCharGlyph <|> bracketedGlyph <|> escFont <|> escSingle <|> escStar

159+

159 where

160 where

160

161

161 twoCharGlyph = do

162 twoCharGlyph = do

175 char 'u'

176 char 'u'

176 cs <- many1 (satisfy isHexDigit)

177 cs <- many1 (satisfy isHexDigit)

177 case chr <$> safeRead ('0':'x':cs) of

178 case chr <$> safeRead ('0':'x':cs) of

178− Nothing -> mzero

179+ Nothing -> escUnknown ("\\[u" ++ cs ++ "]") '\xFFFD'

179 Just c -> return c

180 Just c -> return c

180

181

181 charCode = do

182 charCode = do

186

187

187 escStar = do

188 escStar = do

188 char '*'

189 char '*'

189− choice

190+ (do char '('

190− [ ("\xae" <$ char 'R')

191+ cs <- count 2 anyChar

192+ case cs of

193+ "HF" -> mempty <$ modifyState (\st ->

194+ st{fontKind = S.insert Bold (fontKind st) })

195+ "Tm" -> return "\x2122"

196+ "lq" -> return "\x201c"

197+ "rq" -> return "\x201d"

198+ _ -> resolveString cs <|> escUnknown ("\\(" ++ cs) "\xFFFD")

199+ <|>

200+ (do char '['

201+ cs <- many (noneOf "\t\n\r ]")

202+ char ']'

203+ resolveString cs <|> escUnknown ("\\[" ++ cs ++ "]") "\xFFFD" )

204+ <|>

205+ (do c <- anyChar

206+ case c of

207+ 'R' -> return "\xae"

191− , ("" <$ char 'S') -- switch back to default font size

208+ 'S' -> return mempty -- switch back to default font size

192− , ("\x201c" <$ try (string "(lq") <|> try (string "[lq]"))

209+ _ -> resolveString [c] <|> escUnknown ['\\',c] "\xFFFD" )

193− , ("\x201d" <$ try (string "(rq") <|> try (string "[rq]"))

210+

194− , ("" <$ try (string "(HF" >>

211+ -- strings and macros share namespace

195− modifyState (\r -> r {fontKind = S.singleton Bold})))

212+ resolveString stringname = do

196− , ("\x2122" <$ try (string "(Tm"))

213+ ManTokens ts <- resolveMacro stringname []

197− ]

214+ case Foldable.toList ts of

215+ [MLine [RoffStr (s,_)]] -> return s

216+ _ -> mzero

198

217

199 escSingle = do

218 escSingle = do

200− c <- anyChar

219+ c <- noneOf ['*','[','(']

201 case c of

220 case c of

202 '"' -> mempty <$ skipMany (satisfy (/='\n')) -- line comment

221 '"' -> mempty <$ skipMany (satisfy (/='\n')) -- line comment

203 '#' -> mempty <$ manyTill anyChar newline

222 '#' -> mempty <$ manyTill anyChar newline

283 "so" -> lexIncludeFile args

302 "so" -> lexIncludeFile args

284 _ -> resolveMacro macroName args

303 _ -> resolveMacro macroName args

285

304

286− where

287

305

288− lexIncludeFile :: PandocMonad m => [Arg] -> ManLexer m ManTokens

306+lexIncludeFile :: PandocMonad m => [Arg] -> ManLexer m ManTokens

289− lexIncludeFile args = do

307+lexIncludeFile args = do

290− pos <- getPosition

308+ pos <- getPosition

291− case args of

309+ case args of

292− (f:_) -> do

310+ (f:_) -> do

293− let fp = linePartsToString f

311+ let fp = linePartsToString f

294− dirs <- getResourcePath

312+ dirs <- getResourcePath

295− result <- readFileFromDirs dirs fp

313+ result <- readFileFromDirs dirs fp

296− case result of

314+ case result of

297− Nothing -> report $ CouldNotLoadIncludeFile fp pos

315+ Nothing -> report $ CouldNotLoadIncludeFile fp pos

298− Just s -> getInput >>= setInput . (s ++)

316+ Just s -> getInput >>= setInput . (s ++)

299− return mempty

317+ return mempty

300− [] -> return mempty

318+ [] -> return mempty

301−

319+

302− resolveMacro :: PandocMonad m

320+resolveMacro :: PandocMonad m

303− => String -> [Arg] -> ManLexer m ManTokens

321+ => String -> [Arg] -> ManLexer m ManTokens

304− resolveMacro macroName args = do

322+resolveMacro macroName args = do

305− macros <- customMacros <$> getState

323+ macros <- customMacros <$> getState

306− case M.lookup macroName macros of

324+ case M.lookup macroName macros of

307− Nothing -> return $ singleTok $ MMacro macroName args

325+ Nothing -> return $ singleTok $ MMacro macroName args

308− Just ts -> do

326+ Just ts -> do

309− let fillLP (RoffStr (x,y)) zs = RoffStr (x,y) : zs

327+ let fillLP (RoffStr (x,y)) zs = RoffStr (x,y) : zs

310− fillLP (MacroArg i) zs =

328+ fillLP (MacroArg i) zs =

311− case drop (i - 1) args of

329+ case drop (i - 1) args of

312− [] -> zs

330+ [] -> zs

313− (ys:_) -> ys ++ zs

331+ (ys:_) -> ys ++ zs

314− let fillMacroArg (MLine lineparts) =

332+ let fillMacroArg (MLine lineparts) =

315− MLine (foldr fillLP [] lineparts)

333+ MLine (foldr fillLP [] lineparts)

316− fillMacroArg x = x

334+ fillMacroArg x = x

317− return $ ManTokens . fmap fillMacroArg . unManTokens $ ts

335+ return $ ManTokens . fmap fillMacroArg . unManTokens $ ts

318−

336+

319− lexMacroDef :: PandocMonad m => [Arg] -> ManLexer m ManTokens

337+lexMacroDef :: PandocMonad m => [Arg] -> ManLexer m ManTokens

320− lexMacroDef args = do -- macro definition

338+lexMacroDef args = do -- macro definition

321− (macroName, stopMacro) <-

339+ (macroName, stopMacro) <-

322− case args of

340+ case args of

323− (x : y : _) -> return (linePartsToString x, linePartsToString y)

341+ (x : y : _) -> return (linePartsToString x, linePartsToString y)

324− -- optional second arg

342+ -- optional second arg

325− (x:_) -> return (linePartsToString x, ".")

343+ (x:_) -> return (linePartsToString x, ".")

326− [] -> fail "No argument to .de"

344+ [] -> fail "No argument to .de"

327− let stop = try $ do

345+ let stop = try $ do

328− char '.' <|> char '\''

346+ char '.' <|> char '\''

329− many spacetab

347+ many spacetab

330− string stopMacro

348+ string stopMacro

331− _ <- lexArgs

349+ _ <- lexArgs

332− return ()

350+ return ()

333− ts <- mconcat <$> manyTill manToken stop

351+ ts <- mconcat <$> manyTill manToken stop

334− modifyState $ \st ->

352+ modifyState $ \st ->

335− st{ customMacros = M.insert macroName ts (customMacros st) }

353+ st{ customMacros = M.insert macroName ts (customMacros st) }

336− return mempty

354+ return mempty

337−

355+

338− lexArgs :: PandocMonad m => ManLexer m [Arg]

356+lexArgs :: PandocMonad m => ManLexer m [Arg]

339− lexArgs = do

357+lexArgs = do

340− args <- many $ try oneArg

358+ args <- many $ try oneArg

341− skipMany spacetab

359+ skipMany spacetab

342− eofline

360+ eofline

343− return args

361+ return args

344

362

345− where

363+ where

364+

365+ oneArg :: PandocMonad m => ManLexer m [LinePart]

366+ oneArg = do

367+ many1 spacetab

368+ skipMany $ try $ string "\\\n" -- TODO why is this here?

369+ try quotedArg <|> plainArg

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

346

371

347− oneArg :: PandocMonad m => ManLexer m [LinePart]

348− oneArg = do

349− many1 spacetab

350− skipMany $ try $ string "\\\n" -- TODO why is this here?

351− try quotedArg <|> plainArg

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

353−

354− plainArg :: PandocMonad m => ManLexer m [LinePart]

372+ plainArg :: PandocMonad m => ManLexer m [LinePart]

355− plainArg = do

373+ plainArg = do

356− -- TODO skip initial spaces, then parse many linePart til a spaec

374+ -- TODO skip initial spaces, then parse many linePart til a spaec

357− skipMany spacetab

375+ skipMany spacetab

358− many (macroArg <|> esc <|> regularText <|> unescapedQuote)

376+ many (macroArg <|> esc <|> regularText <|> unescapedQuote)

359− where unescapedQuote = do

377+ where unescapedQuote = do

360− char '"'

378+ char '"'

361− fonts <- currentFont

379+ fonts <- currentFont

362− return $ RoffStr ("\"", fonts)

380+ return $ RoffStr ("\"", fonts)

363−

381+

364−

382+

365− quotedArg :: PandocMonad m => ManLexer m [LinePart]

383+ quotedArg :: PandocMonad m => ManLexer m [LinePart]

366− quotedArg = do

384+ quotedArg = do

367− char '"'

385+ char '"'

368− xs <- many (macroArg <|> esc <|> regularText <|> spaceTabChar

386+ xs <- many (macroArg <|> esc <|> regularText <|> spaceTabChar

369− <|> escapedQuote)

387+ <|> escapedQuote)

370− char '"'

388+ char '"'

371− return xs

389+ return xs

372− where escapedQuote = try $ do

390+ where escapedQuote = try $ do

373− char '"'

391+ char '"'

374− char '"'

392+ char '"'

375− fonts <- currentFont

393+ fonts <- currentFont

376− return $ RoffStr ("\"", fonts)

394+ return $ RoffStr ("\"", fonts)

377

395

378lexLine :: PandocMonad m => ManLexer m ManTokens

396lexLine :: PandocMonad m => ManLexer m ManTokens

379lexLine = do

397lexLine = do