@@ -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,698 @@ 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 <* spaces
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'
408+ <|> (str . T.unpack . untoken) <$> anyTok
409+ -- note: this will swallow a whole word in cases
410+ -- where latex would only consider one letter (TODO?)
411+
412+opt :: PandocMonad m => LP m Inlines
413+opt = bracketed inline
414+
415+rawopt :: PandocMonad m => LP m Text
416+rawopt = do
417+ symbol '['
418+ inner <- untokenize <$> manyTill anyTok (symbol ']')
419+ spaces
420+ return $ "[" <> inner <> "]"
421+
422+skipopts :: PandocMonad m => LP m ()
423+skipopts = skipMany rawopt
424+
425+-- opts in angle brackets are used in beamer
426+rawangle :: PandocMonad m => LP m ()
427+rawangle = try $ do
428+ symbol '<'
429+ () <$ manyTill anyTok (symbol '>')
430+
431+skipangles :: PandocMonad m => LP m ()
432+skipangles = skipMany rawangle
433+
434+ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a
435+ignore raw = do
436+ pos <- getPosition
437+ report $ SkippedContent raw pos
438+ return mempty
439+
440+withRaw :: PandocMonad m => LP m a -> LP m (a, [Tok])
441+withRaw parser = do
442+ pos1 <- getPosition
443+ inp <- getInput
444+ result <- parser
445+ nxt <- option (Tok (0,0) Word "") (lookAhead anyTok)
446+ let raw = takeWhile (/= nxt) inp
447+ return (result, raw)
448+
449+inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)
450+inlineCommands = M.fromList
451+ [ ("emph", extractSpaces emph <$> tok)
452+ ]
453+
454+isBlockCommand :: Text -> Bool
455+isBlockCommand s =
456+ s `M.member` (blockCommands :: M.Map Text (LP PandocPure Blocks))
457+
458+lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
459+lookupListDefault d = (fromMaybe d .) . lookupList
460+ where
461+ lookupList l m = msum $ map (`M.lookup` m) l
462+
463+{-
464+rawInlineOr :: PandocMonad m => String -> LP m Inlines -> LP m Inlines
465+rawInlineOr name' fallback = do
466+ parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
467+ if parseRaw
468+ then rawInline "latex" <$> getRawCommand name'
469+ else fallback
470+
471+isBlockCommand :: String -> Bool
472+isBlockCommand s = s `M.member` (blockCommands :: M.Map String (LP PandocPure Blocks))
473+
474+inlineCommands :: PandocMonad m => M.Map String (LP m Inlines)
475+inlineCommands = M.fromList $
476+ [ ("emph", extractSpaces emph <$> tok)
477+ , ("textit", extractSpaces emph <$> tok)
478+ , ("textsl", extractSpaces emph <$> tok)
479+ , ("textsc", extractSpaces smallcaps <$> tok)
480+ , ("textsf", extractSpaces (spanWith ("",["sans-serif"],[])) <$> tok)
481+ , ("textmd", extractSpaces (spanWith ("",["medium"],[])) <$> tok)
482+ , ("textrm", extractSpaces (spanWith ("",["roman"],[])) <$> tok)
483+ , ("textup", extractSpaces (spanWith ("",["upright"],[])) <$> tok)
484+ , ("texttt", ttfamily)
485+ , ("sout", extractSpaces strikeout <$> tok)
486+ , ("textsuperscript", extractSpaces superscript <$> tok)
487+ , ("textsubscript", extractSpaces subscript <$> tok)
488+ , ("textbackslash", lit "\\")
489+ , ("backslash", lit "\\")
490+ , ("slash", lit "/")
491+ , ("textbf", extractSpaces strong <$> tok)
492+ , ("textnormal", extractSpaces (spanWith ("",["nodecor"],[])) <$> tok)
493+ , ("ldots", lit "…")
494+ , ("vdots", lit "\8942")
495+ , ("dots", lit "…")
496+ , ("mdots", lit "…")
497+ , ("sim", lit "~")
498+ , ("label", rawInlineOr "label" (inBrackets <$> tok))
499+ , ("ref", rawInlineOr "ref" (inBrackets <$> tok))
500+ , ("textgreek", tok)
501+ , ("sep", lit ",")
502+ , ("cref", rawInlineOr "cref" (inBrackets <$> tok)) -- from cleveref.sty
503+ , ("(", mathInline $ manyTill anyChar (try $ string "\\)"))
504+ , ("[", mathDisplay $ manyTill anyChar (try $ string "\\]"))
505+ , ("ensuremath", mathInline braced)
506+ , ("texorpdfstring", (\_ x -> x) <$> tok <*> tok)
507+ , ("P", lit "¶")
508+ , ("S", lit "§")
509+ , ("$", lit "$")
510+ , ("%", lit "%")
511+ , ("&", lit "&")
512+ , ("#", lit "#")
513+ , ("_", lit "_")
514+ , ("{", lit "{")
515+ , ("}", lit "}")
516+ -- old TeX commands
517+ , ("em", extractSpaces emph <$> inlines)
518+ , ("it", extractSpaces emph <$> inlines)
519+ , ("sl", extractSpaces emph <$> inlines)
520+ , ("bf", extractSpaces strong <$> inlines)
521+ , ("rm", inlines)
522+ , ("itshape", extractSpaces emph <$> inlines)
523+ , ("slshape", extractSpaces emph <$> inlines)
524+ , ("scshape", extractSpaces smallcaps <$> inlines)
525+ , ("bfseries", extractSpaces strong <$> inlines)
526+ , ("/", pure mempty) -- italic correction
527+ , ("aa", lit "å")
528+ , ("AA", lit "Å")
529+ , ("ss", lit "ß")
530+ , ("o", lit "ø")
531+ , ("O", lit "Ø")
532+ , ("L", lit "Ł")
533+ , ("l", lit "ł")
534+ , ("ae", lit "æ")
535+ , ("AE", lit "Æ")
536+ , ("oe", lit "œ")
537+ , ("OE", lit "Œ")
538+ , ("pounds", lit "£")
539+ , ("euro", lit "€")
540+ , ("copyright", lit "©")
541+ , ("textasciicircum", lit "^")
542+ , ("textasciitilde", lit "~")
543+ , ("H", try $ tok >>= accent hungarumlaut)
544+ , ("`", option (str "`") $ try $ tok >>= accent grave)
545+ , ("'", option (str "'") $ try $ tok >>= accent acute)
546+ , ("^", option (str "^") $ try $ tok >>= accent circ)
547+ , ("~", option (str "~") $ try $ tok >>= accent tilde)
548+ , ("\"", option (str "\"") $ try $ tok >>= accent umlaut)
549+ , (".", option (str ".") $ try $ tok >>= accent dot)
550+ , ("=", option (str "=") $ try $ tok >>= accent macron)
551+ , ("c", option (str "c") $ try $ tok >>= accent cedilla)
552+ , ("v", option (str "v") $ try $ tok >>= accent hacek)
553+ , ("u", option (str "u") $ try $ tok >>= accent breve)
554+ , ("i", lit "i")
555+ , ("\\", linebreak <$ (optional (bracketed inline) *> spaces'))
556+ , (",", lit "\8198")
557+ , ("@", pure mempty)
558+ , (" ", lit "\160")
559+ , ("ps", pure $ str "PS." <> space)
560+ , ("TeX", lit "TeX")
561+ , ("LaTeX", lit "LaTeX")
562+ , ("bar", lit "|")
563+ , ("textless", lit "<")
564+ , ("textgreater", lit ">")
565+ , ("thanks", note <$> grouped block)
566+ , ("footnote", note <$> grouped block)
567+ , ("verb", doverb)
568+ , ("lstinline", dolstinline)
569+ , ("Verb", doverb)
570+ , ("url", (unescapeURL <$> braced) >>= \url ->
571+ pure (link url "" (str url)))
572+ , ("href", (unescapeURL <$> braced <* optional sp) >>= \url ->
573+ tok >>= \lab ->
574+ pure (link url "" lab))
575+ , ("includegraphics", do options <- option [] keyvals
576+ src <- unescapeURL . removeDoubleQuotes <$> braced
577+ mkImage options src)
578+ , ("enquote", enquote)
579+ , ("cite", citation "cite" NormalCitation False)
580+ , ("Cite", citation "Cite" NormalCitation False)
581+ , ("citep", citation "citep" NormalCitation False)
582+ , ("citep*", citation "citep*" NormalCitation False)
583+ , ("citeal", citation "citeal" NormalCitation False)
584+ , ("citealp", citation "citealp" NormalCitation False)
585+ , ("citealp*", citation "citealp*" NormalCitation False)
586+ , ("autocite", citation "autocite" NormalCitation False)
587+ , ("smartcite", citation "smartcite" NormalCitation False)
588+ , ("footcite", inNote <$> citation "footcite" NormalCitation False)
589+ , ("parencite", citation "parencite" NormalCitation False)
590+ , ("supercite", citation "supercite" NormalCitation False)
591+ , ("footcitetext", inNote <$> citation "footcitetext" NormalCitation False)
592+ , ("citeyearpar", citation "citeyearpar" SuppressAuthor False)
593+ , ("citeyear", citation "citeyear" SuppressAuthor False)
594+ , ("autocite*", citation "autocite*" SuppressAuthor False)
595+ , ("cite*", citation "cite*" SuppressAuthor False)
596+ , ("parencite*", citation "parencite*" SuppressAuthor False)
597+ , ("textcite", citation "textcite" AuthorInText False)
598+ , ("citet", citation "citet" AuthorInText False)
599+ , ("citet*", citation "citet*" AuthorInText False)
600+ , ("citealt", citation "citealt" AuthorInText False)
601+ , ("citealt*", citation "citealt*" AuthorInText False)
602+ , ("textcites", citation "textcites" AuthorInText True)
603+ , ("cites", citation "cites" NormalCitation True)
604+ , ("autocites", citation "autocites" NormalCitation True)
605+ , ("footcites", inNote <$> citation "footcites" NormalCitation True)
606+ , ("parencites", citation "parencites" NormalCitation True)
607+ , ("supercites", citation "supercites" NormalCitation True)
608+ , ("footcitetexts", inNote <$> citation "footcitetexts" NormalCitation True)
609+ , ("Autocite", citation "Autocite" NormalCitation False)
610+ , ("Smartcite", citation "Smartcite" NormalCitation False)
611+ , ("Footcite", citation "Footcite" NormalCitation False)
612+ , ("Parencite", citation "Parencite" NormalCitation False)
613+ , ("Supercite", citation "Supercite" NormalCitation False)
614+ , ("Footcitetext", inNote <$> citation "Footcitetext" NormalCitation False)
615+ , ("Citeyearpar", citation "Citeyearpar" SuppressAuthor False)
616+ , ("Citeyear", citation "Citeyear" SuppressAuthor False)
617+ , ("Autocite*", citation "Autocite*" SuppressAuthor False)
618+ , ("Cite*", citation "Cite*" SuppressAuthor False)
619+ , ("Parencite*", citation "Parencite*" SuppressAuthor False)
620+ , ("Textcite", citation "Textcite" AuthorInText False)
621+ , ("Textcites", citation "Textcites" AuthorInText True)
622+ , ("Cites", citation "Cites" NormalCitation True)
623+ , ("Autocites", citation "Autocites" NormalCitation True)
624+ , ("Footcites", citation "Footcites" NormalCitation True)
625+ , ("Parencites", citation "Parencites" NormalCitation True)
626+ , ("Supercites", citation "Supercites" NormalCitation True)
627+ , ("Footcitetexts", inNote <$> citation "Footcitetexts" NormalCitation True)
628+ , ("citetext", complexNatbibCitation NormalCitation)
629+ , ("citeauthor", (try (tok *> optional sp *> controlSeq "citetext") *>
630+ complexNatbibCitation AuthorInText)
631+ <|> citation "citeauthor" AuthorInText False)
632+ , ("nocite", mempty <$ (citation "nocite" NormalCitation False >>=
633+ addMeta "nocite"))
634+ , ("hypertarget", braced >> tok)
635+ -- siuntix
636+ , ("SI", dosiunitx)
637+ -- hyphenat
638+ , ("bshyp", lit "\\\173")
639+ , ("fshyp", lit "/\173")
640+ , ("dothyp", lit ".\173")
641+ , ("colonhyp", lit ":\173")
642+ , ("hyp", lit "-")
643+ , ("nohyphens", tok)
644+ , ("textnhtt", ttfamily)
645+ , ("nhttfamily", ttfamily)
646+ -- fontawesome
647+ , ("faCheck", lit "\10003")
648+ , ("faClose", lit "\10007")
649+ ] ++ map ignoreInlines
650+ -- these commands will be ignored unless --parse-raw is specified,
651+ -- in which case they will appear as raw latex blocks:
652+ [ "index"
653+ , "hspace"
654+ , "vspace"
655+ , "newpage"
656+ , "clearpage"
657+ , "pagebreak"
658+ ]
659+
660+
661+-}
662+
663+inline :: PandocMonad m => LP m Inlines
664+inline = (mempty <$ comment)
665+ <|> (space <$ whitespace)
666+ <|> (softbreak <$ endline)
667+ <|> inlineText
668+ <|> inlineCommand'
669+ -- <|> inlineEnvironment
670+ <|> inlineGroup
671+ <|> (symbol '-' *>
672+ option (str "-") (symbol '-' *>
673+ option (str "–") (str "—" <$ symbol '-')))
674+ <|> doubleQuote
675+ <|> singleQuote
676+ <|> (str "”" <$ try (symbol '\'' >> symbol '\''))
677+ <|> (str "”" <$ symbol '”')
678+ <|> (str "’" <$ symbol '\'')
679+ <|> (str "’" <$ symbol '’')
680+ <|> (str "\160" <$ symbol '~')
681+ <|> dollarsMath
682+ <|> (guardEnabled Ext_literate_haskell *> symbol '|' *> doLHSverb)
683+ <|> (str . (:[]) <$> primEscape)
684+ <|> (do res <- symbolIn "#&~^'`\"[]"
685+ pos <- getPosition
686+ let s = T.unpack (untoken res)
687+ report $ ParsingUnescaped s pos
688+ return $ str s)
689+
690+inlines :: PandocMonad m => LP m Inlines
691+inlines = mconcat <$> many inline
692+
693+-- PREVIOUSLY HAD (notFollowedBy (char '}') *> inline)
694+
695+-- block elements:
696+
697+paragraph :: PandocMonad m => LP m Blocks
698+paragraph = do
699+ x <- trimInlines . mconcat <$> many1 inline
700+ if x == mempty
701+ then return mempty
702+ else return $ para x
703+
704+include :: PandocMonad m => LP m Blocks
705+include = do
706+ (Tok _ _ name) <- controlSeq "include" <|> controlSeq "input" <|>
707+ controlSeq "subfile" <|> controlSeq "usepackage"
708+ skipMany $ bracketed inline -- skip options
709+ fs <- (map trim . splitBy (==',') . T.unpack . untokenize) <$> braced
710+ let fs' = if name == "\\usepackage"
711+ then map (maybeAddExtension ".sty") fs
712+ else map (maybeAddExtension ".tex") fs
713+ dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
714+ mconcat <$> mapM (insertIncludedFile blocks (tokenize . T.pack) dirs) fs'
715+
716+maybeAddExtension :: String -> FilePath -> FilePath
717+maybeAddExtension ext fp =
718+ if null (takeExtension fp)
719+ then addExtension fp ext
720+ else fp
721+
722+blockCommands :: PandocMonad m => M.Map Text (LP m Blocks)
723+blockCommands = M.empty
724+
725+block :: PandocMonad m => LP m Blocks
726+block = (mempty <$ spaces1)
727+ -- <|> environment
728+ <|> include
729+ -- <|> macro
730+ -- <|> blockCommand
731+ <|> paragraph
732+ <|> grouped block
733+
734+blocks :: PandocMonad m => LP m Blocks
735+blocks = mconcat <$> many block
736+
737+
738+{-
739+
740+-}
741+
742+{-
60743-- | Parse LaTeX from string and return 'Pandoc' document.
61744readLaTeX :: PandocMonad m
62745 => ReaderOptions -- ^ Reader options
@@ -69,6 +752,7 @@ readLaTeX opts ltx = do
69752 Right result -> return result
70753 Left e -> throwError e
71754
755+
72756parseLaTeX :: PandocMonad m => LP m Pandoc
73757parseLaTeX = do
74758 bs <- blocks
@@ -88,8 +772,6 @@ parseLaTeX = do
88772 else id) doc'
89773 return $ Pandoc meta bs'
90774
91−type LP m = ParserT String ParserState m
92−
93775anyControlSeq :: PandocMonad m => LP m String
94776anyControlSeq = do
95777 char '\\'
@@ -127,8 +809,8 @@ endline = try (newline >> lookAhead anyChar >> notFollowedBy blankline)
127809isLowerHex :: Char -> Bool
128810isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
129811
130−tildeEscape :: PandocMonad m => LP m Char
131−tildeEscape = try $ do
812+primEscape :: PandocMonad m => LP m Char
813+primEscape = try $ do
132814 string "^^"
133815 c <- satisfy (\x -> x >= '\0' && x <= '\128')
134816 d <- if isLowerHex c
@@ -200,37 +882,6 @@ mathChars =
200882 isOrdChar '\\' = False
201883 isOrdChar _ = True
202884
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−
234885inline :: PandocMonad m => LP m Inlines
235886inline = (mempty <$ comment)
236887 <|> (space <$ whitespace)
@@ -251,7 +902,7 @@ inline = (mempty <$ comment)
251902 <|> mathDisplay (string "$$" *> mathChars <* string "$$")
252903 <|> mathInline (char '$' *> mathChars <* char '$')
253904 <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)
254− <|> (str . (:[]) <$> tildeEscape)
905+ <|> (str . (:[]) <$> primEscape)
255906 <|> (do res <- oneOf "#&~^'`\"[]"
256907 pos <- getPosition
257908 report $ ParsingUnescaped [res] pos
@@ -744,9 +1395,6 @@ dolstinline = do
7441395 marker <- char '{' <|> anyChar
7451396 codeWith ("",classes,[]) <$> manyTill (satisfy (/='\n')) (char '}' <|> char marker)
7461397
747−doLHSverb :: PandocMonad m => LP m Inlines
748−doLHSverb = codeWith ("",["haskell"],[]) <$> manyTill (satisfy (/='\n')) (char '|')
749−
7501398-- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"
7511399dosiunitx :: PandocMonad m => LP m Inlines
7521400dosiunitx = do
@@ -762,9 +1410,6 @@ dosiunitx = do
7621410 emptyOr160 unit,
7631411 unit]
7641412
765−lit :: String -> LP m Inlines
766−lit = pure . str
767−
7681413accent :: (Char -> String) -> Inlines -> LP m Inlines
7691414accent f ils =
7701415 case toList ils of
@@ -1052,63 +1697,6 @@ rawVerbEnv name = do
10521697
10531698----
10541699
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−
11121700----
11131701
11141702keyval :: PandocMonad m => LP m (String, String)
@@ -1131,10 +1719,10 @@ alltt t = walk strToCode <$> parseFromString' blocks
11311719 where strToCode (Str s) = Code nullAttr s
11321720 strToCode x = x
11331721
1134−rawLaTeXBlock :: PandocMonad m => LP m String
1722+rawLaTeXBlock :: PandocMonad m => ParserT String ParserState String
11351723rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))
11361724
1137−rawLaTeXInline :: PandocMonad m => LP m Inline
1725+rawLaTeXInline :: PandocMonad m => ParserT String ParserState Inline
11381726rawLaTeXInline = do
11391727 raw <- (snd <$> withRaw inlineCommand)
11401728 <|> (snd <$> withRaw inlineEnvironment)
@@ -1570,3 +2158,40 @@ removeDoubleQuotes ('"':xs) =
15702158 '"':ys -> reverse ys
15712159 _ -> '"':xs
15722160removeDoubleQuotes xs = xs
2161+
2162+inputListing :: PandocMonad m => LP m Blocks
2163+inputListing = do
2164+ pos <- getPosition
2165+ options <- option [] keyvals
2166+ f <- filter (/='"') <$> braced
2167+ dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
2168+ mbCode <- readFileFromDirs dirs f
2169+ codeLines <- case mbCode of
2170+ Just s -> return $ lines s
2171+ Nothing -> do
2172+ report $ CouldNotLoadIncludeFile f pos
2173+ return []
2174+ let (ident,classes,kvs) = parseListingsOptions options
2175+ let language = case lookup "language" options >>= fromListingsLanguage of
2176+ Just l -> [l]
2177+ Nothing -> take 1 $ languagesByExtension (takeExtension f)
2178+ let firstline = fromMaybe 1 $ lookup "firstline" options >>= safeRead
2179+ let lastline = fromMaybe (length codeLines) $
2180+ lookup "lastline" options >>= safeRead
2181+ let codeContents = intercalate "\n" $ take (1 + lastline - firstline) $
2182+ drop (firstline - 1) codeLines
2183+ return $ codeBlockWith (ident,ordNub (classes ++ language),kvs) codeContents
2184+
2185+parseListingsOptions :: [(String, String)] -> Attr
2186+parseListingsOptions options =
2187+ let kvs = [ (if k == "firstnumber"
2188+ then "startFrom"
2189+ else k, v) | (k,v) <- options ]
2190+ classes = [ "numberLines" |
2191+ lookup "numbers" options == Just "left" ]
2192+ ++ maybeToList (lookup "language" options
2193+ >>= fromListingsLanguage)
2194+ in (fromMaybe "" (lookup "label" options), classes, kvs)
2195+
2196+
2197+-}