22755a3 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Roff tokenizer: revamped font parsing using escapeArg.

22755a3John MacFarlane8 years ago

src/Text/Pandoc/Readers/Roff.hs+59−62

compare with master

unifiedsplit

@@ -49,11 +49,11 @@ where

50import Prelude

51import Safe (lastDef)

52−import Control.Monad (void, mzero, guard, when)

52+import Control.Monad (void, mzero, guard, when, mplus)

53import Control.Monad.Except (throwError)

54import Text.Pandoc.Class

55 (getResourcePath, readFileFromDirs, PandocMonad(..), report)

56−import Data.Char (isLower, toLower, toUpper, isHexDigit, chr, ord,

56+import Data.Char (isLower, toLower, toUpper, chr, ord,

57 isAscii, isAlphaNum, isSpace)

58import Data.Default (Default)

59import qualified Data.Map as M

@@ -62,7 +62,7 @@ import qualified Data.Text as T

62import Text.Pandoc.Logging (LogMessage(..))

63import Text.Pandoc.Options

64import Text.Pandoc.Parsing

65−import Text.Pandoc.Shared (safeRead)

65+import Text.Pandoc.Shared (safeRead, substitute)

66import Text.Parsec hiding (tokenPrim)

67import qualified Text.Parsec as Parsec

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

@@ -160,13 +160,59 @@ combiningAccentsMap =

160escape :: PandocMonad m => RoffLexer m [LinePart]

161escape = do

162 char '\\'

163+ escapeGlyph <|> escapeNormal

164+

165+escapeGlyph :: PandocMonad m => RoffLexer m [LinePart]

166+escapeGlyph = do

167+ c <- lookAhead (oneOf ['[','('])

168+ escapeArg >>= resolveGlyph c

169+

170+resolveGlyph :: PandocMonad m => Char -> String -> RoffLexer m [LinePart]

171+resolveGlyph delimChar glyph = do

172+ let cs = substitute "_u" " u" glyph -- unicode glyphs separated by _

173+ (case words cs of

174+ [] -> mzero

175+ [s] -> case M.lookup s characterCodeMap `mplus` readUnicodeChar s of

176+ Nothing -> mzero

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

178+ (s:ss) -> do

179+ basechar <- case M.lookup s characterCodeMap `mplus`

180+ readUnicodeChar s of

181+ Nothing ->

182+ case s of

183+ [ch] | isAscii ch && isAlphaNum ch ->

184+ return ch

185+ _ -> mzero

186+ Just c -> return c

187+ let addAccents [] xs = return $ T.unpack .

188+ Normalize.normalize Normalize.NFC .

189+ T.pack $ reverse xs

190+ addAccents (a:as) xs =

191+ case M.lookup a combiningAccentsMap `mplus` readUnicodeChar a of

192+ Just x -> addAccents as (x:xs)

193+ Nothing -> mzero

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

195+ <|> case delimChar of

196+ '[' -> escUnknown ("\\[" ++ glyph ++ "]")

197+ '(' -> escUnknown ("\\(" ++ glyph)

198+ '\'' -> escUnknown ("\\C'" ++ glyph ++ "'")

199+ _ -> fail "resolveGlyph: unknown glyph delimiter"

200+

201+readUnicodeChar :: String -> Maybe Char

202+readUnicodeChar ('u':cs@(_:_:_:_:_)) =

203+ case safeRead ('0':'x':cs) of

204+ Just i -> Just (chr i)

205+ Nothing -> Nothing

206+readUnicodeChar _ = Nothing

207+

208+escapeNormal :: PandocMonad m => RoffLexer m [LinePart]

209+escapeNormal = do

163 c <- anyChar

210 c <- anyChar

164 case c of

211 case c of

212+ 'C' -> quoteArg >>= resolveGlyph '\''

165 'f' -> escFont

213 'f' -> escFont

166 's' -> escFontSize

214 's' -> escFontSize

167 '*' -> escStar

215 '*' -> escStar

168− '(' -> twoCharGlyph

169− '[' -> bracketedGlyph

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

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

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

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

172 '%' -> return mempty

218 '%' -> return mempty

@@ -191,59 +237,11 @@ escape = do

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

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

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

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

193

239

194− where

195−

196− twoCharGlyph = do

197− cs <- count 2 anyChar

198− case M.lookup cs characterCodeMap of

199− Just c -> return [RoffStr [c]]

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

201−

202− bracketedGlyph = unicodeGlyph <|> charGlyph

203−

204− charGlyph = do

205− cs <- manyTill (noneOf ['[',']','\n']) (char ']')

206− (case words cs of

207− [] -> mzero

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

209− Nothing -> mzero

210− Just c -> return [RoffStr [c]]

211− (s:ss) -> do

212− basechar <- case M.lookup cs characterCodeMap of

213− Nothing ->

214− case s of

215− [ch] | isAscii ch && isAlphaNum ch ->

216− return ch

217− _ -> mzero

218− Just c -> return c

219− let addAccents [] xs = return $ T.unpack .

220− Normalize.normalize Normalize.NFC .

221− T.pack $ reverse xs

222− addAccents (a:as) xs =

223− case M.lookup a combiningAccentsMap of

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

225− Nothing -> mzero

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

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

228−

229− unicodeGlyph = try $ do

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

231− return [RoffStr xs]

232−

233− ucharCode = try $ do

234− char 'u'

235− cs <- many1 (satisfy isHexDigit)

236− let lcs = length cs

237− guard $ lcs >= 4 && lcs <= 6

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

239− Nothing -> mzero

240− Just c -> return c

241−

242− escUnknown :: PandocMonad m => String -> RoffLexer m [LinePart]

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

243− escUnknown s = do

241+escUnknown s = do

244− pos <- getPosition

242+ pos <- getPosition

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

243+ report $ SkippedContent s pos

246− return [RoffStr "\xFFFD"]

244+ return [RoffStr "\xFFFD"]

247

245

248-- \s-1 \s0

246-- \s-1 \s0

249escFontSize :: PandocMonad m => RoffLexer m [LinePart]

247escFontSize :: PandocMonad m => RoffLexer m [LinePart]

@@ -268,12 +266,11 @@ escFontSize = do

268 toFontSize (s ++ ds)

266 toFontSize (s ++ ds)

269 ]

267 ]

270

268

271−-- Parses: [..], (.., or . (single character).

269+-- Parses: [..] or (..

272escapeArg :: PandocMonad m => RoffLexer m String

270escapeArg :: PandocMonad m => RoffLexer m String

273escapeArg = choice

271escapeArg = choice

274 [ char '[' *> manyTill (noneOf ['\n',']']) (char ']')

272 [ char '[' *> manyTill (noneOf ['\n',']']) (char ']')

275− , char ')' *> count 2 anyChar

273+ , char '(' *> count 2 anyChar

276− , count 1 anyChar

277 ]

274 ]

278

275

279-- Parses: '..'

276-- Parses: '..'

@@ -282,7 +279,7 @@ quoteArg = char '\'' *> manyTill (noneOf ['\n','\'']) (char '\'')

282

279

283escFont :: PandocMonad m => RoffLexer m [LinePart]

280escFont :: PandocMonad m => RoffLexer m [LinePart]

284escFont = do

281escFont = do

285− font <- escapeArg

282+ font <- escapeArg <|> count 1 alphaNum

286 font' <- if null font

283 font' <- if null font

287 then prevFont <$> getState

284 then prevFont <$> getState

288 else return $ foldr processFontLetter defaultFontSpec font

285 else return $ foldr processFontLetter defaultFontSpec font

test/Tests/Readers/Man.hs+1−1

@@ -80,7 +80,7 @@ tests = [

80 , "unicode escapes" =:

81 "\\[u2020]" =?> (para $ text "†")

82 , "unicode escapes (combined)" =:

83− "\\[u0075_u0301]" =?> (para $ text "ú")

83+ "\\[u0075_u0301]" =?> (para $ text "\250")

84 ],

85 testGroup "Lists" [

86 "bullet" =: