Move some code from T.P.R.LaTeX. to T.P.R.LaTeX.Parsing.

We need to reduce the size of the LaTeX reader to ease
compilation on resource-limited systems.  More can be done
in this vein.
This commit is contained in:
John MacFarlane 2020-07-20 23:36:54 -07:00
parent e17b4718d4
commit fe315a8290
2 changed files with 78 additions and 70 deletions

View file

@ -586,44 +586,6 @@ nlToSpace :: Char -> Char
nlToSpace '\n' = ' ' nlToSpace '\n' = ' '
nlToSpace x = x nlToSpace x = x
keyval :: PandocMonad m => LP m (Text, Text)
keyval = try $ do
Tok _ Word key <- satisfyTok isWordTok
sp
val <- option mempty $ do
symbol '='
sp
(untokenize <$> braced) <|>
(mconcat <$> many1 (
(untokenize . snd <$> withRaw braced)
<|>
(untokenize <$> (many1
(satisfyTok
(\t -> case t of
Tok _ Symbol "]" -> False
Tok _ Symbol "," -> False
Tok _ Symbol "{" -> False
Tok _ Symbol "}" -> False
_ -> True))))))
optional (symbol ',')
sp
return (key, T.strip val)
keyvals :: PandocMonad m => LP m [(Text, Text)]
keyvals = try $ symbol '[' >> manyTill keyval (symbol ']') <* sp
accent :: PandocMonad m => Char -> Maybe Char -> LP m Inlines
accent combiningAccent fallBack = try $ do
ils <- tok
case toList ils of
(Str (T.uncons -> Just (x, xs)) : ys) -> return $ fromList $
-- try to normalize to the combined character:
Str (Normalize.normalize Normalize.NFC
(T.pack [x, combiningAccent]) <> xs) : ys
[Space] -> return $ str $ T.singleton $ fromMaybe combiningAccent fallBack
[] -> return $ str $ T.singleton $ fromMaybe combiningAccent fallBack
_ -> return ils
mathDisplay :: Text -> Inlines mathDisplay :: Text -> Inlines
mathDisplay = displayMath . trimMath mathDisplay = displayMath . trimMath
@ -782,6 +744,7 @@ inlineCommand' = try $ do
<|> ignore rawcommand <|> ignore rawcommand
lookupListDefault raw names inlineCommands lookupListDefault raw names inlineCommands
tok :: PandocMonad m => LP m Inlines tok :: PandocMonad m => LP m Inlines
tok = try $ spaces >> grouped inline <|> inlineCommand' <|> singleChar' tok = try $ spaces >> grouped inline <|> inlineCommand' <|> singleChar'
where singleChar' = do where singleChar' = do
@ -1178,6 +1141,19 @@ inlineCommands = M.union inlineLanguageCommands $ M.fromList
, ("ifdim", ifdim) , ("ifdim", ifdim)
] ]
accent :: PandocMonad m => Char -> Maybe Char -> LP m Inlines
accent combiningAccent fallBack = try $ do
ils <- tok
case toList ils of
(Str (T.uncons -> Just (x, xs)) : ys) -> return $ fromList $
-- try to normalize to the combined character:
Str (Normalize.normalize Normalize.NFC
(T.pack [x, combiningAccent]) <> xs) : ys
[Space] -> return $ str $ T.singleton $ fromMaybe combiningAccent fallBack
[] -> return $ str $ T.singleton $ fromMaybe combiningAccent fallBack
_ -> return ils
lettrine :: PandocMonad m => LP m Inlines lettrine :: PandocMonad m => LP m Inlines
lettrine = do lettrine = do
optional opt optional opt
@ -1471,20 +1447,6 @@ inlines = mconcat <$> many inline
-- block elements: -- block elements:
begin_ :: PandocMonad m => Text -> LP m ()
begin_ t = try (do
controlSeq "begin"
spaces
txt <- untokenize <$> braced
guard (t == txt)) <?> ("\\begin{" ++ T.unpack t ++ "}")
end_ :: PandocMonad m => Text -> LP m ()
end_ t = try (do
controlSeq "end"
spaces
txt <- untokenize <$> braced
guard $ t == txt) <?> ("\\end{" ++ T.unpack t ++ "}")
preamble :: PandocMonad m => LP m Blocks preamble :: PandocMonad m => LP m Blocks
preamble = mconcat <$> many preambleBlock preamble = mconcat <$> many preambleBlock
where preambleBlock = (mempty <$ spaces1) where preambleBlock = (mempty <$ spaces1)
@ -1997,24 +1959,6 @@ rawVerbEnv name = do
report $ SkippedContent raw' pos report $ SkippedContent raw' pos
return mempty return mempty
verbEnv :: PandocMonad m => Text -> LP m Text
verbEnv name = withVerbatimMode $ do
optional blankline
res <- manyTill anyTok (end_ name)
return $ stripTrailingNewline
$ untokenize
$ res
-- Strip single final newline and any spaces following it.
-- Input is unchanged if it doesn't end with newline +
-- optional spaces.
stripTrailingNewline :: Text -> Text
stripTrailingNewline t =
let (b, e) = T.breakOnEnd "\n" t
in if T.all (== ' ') e
then T.dropEnd 1 b
else t
fancyverbEnv :: PandocMonad m => Text -> LP m Blocks fancyverbEnv :: PandocMonad m => Text -> LP m Blocks
fancyverbEnv name = do fancyverbEnv name = do
options <- option [] keyvals options <- option [] keyvals

View file

@ -2,6 +2,7 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{- | {- |
Module : Text.Pandoc.Readers.LaTeX.Parsing Module : Text.Pandoc.Readers.LaTeX.Parsing
Copyright : Copyright (C) 2006-2020 John MacFarlane Copyright : Copyright (C) 2006-2020 John MacFarlane
@ -66,6 +67,10 @@ module Text.Pandoc.Readers.LaTeX.Parsing
, dimenarg , dimenarg
, ignore , ignore
, withRaw , withRaw
, keyvals
, verbEnv
, begin_
, end_
) where ) where
import Control.Applicative (many, (<|>)) import Control.Applicative (many, (<|>))
@ -695,3 +700,62 @@ withRaw parser = do
let raw = takeWhile (\(Tok pos _ _) -> maybe True let raw = takeWhile (\(Tok pos _ _) -> maybe True
(\p -> sourceName p /= sourceName pos || pos < p) nxtpos) inp (\p -> sourceName p /= sourceName pos || pos < p) nxtpos) inp
return (result, raw) return (result, raw)
keyval :: PandocMonad m => LP m (Text, Text)
keyval = try $ do
Tok _ Word key <- satisfyTok isWordTok
sp
val <- option mempty $ do
symbol '='
sp
(untokenize <$> braced) <|>
(mconcat <$> many1 (
(untokenize . snd <$> withRaw braced)
<|>
(untokenize <$> (many1
(satisfyTok
(\t -> case t of
Tok _ Symbol "]" -> False
Tok _ Symbol "," -> False
Tok _ Symbol "{" -> False
Tok _ Symbol "}" -> False
_ -> True))))))
optional (symbol ',')
sp
return (key, T.strip val)
keyvals :: PandocMonad m => LP m [(Text, Text)]
keyvals = try $ symbol '[' >> manyTill keyval (symbol ']') <* sp
verbEnv :: PandocMonad m => Text -> LP m Text
verbEnv name = withVerbatimMode $ do
optional blankline
res <- manyTill anyTok (end_ name)
return $ stripTrailingNewline
$ untokenize
$ res
-- Strip single final newline and any spaces following it.
-- Input is unchanged if it doesn't end with newline +
-- optional spaces.
stripTrailingNewline :: Text -> Text
stripTrailingNewline t =
let (b, e) = T.breakOnEnd "\n" t
in if T.all (== ' ') e
then T.dropEnd 1 b
else t
begin_ :: PandocMonad m => Text -> LP m ()
begin_ t = try (do
controlSeq "begin"
spaces
txt <- untokenize <$> braced
guard (t == txt)) <?> ("\\begin{" ++ T.unpack t ++ "}")
end_ :: PandocMonad m => Text -> LP m ()
end_ t = try (do
controlSeq "end"
spaces
txt <- untokenize <$> braced
guard $ t == txt) <?> ("\\end{" ++ T.unpack t ++ "}")