master...9f6f4ab · typeable/pandoc

git.iko.soy/typeable/pandoc

on 9f6f4ab help sign in

src/Text/Pandoc/Parsing.hs+4−1

since splitsnapshots

unifiedsplit

@@ -130,6 +130,7 @@ module Text.Pandoc.Parsing ( anyLine,

130 runParser,

131 runParserT,

132 parse,

133+ tokenPrim,

133 anyToken,

134 anyToken,

134 getInput,

135 getInput,

135 setInput,

136 setInput,

@@ -178,7 +179,9 @@ module Text.Pandoc.Parsing ( anyLine,

178 sourceLine,

179 sourceLine,

179 setSourceColumn,

180 setSourceColumn,

180 setSourceLine,

181 setSourceLine,

181− newPos

182+ newPos,

183+ Line,

184+ Column

182 )

185 )

183where

186where

184

187

src/Text/Pandoc/Readers/LaTeX.hs+365−44

@@ -40,6 +40,7 @@ import Control.Monad

40import Control.Monad.Except (throwError)

41import Data.Char (chr, isAlphaNum, isLetter, ord)

42import Data.Text (Text, unpack)

43+import qualified Data.Text as T

43import Data.List (intercalate, isPrefixOf)

44import Data.List (intercalate, isPrefixOf)

44import qualified Data.Map as M

45import qualified Data.Map as M

45import Data.Maybe (fromMaybe, maybeToList)

46import Data.Maybe (fromMaybe, maybeToList)

@@ -47,16 +48,373 @@ import Safe (minimumDef)

47import System.FilePath (addExtension, replaceExtension, takeExtension)

48import System.FilePath (addExtension, replaceExtension, takeExtension)

48import Text.Pandoc.Builder

49import Text.Pandoc.Builder

49import Text.Pandoc.Class (PandocMonad, PandocPure, lookupEnv, readFileFromDirs,

50import Text.Pandoc.Class (PandocMonad, PandocPure, lookupEnv, readFileFromDirs,

50− report, setResourcePath, getResourcePath)

51+ report, setResourcePath, getResourcePath,

52+ runIOorExplode, PandocIO)

51import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)

53import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)

52import Text.Pandoc.ImageSize (numUnit, showFl)

54import Text.Pandoc.ImageSize (numUnit, showFl)

53import Text.Pandoc.Logging

55import Text.Pandoc.Logging

54import Text.Pandoc.Options

56import Text.Pandoc.Options

55import Text.Pandoc.Parsing hiding (many, mathDisplay, mathInline, optional,

57import Text.Pandoc.Parsing hiding (many, mathDisplay, mathInline, optional,

56− space, (<|>))

58+ space, (<|>), spaces, blankline)

57import Text.Pandoc.Shared

59import Text.Pandoc.Shared

58import Text.Pandoc.Walk

60import Text.Pandoc.Walk

62+import Text.Pandoc.Extensions (getDefaultExtensions)

63+

64+-- | Parse LaTeX from string and return 'Pandoc' document.

65+readLaTeX :: PandocMonad m

66+ => ReaderOptions -- ^ Reader options

67+ -> Text -- ^ String to parse (assumes @'\n'@ line endings)

68+ -> m Pandoc

69+readLaTeX opts ltx = undefined

70+

71+testParser :: LP PandocIO a -> Text -> IO a

72+testParser p t = do

73+ res <- runIOorExplode (runParserT p defaultParserState{

74+ stateOptions = def{ readerExtensions =

75+ getDefaultExtensions "latex" }} "name" (tokenize t))

76+ case res of

77+ Left e -> error (show e)

78+ Right r -> return r

79+

80+type LP m = ParserT [Tok] ParserState m

81+

82+rawLaTeXBlock :: PandocMonad m => LP m String

83+rawLaTeXBlock = mzero

84+

85+rawLaTeXInline :: PandocMonad m => LP m Inline

86+rawLaTeXInline = mzero

87+

88+inlineCommand :: PandocMonad m => LP m Inlines

89+inlineCommand = mzero

90+

92+ Esc1 | Esc2

93+ deriving (Eq, Ord, Show)

94+

95+data Tok = Tok (Line, Column) TokType Text

96+ deriving (Eq, Ord, Show)

97+

98+tokenize :: Text -> [Tok]

99+tokenize = totoks (1, 1)

100+

101+totoks :: (Line, Column) -> Text -> [Tok]

102+totoks (lin,col) t =

103+ case T.uncons t of

104+ Nothing -> []

105+ Just (c, rest)

106+ | c == '\n' ->

107+ Tok (lin, col) Newline (T.singleton '\n')

108+ : totoks (lin + 1,1) rest

109+ | isSpaceOrTab c ->

110+ let (sps, rest') = T.span isSpaceOrTab t

111+ in Tok (lin, col) Spaces sps

112+ : totoks (lin, col + T.length sps) rest'

113+ | isAlphaNum c ->

114+ let (ws, rest') = T.span isAlphaNum t

115+ in Tok (lin, col) Word ws

116+ : totoks (lin, col + T.length ws) rest'

117+ | c == '%' ->

118+ let (cs, rest') = T.break (== '\n') rest

119+ in Tok (lin, col) Comment (T.singleton '%' <> cs)

120+ : totoks (lin, col + 1 + T.length cs) rest'

121+ | c == '\\' ->

122+ case T.uncons rest of

123+ Nothing -> [Tok (lin, col) Symbol (T.singleton c)]

124+ Just (d, rest')

125+ | isLetter d ->

126+ let (ws, rest'') = T.span isLetter rest

127+ in Tok (lin, col) CtrlSeq (T.singleton '\\' <> ws)

128+ : totoks (lin, col + 1 + T.length ws) rest''

129+ | d == '\t' || d == '\n' ->

130+ Tok (lin, col) Symbol (T.singleton '\\')

131+ : totoks (lin, col + 1) rest

132+ | otherwise ->

133+ Tok (lin, col) CtrlSeq (T.pack [c,d])

134+ : totoks (lin, col + 2) rest'

135+ | c == '^' ->

136+ case T.uncons rest of

137+ Just ('^', rest') ->

138+ case T.uncons rest' of

139+ Just (d, rest'')

140+ | isLowerHex d ->

141+ case T.uncons rest'' of

142+ Just (e, rest''') | isLowerHex e ->

143+ Tok (lin, col) Esc2 (T.pack ['^','^',d,e])

144+ : totoks (lin, col + 4) rest'''

145+ _ ->

146+ Tok (lin, col) Esc1 (T.pack ['^','^',d])

147+ : totoks (lin, col + 3) rest''

148+ | d < '\128' ->

149+ Tok (lin, col) Esc1 (T.pack ['^','^',d])

150+ : totoks (lin, col + 3) rest''

151+ _ -> [Tok (lin, col) Symbol (T.singleton '^'),

152+ Tok (lin, col + 1) Symbol (T.singleton '^')]

153+ Nothing -> [Tok (lin, col) Symbol (T.singleton '^')]

154+ | otherwise ->

155+ Tok (lin, col) Symbol (T.singleton c) : totoks (lin, col + 1) rest

156+

157+ where isSpaceOrTab ' ' = True

158+ isSpaceOrTab '\t' = True

159+ isSpaceOrTab _ = False

160+

161+isLowerHex :: Char -> Bool

162+isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'

163+

164+untokenize :: [Tok] -> Text

165+untokenize = mconcat . map untoken

166+

167+untoken :: Tok -> Text

168+untoken (Tok _ _ t) = t

169+

170+satisfyTok :: Monad m

171+ => (Tok -> Bool)

172+ -> ParserT [Tok] u m Tok

173+satisfyTok f = tokenPrim (T.unpack . untoken) updatePos matcher

174+ where matcher t | f t = Just t

175+ | otherwise = Nothing

176+ updatePos :: SourcePos -> Tok -> [Tok] -> SourcePos

177+ updatePos spos _ (Tok (lin,col) _ _ : _) =

178+ setSourceColumn (setSourceLine spos lin) col

179+ updatePos spos _ [] = spos

180+

181+anyControlSeq :: PandocMonad m => LP m Tok

182+anyControlSeq = satisfyTok isCtrlSeq <* spaces

183+ where isCtrlSeq (Tok _ CtrlSeq _) = True

184+ isCtrlSeq _ = False

185+

186+spaces :: PandocMonad m => LP m ()

187+spaces = skipMany (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))

188+

189+spaces1 :: PandocMonad m => LP m ()

190+spaces1 = skipMany1 (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))

191+

192+tokTypeIn :: [TokType] -> Tok -> Bool

193+tokTypeIn toktypes (Tok _ tt _) = tt `elem` toktypes

194+tokTypeIn _ _ = False

195+

196+controlSeq :: PandocMonad m => Text -> LP m Tok

197+controlSeq name = satisfyTok isNamed

198+ where isNamed t@(Tok _ CtrlSeq n) = n == T.singleton '\\' <> name

199+ isNamed _ = False

200+

201+symbol :: PandocMonad m => Char -> LP m Tok

202+symbol c = satisfyTok isc

203+ where isc (Tok _ Symbol d) = case T.uncons d of

204+ Just (c',_) -> c == c'

205+ _ -> False

206+ isc _ = False

207+

208+symbolIn :: PandocMonad m => [Char] -> LP m Tok

209+symbolIn cs = satisfyTok isInCs

210+ where isInCs (Tok _ Symbol d) = case T.uncons d of

211+ Just (c,_) -> c `elem` cs

212+ _ -> False

213+ isInCs _ = False

214+

215+sp :: PandocMonad m => LP m ()

216+sp = whitespace <|> endline

217+

218+whitespace :: PandocMonad m => LP m ()

219+whitespace = () <$ satisfyTok isSpaceTok

220+ where isSpaceTok (Tok _ Spaces _) = True

221+ isSpaceTok _ = False

222+

223+newlineTok :: PandocMonad m => LP m ()

224+newlineTok = () <$ satisfyTok isNewlineTok

225+

226+isNewlineTok :: Tok -> Bool

227+isNewlineTok (Tok _ Newline _) = True

228+isNewlineTok _ = False

229+

230+comment :: PandocMonad m => LP m ()

231+comment = () <$ satisfyTok isCommentTok

232+ where isCommentTok (Tok _ Comment _) = True

233+ isCommentTok _ = False

234+

235+anyTok :: PandocMonad m => LP m Tok

236+anyTok = satisfyTok (const True)

237+

238+endline :: PandocMonad m => LP m ()

239+endline = try $ do

240+ newlineTok

241+ lookAhead anyTok

242+ notFollowedBy blankline

243+

244+blankline :: PandocMonad m => LP m ()

245+blankline = try $ do

246+ skipMany (satisfyTok (tokTypeIn [Spaces, Newline]))

247+ newlineTok

248+

249+primEscape :: PandocMonad m => LP m Char

250+primEscape = do

251+ Tok _ toktype t <- satisfyTok (tokTypeIn [Esc1, Esc2])

252+ case toktype of

253+ Esc1 -> case T.uncons t of

254+ Just (c, _)

255+ | c >= '\64' && c <= '\127' -> return (chr (ord c - 64))

256+ | otherwise -> return (chr (ord c + 64))

257+ Nothing -> fail "Empty content of Esc1"

258+ Esc2 -> case safeRead ('0':'x':T.unpack (T.drop 2 t)) of

259+ Just x -> return (chr x)

260+ Nothing -> fail $ "Could not read: " ++ T.unpack t

261+ _ -> fail "Expected an Esc1 or Esc2 token" -- should not happen

262+

263+bgroup :: PandocMonad m => LP m ()

264+bgroup = try $ do

265+ skipMany sp

266+ symbol '{' <|> controlSeq "bgroup" <|> controlSeq "begingroup"

267+ return ()

268+

269+egroup :: PandocMonad m => LP m ()

270+egroup = () <$ (symbol '}' <|> controlSeq "egroup" <|> controlSeq "endgroup")

271+

272+grouped :: (PandocMonad m, Monoid a) => LP m a -> LP m a

273+grouped parser = try $ do

274+ bgroup

275+ -- first we check for an inner 'grouped', because

276+ -- {{a,b}} should be parsed the same as {a,b}

277+ try (grouped parser <* egroup) <|> (mconcat <$> manyTill parser egroup)

278+

279+braced :: PandocMonad m => LP m [Tok]

280+braced = try $ do

281+ bgroup

282+ -- {{a,b}} should be parsed the same as {a,b}

283+ try (braced <* egroup) <|> manyTill anyTok egroup

284+

285+bracketed :: PandocMonad m => Monoid a => LP m a -> LP m a

286+bracketed parser = try $ do

287+ symbol '['

288+ mconcat <$> manyTill parser (symbol ']')

289+

290+-- inline elements:

291+

292+inlineText :: PandocMonad m => LP m Inlines

293+inlineText = (str . T.unpack . untoken) <$> satisfyTok isWordTok

294+ where isWordTok (Tok _ Word _) = True

295+ isWordTok _ = False

296+

297+inlineGroup :: PandocMonad m => LP m Inlines

298+inlineGroup = do

299+ ils <- grouped inline

300+ if isNull ils

301+ then return mempty

302+ else return $ spanWith nullAttr ils

303+ -- we need the span so we can detitlecase bibtex entries;

304+ -- we need to know when something is {C}apitalized

305+

306+doLHSverb :: PandocMonad m => LP m Inlines

307+doLHSverb =

308+ (codeWith ("",["haskell"],[]) . T.unpack . untokenize)

309+ <$> manyTill (satisfyTok (not . isNewlineTok)) (symbol '|')

310+

311+lit :: String -> LP m Inlines

312+lit = pure . str

313+

314+doubleQuote :: PandocMonad m => LP m Inlines

315+doubleQuote = do

316+ quoted' doubleQuoted (try $ count 2 $ symbol '`')

317+ (void $ try $ count 2 $ symbol '\'')

318+ <|> quoted' doubleQuoted ((:[]) <$> symbol '“') (void $ symbol '”')

319+ -- the following is used by babel for localized quotes:

320+ <|> quoted' doubleQuoted (try $ sequence [symbol '"', symbol '`'])

321+ (void $ try $ sequence [symbol '"', symbol '\''])

322+ <|> quoted' doubleQuoted ((:[]) <$> symbol '"')

323+ (void $ symbol '"')

324+

325+singleQuote :: PandocMonad m => LP m Inlines

326+singleQuote = do

327+ quoted' singleQuoted ((:[]) <$> symbol '`')

328+ (try $ symbol '\'' >>

329+ notFollowedBy (satisfyTok startsWithLetter))

330+ <|> quoted' singleQuoted ((:[]) <$> symbol '‘')

331+ (try $ symbol '’' >>

332+ notFollowedBy (satisfyTok startsWithLetter))

333+ where startsWithLetter (Tok _ Word t) =

334+ case T.uncons t of

335+ Just (c, _) | isLetter c -> True

336+ _ -> False

337+ startsWithLetter _ = False

338+

339+quoted' :: PandocMonad m

340+ => (Inlines -> Inlines)

341+ -> LP m [Tok]

342+ -> LP m ()

343+ -> LP m Inlines

344+quoted' f starter ender = do

345+ startchs <- (T.unpack . untokenize) <$> starter

346+ smart <- extensionEnabled Ext_smart <$> getOption readerExtensions

347+ if smart

348+ then do

349+ ils <- many (notFollowedBy ender >> inline)

350+ (ender >> return (f (mconcat ils))) <|>

351+ (<> mconcat ils) <$>

352+ lit (case startchs of

353+ "``" -> "“"

354+ "`" -> "‘"

355+ cs -> cs)

356+ else lit startchs

357+

358+inline :: PandocMonad m => LP m Inlines

359+inline = (mempty <$ comment)

360+ <|> (space <$ whitespace)

361+ <|> (softbreak <$ endline)

362+ <|> inlineText

363+ -- <|> inlineCommand

364+ -- <|> inlineEnvironment

365+ <|> inlineGroup

366+ <|> (symbol '-' *>

367+ option (str "-") (symbol '-' *>

368+ option (str "–") (str "—" <$ symbol '-')))

369+ <|> doubleQuote

370+ <|> singleQuote

371+ <|> (str "”" <$ try (symbol '\'' >> symbol '\''))

372+ <|> (str "”" <$ symbol '”')

373+ <|> (str "’" <$ symbol '\'')

374+ <|> (str "’" <$ symbol '’')

375+ <|> (str "\160" <$ symbol '~')

376+ -- <|> mathDisplay (string "$$" *> mathChars <* string "$$")

377+ -- <|> mathInline (char '$' *> mathChars <* char '$')

378+ <|> (guardEnabled Ext_literate_haskell *> symbol '|' *> doLHSverb)

379+ <|> (str . (:[]) <$> primEscape)

380+ <|> (do res <- symbolIn "#&~^'`\"[]"

381+ pos <- getPosition

382+ let s = T.unpack (untoken res)

383+ report $ ParsingUnescaped s pos

384+ return $ str s)

385+

386+inlines :: PandocMonad m => LP m Inlines

387+inlines = mconcat <$> many inline

388+

389+-- PREVIOUSLY HAD (notFollowedBy (char '}') *> inline)

390+

391+-- block elements:

392+

393+paragraph :: PandocMonad m => LP m Blocks

394+paragraph = do

395+ x <- trimInlines . mconcat <$> many1 inline

396+ if x == mempty

397+ then return mempty

398+ else return $ para x

399+

400+block :: PandocMonad m => LP m Blocks

401+block = (mempty <$ spaces1)

402+ -- <|> environment

403+ -- <|> include

404+ -- <|> macro

405+ -- <|> blockCommand

406+ <|> paragraph

407+ <|> grouped block

408+

409+blocks :: PandocMonad m => LP m Blocks

410+blocks = mconcat <$> many block

411+

412+

413+{-

414+

415+-}

416+

417+{-

60-- | Parse LaTeX from string and return 'Pandoc' document.

418-- | Parse LaTeX from string and return 'Pandoc' document.

61readLaTeX :: PandocMonad m

419readLaTeX :: PandocMonad m

62 => ReaderOptions -- ^ Reader options

420 => ReaderOptions -- ^ Reader options

@@ -69,6 +427,7 @@ readLaTeX opts ltx = do

69 Right result -> return result

427 Right result -> return result

70 Left e -> throwError e

428 Left e -> throwError e

429

430+

72parseLaTeX :: PandocMonad m => LP m Pandoc

431parseLaTeX :: PandocMonad m => LP m Pandoc

73parseLaTeX = do

432parseLaTeX = do

74 bs <- blocks

433 bs <- blocks

@@ -88,8 +447,6 @@ parseLaTeX = do

88 else id) doc'

447 else id) doc'

89 return $ Pandoc meta bs'

448 return $ Pandoc meta bs'

449

91−type LP m = ParserT String ParserState m

92−

93anyControlSeq :: PandocMonad m => LP m String

450anyControlSeq :: PandocMonad m => LP m String

94anyControlSeq = do

451anyControlSeq = do

95 char '\\'

452 char '\\'

@@ -127,8 +484,8 @@ endline = try (newline >> lookAhead anyChar >> notFollowedBy blankline)

127isLowerHex :: Char -> Bool

484isLowerHex :: Char -> Bool

128isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'

485isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'

129

486

130−tildeEscape :: PandocMonad m => LP m Char

487+primEscape :: PandocMonad m => LP m Char

131−tildeEscape = try $ do

488+primEscape = try $ do

132 string "^^"

489 string "^^"

133 c <- satisfy (\x -> x >= '\0' && x <= '\128')

490 c <- satisfy (\x -> x >= '\0' && x <= '\128')

134 d <- if isLowerHex c

491 d <- if isLowerHex c

@@ -200,37 +557,6 @@ mathChars =

200 isOrdChar '\\' = False

557 isOrdChar '\\' = False

201 isOrdChar _ = True

558 isOrdChar _ = True

202

559

203−quoted' :: PandocMonad m => (Inlines -> Inlines) -> LP m String -> LP m () -> LP m Inlines

204−quoted' f starter ender = do

205− startchs <- starter

206− smart <- extensionEnabled Ext_smart <$> getOption readerExtensions

207− if smart

208− then do

209− ils <- many (notFollowedBy ender >> inline)

210− (ender >> return (f (mconcat ils))) <|>

211− (<> mconcat ils) <$>

212− lit (case startchs of

213− "``" -> "“"

214− "`" -> "‘"

215− _ -> startchs)

216− else lit startchs

217−

218−doubleQuote :: PandocMonad m => LP m Inlines

219−doubleQuote = do

220− quoted' doubleQuoted (try $ string "``") (void $ try $ string "''")

221− <|> quoted' doubleQuoted (string "“") (void $ char '”')

222− -- the following is used by babel for localized quotes:

223− <|> quoted' doubleQuoted (try $ string "\"`") (void $ try $ string "\"'")

224− <|> quoted' doubleQuoted (string "\"") (void $ char '"')

225−

226−singleQuote :: PandocMonad m => LP m Inlines

227−singleQuote = do

228− smart <- extensionEnabled Ext_smart <$> getOption readerExtensions

229− if smart

230− then quoted' singleQuoted (string "`") (try $ char '\'' >> notFollowedBy letter)

231− <|> quoted' singleQuoted (string "‘") (try $ char '’' >> notFollowedBy letter)

232− else str <$> many1 (oneOf "`\'‘’")

233−

234inline :: PandocMonad m => LP m Inlines

560inline :: PandocMonad m => LP m Inlines

235inline = (mempty <$ comment)

561inline = (mempty <$ comment)

236 <|> (space <$ whitespace)

562 <|> (space <$ whitespace)

@@ -251,7 +577,7 @@ inline = (mempty <$ comment)

251 <|> mathDisplay (string "$$" *> mathChars <* string "$$")

577 <|> mathDisplay (string "$$" *> mathChars <* string "$$")

252 <|> mathInline (char '$' *> mathChars <* char '$')

578 <|> mathInline (char '$' *> mathChars <* char '$')

253 <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)

579 <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)

254− <|> (str . (:[]) <$> tildeEscape)

580+ <|> (str . (:[]) <$> primEscape)

255 <|> (do res <- oneOf "#&~^'`\"[]"

581 <|> (do res <- oneOf "#&~^'`\"[]"

256 pos <- getPosition

582 pos <- getPosition

257 report $ ParsingUnescaped [res] pos

583 report $ ParsingUnescaped [res] pos

@@ -744,9 +1070,6 @@ dolstinline = do

744 marker <- char '{' <|> anyChar

1070 marker <- char '{' <|> anyChar

745 codeWith ("",classes,[]) <$> manyTill (satisfy (/='\n')) (char '}' <|> char marker)

1071 codeWith ("",classes,[]) <$> manyTill (satisfy (/='\n')) (char '}' <|> char marker)

746

1072

747−doLHSverb :: PandocMonad m => LP m Inlines

748−doLHSverb = codeWith ("",["haskell"],[]) <$> manyTill (satisfy (/='\n')) (char '|')

749−

750-- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"

1073-- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"

751dosiunitx :: PandocMonad m => LP m Inlines

1074dosiunitx :: PandocMonad m => LP m Inlines

752dosiunitx = do

1075dosiunitx = do

@@ -762,9 +1085,6 @@ dosiunitx = do

762 emptyOr160 unit,

1085 emptyOr160 unit,

763 unit]

1086 unit]

764

1087

765−lit :: String -> LP m Inlines

766−lit = pure . str

767−

768accent :: (Char -> String) -> Inlines -> LP m Inlines

1088accent :: (Char -> String) -> Inlines -> LP m Inlines

769accent f ils =

1089accent f ils =

770 case toList ils of

1090 case toList ils of

@@ -1570,3 +1890,4 @@ removeDoubleQuotes ('"':xs) =

1570 '"':ys -> reverse ys

1890 '"':ys -> reverse ys

1571 _ -> '"':xs

1891 _ -> '"':xs

1572removeDoubleQuotes xs = xs

1892removeDoubleQuotes xs = xs

1893+-}