@@ -38,8 +38,9 @@ module Text.Pandoc.Readers.LaTeX ( readLaTeX,
3838import Control.Applicative (many, optional, (<|>))
3939import Control.Monad
4040import Control.Monad.Except (throwError)
41−import Data.Char (chr, isAlphaNum, isLetter, ord)
41+import Data.Char (chr, isAlphaNum, isLetter, ord, isDigit)
4242import Data.Text (Text, unpack)
43+import qualified Data.Text as T
4344import Data.List (intercalate, isPrefixOf)
4445import qualified Data.Map as M
4546import Data.Maybe (fromMaybe, maybeToList)
@@ -47,16 +48,703 @@ import Safe (minimumDef)
4748import System.FilePath (addExtension, replaceExtension, takeExtension)
4849import Text.Pandoc.Builder
4950import Text.Pandoc.Class (PandocMonad, PandocPure, lookupEnv, readFileFromDirs,
50− report, setResourcePath, getResourcePath)
51+ report, setResourcePath, getResourcePath,
52+ runIOorExplode, PandocIO)
5153import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)
5254import Text.Pandoc.ImageSize (numUnit, showFl)
5355import Text.Pandoc.Logging
5456import Text.Pandoc.Options
55−import Text.Pandoc.Parsing hiding (many, mathDisplay, mathInline, optional,
56− space, (<|>))
57+import Text.Pandoc.Parsing hiding (many, optional, withRaw,
58+ space, (<|>), spaces, blankline)
5759import Text.Pandoc.Shared
5860import Text.Pandoc.Walk
5961
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 => ParserT String ParserState m String
83+rawLaTeXBlock = mzero
84+
85+rawLaTeXInline :: PandocMonad m => ParserT String ParserState m Inline
86+rawLaTeXInline = mzero
87+
88+inlineCommand :: PandocMonad m => ParserT String ParserState m Inlines
89+inlineCommand = mzero
90+
91+data TokType = CtrlSeq | Spaces | Newline | Symbol | Word | Comment |
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+ _ -> Tok (lin, col) Symbol (T.singleton '^')
154+ : totoks (lin, col + 1) rest
155+ | otherwise ->
156+ Tok (lin, col) Symbol (T.singleton c) : totoks (lin, col + 1) rest
157+
158+ where isSpaceOrTab ' ' = True
159+ isSpaceOrTab '\t' = True
160+ isSpaceOrTab _ = False
161+
162+isLowerHex :: Char -> Bool
163+isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
164+
165+untokenize :: [Tok] -> Text
166+untokenize = mconcat . map untoken
167+
168+untoken :: Tok -> Text
169+untoken (Tok _ _ t) = t
170+
171+satisfyTok :: Monad m
172+ => (Tok -> Bool)
173+ -> ParserT [Tok] u m Tok
174+satisfyTok f = tokenPrim (T.unpack . untoken) updatePos matcher
175+ where matcher t | f t = Just t
176+ | otherwise = Nothing
177+ updatePos :: SourcePos -> Tok -> [Tok] -> SourcePos
178+ updatePos spos _ (Tok (lin,col) _ _ : _) =
179+ setSourceColumn (setSourceLine spos lin) col
180+ updatePos spos _ [] = spos
181+
182+anyControlSeq :: PandocMonad m => LP m Tok
183+anyControlSeq = satisfyTok isCtrlSeq <* optional sp
184+ where isCtrlSeq (Tok _ CtrlSeq _) = True
185+ isCtrlSeq _ = False
186+
187+spaces :: PandocMonad m => LP m ()
188+spaces = skipMany (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
189+
190+spaces1 :: PandocMonad m => LP m ()
191+spaces1 = skipMany1 (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
192+
193+tokTypeIn :: [TokType] -> Tok -> Bool
194+tokTypeIn toktypes (Tok _ tt _) = tt `elem` toktypes
195+tokTypeIn _ _ = False
196+
197+controlSeq :: PandocMonad m => Text -> LP m Tok
198+controlSeq name = satisfyTok isNamed
199+ where isNamed t@(Tok _ CtrlSeq n) = n == T.singleton '\\' <> name
200+ isNamed _ = False
201+
202+symbol :: PandocMonad m => Char -> LP m Tok
203+symbol c = satisfyTok isc
204+ where isc (Tok _ Symbol d) = case T.uncons d of
205+ Just (c',_) -> c == c'
206+ _ -> False
207+ isc _ = False
208+
209+symbolIn :: PandocMonad m => [Char] -> LP m Tok
210+symbolIn cs = satisfyTok isInCs
211+ where isInCs (Tok _ Symbol d) = case T.uncons d of
212+ Just (c,_) -> c `elem` cs
213+ _ -> False
214+ isInCs _ = False
215+
216+sp :: PandocMonad m => LP m ()
217+sp = whitespace <|> endline
218+
219+whitespace :: PandocMonad m => LP m ()
220+whitespace = () <$ satisfyTok isSpaceTok
221+ where isSpaceTok (Tok _ Spaces _) = True
222+ isSpaceTok _ = False
223+
224+newlineTok :: PandocMonad m => LP m ()
225+newlineTok = () <$ satisfyTok isNewlineTok
226+
227+isNewlineTok :: Tok -> Bool
228+isNewlineTok (Tok _ Newline _) = True
229+isNewlineTok _ = False
230+
231+comment :: PandocMonad m => LP m ()
232+comment = () <$ satisfyTok isCommentTok
233+ where isCommentTok (Tok _ Comment _) = True
234+ isCommentTok _ = False
235+
236+anyTok :: PandocMonad m => LP m Tok
237+anyTok = satisfyTok (const True)
238+
239+endline :: PandocMonad m => LP m ()
240+endline = try $ do
241+ newlineTok
242+ lookAhead anyTok
243+ notFollowedBy blankline
244+
245+blankline :: PandocMonad m => LP m ()
246+blankline = try $ do
247+ skipMany (satisfyTok (tokTypeIn [Spaces, Newline]))
248+ newlineTok
249+
250+primEscape :: PandocMonad m => LP m Char
251+primEscape = do
252+ Tok _ toktype t <- satisfyTok (tokTypeIn [Esc1, Esc2])
253+ case toktype of
254+ Esc1 -> case T.uncons t of
255+ Just (c, _)
256+ | c >= '\64' && c <= '\127' -> return (chr (ord c - 64))
257+ | otherwise -> return (chr (ord c + 64))
258+ Nothing -> fail "Empty content of Esc1"
259+ Esc2 -> case safeRead ('0':'x':T.unpack (T.drop 2 t)) of
260+ Just x -> return (chr x)
261+ Nothing -> fail $ "Could not read: " ++ T.unpack t
262+ _ -> fail "Expected an Esc1 or Esc2 token" -- should not happen
263+
264+bgroup :: PandocMonad m => LP m ()
265+bgroup = try $ do
266+ skipMany sp
267+ symbol '{' <|> controlSeq "bgroup" <|> controlSeq "begingroup"
268+ return ()
269+
270+egroup :: PandocMonad m => LP m ()
271+egroup = () <$ (symbol '}' <|> controlSeq "egroup" <|> controlSeq "endgroup")
272+
273+grouped :: (PandocMonad m, Monoid a) => LP m a -> LP m a
274+grouped parser = try $ do
275+ bgroup
276+ -- first we check for an inner 'grouped', because
277+ -- {{a,b}} should be parsed the same as {a,b}
278+ try (grouped parser <* egroup) <|> (mconcat <$> manyTill parser egroup)
279+
280+braced :: PandocMonad m => LP m [Tok]
281+braced = try $ do
282+ bgroup
283+ -- {{a,b}} should be parsed the same as {a,b}
284+ try (braced <* egroup) <|> manyTill anyTok egroup
285+
286+bracketed :: PandocMonad m => Monoid a => LP m a -> LP m a
287+bracketed parser = try $ do
288+ symbol '['
289+ mconcat <$> manyTill parser (symbol ']')
290+
291+dimenarg :: PandocMonad m => LP m Text
292+dimenarg = try $ do
293+ ch <- option False $ True <$ symbol '='
294+ Tok _ _ s <- satisfyTok isWordTok
295+ guard $ (T.take 2 (T.reverse s)) `elem`
296+ ["pt","pc","in","bp","cm","mm","dd","cc","sp"]
297+ let num = T.take (T.length s - 2) s
298+ guard $ T.length num > 0
299+ guard $ T.all isDigit num
300+ return $ T.pack ['=' | ch] <> s
301+
302+-- inline elements:
303+
304+inlineText :: PandocMonad m => LP m Inlines
305+inlineText = (str . T.unpack . untoken) <$> satisfyTok isWordTok
306+
307+isWordTok :: Tok -> Bool
308+isWordTok (Tok _ Word _) = True
309+isWordTok _ = False
310+
311+inlineGroup :: PandocMonad m => LP m Inlines
312+inlineGroup = do
313+ ils <- grouped inline
314+ if isNull ils
315+ then return mempty
316+ else return $ spanWith nullAttr ils
317+ -- we need the span so we can detitlecase bibtex entries;
318+ -- we need to know when something is {C}apitalized
319+
320+doLHSverb :: PandocMonad m => LP m Inlines
321+doLHSverb =
322+ (codeWith ("",["haskell"],[]) . T.unpack . untokenize)
323+ <$> manyTill (satisfyTok (not . isNewlineTok)) (symbol '|')
324+
325+lit :: String -> LP m Inlines
326+lit = pure . str
327+
328+doubleQuote :: PandocMonad m => LP m Inlines
329+doubleQuote = do
330+ quoted' doubleQuoted (try $ count 2 $ symbol '`')
331+ (void $ try $ count 2 $ symbol '\'')
332+ <|> quoted' doubleQuoted ((:[]) <$> symbol '“') (void $ symbol '”')
333+ -- the following is used by babel for localized quotes:
334+ <|> quoted' doubleQuoted (try $ sequence [symbol '"', symbol '`'])
335+ (void $ try $ sequence [symbol '"', symbol '\''])
336+ <|> quoted' doubleQuoted ((:[]) <$> symbol '"')
337+ (void $ symbol '"')
338+
339+singleQuote :: PandocMonad m => LP m Inlines
340+singleQuote = do
341+ quoted' singleQuoted ((:[]) <$> symbol '`')
342+ (try $ symbol '\'' >>
343+ notFollowedBy (satisfyTok startsWithLetter))
344+ <|> quoted' singleQuoted ((:[]) <$> symbol '‘')
345+ (try $ symbol '’' >>
346+ notFollowedBy (satisfyTok startsWithLetter))
347+ where startsWithLetter (Tok _ Word t) =
348+ case T.uncons t of
349+ Just (c, _) | isLetter c -> True
350+ _ -> False
351+ startsWithLetter _ = False
352+
353+quoted' :: PandocMonad m
354+ => (Inlines -> Inlines)
355+ -> LP m [Tok]
356+ -> LP m ()
357+ -> LP m Inlines
358+quoted' f starter ender = do
359+ startchs <- (T.unpack . untokenize) <$> starter
360+ smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
361+ if smart
362+ then do
363+ ils <- many (notFollowedBy ender >> inline)
364+ (ender >> return (f (mconcat ils))) <|>
365+ (<> mconcat ils) <$>
366+ lit (case startchs of
367+ "``" -> "“"
368+ "`" -> "‘"
369+ cs -> cs)
370+ else lit startchs
371+
372+dollarsMath :: PandocMonad m => LP m Inlines
373+dollarsMath = do
374+ symbol '$'
375+ display <- option False (True <$ symbol '$')
376+ contents <- many1Till anyTok (symbol '$')
377+ when display (() <$ symbol '$')
378+ let constructor = if display then displayMath else math
379+ return $ constructor $ T.unpack $ untokenize contents
380+
381+inlineCommand' :: PandocMonad m => LP m Inlines
382+inlineCommand' = try $ do
383+ cs@(Tok _ CtrlSeq t) <- anyControlSeq
384+ let name = T.drop 1 t
385+ guard $ name /= "begin" && name /= "end"
386+ mbstar <- option Nothing (Just <$> symbol '*')
387+ let names = name : maybe [] (const [name <> "*"]) mbstar
388+ optional $ try $ symbol '{' >> symbol '}'
389+ let raw = do
390+ guard $ not (isBlockCommand name)
391+ (_, rawargs) <- withRaw
392+ (skipangles *> skipopts *> option "" dimenarg *> many braced)
393+ let rawcommand = T.unpack $ untokenize $
394+ cs : maybe [] (:[]) mbstar ++ rawargs
395+ (guardEnabled Ext_raw_tex >> return (rawInline "latex" rawcommand))
396+ <|> ignore rawcommand
397+ -- transformed <- applyMacros' rawcommand -- TODO or get rid of
398+ -- exts <- getOption readerExtensions
399+ -- if transformed /= rawcommand
400+ -- then parseFromString' inlines transformed
401+ -- else if extensionEnabled Ext_raw_tex exts
402+ -- then return $ rawInline "latex" rawcommand
403+ -- else ignore rawcommand
404+ lookupListDefault raw names inlineCommands
405+
406+tok :: PandocMonad m => LP m Inlines
407+tok = try $ grouped inline <|> inlineCommand' <|> singleChar
408+ where singleChar = do
409+ Tok (lin,col) toktype t <- satisfyTok (tokTypeIn [Word, Symbol])
410+ if T.length t > 1
411+ then do
412+ let (t1, t2) = (T.take 1 t, T.drop 1 t)
413+ inp <- getInput
414+ setInput $ (Tok (lin, col + 1) toktype t2) : inp
415+ return $ str (T.unpack t1)
416+ else return $ str (T.unpack t)
417+
418+opt :: PandocMonad m => LP m Inlines
419+opt = bracketed inline
420+
421+rawopt :: PandocMonad m => LP m Text
422+rawopt = do
423+ symbol '['
424+ inner <- untokenize <$> manyTill anyTok (symbol ']')
425+ optional sp
426+ return $ "[" <> inner <> "]"
427+
428+skipopts :: PandocMonad m => LP m ()
429+skipopts = skipMany rawopt
430+
431+-- opts in angle brackets are used in beamer
432+rawangle :: PandocMonad m => LP m ()
433+rawangle = try $ do
434+ symbol '<'
435+ () <$ manyTill anyTok (symbol '>')
436+
437+skipangles :: PandocMonad m => LP m ()
438+skipangles = skipMany rawangle
439+
440+ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a
441+ignore raw = do
442+ pos <- getPosition
443+ report $ SkippedContent raw pos
444+ return mempty
445+
446+withRaw :: PandocMonad m => LP m a -> LP m (a, [Tok])
447+withRaw parser = do
448+ pos1 <- getPosition
449+ inp <- getInput
450+ result <- parser
451+ nxt <- option (Tok (0,0) Word "") (lookAhead anyTok)
452+ let raw = takeWhile (/= nxt) inp
453+ return (result, raw)
454+
455+inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)
456+inlineCommands = M.fromList
457+ [ ("emph", extractSpaces emph <$> tok)
458+ , ("textit", extractSpaces emph <$> tok)
459+ , ("textsl", extractSpaces emph <$> tok)
460+ , ("textsc", extractSpaces smallcaps <$> tok)
461+ , ("textsf", extractSpaces (spanWith ("",["sans-serif"],[])) <$> tok)
462+ , ("textmd", extractSpaces (spanWith ("",["medium"],[])) <$> tok)
463+ , ("textrm", extractSpaces (spanWith ("",["roman"],[])) <$> tok)
464+ , ("textup", extractSpaces (spanWith ("",["upright"],[])) <$> tok)
465+ , ("texttt", ttfamily)
466+ , ("sout", extractSpaces strikeout <$> tok)
467+ , ("textsuperscript", extractSpaces superscript <$> tok)
468+ , ("textsubscript", extractSpaces subscript <$> tok)
469+ , ("textbackslash", lit "\\")
470+ , ("backslash", lit "\\")
471+ , ("slash", lit "/")
472+ , ("textbf", extractSpaces strong <$> tok)
473+ , ("textnormal", extractSpaces (spanWith ("",["nodecor"],[])) <$> tok)
474+ , ("ldots", lit "…")
475+ , ("vdots", lit "\8942")
476+ , ("dots", lit "…")
477+ , ("mdots", lit "…")
478+ , ("sim", lit "~")
479+-- , ("label", rawInlineOr "label" (inBrackets <$> tok))
480+-- , ("ref", rawInlineOr "ref" (inBrackets <$> tok))
481+-- , ("textgreek", tok)
482+-- , ("sep", lit ",")
483+-- , ("cref", rawInlineOr "cref" (inBrackets <$> tok)) -- from cleveref.sty
484+-- , ("(", mathInline $ manyTill anyChar (try $ string "\\)"))
485+-- , ("[", mathDisplay $ manyTill anyChar (try $ string "\\]"))
486+-- , ("ensuremath", mathInline braced)
487+-- , ("texorpdfstring", (\_ x -> x) <$> tok <*> tok)
488+ , ("P", lit "¶")
489+ , ("S", lit "§")
490+ , ("$", lit "$")
491+ , ("%", lit "%")
492+ , ("&", lit "&")
493+ , ("#", lit "#")
494+ , ("_", lit "_")
495+ , ("{", lit "{")
496+ , ("}", lit "}")
497+ -- old TeX commands
498+ , ("em", extractSpaces emph <$> inlines)
499+ , ("it", extractSpaces emph <$> inlines)
500+ , ("sl", extractSpaces emph <$> inlines)
501+ , ("bf", extractSpaces strong <$> inlines)
502+ , ("rm", inlines)
503+ , ("itshape", extractSpaces emph <$> inlines)
504+ , ("slshape", extractSpaces emph <$> inlines)
505+ , ("scshape", extractSpaces smallcaps <$> inlines)
506+ , ("bfseries", extractSpaces strong <$> inlines)
507+ , ("/", pure mempty) -- italic correction
508+ , ("aa", lit "å")
509+ , ("AA", lit "Å")
510+ , ("ss", lit "ß")
511+ , ("o", lit "ø")
512+ , ("O", lit "Ø")
513+ , ("L", lit "Ł")
514+ , ("l", lit "ł")
515+ , ("ae", lit "æ")
516+ , ("AE", lit "Æ")
517+ , ("oe", lit "œ")
518+ , ("OE", lit "Œ")
519+ , ("pounds", lit "£")
520+ , ("euro", lit "€")
521+ , ("copyright", lit "©")
522+ , ("textasciicircum", lit "^")
523+ , ("textasciitilde", lit "~")
524+-- , ("H", try $ tok >>= accent hungarumlaut)
525+-- , ("`", option (str "`") $ try $ tok >>= accent grave)
526+-- , ("'", option (str "'") $ try $ tok >>= accent acute)
527+-- , ("^", option (str "^") $ try $ tok >>= accent circ)
528+-- , ("~", option (str "~") $ try $ tok >>= accent tilde)
529+-- , ("\"", option (str "\"") $ try $ tok >>= accent umlaut)
530+-- , (".", option (str ".") $ try $ tok >>= accent dot)
531+-- , ("=", option (str "=") $ try $ tok >>= accent macron)
532+-- , ("c", option (str "c") $ try $ tok >>= accent cedilla)
533+-- , ("v", option (str "v") $ try $ tok >>= accent hacek)
534+-- , ("u", option (str "u") $ try $ tok >>= accent breve)
535+-- , ("i", lit "i")
536+-- , ("\\", linebreak <$ (optional (bracketed inline) *> spaces'))
537+-- , (",", lit "\8198")
538+-- , ("@", pure mempty)
539+-- , (" ", lit "\160")
540+-- , ("ps", pure $ str "PS." <> space)
541+-- , ("TeX", lit "TeX")
542+-- , ("LaTeX", lit "LaTeX")
543+-- , ("bar", lit "|")
544+-- , ("textless", lit "<")
545+-- , ("textgreater", lit ">")
546+-- , ("thanks", note <$> grouped block)
547+-- , ("footnote", note <$> grouped block)
548+-- , ("verb", doverb)
549+-- , ("lstinline", dolstinline)
550+-- , ("Verb", doverb)
551+-- , ("url", (unescapeURL <$> braced) >>= \url ->
552+-- pure (link url "" (str url)))
553+-- , ("href", (unescapeURL <$> braced <* optional sp) >>= \url ->
554+-- tok >>= \lab ->
555+-- pure (link url "" lab))
556+-- , ("includegraphics", do options <- option [] keyvals
557+-- src <- unescapeURL . removeDoubleQuotes <$> braced
558+-- mkImage options src)
559+-- , ("enquote", enquote)
560+-- , ("cite", citation "cite" NormalCitation False)
561+-- , ("Cite", citation "Cite" NormalCitation False)
562+-- , ("citep", citation "citep" NormalCitation False)
563+-- , ("citep*", citation "citep*" NormalCitation False)
564+-- , ("citeal", citation "citeal" NormalCitation False)
565+-- , ("citealp", citation "citealp" NormalCitation False)
566+-- , ("citealp*", citation "citealp*" NormalCitation False)
567+-- , ("autocite", citation "autocite" NormalCitation False)
568+-- , ("smartcite", citation "smartcite" NormalCitation False)
569+-- , ("footcite", inNote <$> citation "footcite" NormalCitation False)
570+-- , ("parencite", citation "parencite" NormalCitation False)
571+-- , ("supercite", citation "supercite" NormalCitation False)
572+-- , ("footcitetext", inNote <$> citation "footcitetext" NormalCitation False)
573+-- , ("citeyearpar", citation "citeyearpar" SuppressAuthor False)
574+-- , ("citeyear", citation "citeyear" SuppressAuthor False)
575+-- , ("autocite*", citation "autocite*" SuppressAuthor False)
576+-- , ("cite*", citation "cite*" SuppressAuthor False)
577+-- , ("parencite*", citation "parencite*" SuppressAuthor False)
578+-- , ("textcite", citation "textcite" AuthorInText False)
579+-- , ("citet", citation "citet" AuthorInText False)
580+-- , ("citet*", citation "citet*" AuthorInText False)
581+-- , ("citealt", citation "citealt" AuthorInText False)
582+-- , ("citealt*", citation "citealt*" AuthorInText False)
583+-- , ("textcites", citation "textcites" AuthorInText True)
584+-- , ("cites", citation "cites" NormalCitation True)
585+-- , ("autocites", citation "autocites" NormalCitation True)
586+-- , ("footcites", inNote <$> citation "footcites" NormalCitation True)
587+-- , ("parencites", citation "parencites" NormalCitation True)
588+-- , ("supercites", citation "supercites" NormalCitation True)
589+-- , ("footcitetexts", inNote <$> citation "footcitetexts" NormalCitation True)
590+-- , ("Autocite", citation "Autocite" NormalCitation False)
591+-- , ("Smartcite", citation "Smartcite" NormalCitation False)
592+-- , ("Footcite", citation "Footcite" NormalCitation False)
593+-- , ("Parencite", citation "Parencite" NormalCitation False)
594+-- , ("Supercite", citation "Supercite" NormalCitation False)
595+-- , ("Footcitetext", inNote <$> citation "Footcitetext" NormalCitation False)
596+-- , ("Citeyearpar", citation "Citeyearpar" SuppressAuthor False)
597+-- , ("Citeyear", citation "Citeyear" SuppressAuthor False)
598+-- , ("Autocite*", citation "Autocite*" SuppressAuthor False)
599+-- , ("Cite*", citation "Cite*" SuppressAuthor False)
600+-- , ("Parencite*", citation "Parencite*" SuppressAuthor False)
601+-- , ("Textcite", citation "Textcite" AuthorInText False)
602+-- , ("Textcites", citation "Textcites" AuthorInText True)
603+-- , ("Cites", citation "Cites" NormalCitation True)
604+-- , ("Autocites", citation "Autocites" NormalCitation True)
605+-- , ("Footcites", citation "Footcites" NormalCitation True)
606+-- , ("Parencites", citation "Parencites" NormalCitation True)
607+-- , ("Supercites", citation "Supercites" NormalCitation True)
608+-- , ("Footcitetexts", inNote <$> citation "Footcitetexts" NormalCitation True)
609+-- , ("citetext", complexNatbibCitation NormalCitation)
610+-- , ("citeauthor", (try (tok *> optional sp *> controlSeq "citetext") *>
611+-- complexNatbibCitation AuthorInText)
612+-- <|> citation "citeauthor" AuthorInText False)
613+-- , ("nocite", mempty <$ (citation "nocite" NormalCitation False >>=
614+-- addMeta "nocite"))
615+-- , ("hypertarget", braced >> tok)
616+-- -- siuntix
617+-- , ("SI", dosiunitx)
618+-- -- hyphenat
619+-- , ("bshyp", lit "\\\173")
620+-- , ("fshyp", lit "/\173")
621+-- , ("dothyp", lit ".\173")
622+-- , ("colonhyp", lit ":\173")
623+-- , ("hyp", lit "-")
624+-- , ("nohyphens", tok)
625+-- , ("textnhtt", ttfamily)
626+-- , ("nhttfamily", ttfamily)
627+-- -- fontawesome
628+-- , ("faCheck", lit "\10003")
629+-- , ("faClose", lit "\10007")
630+-- ] ++ map ignoreInlines
631+-- -- these commands will be ignored unless --parse-raw is specified,
632+-- -- in which case they will appear as raw latex blocks:
633+-- [ "index"
634+-- , "hspace"
635+-- , "vspace"
636+-- , "newpage"
637+-- , "clearpage"
638+-- , "pagebreak"
639+ ]
640+
641+ttfamily :: PandocMonad m => LP m Inlines
642+ttfamily = (code . stringify . toList) <$> tok
643+
644+rawInlineOr :: PandocMonad m => String -> LP m Inlines -> LP m Inlines
645+rawInlineOr name' fallback = do
646+ parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
647+ if parseRaw
648+ then rawInline "latex" <$> getRawCommand name'
649+ else fallback
650+
651+getRawCommand :: PandocMonad m => String -> LP m String
652+getRawCommand name' = do
653+ (_, rawargs) <- withRaw
654+ (many (try (optional sp *> opt)) *>
655+ option "" (try (optional sp *> dimenarg)) *>
656+ many braced)
657+ return $ '\\' : name' ++ T.unpack (untokenize rawargs)
658+
659+isBlockCommand :: Text -> Bool
660+isBlockCommand s =
661+ s `M.member` (blockCommands :: M.Map Text (LP PandocPure Blocks))
662+
663+lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
664+lookupListDefault d = (fromMaybe d .) . lookupList
665+ where
666+ lookupList l m = msum $ map (`M.lookup` m) l
667+
668+inline :: PandocMonad m => LP m Inlines
669+inline = (mempty <$ comment)
670+ <|> (space <$ whitespace)
671+ <|> (softbreak <$ endline)
672+ <|> inlineText
673+ <|> inlineCommand'
674+ -- <|> inlineEnvironment
675+ <|> inlineGroup
676+ <|> (symbol '-' *>
677+ option (str "-") (symbol '-' *>
678+ option (str "–") (str "—" <$ symbol '-')))
679+ <|> doubleQuote
680+ <|> singleQuote
681+ <|> (str "”" <$ try (symbol '\'' >> symbol '\''))
682+ <|> (str "”" <$ symbol '”')
683+ <|> (str "’" <$ symbol '\'')
684+ <|> (str "’" <$ symbol '’')
685+ <|> (str "\160" <$ symbol '~')
686+ <|> dollarsMath
687+ <|> (guardEnabled Ext_literate_haskell *> symbol '|' *> doLHSverb)
688+ <|> (str . (:[]) <$> primEscape)
689+ <|> (do res <- symbolIn "#&~^'`\"[]"
690+ pos <- getPosition
691+ let s = T.unpack (untoken res)
692+ report $ ParsingUnescaped s pos
693+ return $ str s)
694+
695+inlines :: PandocMonad m => LP m Inlines
696+inlines = mconcat <$> many inline
697+
698+-- PREVIOUSLY HAD (notFollowedBy (char '}') *> inline)
699+
700+-- block elements:
701+
702+paragraph :: PandocMonad m => LP m Blocks
703+paragraph = do
704+ x <- trimInlines . mconcat <$> many1 inline
705+ if x == mempty
706+ then return mempty
707+ else return $ para x
708+
709+include :: PandocMonad m => LP m Blocks
710+include = do
711+ (Tok _ _ name) <- controlSeq "include" <|> controlSeq "input" <|>
712+ controlSeq "subfile" <|> controlSeq "usepackage"
713+ skipMany $ bracketed inline -- skip options
714+ fs <- (map trim . splitBy (==',') . T.unpack . untokenize) <$> braced
715+ let fs' = if name == "\\usepackage"
716+ then map (maybeAddExtension ".sty") fs
717+ else map (maybeAddExtension ".tex") fs
718+ dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
719+ mconcat <$> mapM (insertIncludedFile blocks (tokenize . T.pack) dirs) fs'
720+
721+maybeAddExtension :: String -> FilePath -> FilePath
722+maybeAddExtension ext fp =
723+ if null (takeExtension fp)
724+ then addExtension fp ext
725+ else fp
726+
727+blockCommands :: PandocMonad m => M.Map Text (LP m Blocks)
728+blockCommands = M.empty
729+
730+block :: PandocMonad m => LP m Blocks
731+block = (mempty <$ spaces1)
732+ -- <|> environment
733+ <|> include
734+ -- <|> macro
735+ -- <|> blockCommand
736+ <|> paragraph
737+ <|> grouped block
738+
739+blocks :: PandocMonad m => LP m Blocks
740+blocks = mconcat <$> many block
741+
742+
743+{-
744+
745+-}
746+
747+{-
60748-- | Parse LaTeX from string and return 'Pandoc' document.
61749readLaTeX :: PandocMonad m
62750 => ReaderOptions -- ^ Reader options
@@ -69,6 +757,7 @@ readLaTeX opts ltx = do
69757 Right result -> return result
70758 Left e -> throwError e
71759
760+
72761parseLaTeX :: PandocMonad m => LP m Pandoc
73762parseLaTeX = do
74763 bs <- blocks
@@ -88,8 +777,6 @@ parseLaTeX = do
88777 else id) doc'
89778 return $ Pandoc meta bs'
90779
91−type LP m = ParserT String ParserState m
92−
93780anyControlSeq :: PandocMonad m => LP m String
94781anyControlSeq = do
95782 char '\\'
@@ -127,8 +814,8 @@ endline = try (newline >> lookAhead anyChar >> notFollowedBy blankline)
127814isLowerHex :: Char -> Bool
128815isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
129816
130−tildeEscape :: PandocMonad m => LP m Char
131−tildeEscape = try $ do
817+primEscape :: PandocMonad m => LP m Char
818+primEscape = try $ do
132819 string "^^"
133820 c <- satisfy (\x -> x >= '\0' && x <= '\128')
134821 d <- if isLowerHex c
@@ -200,37 +887,6 @@ mathChars =
200887 isOrdChar '\\' = False
201888 isOrdChar _ = True
202889
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−
234890inline :: PandocMonad m => LP m Inlines
235891inline = (mempty <$ comment)
236892 <|> (space <$ whitespace)
@@ -251,7 +907,7 @@ inline = (mempty <$ comment)
251907 <|> mathDisplay (string "$$" *> mathChars <* string "$$")
252908 <|> mathInline (char '$' *> mathChars <* char '$')
253909 <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)
254− <|> (str . (:[]) <$> tildeEscape)
910+ <|> (str . (:[]) <$> primEscape)
255911 <|> (do res <- oneOf "#&~^'`\"[]"
256912 pos <- getPosition
257913 report $ ParsingUnescaped [res] pos
@@ -744,9 +1400,6 @@ dolstinline = do
7441400 marker <- char '{' <|> anyChar
7451401 codeWith ("",classes,[]) <$> manyTill (satisfy (/='\n')) (char '}' <|> char marker)
7461402
747−doLHSverb :: PandocMonad m => LP m Inlines
748−doLHSverb = codeWith ("",["haskell"],[]) <$> manyTill (satisfy (/='\n')) (char '|')
749−
7501403-- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"
7511404dosiunitx :: PandocMonad m => LP m Inlines
7521405dosiunitx = do
@@ -762,9 +1415,6 @@ dosiunitx = do
7621415 emptyOr160 unit,
7631416 unit]
7641417
765−lit :: String -> LP m Inlines
766−lit = pure . str
767−
7681418accent :: (Char -> String) -> Inlines -> LP m Inlines
7691419accent f ils =
7701420 case toList ils of
@@ -1052,63 +1702,6 @@ rawVerbEnv name = do
10521702
10531703----
10541704
1055−maybeAddExtension :: String -> FilePath -> FilePath
1056−maybeAddExtension ext fp =
1057− if null (takeExtension fp)
1058− then addExtension fp ext
1059− else fp
1060−
1061−include :: PandocMonad m => LP m Blocks
1062−include = do
1063− fs' <- try $ do
1064− char '\\'
1065− name <- try (string "include")
1066− <|> try (string "input")
1067− <|> try (string "subfile")
1068− <|> string "usepackage"
1069− -- skip options
1070− skipMany $ try $ char '[' *> manyTill anyChar (char ']')
1071− fs <- (map trim . splitBy (==',')) <$> braced
1072− return $ if name == "usepackage"
1073− then map (maybeAddExtension ".sty") fs
1074− else map (maybeAddExtension ".tex") fs
1075− dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
1076− mconcat <$> mapM (insertIncludedFile blocks dirs) fs'
1077−
1078−inputListing :: PandocMonad m => LP m Blocks
1079−inputListing = do
1080− pos <- getPosition
1081− options <- option [] keyvals
1082− f <- filter (/='"') <$> braced
1083− dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
1084− mbCode <- readFileFromDirs dirs f
1085− codeLines <- case mbCode of
1086− Just s -> return $ lines s
1087− Nothing -> do
1088− report $ CouldNotLoadIncludeFile f pos
1089− return []
1090− let (ident,classes,kvs) = parseListingsOptions options
1091− let language = case lookup "language" options >>= fromListingsLanguage of
1092− Just l -> [l]
1093− Nothing -> take 1 $ languagesByExtension (takeExtension f)
1094− let firstline = fromMaybe 1 $ lookup "firstline" options >>= safeRead
1095− let lastline = fromMaybe (length codeLines) $
1096− lookup "lastline" options >>= safeRead
1097− let codeContents = intercalate "\n" $ take (1 + lastline - firstline) $
1098− drop (firstline - 1) codeLines
1099− return $ codeBlockWith (ident,ordNub (classes ++ language),kvs) codeContents
1100−
1101−parseListingsOptions :: [(String, String)] -> Attr
1102−parseListingsOptions options =
1103− let kvs = [ (if k == "firstnumber"
1104− then "startFrom"
1105− else k, v) | (k,v) <- options ]
1106− classes = [ "numberLines" |
1107− lookup "numbers" options == Just "left" ]
1108− ++ maybeToList (lookup "language" options
1109− >>= fromListingsLanguage)
1110− in (fromMaybe "" (lookup "label" options), classes, kvs)
1111−
11121705----
11131706
11141707keyval :: PandocMonad m => LP m (String, String)
@@ -1131,10 +1724,10 @@ alltt t = walk strToCode <$> parseFromString' blocks
11311724 where strToCode (Str s) = Code nullAttr s
11321725 strToCode x = x
11331726
1134−rawLaTeXBlock :: PandocMonad m => LP m String
1727+rawLaTeXBlock :: PandocMonad m => ParserT String ParserState String
11351728rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))
11361729
1137−rawLaTeXInline :: PandocMonad m => LP m Inline
1730+rawLaTeXInline :: PandocMonad m => ParserT String ParserState Inline
11381731rawLaTeXInline = do
11391732 raw <- (snd <$> withRaw inlineCommand)
11401733 <|> (snd <$> withRaw inlineEnvironment)
@@ -1570,3 +2163,40 @@ removeDoubleQuotes ('"':xs) =
15702163 '"':ys -> reverse ys
15712164 _ -> '"':xs
15722165removeDoubleQuotes xs = xs
2166+
2167+inputListing :: PandocMonad m => LP m Blocks
2168+inputListing = do
2169+ pos <- getPosition
2170+ options <- option [] keyvals
2171+ f <- filter (/='"') <$> braced
2172+ dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
2173+ mbCode <- readFileFromDirs dirs f
2174+ codeLines <- case mbCode of
2175+ Just s -> return $ lines s
2176+ Nothing -> do
2177+ report $ CouldNotLoadIncludeFile f pos
2178+ return []
2179+ let (ident,classes,kvs) = parseListingsOptions options
2180+ let language = case lookup "language" options >>= fromListingsLanguage of
2181+ Just l -> [l]
2182+ Nothing -> take 1 $ languagesByExtension (takeExtension f)
2183+ let firstline = fromMaybe 1 $ lookup "firstline" options >>= safeRead
2184+ let lastline = fromMaybe (length codeLines) $
2185+ lookup "lastline" options >>= safeRead
2186+ let codeContents = intercalate "\n" $ take (1 + lastline - firstline) $
2187+ drop (firstline - 1) codeLines
2188+ return $ codeBlockWith (ident,ordNub (classes ++ language),kvs) codeContents
2189+
2190+parseListingsOptions :: [(String, String)] -> Attr
2191+parseListingsOptions options =
2192+ let kvs = [ (if k == "firstnumber"
2193+ then "startFrom"
2194+ else k, v) | (k,v) <- options ]
2195+ classes = [ "numberLines" |
2196+ lookup "numbers" options == Just "left" ]
2197+ ++ maybeToList (lookup "language" options
2198+ >>= fromListingsLanguage)
2199+ in (fromMaybe "" (lookup "label" options), classes, kvs)
2200+
2201+
2202+-}