@@ -1,4 +1,6 @@
11{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE MultiParamTypeClasses #-}
24{-# LANGUAGE ScopedTypeVariables #-}
35{-
46Copyright (C) 2006-2017 John MacFarlane <jgm@berkeley.edu>
@@ -38,24 +40,33 @@ module Text.Pandoc.Readers.LaTeX ( readLaTeX,
3840import Control.Applicative (many, optional, (<|>))
3941import Control.Monad
4042import Control.Monad.Except (throwError)
41−import Data.Char (chr, isAlphaNum, isLetter, ord)
43+import Data.Char (chr, isAlphaNum, isLetter, ord, isDigit)
44+import Data.Default
4245import Data.Text (Text, unpack)
46+import qualified Data.Text as T
4347import Data.List (intercalate, isPrefixOf)
4448import qualified Data.Map as M
49+import qualified Data.Set as Set
4550import Data.Maybe (fromMaybe, maybeToList)
4651import Safe (minimumDef)
4752import System.FilePath (addExtension, replaceExtension, takeExtension)
4853import Text.Pandoc.Builder
4954import Text.Pandoc.Class (PandocMonad, PandocPure, lookupEnv, readFileFromDirs,
50− report, setResourcePath, getResourcePath)
55+ report, setResourcePath, getResourcePath,
56+ runIOorExplode, PandocIO)
5157import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)
5258import Text.Pandoc.ImageSize (numUnit, showFl)
5359import Text.Pandoc.Logging
5460import Text.Pandoc.Options
55−import Text.Pandoc.Parsing hiding (many, mathDisplay, mathInline, optional,
56− space, (<|>))
61+import Text.Pandoc.Parsing hiding (many, optional, withRaw,
62+ mathInline, mathDisplay,
63+ space, (<|>), spaces, blankline)
5764import Text.Pandoc.Shared
5865import Text.Pandoc.Walk
66+import Text.Pandoc.Error (PandocError(PandocParsecError))
67+
68+import Text.Pandoc.Extensions (getDefaultExtensions)
69+import Debug.Trace (traceShowId)
5970
6071-- | Parse LaTeX from string and return 'Pandoc' document.
6172readLaTeX :: PandocMonad m
@@ -63,18 +74,18 @@ readLaTeX :: PandocMonad m
6374 -> Text -- ^ String to parse (assumes @'\n'@ line endings)
6475 -> m Pandoc
6576readLaTeX opts ltx = do
66− parsed <- readWithM parseLaTeX def{ stateOptions = opts }
67− (unpack (crFilter ltx))
77+ parsed <- runParserT parseLaTeX def{ sOptions = opts } "source"
78+ (tokenize (crFilter ltx))
6879 case parsed of
6980 Right result -> return result
70− Left e -> throwError e
81+ Left e -> throwError $ PandocParsecError (T.unpack ltx) e
7182
7283parseLaTeX :: PandocMonad m => LP m Pandoc
7384parseLaTeX = do
7485 bs <- blocks
7586 eof
7687 st <- getState
77− let meta = stateMeta st
88+ let meta = sMeta st
7889 let doc' = doc bs
7990 let headerLevel (Header n _ _) = [n]
8091 headerLevel _ = []
@@ -88,177 +99,327 @@ parseLaTeX = do
8899 else id) doc'
89100 return $ Pandoc meta bs'
90101
91−type LP m = ParserT String ParserState m
92−
93−anyControlSeq :: PandocMonad m => LP m String
94−anyControlSeq = do
95− char '\\'
96− next <- option '\n' anyChar
97− case next of
98− '\n' -> return ""
99− c | isLetter c -> (c:) <$> (many letter <* optional sp)
100− | otherwise -> return [c]
101−
102−controlSeq :: PandocMonad m => String -> LP m String
103−controlSeq name = try $ do
104− char '\\'
105− case name of
106− "" -> mzero
107− [c] | not (isLetter c) -> string [c]
108− cs -> string cs <* notFollowedBy letter <* optional sp
109− return name
110−
111−dimenarg :: PandocMonad m => LP m String
112−dimenarg = try $ do
113− ch <- option "" $ string "="
114− num <- many1 digit
115− dim <- oneOfStrings ["pt","pc","in","bp","cm","mm","dd","cc","sp"]
116− return $ ch ++ num ++ dim
102+testParser :: LP PandocIO a -> Text -> IO a
103+testParser p t = do
104+ res <- runIOorExplode (runParserT p defaultLaTeXState{
105+ sOptions = def{ readerExtensions =
106+ getDefaultExtensions "latex" }} "name" (tokenize t))
107+ case res of
108+ Left e -> error (show e)
109+ Right r -> return r
110+
111+data Macro = CommandMacro Text ([Tok] -> [Tok])
112+ | EnvironmentMacro Text ([Tok] -> [Tok])
113+
114+data LaTeXState = LaTeXState{ sOptions :: ReaderOptions
115+ , sMeta :: Meta
116+ , sQuoteContext :: QuoteContext
117+ , sMacros :: [Macro]
118+ , sContainers :: [String]
119+ , sHeaders :: M.Map Inlines String
120+ , sLogMessages :: [LogMessage]
121+ , sIdentifiers :: Set.Set String }
122+
123+defaultLaTeXState :: LaTeXState
124+defaultLaTeXState = LaTeXState{ sOptions = def
125+ , sMeta = nullMeta
126+ , sQuoteContext = NoQuote
127+ , sMacros = []
128+ , sContainers = []
129+ , sHeaders = M.empty
130+ , sLogMessages = []
131+ , sIdentifiers = Set.empty }
132+
133+instance PandocMonad m => HasQuoteContext LaTeXState m where
134+ getQuoteContext = sQuoteContext <$> getState
135+ withQuoteContext context parser = do
136+ oldState <- getState
137+ let oldQuoteContext = sQuoteContext oldState
138+ setState oldState { sQuoteContext = context }
139+ result <- parser
140+ newState <- getState
141+ setState newState { sQuoteContext = oldQuoteContext }
142+ return result
143+
144+instance HasLogMessages LaTeXState where
145+ addLogMessage msg st = st{ sLogMessages = msg : sLogMessages st }
146+ getLogMessages st = reverse $ sLogMessages st
147+
148+instance HasIdentifierList LaTeXState where
149+ extractIdentifierList = sIdentifiers
150+ updateIdentifierList f st = st{ sIdentifiers = f $ sIdentifiers st }
151+
152+instance HasIncludeFiles LaTeXState where
153+ getIncludeFiles = sContainers
154+ addIncludeFile f s = s{ sContainers = f : sContainers s }
155+ dropLatestIncludeFile s = s { sContainers = drop 1 $ sContainers s }
156+
157+instance HasHeaderMap LaTeXState where
158+ extractHeaderMap = sHeaders
159+ updateHeaderMap f st = st{ sHeaders = f $ sHeaders st }
160+
161+instance HasReaderOptions LaTeXState where
162+ extractReaderOptions = sOptions
163+
164+instance HasMeta LaTeXState where
165+ setMeta field val st =
166+ st{ sMeta = setMeta field val $ sMeta st }
167+ deleteMeta field st =
168+ st{ sMeta = deleteMeta field $ sMeta st }
169+
170+instance Default LaTeXState where
171+ def = defaultLaTeXState
172+
173+type LP m = ParserT [Tok] LaTeXState m
174+
175+rawLaTeXBlock :: PandocMonad m => ParserT String LaTeXState m String
176+rawLaTeXBlock = mzero
177+
178+rawLaTeXInline :: PandocMonad m => ParserT String LaTeXState m Inline
179+rawLaTeXInline = mzero
180+
181+inlineCommand :: PandocMonad m => ParserT String LaTeXState m Inlines
182+inlineCommand = mzero
183+
184+data TokType = CtrlSeq | Spaces | Newline | Symbol | Word | Comment |
185+ Esc1 | Esc2
186+ deriving (Eq, Ord, Show)
187+
188+data Tok = Tok (Line, Column) TokType Text
189+ deriving (Eq, Ord, Show)
190+
191+tokenize :: Text -> [Tok]
192+tokenize = totoks (1, 1)
193+
194+totoks :: (Line, Column) -> Text -> [Tok]
195+totoks (lin,col) t =
196+ case T.uncons t of
197+ Nothing -> []
198+ Just (c, rest)
199+ | c == '\n' ->
200+ Tok (lin, col) Newline (T.singleton '\n')
201+ : totoks (lin + 1,1) rest
202+ | isSpaceOrTab c ->
203+ let (sps, rest') = T.span isSpaceOrTab t
204+ in Tok (lin, col) Spaces sps
205+ : totoks (lin, col + T.length sps) rest'
206+ | isAlphaNum c ->
207+ let (ws, rest') = T.span isAlphaNum t
208+ in Tok (lin, col) Word ws
209+ : totoks (lin, col + T.length ws) rest'
210+ | c == '%' ->
211+ let (cs, rest') = T.break (== '\n') rest
212+ in Tok (lin, col) Comment (T.singleton '%' <> cs)
213+ : totoks (lin, col + 1 + T.length cs) rest'
214+ | c == '\\' ->
215+ case T.uncons rest of
216+ Nothing -> [Tok (lin, col) Symbol (T.singleton c)]
217+ Just (d, rest')
218+ | isLetter d ->
219+ let (ws, rest'') = T.span isLetter rest
220+ in Tok (lin, col) CtrlSeq (T.singleton '\\' <> ws)
221+ : totoks (lin, col + 1 + T.length ws) rest''
222+ | d == '\t' || d == '\n' ->
223+ Tok (lin, col) Symbol (T.singleton '\\')
224+ : totoks (lin, col + 1) rest
225+ | otherwise ->
226+ Tok (lin, col) CtrlSeq (T.pack [c,d])
227+ : totoks (lin, col + 2) rest'
228+ | c == '^' ->
229+ case T.uncons rest of
230+ Just ('^', rest') ->
231+ case T.uncons rest' of
232+ Just (d, rest'')
233+ | isLowerHex d ->
234+ case T.uncons rest'' of
235+ Just (e, rest''') | isLowerHex e ->
236+ Tok (lin, col) Esc2 (T.pack ['^','^',d,e])
237+ : totoks (lin, col + 4) rest'''
238+ _ ->
239+ Tok (lin, col) Esc1 (T.pack ['^','^',d])
240+ : totoks (lin, col + 3) rest''
241+ | d < '\128' ->
242+ Tok (lin, col) Esc1 (T.pack ['^','^',d])
243+ : totoks (lin, col + 3) rest''
244+ _ -> [Tok (lin, col) Symbol (T.singleton '^'),
245+ Tok (lin, col + 1) Symbol (T.singleton '^')]
246+ _ -> Tok (lin, col) Symbol (T.singleton '^')
247+ : totoks (lin, col + 1) rest
248+ | otherwise ->
249+ Tok (lin, col) Symbol (T.singleton c) : totoks (lin, col + 1) rest
250+
251+ where isSpaceOrTab ' ' = True
252+ isSpaceOrTab '\t' = True
253+ isSpaceOrTab _ = False
254+
255+isLowerHex :: Char -> Bool
256+isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
257+
258+untokenize :: [Tok] -> Text
259+untokenize = mconcat . map untoken
260+
261+untoken :: Tok -> Text
262+untoken (Tok _ _ t) = t
263+
264+-- we put withMacros in front of satisfyTok, so it works on everything
265+satisfyTok :: PandocMonad m => (Tok -> Bool) -> LP m Tok
266+satisfyTok f =
267+ doMacros *> tokenPrim (T.unpack . untoken) updatePos matcher
268+ where matcher t | f t = Just t
269+ | otherwise = Nothing
270+ updatePos :: SourcePos -> Tok -> [Tok] -> SourcePos
271+ updatePos spos _ (Tok (lin,col) _ _ : _) =
272+ setSourceColumn (setSourceLine spos lin) col
273+ updatePos spos _ [] = spos
274+
275+-- TODO use something other than LaTeXState
276+doMacros :: PandocMonad m => LP m ()
277+doMacros = do
278+ inp <- getInput
279+ macros <- sMacros <$> getState
280+ case inp of
281+ t@(Tok spos CtrlSeq txt) : ts
282+ | txt == "\\macro" -> do -- TODO actually check macros
283+ setInput $ map (setpos spos) (tokenize "Hi there") ++ ts
284+ -- TODO loop detection
285+ doMacros
286+ _ -> return ()
287+
288+setpos :: (Line, Column) -> Tok -> Tok
289+setpos spos (Tok _ tt txt) = Tok spos tt txt
290+
291+anyControlSeq :: PandocMonad m => LP m Tok
292+anyControlSeq = satisfyTok isCtrlSeq <* optional sp
293+ where isCtrlSeq (Tok _ CtrlSeq _) = True
294+ isCtrlSeq _ = False
295+
296+anySymbol :: PandocMonad m => LP m Tok
297+anySymbol = satisfyTok isSym
298+ where isSym (Tok _ Symbol _) = True
299+ isSym _ = False
300+
301+spaces :: PandocMonad m => LP m ()
302+spaces = skipMany (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
303+
304+spaces1 :: PandocMonad m => LP m ()
305+spaces1 = skipMany1 (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
306+
307+tokTypeIn :: [TokType] -> Tok -> Bool
308+tokTypeIn toktypes (Tok _ tt _) = tt `elem` toktypes
309+
310+controlSeq :: PandocMonad m => Text -> LP m Tok
311+controlSeq name = satisfyTok isNamed
312+ where isNamed (Tok _ CtrlSeq n) = n == T.singleton '\\' <> name
313+ isNamed _ = False
314+
315+symbol :: PandocMonad m => Char -> LP m Tok
316+symbol c = satisfyTok isc
317+ where isc (Tok _ Symbol d) = case T.uncons d of
318+ Just (c',_) -> c == c'
319+ _ -> False
320+ isc _ = False
321+
322+symbolIn :: PandocMonad m => [Char] -> LP m Tok
323+symbolIn cs = satisfyTok isInCs
324+ where isInCs (Tok _ Symbol d) = case T.uncons d of
325+ Just (c,_) -> c `elem` cs
326+ _ -> False
327+ isInCs _ = False
117328
118329sp :: PandocMonad m => LP m ()
119330sp = whitespace <|> endline
120331
121332whitespace :: PandocMonad m => LP m ()
122−whitespace = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t')
123−
124−endline :: PandocMonad m => LP m ()
125−endline = try (newline >> lookAhead anyChar >> notFollowedBy blankline)
333+whitespace = () <$ satisfyTok isSpaceTok
334+ where isSpaceTok (Tok _ Spaces _) = True
335+ isSpaceTok _ = False
126336
127−isLowerHex :: Char -> Bool
128−isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
337+newlineTok :: PandocMonad m => LP m ()
338+newlineTok = () <$ satisfyTok isNewlineTok
129339
130−tildeEscape :: PandocMonad m => LP m Char
131−tildeEscape = try $ do
132− string "^^"
133− c <- satisfy (\x -> x >= '\0' && x <= '\128')
134− d <- if isLowerHex c
135− then option "" $ count 1 (satisfy isLowerHex)
136− else return ""
137− if null d
138− then case ord c of
139− x | x >= 64 && x <= 127 -> return $ chr (x - 64)
140− | otherwise -> return $ chr (x + 64)
141− else return $ chr $ read ('0':'x':c:d)
340+isNewlineTok :: Tok -> Bool
341+isNewlineTok (Tok _ Newline _) = True
342+isNewlineTok _ = False
142343
143344comment :: PandocMonad m => LP m ()
144−comment = do
145− char '%'
146− skipMany (satisfy (/='\n'))
147− optional newline
148− return ()
345+comment = () <$ satisfyTok isCommentTok
346+ where isCommentTok (Tok _ Comment _) = True
347+ isCommentTok _ = False
348+
349+anyTok :: PandocMonad m => LP m Tok
350+anyTok = satisfyTok (const True)
351+
352+endline :: PandocMonad m => LP m ()
353+endline = try $ do
354+ newlineTok
355+ lookAhead anyTok
356+ notFollowedBy blankline
357+
358+blankline :: PandocMonad m => LP m ()
359+blankline = try $ do
360+ skipMany (satisfyTok (tokTypeIn [Spaces, Newline]))
361+ newlineTok
362+
363+primEscape :: PandocMonad m => LP m Char
364+primEscape = do
365+ Tok _ toktype t <- satisfyTok (tokTypeIn [Esc1, Esc2])
366+ case toktype of
367+ Esc1 -> case T.uncons t of
368+ Just (c, _)
369+ | c >= '\64' && c <= '\127' -> return (chr (ord c - 64))
370+ | otherwise -> return (chr (ord c + 64))
371+ Nothing -> fail "Empty content of Esc1"
372+ Esc2 -> case safeRead ('0':'x':T.unpack (T.drop 2 t)) of
373+ Just x -> return (chr x)
374+ Nothing -> fail $ "Could not read: " ++ T.unpack t
375+ _ -> fail "Expected an Esc1 or Esc2 token" -- should not happen
149376
150377bgroup :: PandocMonad m => LP m ()
151378bgroup = try $ do
152− skipMany (spaceChar <|> try (newline <* notFollowedBy blankline))
153− () <$ char '{'
154− <|> () <$ controlSeq "bgroup"
155− <|> () <$ controlSeq "begingroup"
379+ skipMany sp
380+ symbol '{' <|> controlSeq "bgroup" <|> controlSeq "begingroup"
381+ return ()
156382
157383egroup :: PandocMonad m => LP m ()
158−egroup = () <$ char '}'
159− <|> () <$ controlSeq "egroup"
160− <|> () <$ controlSeq "endgroup"
384+egroup = () <$ (symbol '}' <|> controlSeq "egroup" <|> controlSeq "endgroup")
161385
162−grouped :: PandocMonad m => Monoid a => LP m a -> LP m a
386+grouped :: (PandocMonad m, Monoid a) => LP m a -> LP m a
163387grouped parser = try $ do
164388 bgroup
165389 -- first we check for an inner 'grouped', because
166390 -- {{a,b}} should be parsed the same as {a,b}
167− try (grouped parser <* egroup)
168− <|> (mconcat <$> manyTill parser egroup)
169−
170−braced :: PandocMonad m => LP m String
171−braced = grouped chunk
172− where chunk =
173− many1 (satisfy (\c -> c /= '\\' && c /= '}' && c /= '{'))
174− <|> try (string "\\}")
175− <|> try (string "\\{")
176− <|> try (string "\\\\")
177− <|> ((\x -> "{" ++ x ++ "}") <$> braced)
178− <|> count 1 anyChar
391+ try (grouped parser <* egroup) <|> (mconcat <$> manyTill parser egroup)
392+
393+braced :: PandocMonad m => LP m [Tok]
394+braced = try $ do
395+ bgroup
396+ -- {{a,b}} should be parsed the same as {a,b}
397+ try (braced <* egroup) <|> manyTill anyTok egroup
179398
180399bracketed :: PandocMonad m => Monoid a => LP m a -> LP m a
181−bracketed parser = try $ char '[' *> (mconcat <$> manyTill parser (char ']'))
182−
183−mathDisplay :: PandocMonad m => LP m String -> LP m Inlines
184−mathDisplay p = displayMath <$> (try p >>= applyMacros' . trim)
185−
186−mathInline :: PandocMonad m => LP m String -> LP m Inlines
187−mathInline p = math <$> (try p >>= applyMacros')
188−
189−mathChars :: PandocMonad m => LP m String
190−mathChars =
191− concat <$> many (escapedChar
192− <|> (snd <$> withRaw braced)
193− <|> many1 (satisfy isOrdChar))
194− where escapedChar = try $ do char '\\'
195− c <- anyChar
196− return ['\\',c]
197− isOrdChar '$' = False
198− isOrdChar '{' = False
199− isOrdChar '}' = False
200− isOrdChar '\\' = False
201− isOrdChar _ = True
202−
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
400+bracketed parser = try $ do
401+ symbol '['
402+ mconcat <$> manyTill parser (symbol ']')
217403
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 '"')
404+dimenarg :: PandocMonad m => LP m Text
405+dimenarg = try $ do
406+ ch <- option False $ True <$ symbol '='
407+ Tok _ _ s <- satisfyTok isWordTok
408+ guard $ (T.take 2 (T.reverse s)) `elem`
409+ ["pt","pc","in","bp","cm","mm","dd","cc","sp"]
410+ let num = T.take (T.length s - 2) s
411+ guard $ T.length num > 0
412+ guard $ T.all isDigit num
413+ return $ T.pack ['=' | ch] <> s
225414
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 "`\'‘’")
415+-- inline elements:
233416
234−inline :: PandocMonad m => LP m Inlines
235−inline = (mempty <$ comment)
236− <|> (space <$ whitespace)
237− <|> (softbreak <$ endline)
238− <|> inlineText
239− <|> inlineCommand
240− <|> inlineEnvironment
241− <|> inlineGroup
242− <|> (char '-' *> option (str "-")
243− (char '-' *> option (str "–") (str "—" <$ char '-')))
244− <|> doubleQuote
245− <|> singleQuote
246− <|> (str "”" <$ try (string "''"))
247− <|> (str "”" <$ char '”')
248− <|> (str "’" <$ char '\'')
249− <|> (str "’" <$ char '’')
250− <|> (str "\160" <$ char '~')
251− <|> mathDisplay (string "$$" *> mathChars <* string "$$")
252− <|> mathInline (char '$' *> mathChars <* char '$')
253− <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)
254− <|> (str . (:[]) <$> tildeEscape)
255− <|> (do res <- oneOf "#&~^'`\"[]"
256− pos <- getPosition
257− report $ ParsingUnescaped [res] pos
258− return $ str [res])
417+inlineText :: PandocMonad m => LP m Inlines
418+inlineText = (str . T.unpack . untoken) <$> satisfyTok isWordTok
259419
260−inlines :: PandocMonad m => LP m Inlines
261−inlines = mconcat <$> many (notFollowedBy (char '}') *> inline)
420+isWordTok :: Tok -> Bool
421+isWordTok (Tok _ Word _) = True
422+isWordTok _ = False
262423
263424inlineGroup :: PandocMonad m => LP m Inlines
264425inlineGroup = do
@@ -269,233 +430,466 @@ inlineGroup = do
269430 -- we need the span so we can detitlecase bibtex entries;
270431 -- we need to know when something is {C}apitalized
271432
272−block :: PandocMonad m => LP m Blocks
273−block = (mempty <$ comment)
274− <|> (mempty <$ ((spaceChar <|> newline) *> spaces))
275− <|> environment
276− <|> include
277− <|> macro
278− <|> blockCommand
279− <|> paragraph
280− <|> grouped block
281−
282−blocks :: PandocMonad m => LP m Blocks
283−blocks = mconcat <$> many block
433+doLHSverb :: PandocMonad m => LP m Inlines
434+doLHSverb =
435+ (codeWith ("",["haskell"],[]) . T.unpack . untokenize)
436+ <$> manyTill (satisfyTok (not . isNewlineTok)) (symbol '|')
284437
285−getRawCommand :: PandocMonad m => String -> LP m String
286−getRawCommand name' = do
287− rawargs <- withRaw (many (try (optional sp *> opt)) *>
288− option "" (try (optional sp *> dimenarg)) *>
289− many braced)
290− return $ '\\' : name' ++ snd rawargs
438+lit :: String -> LP m Inlines
439+lit = pure . str
291440
292−lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
293−lookupListDefault d = (fromMaybe d .) . lookupList
294− where
295− lookupList l m = msum $ map (`M.lookup` m) l
441+doubleQuote :: PandocMonad m => LP m Inlines
442+doubleQuote = do
443+ quoted' doubleQuoted (try $ count 2 $ symbol '`')
444+ (void $ try $ count 2 $ symbol '\'')
445+ <|> quoted' doubleQuoted ((:[]) <$> symbol '“') (void $ symbol '”')
446+ -- the following is used by babel for localized quotes:
447+ <|> quoted' doubleQuoted (try $ sequence [symbol '"', symbol '`'])
448+ (void $ try $ sequence [symbol '"', symbol '\''])
449+ <|> quoted' doubleQuoted ((:[]) <$> symbol '"')
450+ (void $ symbol '"')
296451
297−blockCommand :: PandocMonad m => LP m Blocks
298−blockCommand = try $ do
299− name <- anyControlSeq
300− guard $ name /= "begin" && name /= "end"
301− star <- option "" (string "*" <* optional sp)
302− let name' = name ++ star
303− let raw = do
304− rawcommand <- getRawCommand name'
305− transformed <- applyMacros' rawcommand
306− guard $ transformed /= rawcommand
307− notFollowedBy $ parseFromString' inlines transformed
308− parseFromString' blocks transformed
309− lookupListDefault raw [name',name] blockCommands
452+singleQuote :: PandocMonad m => LP m Inlines
453+singleQuote = do
454+ quoted' singleQuoted ((:[]) <$> symbol '`')
455+ (try $ symbol '\'' >>
456+ notFollowedBy (satisfyTok startsWithLetter))
457+ <|> quoted' singleQuoted ((:[]) <$> symbol '‘')
458+ (try $ symbol '’' >>
459+ notFollowedBy (satisfyTok startsWithLetter))
460+ where startsWithLetter (Tok _ Word t) =
461+ case T.uncons t of
462+ Just (c, _) | isLetter c -> True
463+ _ -> False
464+ startsWithLetter _ = False
465+
466+quoted' :: PandocMonad m
467+ => (Inlines -> Inlines)
468+ -> LP m [Tok]
469+ -> LP m ()
470+ -> LP m Inlines
471+quoted' f starter ender = do
472+ startchs <- (T.unpack . untokenize) <$> starter
473+ smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
474+ if smart
475+ then do
476+ ils <- many (notFollowedBy ender >> inline)
477+ (ender >> return (f (mconcat ils))) <|>
478+ (<> mconcat ils) <$>
479+ lit (case startchs of
480+ "``" -> "“"
481+ "`" -> "‘"
482+ cs -> cs)
483+ else lit startchs
310484
311−inBrackets :: Inlines -> Inlines
312−inBrackets x = str "[" <> x <> str "]"
485+enquote :: PandocMonad m => LP m Inlines
486+enquote = do
487+ skipopts
488+ quoteContext <- sQuoteContext <$> getState
489+ if quoteContext == InDoubleQuote
490+ then singleQuoted <$> withQuoteContext InSingleQuote tok
491+ else doubleQuoted <$> withQuoteContext InDoubleQuote tok
313492
314−-- eat an optional argument and one or more arguments in braces
315−ignoreInlines :: PandocMonad m => String -> (String, LP m Inlines)
316−ignoreInlines name = (name, p)
317− where
318− p = do oa <- optargs
319− let rawCommand = '\\':name ++ oa
320− let doraw = guardRaw >> return (rawInline "latex" rawCommand)
321− doraw <|> ignore rawCommand
493+doverb :: PandocMonad m => LP m Inlines
494+doverb = do
495+ Tok _ Symbol t <- anySymbol
496+ marker <- case T.uncons t of
497+ Just (c, ts) | T.null ts -> return c
498+ _ -> mzero
499+ (code . T.unpack . untokenize) <$> manyTill (verbTok marker) (symbol marker)
500+
501+verbTok :: PandocMonad m => Char -> LP m Tok
502+verbTok stopchar = do
503+ t@(Tok (lin, col) toktype txt) <- satisfyTok (not . isNewlineTok)
504+ case T.findIndex (== stopchar) txt of
505+ Nothing -> return t
506+ Just i -> do
507+ let (t1, t2) = T.splitAt i txt
508+ inp <- getInput
509+ setInput $ Tok (lin, col + i) Symbol (T.singleton stopchar)
510+ : (totoks (lin, col + i + 1) (T.drop 1 t2)) ++ inp
511+ return $ Tok (lin, col) toktype t1
322512
323−guardRaw :: PandocMonad m => LP m ()
324−guardRaw = getOption readerExtensions >>= guard . extensionEnabled Ext_raw_tex
513+dolstinline :: PandocMonad m => LP m Inlines
514+dolstinline = do
515+ options <- option [] keyvals
516+ let classes = maybeToList $ lookup "language" options >>= fromListingsLanguage
517+ Tok _ Symbol t <- anySymbol
518+ marker <- case T.uncons t of
519+ Just (c, ts) | T.null ts -> return c
520+ _ -> mzero
521+ let stopchar = if marker == '{' then '}' else marker
522+ (codeWith ("",classes,[]) . T.unpack . untokenize) <$>
523+ manyTill (verbTok stopchar) (symbol stopchar)
325524
326−optargs :: PandocMonad m => LP m String
327−optargs = snd <$> withRaw (skipopts *> skipMany (try $ optional sp *> braced))
525+keyval :: PandocMonad m => LP m (String, String)
526+keyval = try $ do
527+ Tok _ Word key <- satisfyTok isWordTok
528+ let isSpecSym (Tok _ Symbol t) = t `elem` [".",":","-","|","\\"]
529+ isSpecSym _ = False
530+ val <- option [] $ do
531+ symbol '='
532+ braced <|> (many1 (satisfyTok isWordTok <|> satisfyTok isSpecSym))
533+ optional sp
534+ optional (symbol ',')
535+ optional sp
536+ return (T.unpack key, T.unpack . untokenize $ val)
328537
329−ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a
330−ignore raw = do
331− pos <- getPosition
332− report $ SkippedContent raw pos
333− return mempty
538+keyvals :: PandocMonad m => LP m [(String, String)]
539+keyvals = try $ symbol '[' >> manyTill keyval (symbol ']')
334540
335−ignoreBlocks :: PandocMonad m => String -> (String, LP m Blocks)
336−ignoreBlocks name = (name, p)
337− where
338− p = do oa <- optargs
339− let rawCommand = '\\':name ++ oa
340− let doraw = guardRaw >> return (rawBlock "latex" rawCommand)
341− doraw <|> ignore rawCommand
541+accent :: (Char -> String) -> Inlines -> LP m Inlines
542+accent f ils =
543+ case toList ils of
544+ (Str (x:xs) : ys) -> return $ fromList (Str (f x ++ xs) : ys)
545+ [] -> mzero
546+ _ -> return ils
342547
343−blockCommands :: PandocMonad m => M.Map String (LP m Blocks)
344−blockCommands = M.fromList $
345− [ ("par", mempty <$ skipopts)
346− , ("parbox", braced >> grouped blocks)
347− , ("title", mempty <$ (skipopts *>
348− (grouped inline >>= addMeta "title")
349− <|> (grouped block >>= addMeta "title")))
350− , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle"))
351− , ("author", mempty <$ (skipopts *> authors))
352− -- -- in letter class, temp. store address & sig as title, author
353− , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))
354− , ("signature", mempty <$ (skipopts *> authors))
355− , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))
356− -- Koma-script metadata commands
357− , ("dedication", mempty <$ (skipopts *> tok >>= addMeta "dedication"))
358− -- sectioning
359− , ("part", section nullAttr (-1))
360− , ("part*", section nullAttr (-1))
361− , ("chapter", section nullAttr 0)
362− , ("chapter*", section ("",["unnumbered"],[]) 0)
363− , ("section", section nullAttr 1)
364− , ("section*", section ("",["unnumbered"],[]) 1)
365− , ("subsection", section nullAttr 2)
366− , ("subsection*", section ("",["unnumbered"],[]) 2)
367− , ("subsubsection", section nullAttr 3)
368− , ("subsubsection*", section ("",["unnumbered"],[]) 3)
369− , ("paragraph", section nullAttr 4)
370− , ("paragraph*", section ("",["unnumbered"],[]) 4)
371− , ("subparagraph", section nullAttr 5)
372− , ("subparagraph*", section ("",["unnumbered"],[]) 5)
373− -- beamer slides
374− , ("frametitle", section nullAttr 3)
375− , ("framesubtitle", section nullAttr 4)
376− -- letters
377− , ("opening", (para . trimInlines) <$> (skipopts *> tok))
378− , ("closing", skipopts *> closing)
379− --
380− , ("hrule", pure horizontalRule)
381− , ("strut", pure mempty)
382− , ("rule", skipopts *> tok *> tok *> pure horizontalRule)
383− , ("item", skipopts *> looseItem)
384− , ("documentclass", skipopts *> braced *> preamble)
385− , ("centerline", (para . trimInlines) <$> (skipopts *> tok))
386− , ("caption", skipopts *> setCaption)
387− , ("bibliography", mempty <$ (skipopts *> braced >>=
388− addMeta "bibliography" . splitBibs))
389− , ("addbibresource", mempty <$ (skipopts *> braced >>=
390− addMeta "bibliography" . splitBibs))
391− -- includes
392− , ("lstinputlisting", inputListing)
393− , ("graphicspath", graphicsPath)
394− -- hyperlink
395− , ("hypertarget", braced >> grouped block)
396− ] ++ map ignoreBlocks
397− -- these commands will be ignored unless --parse-raw is specified,
398− -- in which case they will appear as raw latex blocks
399− [ "newcommand", "renewcommand", "newenvironment", "renewenvironment"
400− -- newcommand, etc. should be parsed by macro, but we need this
401− -- here so these aren't parsed as inline commands to ignore
402− , "special", "pdfannot", "pdfstringdef"
403− , "bibliographystyle"
404− , "maketitle", "makeindex", "makeglossary"
405− , "addcontentsline", "addtocontents", "addtocounter"
406− -- \ignore{} is used conventionally in literate haskell for definitions
407− -- that are to be processed by the compiler but not printed.
408− , "ignore"
409− , "hyperdef"
410− , "markboth", "markright", "markleft"
411− , "hspace", "vspace"
412− , "newpage"
413− , "clearpage"
414− , "pagebreak"
415− ]
548+grave :: Char -> String
549+grave 'A' = "À"
550+grave 'E' = "È"
551+grave 'I' = "Ì"
552+grave 'O' = "Ò"
553+grave 'U' = "Ù"
554+grave 'a' = "à"
555+grave 'e' = "è"
556+grave 'i' = "ì"
557+grave 'o' = "ò"
558+grave 'u' = "ù"
559+grave c = [c]
416560
417−graphicsPath :: PandocMonad m => LP m Blocks
418−graphicsPath = do
419− ps <- bgroup *> (manyTill braced egroup)
420− getResourcePath >>= setResourcePath . (++ ps)
421− return mempty
561+acute :: Char -> String
562+acute 'A' = "Á"
563+acute 'E' = "É"
564+acute 'I' = "Í"
565+acute 'O' = "Ó"
566+acute 'U' = "Ú"
567+acute 'Y' = "Ý"
568+acute 'a' = "á"
569+acute 'e' = "é"
570+acute 'i' = "í"
571+acute 'o' = "ó"
572+acute 'u' = "ú"
573+acute 'y' = "ý"
574+acute 'C' = "Ć"
575+acute 'c' = "ć"
576+acute 'L' = "Ĺ"
577+acute 'l' = "ĺ"
578+acute 'N' = "Ń"
579+acute 'n' = "ń"
580+acute 'R' = "Ŕ"
581+acute 'r' = "ŕ"
582+acute 'S' = "Ś"
583+acute 's' = "ś"
584+acute 'Z' = "Ź"
585+acute 'z' = "ź"
586+acute c = [c]
422587
423−addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()
424−addMeta field val = updateState $ \st ->
425− st{ stateMeta = addMetaField field val $ stateMeta st }
426−
427−splitBibs :: String -> [Inlines]
428−splitBibs = map (str . flip replaceExtension "bib" . trim) . splitBy (==',')
429−
430−setCaption :: PandocMonad m => LP m Blocks
431−setCaption = do
432− ils <- tok
433− mblabel <- option Nothing $
434− try $ spaces' >> controlSeq "label" >> (Just <$> tok)
435− let ils' = case mblabel of
436− Just lab -> ils <> spanWith
437− ("",[],[("data-label", stringify lab)]) mempty
438− Nothing -> ils
439− updateState $ \st -> st{ stateCaption = Just ils' }
440− return mempty
588+circ :: Char -> String
589+circ 'A' = "Â"
590+circ 'E' = "Ê"
591+circ 'I' = "Î"
592+circ 'O' = "Ô"
593+circ 'U' = "Û"
594+circ 'a' = "â"
595+circ 'e' = "ê"
596+circ 'i' = "î"
597+circ 'o' = "ô"
598+circ 'u' = "û"
599+circ 'C' = "Ĉ"
600+circ 'c' = "ĉ"
601+circ 'G' = "Ĝ"
602+circ 'g' = "ĝ"
603+circ 'H' = "Ĥ"
604+circ 'h' = "ĥ"
605+circ 'J' = "Ĵ"
606+circ 'j' = "ĵ"
607+circ 'S' = "Ŝ"
608+circ 's' = "ŝ"
609+circ 'W' = "Ŵ"
610+circ 'w' = "ŵ"
611+circ 'Y' = "Ŷ"
612+circ 'y' = "ŷ"
613+circ c = [c]
441614
442−resetCaption :: PandocMonad m => LP m ()
443−resetCaption = updateState $ \st -> st{ stateCaption = Nothing }
615+tilde :: Char -> String
616+tilde 'A' = "Ã"
617+tilde 'a' = "ã"
618+tilde 'O' = "Õ"
619+tilde 'o' = "õ"
620+tilde 'I' = "Ĩ"
621+tilde 'i' = "ĩ"
622+tilde 'U' = "Ũ"
623+tilde 'u' = "ũ"
624+tilde 'N' = "Ñ"
625+tilde 'n' = "ñ"
626+tilde c = [c]
444627
445−authors :: PandocMonad m => LP m ()
446−authors = try $ do
447− bgroup
448− let oneAuthor = mconcat <$>
449− many1 (notFollowedBy' (controlSeq "and") >>
450− (inline <|> mempty <$ blockCommand))
451− -- skip e.g. \vspace{10pt}
452− auths <- sepBy oneAuthor (controlSeq "and")
453− egroup
454− addMeta "author" (map trimInlines auths)
628+umlaut :: Char -> String
629+umlaut 'A' = "Ä"
630+umlaut 'E' = "Ë"
631+umlaut 'I' = "Ï"
632+umlaut 'O' = "Ö"
633+umlaut 'U' = "Ü"
634+umlaut 'a' = "ä"
635+umlaut 'e' = "ë"
636+umlaut 'i' = "ï"
637+umlaut 'o' = "ö"
638+umlaut 'u' = "ü"
639+umlaut c = [c]
455640
456−section :: PandocMonad m => Attr -> Int -> LP m Blocks
457−section (ident, classes, kvs) lvl = do
458− skipopts
459− contents <- grouped inline
460− lab <- option ident $ try (spaces' >> controlSeq "label" >> spaces' >> braced)
461− attr' <- registerHeader (lab, classes, kvs) contents
462− return $ headerWith attr' lvl contents
641+hungarumlaut :: Char -> String
642+hungarumlaut 'A' = "A̋"
643+hungarumlaut 'E' = "E̋"
644+hungarumlaut 'I' = "I̋"
645+hungarumlaut 'O' = "Ő"
646+hungarumlaut 'U' = "Ű"
647+hungarumlaut 'Y' = "ӳ"
648+hungarumlaut 'a' = "a̋"
649+hungarumlaut 'e' = "e̋"
650+hungarumlaut 'i' = "i̋"
651+hungarumlaut 'o' = "ő"
652+hungarumlaut 'u' = "ű"
653+hungarumlaut 'y' = "ӳ"
654+hungarumlaut c = [c]
463655
464−inlineCommand :: PandocMonad m => LP m Inlines
465−inlineCommand = try $ do
466− (name, raw') <- withRaw anyControlSeq
467− guard $ name /= "begin" && name /= "end"
468− star <- option "" (string "*")
469− let name' = name ++ star
656+dot :: Char -> String
657+dot 'C' = "Ċ"
658+dot 'c' = "ċ"
659+dot 'E' = "Ė"
660+dot 'e' = "ė"
661+dot 'G' = "Ġ"
662+dot 'g' = "ġ"
663+dot 'I' = "İ"
664+dot 'Z' = "Ż"
665+dot 'z' = "ż"
666+dot c = [c]
667+
668+macron :: Char -> String
669+macron 'A' = "Ā"
670+macron 'E' = "Ē"
671+macron 'I' = "Ī"
672+macron 'O' = "Ō"
673+macron 'U' = "Ū"
674+macron 'a' = "ā"
675+macron 'e' = "ē"
676+macron 'i' = "ī"
677+macron 'o' = "ō"
678+macron 'u' = "ū"
679+macron c = [c]
680+
681+cedilla :: Char -> String
682+cedilla 'c' = "ç"
683+cedilla 'C' = "Ç"
684+cedilla 's' = "ş"
685+cedilla 'S' = "Ş"
686+cedilla 't' = "ţ"
687+cedilla 'T' = "Ţ"
688+cedilla 'e' = "ȩ"
689+cedilla 'E' = "Ȩ"
690+cedilla 'h' = "ḩ"
691+cedilla 'H' = "Ḩ"
692+cedilla 'o' = "o̧"
693+cedilla 'O' = "O̧"
694+cedilla c = [c]
695+
696+hacek :: Char -> String
697+hacek 'A' = "Ǎ"
698+hacek 'a' = "ǎ"
699+hacek 'C' = "Č"
700+hacek 'c' = "č"
701+hacek 'D' = "Ď"
702+hacek 'd' = "ď"
703+hacek 'E' = "Ě"
704+hacek 'e' = "ě"
705+hacek 'G' = "Ǧ"
706+hacek 'g' = "ǧ"
707+hacek 'H' = "Ȟ"
708+hacek 'h' = "ȟ"
709+hacek 'I' = "Ǐ"
710+hacek 'i' = "ǐ"
711+hacek 'j' = "ǰ"
712+hacek 'K' = "Ǩ"
713+hacek 'k' = "ǩ"
714+hacek 'L' = "Ľ"
715+hacek 'l' = "ľ"
716+hacek 'N' = "Ň"
717+hacek 'n' = "ň"
718+hacek 'O' = "Ǒ"
719+hacek 'o' = "ǒ"
720+hacek 'R' = "Ř"
721+hacek 'r' = "ř"
722+hacek 'S' = "Š"
723+hacek 's' = "š"
724+hacek 'T' = "Ť"
725+hacek 't' = "ť"
726+hacek 'U' = "Ǔ"
727+hacek 'u' = "ǔ"
728+hacek 'Z' = "Ž"
729+hacek 'z' = "ž"
730+hacek c = [c]
731+
732+breve :: Char -> String
733+breve 'A' = "Ă"
734+breve 'a' = "ă"
735+breve 'E' = "Ĕ"
736+breve 'e' = "ĕ"
737+breve 'G' = "Ğ"
738+breve 'g' = "ğ"
739+breve 'I' = "Ĭ"
740+breve 'i' = "ĭ"
741+breve 'O' = "Ŏ"
742+breve 'o' = "ŏ"
743+breve 'U' = "Ŭ"
744+breve 'u' = "ŭ"
745+breve c = [c]
746+
747+toksToString :: [Tok] -> String
748+toksToString = T.unpack . untokenize
749+
750+mathDisplay :: String -> Inlines
751+mathDisplay = displayMath . trim
752+-- TODO we shouldn't need applyMacros
753+-- mathDisplay p = displayMath <$> (try p >>= applyMacros' . trim)
754+
755+mathInline :: String -> Inlines
756+mathInline = math . trim
757+-- TODO we shouldn't need applyMacros
758+-- mathInline p = math <$> (try p >>= applyMacros')
759+
760+dollarsMath :: PandocMonad m => LP m Inlines
761+dollarsMath = do
762+ symbol '$'
763+ display <- option False (True <$ symbol '$')
764+ contents <- many1Till anyTok (symbol '$')
765+ when display (() <$ symbol '$')
766+ let constructor = if display then mathDisplay else mathInline
767+ return $ constructor $ toksToString contents
768+
769+inlineCommand' :: PandocMonad m => LP m Inlines
770+inlineCommand' = try $ do
771+ cs@(Tok _ CtrlSeq t) <- anyControlSeq
772+ let name = T.drop 1 t
773+ guard $ name /= "begin" && name /= "end"
774+ mbstar <- option Nothing (Just <$> symbol '*')
775+ let names = name : maybe [] (const [name <> "*"]) mbstar
776+ optional $ try $ symbol '{' >> symbol '}'
470777 let raw = do
471− guard $ not (isBlockCommand name)
472− rawargs <- withRaw
473− (skipangles *> skipopts *> option "" dimenarg *> many braced)
474− let rawcommand = raw' ++ star ++ snd rawargs
475− transformed <- applyMacros' rawcommand
476− exts <- getOption readerExtensions
477− if transformed /= rawcommand
478− then parseFromString' inlines transformed
479− else if extensionEnabled Ext_raw_tex exts
480− then return $ rawInline "latex" rawcommand
481− else ignore rawcommand
482− (lookupListDefault raw [name',name] inlineCommands <*
483− optional (try (string "{}")))
484−
485−rawInlineOr :: PandocMonad m => String -> LP m Inlines -> LP m Inlines
486−rawInlineOr name' fallback = do
487− parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
488− if parseRaw
489− then rawInline "latex" <$> getRawCommand name'
490− else fallback
778+ guard $ not (isBlockCommand name)
779+ (_, rawargs) <- withRaw
780+ (skipangles *> skipopts *> option "" dimenarg *> many braced)
781+ let rawcommand = T.unpack $ untokenize $
782+ cs : maybe [] (:[]) mbstar ++ rawargs
783+ (guardEnabled Ext_raw_tex >> return (rawInline "latex" rawcommand))
784+ <|> ignore rawcommand
785+ -- transformed <- applyMacros' rawcommand -- TODO or get rid of
786+ -- exts <- getOption readerExtensions
787+ -- if transformed /= rawcommand
788+ -- then parseFromString' inlines transformed
789+ -- else if extensionEnabled Ext_raw_tex exts
790+ -- then return $ rawInline "latex" rawcommand
791+ -- else ignore rawcommand
792+ lookupListDefault raw names inlineCommands
793+
794+tok :: PandocMonad m => LP m Inlines
795+tok = try $ grouped inline <|> inlineCommand' <|> singleChar
796+ where singleChar = do
797+ Tok (lin,col) toktype t <- satisfyTok (tokTypeIn [Word, Symbol])
798+ if T.length t > 1
799+ then do
800+ let (t1, t2) = (T.take 1 t, T.drop 1 t)
801+ inp <- getInput
802+ setInput $ (Tok (lin, col + 1) toktype t2) : inp
803+ return $ str (T.unpack t1)
804+ else return $ str (T.unpack t)
805+
806+opt :: PandocMonad m => LP m Inlines
807+opt = bracketed inline
808+
809+rawopt :: PandocMonad m => LP m Text
810+rawopt = do
811+ symbol '['
812+ inner <- untokenize <$> manyTill anyTok (symbol ']')
813+ optional sp
814+ return $ "[" <> inner <> "]"
815+
816+skipopts :: PandocMonad m => LP m ()
817+skipopts = skipMany rawopt
818+
819+-- eat an optional argument and one or more arguments in braces
820+ignoreInlines :: PandocMonad m => Text -> (Text, LP m Inlines)
821+ignoreInlines name = (name, p)
822+ where p = do oa <- optargs
823+ let rawCommand = '\\' : T.unpack (name <> oa)
824+ let doraw = guardRaw >> return (rawInline "latex" rawCommand)
825+ doraw <|> ignore rawCommand
826+
827+guardRaw :: PandocMonad m => LP m ()
828+guardRaw = getOption readerExtensions >>= guard . extensionEnabled Ext_raw_tex
829+
830+optargs :: PandocMonad m => LP m Text
831+optargs = do
832+ (_, raw) <- withRaw (skipopts *> skipMany (try $ optional sp *> braced))
833+ return $ untokenize raw
834+
835+-- opts in angle brackets are used in beamer
836+rawangle :: PandocMonad m => LP m ()
837+rawangle = try $ do
838+ symbol '<'
839+ () <$ manyTill anyTok (symbol '>')
840+
841+skipangles :: PandocMonad m => LP m ()
842+skipangles = skipMany rawangle
843+
844+ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a
845+ignore raw = do
846+ pos <- getPosition
847+ report $ SkippedContent raw pos
848+ return mempty
491849
492−isBlockCommand :: String -> Bool
493−isBlockCommand s = s `M.member` (blockCommands :: M.Map String (LP PandocPure Blocks))
850+withRaw :: PandocMonad m => LP m a -> LP m (a, [Tok])
851+withRaw parser = do
852+ inp <- getInput
853+ result <- parser
854+ nxt <- option (Tok (0,0) Word "") (lookAhead anyTok)
855+ let raw = takeWhile (/= nxt) inp
856+ return (result, raw)
494857
858+inBrackets :: Inlines -> Inlines
859+inBrackets x = str "[" <> x <> str "]"
860+
861+unescapeURL :: String -> String
862+unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs
863+ where isEscapable c = c `elem` ("#$%&~_^\\{}" :: String)
864+unescapeURL (x:xs) = x:unescapeURL xs
865+unescapeURL [] = ""
866+
867+mathEnvWith :: PandocMonad m
868+ => (Inlines -> a) -> Maybe String -> String -> LP m a
869+mathEnvWith f innerEnv name = f . mathDisplay . inner <$> mathEnv name
870+ where inner x = case innerEnv of
871+ Nothing -> x
872+ Just y -> "\\begin{" ++ y ++ "}\n" ++ x ++
873+ "\\end{" ++ y ++ "}"
874+
875+mathEnv :: PandocMonad m => String -> LP m String
876+mathEnv name = do
877+ skipopts
878+ optional blankline
879+ let endEnv = try $ controlSeq "end" *>
880+ (T.unpack . untokenize <$> braced) >>= guard . (== name)
881+ res <- manyTill anyTok endEnv
882+ return $ stripTrailingNewlines $ T.unpack $ untokenize res
883+
884+inlineEnvironment :: PandocMonad m => LP m Inlines
885+inlineEnvironment = try $ do
886+ controlSeq "begin"
887+ name <- untokenize <$> braced
888+ M.findWithDefault mzero name inlineEnvironments
495889
496−inlineEnvironments :: PandocMonad m => M.Map String (LP m Inlines)
497−inlineEnvironments = M.fromList
498− [ ("displaymath", mathEnvWith id Nothing "displaymath")
890+inlineEnvironments :: PandocMonad m => M.Map Text (LP m Inlines)
891+inlineEnvironments = M.fromList [
892+ ("displaymath", mathEnvWith id Nothing "displaymath")
499893 , ("math", math <$> mathEnv "math")
500894 , ("equation", mathEnvWith id Nothing "equation")
501895 , ("equation*", mathEnvWith id Nothing "equation*")
@@ -511,7 +905,7 @@ inlineEnvironments = M.fromList
511905 , ("alignat*", mathEnvWith id (Just "aligned") "alignat*")
512906 ]
513907
514−inlineCommands :: PandocMonad m => M.Map String (LP m Inlines)
908+inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)
515909inlineCommands = M.fromList $
516910 [ ("emph", extractSpaces emph <$> tok)
517911 , ("textit", extractSpaces emph <$> tok)
@@ -540,9 +934,9 @@ inlineCommands = M.fromList $
540934 , ("textgreek", tok)
541935 , ("sep", lit ",")
542936 , ("cref", rawInlineOr "cref" (inBrackets <$> tok)) -- from cleveref.sty
543− , ("(", mathInline $ manyTill anyChar (try $ string "\\)"))
544− , ("[", mathDisplay $ manyTill anyChar (try $ string "\\]"))
545− , ("ensuremath", mathInline braced)
937+ , ("(", mathInline . toksToString <$> manyTill anyTok (controlSeq ")"))
938+ , ("[", mathDisplay . toksToString <$> manyTill anyTok (controlSeq "]"))
939+ , ("ensuremath", mathInline . toksToString <$> braced)
546940 , ("texorpdfstring", (\_ x -> x) <$> tok <*> tok)
547941 , ("P", lit "¶")
548942 , ("S", lit "§")
@@ -592,7 +986,7 @@ inlineCommands = M.fromList $
592986 , ("v", option (str "v") $ try $ tok >>= accent hacek)
593987 , ("u", option (str "u") $ try $ tok >>= accent breve)
594988 , ("i", lit "i")
595− , ("\\", linebreak <$ (optional (bracketed inline) *> spaces'))
989+ , ("\\", linebreak <$ (optional (bracketed inline) *> spaces))
596990 , (",", lit "\8198")
597991 , ("@", pure mempty)
598992 , (" ", lit "\160")
@@ -607,73 +1001,73 @@ inlineCommands = M.fromList $
6071001 , ("verb", doverb)
6081002 , ("lstinline", dolstinline)
6091003 , ("Verb", doverb)
610− , ("url", (unescapeURL <$> braced) >>= \url ->
611− pure (link url "" (str url)))
612− , ("href", (unescapeURL <$> braced <* optional sp) >>= \url ->
613− tok >>= \lab ->
614− pure (link url "" lab))
615− , ("includegraphics", do options <- option [] keyvals
616− src <- unescapeURL . removeDoubleQuotes <$> braced
617− mkImage options src)
1004+ , ("url", ((unescapeURL . T.unpack . untokenize) <$> braced) >>= \url ->
1005+ pure (link url "" (str url)))
1006+-- , ("href", (unescapeURL <$> braced <* optional sp) >>= \url ->
1007+-- tok >>= \lab ->
1008+-- pure (link url "" lab))
1009+-- , ("includegraphics", do options <- option [] keyvals
1010+-- src <- unescapeURL . removeDoubleQuotes <$> braced
1011+-- mkImage options src)
6181012 , ("enquote", enquote)
619− , ("cite", citation "cite" NormalCitation False)
620− , ("Cite", citation "Cite" NormalCitation False)
621− , ("citep", citation "citep" NormalCitation False)
622− , ("citep*", citation "citep*" NormalCitation False)
623− , ("citeal", citation "citeal" NormalCitation False)
624− , ("citealp", citation "citealp" NormalCitation False)
625− , ("citealp*", citation "citealp*" NormalCitation False)
626− , ("autocite", citation "autocite" NormalCitation False)
627− , ("smartcite", citation "smartcite" NormalCitation False)
628− , ("footcite", inNote <$> citation "footcite" NormalCitation False)
629− , ("parencite", citation "parencite" NormalCitation False)
630− , ("supercite", citation "supercite" NormalCitation False)
631− , ("footcitetext", inNote <$> citation "footcitetext" NormalCitation False)
632− , ("citeyearpar", citation "citeyearpar" SuppressAuthor False)
633− , ("citeyear", citation "citeyear" SuppressAuthor False)
634− , ("autocite*", citation "autocite*" SuppressAuthor False)
635− , ("cite*", citation "cite*" SuppressAuthor False)
636− , ("parencite*", citation "parencite*" SuppressAuthor False)
637− , ("textcite", citation "textcite" AuthorInText False)
638− , ("citet", citation "citet" AuthorInText False)
639− , ("citet*", citation "citet*" AuthorInText False)
640− , ("citealt", citation "citealt" AuthorInText False)
641− , ("citealt*", citation "citealt*" AuthorInText False)
642− , ("textcites", citation "textcites" AuthorInText True)
643− , ("cites", citation "cites" NormalCitation True)
644− , ("autocites", citation "autocites" NormalCitation True)
645− , ("footcites", inNote <$> citation "footcites" NormalCitation True)
646− , ("parencites", citation "parencites" NormalCitation True)
647− , ("supercites", citation "supercites" NormalCitation True)
648− , ("footcitetexts", inNote <$> citation "footcitetexts" NormalCitation True)
649− , ("Autocite", citation "Autocite" NormalCitation False)
650− , ("Smartcite", citation "Smartcite" NormalCitation False)
651− , ("Footcite", citation "Footcite" NormalCitation False)
652− , ("Parencite", citation "Parencite" NormalCitation False)
653− , ("Supercite", citation "Supercite" NormalCitation False)
654− , ("Footcitetext", inNote <$> citation "Footcitetext" NormalCitation False)
655− , ("Citeyearpar", citation "Citeyearpar" SuppressAuthor False)
656− , ("Citeyear", citation "Citeyear" SuppressAuthor False)
657− , ("Autocite*", citation "Autocite*" SuppressAuthor False)
658− , ("Cite*", citation "Cite*" SuppressAuthor False)
659− , ("Parencite*", citation "Parencite*" SuppressAuthor False)
660− , ("Textcite", citation "Textcite" AuthorInText False)
661− , ("Textcites", citation "Textcites" AuthorInText True)
662− , ("Cites", citation "Cites" NormalCitation True)
663− , ("Autocites", citation "Autocites" NormalCitation True)
664− , ("Footcites", citation "Footcites" NormalCitation True)
665− , ("Parencites", citation "Parencites" NormalCitation True)
666− , ("Supercites", citation "Supercites" NormalCitation True)
667− , ("Footcitetexts", inNote <$> citation "Footcitetexts" NormalCitation True)
668− , ("citetext", complexNatbibCitation NormalCitation)
669− , ("citeauthor", (try (tok *> optional sp *> controlSeq "citetext") *>
670− complexNatbibCitation AuthorInText)
671− <|> citation "citeauthor" AuthorInText False)
672− , ("nocite", mempty <$ (citation "nocite" NormalCitation False >>=
673− addMeta "nocite"))
1013+-- , ("cite", citation "cite" NormalCitation False)
1014+-- , ("Cite", citation "Cite" NormalCitation False)
1015+-- , ("citep", citation "citep" NormalCitation False)
1016+-- , ("citep*", citation "citep*" NormalCitation False)
1017+-- , ("citeal", citation "citeal" NormalCitation False)
1018+-- , ("citealp", citation "citealp" NormalCitation False)
1019+-- , ("citealp*", citation "citealp*" NormalCitation False)
1020+-- , ("autocite", citation "autocite" NormalCitation False)
1021+-- , ("smartcite", citation "smartcite" NormalCitation False)
1022+-- , ("footcite", inNote <$> citation "footcite" NormalCitation False)
1023+-- , ("parencite", citation "parencite" NormalCitation False)
1024+-- , ("supercite", citation "supercite" NormalCitation False)
1025+-- , ("footcitetext", inNote <$> citation "footcitetext" NormalCitation False)
1026+-- , ("citeyearpar", citation "citeyearpar" SuppressAuthor False)
1027+-- , ("citeyear", citation "citeyear" SuppressAuthor False)
1028+-- , ("autocite*", citation "autocite*" SuppressAuthor False)
1029+-- , ("cite*", citation "cite*" SuppressAuthor False)
1030+-- , ("parencite*", citation "parencite*" SuppressAuthor False)
1031+-- , ("textcite", citation "textcite" AuthorInText False)
1032+-- , ("citet", citation "citet" AuthorInText False)
1033+-- , ("citet*", citation "citet*" AuthorInText False)
1034+-- , ("citealt", citation "citealt" AuthorInText False)
1035+-- , ("citealt*", citation "citealt*" AuthorInText False)
1036+-- , ("textcites", citation "textcites" AuthorInText True)
1037+-- , ("cites", citation "cites" NormalCitation True)
1038+-- , ("autocites", citation "autocites" NormalCitation True)
1039+-- , ("footcites", inNote <$> citation "footcites" NormalCitation True)
1040+-- , ("parencites", citation "parencites" NormalCitation True)
1041+-- , ("supercites", citation "supercites" NormalCitation True)
1042+-- , ("footcitetexts", inNote <$> citation "footcitetexts" NormalCitation True)
1043+-- , ("Autocite", citation "Autocite" NormalCitation False)
1044+-- , ("Smartcite", citation "Smartcite" NormalCitation False)
1045+-- , ("Footcite", citation "Footcite" NormalCitation False)
1046+-- , ("Parencite", citation "Parencite" NormalCitation False)
1047+-- , ("Supercite", citation "Supercite" NormalCitation False)
1048+-- , ("Footcitetext", inNote <$> citation "Footcitetext" NormalCitation False)
1049+-- , ("Citeyearpar", citation "Citeyearpar" SuppressAuthor False)
1050+-- , ("Citeyear", citation "Citeyear" SuppressAuthor False)
1051+-- , ("Autocite*", citation "Autocite*" SuppressAuthor False)
1052+-- , ("Cite*", citation "Cite*" SuppressAuthor False)
1053+-- , ("Parencite*", citation "Parencite*" SuppressAuthor False)
1054+-- , ("Textcite", citation "Textcite" AuthorInText False)
1055+-- , ("Textcites", citation "Textcites" AuthorInText True)
1056+-- , ("Cites", citation "Cites" NormalCitation True)
1057+-- , ("Autocites", citation "Autocites" NormalCitation True)
1058+-- , ("Footcites", citation "Footcites" NormalCitation True)
1059+-- , ("Parencites", citation "Parencites" NormalCitation True)
1060+-- , ("Supercites", citation "Supercites" NormalCitation True)
1061+-- , ("Footcitetexts", inNote <$> citation "Footcitetexts" NormalCitation True)
1062+-- , ("citetext", complexNatbibCitation NormalCitation)
1063+-- , ("citeauthor", (try (tok *> optional sp *> controlSeq "citetext") *>
1064+-- complexNatbibCitation AuthorInText)
1065+-- <|> citation "citeauthor" AuthorInText False)
1066+-- , ("nocite", mempty <$ (citation "nocite" NormalCitation False >>=
1067+-- addMeta "nocite"))
6741068 , ("hypertarget", braced >> tok)
675− -- siuntix
676− , ("SI", dosiunitx)
1069+-- -- siuntix
1070+-- , ("SI", dosiunitx)
6771071 -- hyphenat
6781072 , ("bshyp", lit "\\\173")
6791073 , ("fshyp", lit "/\173")
@@ -700,543 +1094,135 @@ inlineCommands = M.fromList $
7001094ttfamily :: PandocMonad m => LP m Inlines
7011095ttfamily = (code . stringify . toList) <$> tok
7021096
703−mkImage :: PandocMonad m => [(String, String)] -> String -> LP m Inlines
704−mkImage options src = do
705− let replaceTextwidth (k,v) = case numUnit v of
706− Just (num, "\\textwidth") -> (k, showFl (num * 100) ++ "%")
707− _ -> (k, v)
708− let kvs = map replaceTextwidth $ filter (\(k,_) -> k `elem` ["width", "height"]) options
709− let attr = ("",[], kvs)
710− let alt = str "image"
711− case takeExtension src of
712− "" -> do
713− defaultExt <- getOption readerDefaultImageExtension
714− return $ imageWith attr (addExtension src defaultExt) "" alt
715− _ -> return $ imageWith attr src "" alt
716−
717−inNote :: Inlines -> Inlines
718−inNote ils =
719− note $ para $ ils <> str "."
720−
721−unescapeURL :: String -> String
722−unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs
723− where isEscapable c = c `elem` ("#$%&~_^\\{}" :: String)
724−unescapeURL (x:xs) = x:unescapeURL xs
725−unescapeURL [] = ""
1097+rawInlineOr :: PandocMonad m => Text -> LP m Inlines -> LP m Inlines
1098+rawInlineOr name' fallback = do
1099+ parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
1100+ if parseRaw
1101+ then rawInline "latex" <$> getRawCommand name'
1102+ else fallback
7261103
727−enquote :: PandocMonad m => LP m Inlines
728−enquote = do
729− skipopts
730− context <- stateQuoteContext <$> getState
731− if context == InDoubleQuote
732− then singleQuoted <$> withQuoteContext InSingleQuote tok
733− else doubleQuoted <$> withQuoteContext InDoubleQuote tok
1104+getRawCommand :: PandocMonad m => Text -> LP m String
1105+getRawCommand name' = do
1106+ (_, rawargs) <- withRaw
1107+ (many (try (optional sp *> opt)) *>
1108+ option "" (try (optional sp *> dimenarg)) *>
1109+ many braced)
1110+ return $ '\\' : T.unpack (name' <> untokenize rawargs)
7341111
735−doverb :: PandocMonad m => LP m Inlines
736−doverb = do
737− marker <- anyChar
738− code <$> manyTill (satisfy (/='\n')) (char marker)
1112+isBlockCommand :: Text -> Bool
1113+isBlockCommand s =
1114+ s `M.member` (blockCommands :: M.Map Text (LP PandocPure Blocks))
7391115
740−dolstinline :: PandocMonad m => LP m Inlines
741−dolstinline = do
742− options <- option [] keyvals
743− let classes = maybeToList $ lookup "language" options >>= fromListingsLanguage
744− marker <- char '{' <|> anyChar
745− codeWith ("",classes,[]) <$> manyTill (satisfy (/='\n')) (char '}' <|> char marker)
1116+lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
1117+lookupListDefault d = (fromMaybe d .) . lookupList
1118+ where
1119+ lookupList l m = msum $ map (`M.lookup` m) l
7461120
747−doLHSverb :: PandocMonad m => LP m Inlines
748−doLHSverb = codeWith ("",["haskell"],[]) <$> manyTill (satisfy (/='\n')) (char '|')
1121+inline :: PandocMonad m => LP m Inlines
1122+inline = (mempty <$ comment)
1123+ <|> (space <$ whitespace)
1124+ <|> (softbreak <$ endline)
1125+ <|> inlineText
1126+ <|> inlineCommand'
1127+ <|> inlineEnvironment
1128+ <|> inlineGroup
1129+ <|> (symbol '-' *>
1130+ option (str "-") (symbol '-' *>
1131+ option (str "–") (str "—" <$ symbol '-')))
1132+ <|> doubleQuote
1133+ <|> singleQuote
1134+ <|> (str "”" <$ try (symbol '\'' >> symbol '\''))
1135+ <|> (str "”" <$ symbol '”')
1136+ <|> (str "’" <$ symbol '\'')
1137+ <|> (str "’" <$ symbol '’')
1138+ <|> (str "\160" <$ symbol '~')
1139+ <|> dollarsMath
1140+ <|> (guardEnabled Ext_literate_haskell *> symbol '|' *> doLHSverb)
1141+ <|> (str . (:[]) <$> primEscape)
1142+ <|> (do res <- symbolIn "#&~^'`\"[]"
1143+ pos <- getPosition
1144+ let s = T.unpack (untoken res)
1145+ report $ ParsingUnescaped s pos
1146+ return $ str s)
7491147
750−-- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"
751−dosiunitx :: PandocMonad m => LP m Inlines
752−dosiunitx = do
753− skipopts
754− value <- tok
755− valueprefix <- option "" $ char '[' >> (mconcat <$> manyTill tok (char ']'))
756− unit <- tok
757− let emptyOr160 "" = ""
758− emptyOr160 _ = "\160"
759− return . mconcat $ [valueprefix,
760− emptyOr160 valueprefix,
761− value,
762− emptyOr160 unit,
763− unit]
1148+inlines :: PandocMonad m => LP m Inlines
1149+inlines = mconcat <$> many inline
7641150
765−lit :: String -> LP m Inlines
766−lit = pure . str
1151+-- block elements:
7671152
768−accent :: (Char -> String) -> Inlines -> LP m Inlines
769−accent f ils =
770− case toList ils of
771− (Str (x:xs) : ys) -> return $ fromList (Str (f x ++ xs) : ys)
772− [] -> mzero
773− _ -> return ils
1153+paragraph :: PandocMonad m => LP m Blocks
1154+paragraph = do
1155+ x <- trimInlines . mconcat <$> many1 inline
1156+ if x == mempty
1157+ then return mempty
1158+ else return $ para x
7741159
775−grave :: Char -> String
776−grave 'A' = "À"
777−grave 'E' = "È"
778−grave 'I' = "Ì"
779−grave 'O' = "Ò"
780−grave 'U' = "Ù"
781−grave 'a' = "à"
782−grave 'e' = "è"
783−grave 'i' = "ì"
784−grave 'o' = "ò"
785−grave 'u' = "ù"
786−grave c = [c]
1160+include :: PandocMonad m => LP m Blocks
1161+include = do
1162+ (Tok _ _ name) <- controlSeq "include" <|> controlSeq "input" <|>
1163+ controlSeq "subfile" <|> controlSeq "usepackage"
1164+ skipMany $ bracketed inline -- skip options
1165+ fs <- (map trim . splitBy (==',') . T.unpack . untokenize) <$> braced
1166+ let fs' = if name == "\\usepackage"
1167+ then map (maybeAddExtension ".sty") fs
1168+ else map (maybeAddExtension ".tex") fs
1169+ dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
1170+ mconcat <$> mapM (insertIncludedFile blocks (tokenize . T.pack) dirs) fs'
7871171
788−acute :: Char -> String
789−acute 'A' = "Á"
790−acute 'E' = "É"
791−acute 'I' = "Í"
792−acute 'O' = "Ó"
793−acute 'U' = "Ú"
794−acute 'Y' = "Ý"
795−acute 'a' = "á"
796−acute 'e' = "é"
797−acute 'i' = "í"
798−acute 'o' = "ó"
799−acute 'u' = "ú"
800−acute 'y' = "ý"
801−acute 'C' = "Ć"
802−acute 'c' = "ć"
803−acute 'L' = "Ĺ"
804−acute 'l' = "ĺ"
805−acute 'N' = "Ń"
806−acute 'n' = "ń"
807−acute 'R' = "Ŕ"
808−acute 'r' = "ŕ"
809−acute 'S' = "Ś"
810−acute 's' = "ś"
811−acute 'Z' = "Ź"
812−acute 'z' = "ź"
813−acute c = [c]
1172+maybeAddExtension :: String -> FilePath -> FilePath
1173+maybeAddExtension ext fp =
1174+ if null (takeExtension fp)
1175+ then addExtension fp ext
1176+ else fp
8141177
815−circ :: Char -> String
816−circ 'A' = "Â"
817−circ 'E' = "Ê"
818−circ 'I' = "Î"
819−circ 'O' = "Ô"
820−circ 'U' = "Û"
821−circ 'a' = "â"
822−circ 'e' = "ê"
823−circ 'i' = "î"
824−circ 'o' = "ô"
825−circ 'u' = "û"
826−circ 'C' = "Ĉ"
827−circ 'c' = "ĉ"
828−circ 'G' = "Ĝ"
829−circ 'g' = "ĝ"
830−circ 'H' = "Ĥ"
831−circ 'h' = "ĥ"
832−circ 'J' = "Ĵ"
833−circ 'j' = "ĵ"
834−circ 'S' = "Ŝ"
835−circ 's' = "ŝ"
836−circ 'W' = "Ŵ"
837−circ 'w' = "ŵ"
838−circ 'Y' = "Ŷ"
839−circ 'y' = "ŷ"
840−circ c = [c]
841−
842−tilde :: Char -> String
843−tilde 'A' = "Ã"
844−tilde 'a' = "ã"
845−tilde 'O' = "Õ"
846−tilde 'o' = "õ"
847−tilde 'I' = "Ĩ"
848−tilde 'i' = "ĩ"
849−tilde 'U' = "Ũ"
850−tilde 'u' = "ũ"
851−tilde 'N' = "Ñ"
852−tilde 'n' = "ñ"
853−tilde c = [c]
854−
855−umlaut :: Char -> String
856−umlaut 'A' = "Ä"
857−umlaut 'E' = "Ë"
858−umlaut 'I' = "Ï"
859−umlaut 'O' = "Ö"
860−umlaut 'U' = "Ü"
861−umlaut 'a' = "ä"
862−umlaut 'e' = "ë"
863−umlaut 'i' = "ï"
864−umlaut 'o' = "ö"
865−umlaut 'u' = "ü"
866−umlaut c = [c]
867−
868−hungarumlaut :: Char -> String
869−hungarumlaut 'A' = "A̋"
870−hungarumlaut 'E' = "E̋"
871−hungarumlaut 'I' = "I̋"
872−hungarumlaut 'O' = "Ő"
873−hungarumlaut 'U' = "Ű"
874−hungarumlaut 'Y' = "ӳ"
875−hungarumlaut 'a' = "a̋"
876−hungarumlaut 'e' = "e̋"
877−hungarumlaut 'i' = "i̋"
878−hungarumlaut 'o' = "ő"
879−hungarumlaut 'u' = "ű"
880−hungarumlaut 'y' = "ӳ"
881−hungarumlaut c = [c]
882−
883−dot :: Char -> String
884−dot 'C' = "Ċ"
885−dot 'c' = "ċ"
886−dot 'E' = "Ė"
887−dot 'e' = "ė"
888−dot 'G' = "Ġ"
889−dot 'g' = "ġ"
890−dot 'I' = "İ"
891−dot 'Z' = "Ż"
892−dot 'z' = "ż"
893−dot c = [c]
894−
895−macron :: Char -> String
896−macron 'A' = "Ā"
897−macron 'E' = "Ē"
898−macron 'I' = "Ī"
899−macron 'O' = "Ō"
900−macron 'U' = "Ū"
901−macron 'a' = "ā"
902−macron 'e' = "ē"
903−macron 'i' = "ī"
904−macron 'o' = "ō"
905−macron 'u' = "ū"
906−macron c = [c]
907−
908−cedilla :: Char -> String
909−cedilla 'c' = "ç"
910−cedilla 'C' = "Ç"
911−cedilla 's' = "ş"
912−cedilla 'S' = "Ş"
913−cedilla 't' = "ţ"
914−cedilla 'T' = "Ţ"
915−cedilla 'e' = "ȩ"
916−cedilla 'E' = "Ȩ"
917−cedilla 'h' = "ḩ"
918−cedilla 'H' = "Ḩ"
919−cedilla 'o' = "o̧"
920−cedilla 'O' = "O̧"
921−cedilla c = [c]
922−
923−hacek :: Char -> String
924−hacek 'A' = "Ǎ"
925−hacek 'a' = "ǎ"
926−hacek 'C' = "Č"
927−hacek 'c' = "č"
928−hacek 'D' = "Ď"
929−hacek 'd' = "ď"
930−hacek 'E' = "Ě"
931−hacek 'e' = "ě"
932−hacek 'G' = "Ǧ"
933−hacek 'g' = "ǧ"
934−hacek 'H' = "Ȟ"
935−hacek 'h' = "ȟ"
936−hacek 'I' = "Ǐ"
937−hacek 'i' = "ǐ"
938−hacek 'j' = "ǰ"
939−hacek 'K' = "Ǩ"
940−hacek 'k' = "ǩ"
941−hacek 'L' = "Ľ"
942−hacek 'l' = "ľ"
943−hacek 'N' = "Ň"
944−hacek 'n' = "ň"
945−hacek 'O' = "Ǒ"
946−hacek 'o' = "ǒ"
947−hacek 'R' = "Ř"
948−hacek 'r' = "ř"
949−hacek 'S' = "Š"
950−hacek 's' = "š"
951−hacek 'T' = "Ť"
952−hacek 't' = "ť"
953−hacek 'U' = "Ǔ"
954−hacek 'u' = "ǔ"
955−hacek 'Z' = "Ž"
956−hacek 'z' = "ž"
957−hacek c = [c]
958−
959−breve :: Char -> String
960−breve 'A' = "Ă"
961−breve 'a' = "ă"
962−breve 'E' = "Ĕ"
963−breve 'e' = "ĕ"
964−breve 'G' = "Ğ"
965−breve 'g' = "ğ"
966−breve 'I' = "Ĭ"
967−breve 'i' = "ĭ"
968−breve 'O' = "Ŏ"
969−breve 'o' = "ŏ"
970−breve 'U' = "Ŭ"
971−breve 'u' = "ŭ"
972−breve c = [c]
973−
974−tok :: PandocMonad m => LP m Inlines
975−tok = try $ grouped inline <|> inlineCommand <|> str <$> count 1 inlineChar
976−
977−opt :: PandocMonad m => LP m Inlines
978−opt = bracketed inline
979−
980−rawopt :: PandocMonad m => LP m String
981−rawopt = do
982− contents <- bracketed (many1 (noneOf "[]") <|> try (string "\\]") <|>
983− try (string "\\[") <|> rawopt)
984− optional sp
985− return $ "[" ++ contents ++ "]"
986−
987−skipopts :: PandocMonad m => LP m ()
988−skipopts = skipMany rawopt
989−
990−-- opts in angle brackets are used in beamer
991−rawangle :: PandocMonad m => LP m ()
992−rawangle = try $ do
993− char '<'
994− skipMany (noneOf ">")
995− char '>'
996− return ()
997−
998−skipangles :: PandocMonad m => LP m ()
999−skipangles = skipMany rawangle
1000−
1001−inlineText :: PandocMonad m => LP m Inlines
1002−inlineText = str <$> many1 inlineChar
1003−
1004−inlineChar :: PandocMonad m => LP m Char
1005−inlineChar = noneOf "\\$%&~#{}^'`\"‘’“”-[] \t\n"
1006−
1007−environment :: PandocMonad m => LP m Blocks
1008−environment = do
1009− controlSeq "begin"
1010− name <- braced
1011− M.findWithDefault mzero name environments
1012− <|> rawEnv name
1013−
1014−inlineEnvironment :: PandocMonad m => LP m Inlines
1015−inlineEnvironment = try $ do
1016− controlSeq "begin"
1017− name <- braced
1018− M.findWithDefault mzero name inlineEnvironments
1019−
1020−rawEnv :: PandocMonad m => String -> LP m Blocks
1021−rawEnv name = do
1022− exts <- getOption readerExtensions
1023− let parseRaw = extensionEnabled Ext_raw_tex exts
1024− rawOptions <- mconcat <$> many rawopt
1025− let beginCommand = "\\begin{" ++ name ++ "}" ++ rawOptions
1026− pos1 <- getPosition
1027− (bs, raw) <- withRaw $ env name blocks
1028− raw' <- applyMacros' $ beginCommand ++ raw
1029− if raw' /= beginCommand ++ raw
1030− then parseFromString' blocks raw'
1031− else if parseRaw
1032− then return $ rawBlock "latex" $ beginCommand ++ raw'
1033− else do
1034− unless parseRaw $ do
1035− report $ SkippedContent beginCommand pos1
1036− pos2 <- getPosition
1037− report $ SkippedContent ("\\end{" ++ name ++ "}") pos2
1038− return bs
1039−
1040−rawVerbEnv :: PandocMonad m => String -> LP m Blocks
1041−rawVerbEnv name = do
1042− pos <- getPosition
1043− (_, raw) <- withRaw $ verbEnv name
1044− let raw' = "\\begin{tikzpicture}" ++ raw
1045− exts <- getOption readerExtensions
1046− let parseRaw = extensionEnabled Ext_raw_tex exts
1047− if parseRaw
1048− then return $ rawBlock "latex" raw'
1049− else do
1050− report $ SkippedContent raw' pos
1051− return mempty
1052−
1053−----
1054−
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−
1112−----
1113−
1114−keyval :: PandocMonad m => LP m (String, String)
1115−keyval = try $ do
1116− key <- many1 alphaNum
1117− val <- option "" $ char '=' >> braced <|> (many1 (alphaNum <|> oneOf ".:-|\\"))
1118− skipMany spaceChar
1119− optional (char ',')
1120− skipMany spaceChar
1121− return (key, val)
1178+ignoreBlocks :: PandocMonad m => Text -> (Text, LP m Blocks)
1179+ignoreBlocks name = (name, p)
1180+ where
1181+ p = do oa <- optargs
1182+ let rawCommand = '\\' : T.unpack (name <> oa)
1183+ let doraw = guardRaw >> return (rawBlock "latex" rawCommand)
1184+ doraw <|> ignore rawCommand
11221185
1186+addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()
1187+addMeta field val = updateState $ \st ->
1188+ st{ sMeta = addMetaField field val $ sMeta st }
11231189
1124−keyvals :: PandocMonad m => LP m [(String, String)]
1125−keyvals = try $ char '[' *> manyTill keyval (char ']')
1126−
1127−alltt :: PandocMonad m => String -> LP m Blocks
1128−alltt t = walk strToCode <$> parseFromString' blocks
1129− (substitute " " "\\ " $ substitute "%" "\\%" $
1130− intercalate "\\\\\n" $ lines t)
1131− where strToCode (Str s) = Code nullAttr s
1132− strToCode x = x
1133−
1134−rawLaTeXBlock :: PandocMonad m => LP m String
1135−rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))
1136−
1137−rawLaTeXInline :: PandocMonad m => LP m Inline
1138−rawLaTeXInline = do
1139− raw <- (snd <$> withRaw inlineCommand)
1140− <|> (snd <$> withRaw inlineEnvironment)
1141− <|> (snd <$> withRaw blockCommand)
1142− RawInline "latex" <$> applyMacros' raw
1143−
1144−addImageCaption :: PandocMonad m => Blocks -> LP m Blocks
1145−addImageCaption = walkM go
1146− where go (Image attr alt (src,tit))
1147− | not ("fig:" `isPrefixOf` tit) = do
1148− mbcapt <- stateCaption <$> getState
1149− return $ case mbcapt of
1150− Just ils -> Image attr (toList ils) (src, "fig:" ++ tit)
1151− Nothing -> Image attr alt (src,tit)
1152− go x = return x
1153−
1154−addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
1155−addTableCaption = walkM go
1156− where go (Table c als ws hs rs) = do
1157− mbcapt <- stateCaption <$> getState
1158− return $ case mbcapt of
1159− Just ils -> Table (toList ils) als ws hs rs
1160− Nothing -> Table c als ws hs rs
1161− go x = return x
1162−
1163−environments :: PandocMonad m => M.Map String (LP m Blocks)
1164−environments = M.fromList
1165− [ ("document", env "document" blocks <* skipMany anyChar)
1166− , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))
1167− , ("letter", env "letter" letterContents)
1168− , ("minipage", env "minipage" $
1169− skipopts *> spaces' *> optional braced *> spaces' *> blocks)
1170− , ("figure", env "figure" $ skipopts *> figure)
1171− , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)
1172− , ("center", env "center" blocks)
1173− , ("longtable", env "longtable" $
1174− resetCaption *> simpTable "longtable" False >>= addTableCaption)
1175− , ("table", env "table" $
1176− resetCaption *> skipopts *> blocks >>= addTableCaption)
1177− , ("tabular*", env "tabular" $ simpTable "tabular*" True)
1178− , ("tabularx", env "tabularx" $ simpTable "tabularx" True)
1179− , ("tabular", env "tabular" $ simpTable "tabular" False)
1180− , ("quote", blockQuote <$> env "quote" blocks)
1181− , ("quotation", blockQuote <$> env "quotation" blocks)
1182− , ("verse", blockQuote <$> env "verse" blocks)
1183− , ("itemize", bulletList <$> listenv "itemize" (many item))
1184− , ("description", definitionList <$> listenv "description" (many descItem))
1185− , ("enumerate", orderedList')
1186− , ("alltt", alltt =<< verbEnv "alltt")
1187− , ("code", guardEnabled Ext_literate_haskell *>
1188− (codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
1189− verbEnv "code"))
1190− , ("comment", mempty <$ verbEnv "comment")
1191− , ("verbatim", codeBlock <$> verbEnv "verbatim")
1192− , ("Verbatim", fancyverbEnv "Verbatim")
1193− , ("BVerbatim", fancyverbEnv "BVerbatim")
1194− , ("lstlisting", do attr <- parseListingsOptions <$> option [] keyvals
1195− codeBlockWith attr <$> verbEnv "lstlisting")
1196− , ("minted", do options <- option [] keyvals
1197− lang <- grouped (many1 $ satisfy (/='}'))
1198− let kvs = [ (if k == "firstnumber"
1199− then "startFrom"
1200− else k, v) | (k,v) <- options ]
1201− let classes = [ lang | not (null lang) ] ++
1202− [ "numberLines" |
1203− lookup "linenos" options == Just "true" ]
1204− let attr = ("",classes,kvs)
1205− codeBlockWith attr <$> verbEnv "minted")
1206− , ("obeylines", parseFromString
1207− (para . trimInlines . mconcat <$> many inline) =<<
1208− intercalate "\\\\\n" . lines <$> verbEnv "obeylines")
1209− , ("displaymath", mathEnvWith para Nothing "displaymath")
1210− , ("equation", mathEnvWith para Nothing "equation")
1211− , ("equation*", mathEnvWith para Nothing "equation*")
1212− , ("gather", mathEnvWith para (Just "gathered") "gather")
1213− , ("gather*", mathEnvWith para (Just "gathered") "gather*")
1214− , ("multline", mathEnvWith para (Just "gathered") "multline")
1215− , ("multline*", mathEnvWith para (Just "gathered") "multline*")
1216− , ("eqnarray", mathEnvWith para (Just "aligned") "eqnarray")
1217− , ("eqnarray*", mathEnvWith para (Just "aligned") "eqnarray*")
1218− , ("align", mathEnvWith para (Just "aligned") "align")
1219− , ("align*", mathEnvWith para (Just "aligned") "align*")
1220− , ("alignat", mathEnvWith para (Just "aligned") "alignat")
1221− , ("alignat*", mathEnvWith para (Just "aligned") "alignat*")
1222− , ("tikzpicture", rawVerbEnv "tikzpicture")
1223− ]
1190+authors :: PandocMonad m => LP m ()
1191+authors = try $ do
1192+ bgroup
1193+ let oneAuthor = mconcat <$>
1194+ many1 (notFollowedBy' (controlSeq "and") >>
1195+ (inline <|> mempty <$ blockCommand))
1196+ -- skip e.g. \vspace{10pt}
1197+ auths <- sepBy oneAuthor (controlSeq "and")
1198+ egroup
1199+ addMeta "author" (map trimInlines auths)
12241200
1225−figure :: PandocMonad m => LP m Blocks
1226−figure = try $ do
1227− resetCaption
1228− blocks >>= addImageCaption
1201+section :: PandocMonad m => Attr -> Int -> LP m Blocks
1202+section (ident, classes, kvs) lvl = do
1203+ skipopts
1204+ contents <- grouped inline
1205+ lab <- option ident $
1206+ try (spaces >> controlSeq "label"
1207+ >> spaces >> toksToString <$> braced)
1208+ attr' <- registerHeader (lab, classes, kvs) contents
1209+ return $ headerWith attr' lvl contents
12291210
1230−letterContents :: PandocMonad m => LP m Blocks
1231−letterContents = do
1232− bs <- blocks
1233− st <- getState
1234− -- add signature (author) and address (title)
1235− let addr = case lookupMeta "address" (stateMeta st) of
1236− Just (MetaBlocks [Plain xs]) ->
1237− para $ trimInlines $ fromList xs
1238− _ -> mempty
1239− return $ addr <> bs -- sig added by \closing
1211+blockCommand :: PandocMonad m => LP m Blocks
1212+blockCommand = try $ do
1213+ Tok _ CtrlSeq name <- anyControlSeq
1214+ guard $ name /= "\\begin" && name /= "\\end"
1215+ star <- option "" ("*" <$ symbol '*' <* optional sp)
1216+ let name' = name <> star
1217+ let names = name : [name' | name' /= name]
1218+ let raw = rawBlock "latex" <$> getRawCommand name'
1219+ -- TODO do we still need this?
1220+ -- rawcommand <- getRawCommand name'
1221+ -- transformed <- applyMacros' rawcommand
1222+ -- guard $ transformed /= rawcommand
1223+ -- notFollowedBy $ parseFromString' inlines transformed
1224+ -- parseFromString' blocks transformed
1225+ lookupListDefault raw names blockCommands
12401226
12411227closing :: PandocMonad m => LP m Blocks
12421228closing = do
@@ -1245,328 +1231,698 @@ closing = do
12451231 let extractInlines (MetaBlocks [Plain ys]) = ys
12461232 extractInlines (MetaBlocks [Para ys ]) = ys
12471233 extractInlines _ = []
1248− let sigs = case lookupMeta "author" (stateMeta st) of
1234+ let sigs = case lookupMeta "author" (sMeta st) of
12491235 Just (MetaList xs) ->
12501236 para $ trimInlines $ fromList $
12511237 intercalate [LineBreak] $ map extractInlines xs
12521238 _ -> mempty
12531239 return $ para (trimInlines contents) <> sigs
12541240
1255−item :: PandocMonad m => LP m Blocks
1256−item = blocks *> controlSeq "item" *> skipopts *> blocks
1257−
1258−looseItem :: PandocMonad m => LP m Blocks
1259−looseItem = do
1260− ctx <- stateParserContext `fmap` getState
1261− if ctx == ListItemState
1262− then mzero
1263− else return mempty
1241+blockCommands :: PandocMonad m => M.Map Text (LP m Blocks)
1242+blockCommands = M.fromList $
1243+ [ ("par", mempty <$ skipopts)
1244+ , ("parbox", braced >> grouped blocks)
1245+ , ("title", mempty <$ (skipopts *>
1246+ (grouped inline >>= addMeta "title")
1247+ <|> (grouped block >>= addMeta "title")))
1248+ , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle"))
1249+ , ("author", mempty <$ (skipopts *> authors))
1250+ -- -- in letter class, temp. store address & sig as title, author
1251+ , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))
1252+ , ("signature", mempty <$ (skipopts *> authors))
1253+ , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))
1254+ -- Koma-script metadata commands
1255+ , ("dedication", mempty <$ (skipopts *> tok >>= addMeta "dedication"))
1256+ -- sectioning
1257+ , ("part", section nullAttr (-1))
1258+ , ("part*", section nullAttr (-1))
1259+ , ("chapter", section nullAttr 0)
1260+ , ("chapter*", section ("",["unnumbered"],[]) 0)
1261+ , ("section", section nullAttr 1)
1262+ , ("section*", section ("",["unnumbered"],[]) 1)
1263+ , ("subsection", section nullAttr 2)
1264+ , ("subsection*", section ("",["unnumbered"],[]) 2)
1265+ , ("subsubsection", section nullAttr 3)
1266+ , ("subsubsection*", section ("",["unnumbered"],[]) 3)
1267+ , ("paragraph", section nullAttr 4)
1268+ , ("paragraph*", section ("",["unnumbered"],[]) 4)
1269+ , ("subparagraph", section nullAttr 5)
1270+ , ("subparagraph*", section ("",["unnumbered"],[]) 5)
1271+ -- beamer slides
1272+ , ("frametitle", section nullAttr 3)
1273+ , ("framesubtitle", section nullAttr 4)
1274+ -- letters
1275+ , ("opening", (para . trimInlines) <$> (skipopts *> tok))
1276+ , ("closing", skipopts *> closing)
1277+ --
1278+ , ("hrule", pure horizontalRule)
1279+ , ("strut", pure mempty)
1280+ , ("rule", skipopts *> tok *> tok *> pure horizontalRule)
1281+-- , ("item", skipopts *> looseItem)
1282+-- , ("documentclass", skipopts *> braced *> preamble)
1283+ , ("centerline", (para . trimInlines) <$> (skipopts *> tok))
1284+-- , ("caption", skipopts *> setCaption)
1285+-- , ("bibliography", mempty <$ (skipopts *> braced >>=
1286+-- addMeta "bibliography" . splitBibs))
1287+-- , ("addbibresource", mempty <$ (skipopts *> braced >>=
1288+-- addMeta "bibliography" . splitBibs))
1289+-- -- includes
1290+-- , ("lstinputlisting", inputListing)
1291+-- , ("graphicspath", graphicsPath)
1292+-- -- hyperlink
1293+ , ("hypertarget", braced >> grouped block)
1294+ ] ++ map ignoreBlocks
1295+ -- these commands will be ignored unless --parse-raw is specified,
1296+ -- in which case they will appear as raw latex blocks
1297+ [ "newcommand", "renewcommand", "newenvironment", "renewenvironment"
1298+ -- newcommand, etc. should be parsed by macro, but we need this
1299+ -- here so these aren't parsed as inline commands to ignore
1300+ , "special", "pdfannot", "pdfstringdef"
1301+ , "bibliographystyle"
1302+ , "maketitle", "makeindex", "makeglossary"
1303+ , "addcontentsline", "addtocontents", "addtocounter"
1304+ -- \ignore{} is used conventionally in literate haskell for definitions
1305+ -- that are to be processed by the compiler but not printed.
1306+ , "ignore"
1307+ , "hyperdef"
1308+ , "markboth", "markright", "markleft"
1309+ , "hspace", "vspace"
1310+ , "newpage"
1311+ , "clearpage"
1312+ , "pagebreak"
1313+ ]
1314+
1315+environments :: PandocMonad m => M.Map Text (LP m Blocks)
1316+environments = M.fromList
1317+ [ ("document", env "document" blocks)
1318+-- , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))
1319+-- , ("letter", env "letter" letterContents)
1320+-- , ("minipage", env "minipage" $
1321+-- skipopts *> spaces' *> optional braced *> spaces' *> blocks)
1322+-- , ("figure", env "figure" $ skipopts *> figure)
1323+-- , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)
1324+-- , ("center", env "center" blocks)
1325+-- , ("longtable", env "longtable" $
1326+-- resetCaption *> simpTable "longtable" False >>= addTableCaption)
1327+-- , ("table", env "table" $
1328+-- resetCaption *> skipopts *> blocks >>= addTableCaption)
1329+-- , ("tabular*", env "tabular" $ simpTable "tabular*" True)
1330+-- , ("tabularx", env "tabularx" $ simpTable "tabularx" True)
1331+-- , ("tabular", env "tabular" $ simpTable "tabular" False)
1332+-- , ("quote", blockQuote <$> env "quote" blocks)
1333+-- , ("quotation", blockQuote <$> env "quotation" blocks)
1334+-- , ("verse", blockQuote <$> env "verse" blocks)
1335+-- , ("itemize", bulletList <$> listenv "itemize" (many item))
1336+-- , ("description", definitionList <$> listenv "description" (many descItem))
1337+-- , ("enumerate", orderedList')
1338+-- , ("alltt", alltt =<< verbEnv "alltt")
1339+-- , ("code", guardEnabled Ext_literate_haskell *>
1340+-- (codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
1341+-- verbEnv "code"))
1342+-- , ("comment", mempty <$ verbEnv "comment")
1343+-- , ("verbatim", codeBlock <$> verbEnv "verbatim")
1344+-- , ("Verbatim", fancyverbEnv "Verbatim")
1345+-- , ("BVerbatim", fancyverbEnv "BVerbatim")
1346+-- , ("lstlisting", do attr <- parseListingsOptions <$> option [] keyvals
1347+-- codeBlockWith attr <$> verbEnv "lstlisting")
1348+-- , ("minted", do options <- option [] keyvals
1349+-- lang <- grouped (many1 $ satisfy (/='}'))
1350+-- let kvs = [ (if k == "firstnumber"
1351+-- then "startFrom"
1352+-- else k, v) | (k,v) <- options ]
1353+-- let classes = [ lang | not (null lang) ] ++
1354+-- [ "numberLines" |
1355+-- lookup "linenos" options == Just "true" ]
1356+-- let attr = ("",classes,kvs)
1357+-- codeBlockWith attr <$> verbEnv "minted")
1358+-- , ("obeylines", parseFromString
1359+-- (para . trimInlines . mconcat <$> many inline) =<<
1360+-- intercalate "\\\\\n" . lines <$> verbEnv "obeylines")
1361+-- , ("displaymath", mathEnvWith para Nothing "displaymath")
1362+-- , ("equation", mathEnvWith para Nothing "equation")
1363+-- , ("equation*", mathEnvWith para Nothing "equation*")
1364+-- , ("gather", mathEnvWith para (Just "gathered") "gather")
1365+-- , ("gather*", mathEnvWith para (Just "gathered") "gather*")
1366+-- , ("multline", mathEnvWith para (Just "gathered") "multline")
1367+-- , ("multline*", mathEnvWith para (Just "gathered") "multline*")
1368+-- , ("eqnarray", mathEnvWith para (Just "aligned") "eqnarray")
1369+-- , ("eqnarray*", mathEnvWith para (Just "aligned") "eqnarray*")
1370+-- , ("align", mathEnvWith para (Just "aligned") "align")
1371+-- , ("align*", mathEnvWith para (Just "aligned") "align*")
1372+-- , ("alignat", mathEnvWith para (Just "aligned") "alignat")
1373+-- , ("alignat*", mathEnvWith para (Just "aligned") "alignat*")
1374+-- , ("tikzpicture", rawVerbEnv "tikzpicture")
1375+ ]
12641376
1265−descItem :: PandocMonad m => LP m (Inlines, [Blocks])
1266−descItem = do
1267− blocks -- skip blocks before item
1268− controlSeq "item"
1269− optional sp
1270− ils <- opt
1271− bs <- blocks
1272− return (ils, [bs])
1377+environment :: PandocMonad m => LP m Blocks
1378+environment = do
1379+ controlSeq "begin"
1380+ name <- untokenize <$> braced
1381+ M.findWithDefault mzero name environments
1382+ <|> rawEnv name
12731383
1274−env :: PandocMonad m => String -> LP m a -> LP m a
1384+env :: PandocMonad m => Text -> LP m a -> LP m a
12751385env name p = p <*
1276− (try (controlSeq "end" *> braced >>= guard . (== name))
1277− <?> ("\\end{" ++ name ++ "}"))
1278−
1279−listenv :: PandocMonad m => String -> LP m a -> LP m a
1280−listenv name p = try $ do
1281− oldCtx <- stateParserContext `fmap` getState
1282− updateState $ \st -> st{ stateParserContext = ListItemState }
1283− res <- env name p
1284− updateState $ \st -> st{ stateParserContext = oldCtx }
1285− return res
1286−
1287−mathEnvWith :: PandocMonad m
1288− => (Inlines -> a) -> Maybe String -> String -> LP m a
1289−mathEnvWith f innerEnv name = f <$> mathDisplay (inner <$> mathEnv name)
1290− where inner x = case innerEnv of
1291− Nothing -> x
1292− Just y -> "\\begin{" ++ y ++ "}\n" ++ x ++
1293− "\\end{" ++ y ++ "}"
1294−
1295−mathEnv :: PandocMonad m => String -> LP m String
1296−mathEnv name = do
1297− skipopts
1298− optional blankline
1299− let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
1300− charMuncher = skipMany comment *>
1301− (many1 (noneOf "\\%") <|> try (string "\\%")
1302− <|> try (string "\\\\") <|> count 1 anyChar)
1303− res <- concat <$> manyTill charMuncher endEnv
1304− return $ stripTrailingNewlines res
1305−
1306−verbEnv :: PandocMonad m => String -> LP m String
1307−verbEnv name = do
1308− skipopts
1309− optional blankline
1310− let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
1311− charMuncher = anyChar
1312− res <- manyTill charMuncher endEnv
1313− return $ stripTrailingNewlines res
1386+ (try (controlSeq "end" *> braced >>= guard . (== name) . untokenize)
1387+ <?> ("\\end{" ++ T.unpack name ++ "}"))
13141388
1315−fancyverbEnv :: PandocMonad m => String -> LP m Blocks
1316−fancyverbEnv name = do
1317− options <- option [] keyvals
1318− let kvs = [ (if k == "firstnumber"
1319− then "startFrom"
1320− else k, v) | (k,v) <- options ]
1321− let classes = [ "numberLines" |
1322− lookup "numbers" options == Just "left" ]
1323− let attr = ("",classes,kvs)
1324− codeBlockWith attr <$> verbEnv name
1325−
1326−orderedList' :: PandocMonad m => LP m Blocks
1327−orderedList' = try $ do
1328− optional sp
1329− (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $
1330− try $ char '[' *> anyOrderedListMarker <* char ']'
1331− spaces
1332− optional $ try $ controlSeq "setlength" *> grouped (controlSeq "itemindent") *> braced
1333− spaces
1334− start <- option 1 $ try $ do controlSeq "setcounter"
1335− grouped (string "enum" *> many1 (oneOf "iv"))
1336− optional sp
1337− num <- grouped (many1 digit)
1338− spaces
1339− return (read num + 1 :: Int)
1340− bs <- listenv "enumerate" (many item)
1341− return $ orderedListWith (start, style, delim) bs
1389+rawEnv :: PandocMonad m => Text -> LP m Blocks
1390+rawEnv name = do
1391+ exts <- getOption readerExtensions
1392+ let parseRaw = extensionEnabled Ext_raw_tex exts
1393+ rawOptions <- mconcat <$> many rawopt
1394+ let beginCommand = "\\begin{" <> name <> "}" <> rawOptions
1395+ pos1 <- getPosition
1396+ (bs, raw) <- withRaw $ env name blocks
1397+ if parseRaw
1398+ then return $ rawBlock "latex"
1399+ $ T.unpack $ beginCommand <> untokenize raw
1400+ else do
1401+ unless parseRaw $ do
1402+ report $ SkippedContent (T.unpack beginCommand) pos1
1403+ pos2 <- getPosition
1404+ report $ SkippedContent ("\\end{" ++ T.unpack name ++ "}") pos2
1405+ return bs
1406+
1407+ -- raw' <- applyMacros' $ beginCommand <> untokenize raw
1408+ -- if raw' /= beginCommand ++ raw
1409+ -- then parseFromString' blocks raw'
1410+ -- else if parseRaw
1411+ -- then return $ rawBlock "latex" $ beginCommand ++ raw'
1412+ -- else do
1413+ -- unless parseRaw $ do
1414+ -- report $ SkippedContent beginCommand pos1
1415+ -- pos2 <- getPosition
1416+ -- report $ SkippedContent ("\\end{" ++ name ++ "}") pos2
1417+ -- return bs
13421418
1343−paragraph :: PandocMonad m => LP m Blocks
1344−paragraph = do
1345− x <- trimInlines . mconcat <$> many1 inline
1346− if x == mempty
1347− then return mempty
1348− else return $ para x
1419+block :: PandocMonad m => LP m Blocks
1420+block = (mempty <$ spaces1)
1421+ <|> environment
1422+ <|> include
1423+ -- <|> macro
1424+ <|> blockCommand
1425+ <|> paragraph
1426+ <|> grouped block
13491427
1350−preamble :: PandocMonad m => LP m Blocks
1351−preamble = mempty <$> manyTill preambleBlock beginDoc
1352− where beginDoc = lookAhead $ try $ controlSeq "begin" *> string "{document}"
1353− preambleBlock = void comment
1354− <|> void sp
1355− <|> void blanklines
1356− <|> void include
1357− <|> void macro
1358− <|> void blockCommand
1359− <|> void anyControlSeq
1360− <|> void braced
1361− <|> void anyChar
1362−
1363−-------
1364−
1365−-- citations
1366−
1367−addPrefix :: [Inline] -> [Citation] -> [Citation]
1368−addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks
1369−addPrefix _ _ = []
1370−
1371−addSuffix :: [Inline] -> [Citation] -> [Citation]
1372−addSuffix s ks@(_:_) =
1373− let k = last ks
1374− in init ks ++ [k {citationSuffix = citationSuffix k ++ s}]
1375−addSuffix _ _ = []
1376−
1377−simpleCiteArgs :: PandocMonad m => LP m [Citation]
1378−simpleCiteArgs = try $ do
1379− first <- optionMaybe $ toList <$> opt
1380− second <- optionMaybe $ toList <$> opt
1381− keys <- try $ bgroup *> (manyTill citationLabel egroup)
1382− let (pre, suf) = case (first , second ) of
1383− (Just s , Nothing) -> (mempty, s )
1384− (Just s , Just t ) -> (s , t )
1385− _ -> (mempty, mempty)
1386− conv k = Citation { citationId = k
1387− , citationPrefix = []
1388− , citationSuffix = []
1389− , citationMode = NormalCitation
1390− , citationHash = 0
1391− , citationNoteNum = 0
1392− }
1393− return $ addPrefix pre $ addSuffix suf $ map conv keys
1394−
1395−citationLabel :: PandocMonad m => LP m String
1396−citationLabel = optional sp *>
1397− (many1 (satisfy isBibtexKeyChar)
1398− <* optional sp
1399− <* optional (char ',')
1400− <* optional sp)
1401− where isBibtexKeyChar c = isAlphaNum c || c `elem` (".:;?!`'()/*@_+=-[]" :: String)
1402−
1403−cites :: PandocMonad m => CitationMode -> Bool -> LP m [Citation]
1404−cites mode multi = try $ do
1405− cits <- if multi
1406− then many1 simpleCiteArgs
1407− else count 1 simpleCiteArgs
1408− let cs = concat cits
1409− return $ case mode of
1410− AuthorInText -> case cs of
1411− (c:rest) -> c {citationMode = mode} : rest
1412− [] -> []
1413− _ -> map (\a -> a {citationMode = mode}) cs
1414−
1415−citation :: PandocMonad m => String -> CitationMode -> Bool -> LP m Inlines
1416−citation name mode multi = do
1417− (c,raw) <- withRaw $ cites mode multi
1418− return $ cite c (rawInline "latex" $ "\\" ++ name ++ raw)
1419−
1420−complexNatbibCitation :: PandocMonad m => CitationMode -> LP m Inlines
1421−complexNatbibCitation mode = try $ do
1422− let ils = (toList . trimInlines . mconcat) <$>
1423− many (notFollowedBy (oneOf "\\};") >> inline)
1424− let parseOne = try $ do
1425− skipSpaces
1426− pref <- ils
1427− cit' <- inline -- expect a citation
1428− let citlist = toList cit'
1429− cits' <- case citlist of
1430− [Cite cs _] -> return cs
1431− _ -> mzero
1432− suff <- ils
1433− skipSpaces
1434− optional $ char ';'
1435− return $ addPrefix pref $ addSuffix suff cits'
1436− (c:cits, raw) <- withRaw $ grouped parseOne
1437− return $ cite (c{ citationMode = mode }:cits)
1438− (rawInline "latex" $ "\\citetext" ++ raw)
1439−
1440−-- tables
1441−
1442−parseAligns :: PandocMonad m => LP m [(Alignment, Double, (String, String))]
1443−parseAligns = try $ do
1444− bgroup
1445− let maybeBar = skipMany $ sp <|> () <$ char '|' <|> () <$ (char '@' >> braced)
1446− maybeBar
1447− let cAlign = AlignCenter <$ char 'c'
1448− let lAlign = AlignLeft <$ char 'l'
1449− let rAlign = AlignRight <$ char 'r'
1450− let parAlign = AlignLeft <$ char 'p'
1451− -- algins from tabularx
1452− let xAlign = AlignLeft <$ char 'X'
1453− let mAlign = AlignLeft <$ char 'm'
1454− let bAlign = AlignLeft <$ char 'b'
1455− let alignChar = cAlign <|> lAlign <|> rAlign <|> parAlign
1456− <|> xAlign <|> mAlign <|> bAlign
1457− let alignPrefix = char '>' >> braced
1458− let alignSuffix = char '<' >> braced
1459− let colWidth = try $ do
1460− char '{'
1461− ds <- many1 (oneOf "0123456789.")
1462− spaces
1463− string "\\linewidth"
1464− char '}'
1465− case safeRead ds of
1466− Just w -> return w
1467− Nothing -> return 0.0
1468− let alignSpec = do
1469− spaces
1470− pref <- option "" alignPrefix
1471− spaces
1472− al <- alignChar
1473− width <- colWidth <|> option 0.0 (do s <- braced
1474− pos <- getPosition
1475− report $ SkippedContent s pos
1476− return 0.0)
1477− spaces
1478− suff <- option "" alignSuffix
1479− return (al, width, (pref, suff))
1480− aligns' <- sepEndBy alignSpec maybeBar
1481− spaces
1482− egroup
1483− spaces
1484− return $ aligns'
1485−
1486−hline :: PandocMonad m => LP m ()
1487−hline = try $ do
1488− spaces'
1489− controlSeq "hline" <|>
1490− -- booktabs rules:
1491− controlSeq "toprule" <|>
1492− controlSeq "bottomrule" <|>
1493− controlSeq "midrule" <|>
1494− controlSeq "endhead" <|>
1495− controlSeq "endfirsthead"
1496− spaces'
1497− optional $ bracketed (many1 (satisfy (/=']')))
1498− return ()
1428+blocks :: PandocMonad m => LP m Blocks
1429+blocks = mconcat <$> many block
14991430
1500−lbreak :: PandocMonad m => LP m ()
1501−lbreak = () <$ try (spaces' *>
1502− (controlSeq "\\" <|> controlSeq "tabularnewline") <*
1503− spaces')
1504−
1505−amp :: PandocMonad m => LP m ()
1506−amp = () <$ try (spaces' *> char '&' <* spaces')
1507−
1508−parseTableRow :: PandocMonad m
1509− => String -- ^ table environment name
1510− -> [(String, String)] -- ^ pref/suffixes
1511− -> LP m [Blocks]
1512−parseTableRow envname prefsufs = try $ do
1513− let cols = length prefsufs
1514− let tableCellRaw = concat <$> many
1515− (do notFollowedBy amp
1516− notFollowedBy lbreak
1517− notFollowedBy $ () <$ try (string ("\\end{" ++ envname ++ "}"))
1518− many1 (noneOf "&%\n\r\\")
1519− <|> try (string "\\&")
1520− <|> count 1 anyChar)
1521− let plainify bs = case toList bs of
1522− [Para ils] -> plain (fromList ils)
1523− _ -> bs
1524− rawcells <- sepBy1 tableCellRaw amp
1525− guard $ length rawcells == cols
1526− let rawcells' = zipWith (\c (p, s) -> p ++ trim c ++ s) rawcells prefsufs
1527− let tableCell = plainify <$> blocks
1528− cells' <- mapM (parseFromString' tableCell) rawcells'
1529− let numcells = length cells'
1530− guard $ numcells <= cols && numcells >= 1
1531− guard $ cells' /= [mempty]
1532− -- note: a & b in a three-column table leaves an empty 3rd cell:
1533− let cells'' = cells' ++ replicate (cols - numcells) mempty
1534− spaces'
1535− return cells''
1536−
1537−spaces' :: PandocMonad m => LP m ()
1538−spaces' = spaces *> skipMany (comment *> spaces)
1539−
1540−simpTable :: PandocMonad m => String -> Bool -> LP m Blocks
1541−simpTable envname hasWidthParameter = try $ do
1542− when hasWidthParameter $ () <$ (spaces' >> tok)
1543− skipopts
1544− colspecs <- parseAligns
1545− let (aligns, widths, prefsufs) = unzip3 colspecs
1546− let cols = length colspecs
1547− optional $ controlSeq "caption" *> skipopts *> setCaption
1548− optional lbreak
1549− spaces'
1550− skipMany hline
1551− spaces'
1552− header' <- option [] $ try (parseTableRow envname prefsufs <*
1553− lbreak <* many1 hline)
1554− spaces'
1555− rows <- sepEndBy (parseTableRow envname prefsufs)
1556− (lbreak <* optional (skipMany hline))
1557− spaces'
1558− optional $ controlSeq "caption" *> skipopts *> setCaption
1559− optional lbreak
1560− spaces'
1561− let header'' = if null header'
1562− then replicate cols mempty
1563− else header'
1564− lookAhead $ controlSeq "end" -- make sure we're at end
1565− return $ table mempty (zip aligns widths) header'' rows
1566−
1567−removeDoubleQuotes :: String -> String
1568−removeDoubleQuotes ('"':xs) =
1569− case reverse xs of
1570− '"':ys -> reverse ys
1571− _ -> '"':xs
1572−removeDoubleQuotes xs = xs
1431+{-
1432+-- graphicsPath :: PandocMonad m => LP m Blocks
1433+-- graphicsPath = do
1434+-- ps <- bgroup *> (manyTill braced egroup)
1435+-- getResourcePath >>= setResourcePath . (++ ps)
1436+-- return mempty
1437+--
1438+-- addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()
1439+-- addMeta field val = updateState $ \st ->
1440+-- st{ sMeta = addMetaField field val $ sMeta st }
1441+--
1442+-- splitBibs :: String -> [Inlines]
1443+-- splitBibs = map (str . flip replaceExtension "bib" . trim) . splitBy (==',')
1444+--
1445+-- setCaption :: PandocMonad m => LP m Blocks
1446+-- setCaption = do
1447+-- ils <- tok
1448+-- mblabel <- option Nothing $
1449+-- try $ spaces' >> controlSeq "label" >> (Just <$> tok)
1450+-- let ils' = case mblabel of
1451+-- Just lab -> ils <> spanWith
1452+-- ("",[],[("data-label", stringify lab)]) mempty
1453+-- Nothing -> ils
1454+-- updateState $ \st -> st{ stateCaption = Just ils' }
1455+-- return mempty
1456+--
1457+-- resetCaption :: PandocMonad m => LP m ()
1458+-- resetCaption = updateState $ \st -> st{ stateCaption = Nothing }
1459+--
1460+-- mkImage :: PandocMonad m => [(String, String)] -> String -> LP m Inlines
1461+-- mkImage options src = do
1462+-- let replaceTextwidth (k,v) = case numUnit v of
1463+-- Just (num, "\\textwidth") -> (k, showFl (num * 100) ++ "%")
1464+-- _ -> (k, v)
1465+-- let kvs = map replaceTextwidth $ filter (\(k,_) -> k `elem` ["width", "height"]) options
1466+-- let attr = ("",[], kvs)
1467+-- let alt = str "image"
1468+-- case takeExtension src of
1469+-- "" -> do
1470+-- defaultExt <- getOption readerDefaultImageExtension
1471+-- return $ imageWith attr (addExtension src defaultExt) "" alt
1472+-- _ -> return $ imageWith attr src "" alt
1473+--
1474+-- inNote :: Inlines -> Inlines
1475+-- inNote ils =
1476+-- note $ para $ ils <> str "."
1477+--
1478+-
1479+-- -- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"
1480+-- dosiunitx :: PandocMonad m => LP m Inlines
1481+-- dosiunitx = do
1482+-- skipopts
1483+-- value <- tok
1484+-- valueprefix <- option "" $ char '[' >> (mconcat <$> manyTill tok (char ']'))
1485+-- unit <- tok
1486+-- let emptyOr160 "" = ""
1487+-- emptyOr160 _ = "\160"
1488+-- return . mconcat $ [valueprefix,
1489+-- emptyOr160 valueprefix,
1490+-- value,
1491+-- emptyOr160 unit,
1492+-- unit]
1493+--
1494+-- skipangles :: PandocMonad m => LP m ()
1495+-- skipangles = skipMany rawangle
1496+--
1497+-- inlineText :: PandocMonad m => LP m Inlines
1498+-- inlineText = str <$> many1 inlineChar
1499+--
1500+-- inlineChar :: PandocMonad m => LP m Char
1501+-- inlineChar = noneOf "\\$%&~#{}^'`\"‘’“”-[] \t\n"
1502+--
1503+--
1504+-- inlineEnvironment :: PandocMonad m => LP m Inlines
1505+-- inlineEnvironment = try $ do
1506+-- controlSeq "begin"
1507+-- name <- braced
1508+-- M.findWithDefault mzero name inlineEnvironments
1509+--
1510+--
1511+-- rawVerbEnv :: PandocMonad m => String -> LP m Blocks
1512+-- rawVerbEnv name = do
1513+-- pos <- getPosition
1514+-- (_, raw) <- withRaw $ verbEnv name
1515+-- let raw' = "\\begin{tikzpicture}" ++ raw
1516+-- exts <- getOption readerExtensions
1517+-- let parseRaw = extensionEnabled Ext_raw_tex exts
1518+-- if parseRaw
1519+-- then return $ rawBlock "latex" raw'
1520+-- else do
1521+-- report $ SkippedContent raw' pos
1522+-- return mempty
1523+--
1524+-- ----
1525+--
1526+-- alltt :: PandocMonad m => String -> LP m Blocks
1527+-- alltt t = walk strToCode <$> parseFromString' blocks
1528+-- (substitute " " "\\ " $ substitute "%" "\\%" $
1529+-- intercalate "\\\\\n" $ lines t)
1530+-- where strToCode (Str s) = Code nullAttr s
1531+-- strToCode x = x
1532+--
1533+-- rawLaTeXBlock :: PandocMonad m => ParserT String LaTeXState String
1534+-- rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))
1535+--
1536+-- rawLaTeXInline :: PandocMonad m => ParserT String LaTeXState Inline
1537+-- rawLaTeXInline = do
1538+-- raw <- (snd <$> withRaw inlineCommand)
1539+-- <|> (snd <$> withRaw inlineEnvironment)
1540+-- <|> (snd <$> withRaw blockCommand)
1541+-- RawInline "latex" <$> applyMacros' raw
1542+--
1543+-- addImageCaption :: PandocMonad m => Blocks -> LP m Blocks
1544+-- addImageCaption = walkM go
1545+-- where go (Image attr alt (src,tit))
1546+-- | not ("fig:" `isPrefixOf` tit) = do
1547+-- mbcapt <- stateCaption <$> getState
1548+-- return $ case mbcapt of
1549+-- Just ils -> Image attr (toList ils) (src, "fig:" ++ tit)
1550+-- Nothing -> Image attr alt (src,tit)
1551+-- go x = return x
1552+--
1553+-- addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
1554+-- addTableCaption = walkM go
1555+-- where go (Table c als ws hs rs) = do
1556+-- mbcapt <- stateCaption <$> getState
1557+-- return $ case mbcapt of
1558+-- Just ils -> Table (toList ils) als ws hs rs
1559+-- Nothing -> Table c als ws hs rs
1560+-- go x = return x
1561+--
1562+--
1563+-- figure :: PandocMonad m => LP m Blocks
1564+-- figure = try $ do
1565+-- resetCaption
1566+-- blocks >>= addImageCaption
1567+--
1568+-- letterContents :: PandocMonad m => LP m Blocks
1569+-- letterContents = do
1570+-- bs <- blocks
1571+-- st <- getState
1572+-- -- add signature (author) and address (title)
1573+-- let addr = case lookupMeta "address" (sMeta st) of
1574+-- Just (MetaBlocks [Plain xs]) ->
1575+-- para $ trimInlines $ fromList xs
1576+-- _ -> mempty
1577+-- return $ addr <> bs -- sig added by \closing
1578+--
1579+--
1580+-- item :: PandocMonad m => LP m Blocks
1581+-- item = blocks *> controlSeq "item" *> skipopts *> blocks
1582+--
1583+-- looseItem :: PandocMonad m => LP m Blocks
1584+-- looseItem = do
1585+-- ctx <- stateParserContext `fmap` getState
1586+-- if ctx == ListItemState
1587+-- then mzero
1588+-- else return mempty
1589+--
1590+-- descItem :: PandocMonad m => LP m (Inlines, [Blocks])
1591+-- descItem = do
1592+-- blocks -- skip blocks before item
1593+-- controlSeq "item"
1594+-- optional sp
1595+-- ils <- opt
1596+-- bs <- blocks
1597+-- return (ils, [bs])
1598+--
1599+--
1600+-- listenv :: PandocMonad m => String -> LP m a -> LP m a
1601+-- listenv name p = try $ do
1602+-- oldCtx <- stateParserContext `fmap` getState
1603+-- updateState $ \st -> st{ stateParserContext = ListItemState }
1604+-- res <- env name p
1605+-- updateState $ \st -> st{ stateParserContext = oldCtx }
1606+-- return res
1607+--
1608+-- mathEnvWith :: PandocMonad m
1609+-- => (Inlines -> a) -> Maybe String -> String -> LP m a
1610+-- mathEnvWith f innerEnv name = f <$> mathDisplay (inner <$> mathEnv name)
1611+-- where inner x = case innerEnv of
1612+-- Nothing -> x
1613+-- Just y -> "\\begin{" ++ y ++ "}\n" ++ x ++
1614+-- "\\end{" ++ y ++ "}"
1615+--
1616+-- mathEnv :: PandocMonad m => String -> LP m String
1617+-- mathEnv name = do
1618+-- skipopts
1619+-- optional blankline
1620+-- let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
1621+-- charMuncher = skipMany comment *>
1622+-- (many1 (noneOf "\\%") <|> try (string "\\%")
1623+-- <|> try (string "\\\\") <|> count 1 anyChar)
1624+-- res <- concat <$> manyTill charMuncher endEnv
1625+-- return $ stripTrailingNewlines res
1626+--
1627+-- verbEnv :: PandocMonad m => String -> LP m String
1628+-- verbEnv name = do
1629+-- skipopts
1630+-- optional blankline
1631+-- let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
1632+-- charMuncher = anyChar
1633+-- res <- manyTill charMuncher endEnv
1634+-- return $ stripTrailingNewlines res
1635+--
1636+-- fancyverbEnv :: PandocMonad m => String -> LP m Blocks
1637+-- fancyverbEnv name = do
1638+-- options <- option [] keyvals
1639+-- let kvs = [ (if k == "firstnumber"
1640+-- then "startFrom"
1641+-- else k, v) | (k,v) <- options ]
1642+-- let classes = [ "numberLines" |
1643+-- lookup "numbers" options == Just "left" ]
1644+-- let attr = ("",classes,kvs)
1645+-- codeBlockWith attr <$> verbEnv name
1646+--
1647+-- orderedList' :: PandocMonad m => LP m Blocks
1648+-- orderedList' = try $ do
1649+-- optional sp
1650+-- (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $
1651+-- try $ char '[' *> anyOrderedListMarker <* char ']'
1652+-- spaces
1653+-- optional $ try $ controlSeq "setlength" *> grouped (controlSeq "itemindent") *> braced
1654+-- spaces
1655+-- start <- option 1 $ try $ do controlSeq "setcounter"
1656+-- grouped (string "enum" *> many1 (oneOf "iv"))
1657+-- optional sp
1658+-- num <- grouped (many1 digit)
1659+-- spaces
1660+-- return (read num + 1 :: Int)
1661+-- bs <- listenv "enumerate" (many item)
1662+-- return $ orderedListWith (start, style, delim) bs
1663+--
1664+-- paragraph :: PandocMonad m => LP m Blocks
1665+-- paragraph = do
1666+-- x <- trimInlines . mconcat <$> many1 inline
1667+-- if x == mempty
1668+-- then return mempty
1669+-- else return $ para x
1670+--
1671+-- preamble :: PandocMonad m => LP m Blocks
1672+-- preamble = mempty <$> manyTill preambleBlock beginDoc
1673+-- where beginDoc = lookAhead $ try $ controlSeq "begin" *> string "{document}"
1674+-- preambleBlock = void comment
1675+-- <|> void sp
1676+-- <|> void blanklines
1677+-- <|> void include
1678+-- <|> void macro
1679+-- <|> void blockCommand
1680+-- <|> void anyControlSeq
1681+-- <|> void braced
1682+-- <|> void anyChar
1683+--
1684+-- -------
1685+--
1686+-- -- citations
1687+--
1688+-- addPrefix :: [Inline] -> [Citation] -> [Citation]
1689+-- addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks
1690+-- addPrefix _ _ = []
1691+--
1692+-- addSuffix :: [Inline] -> [Citation] -> [Citation]
1693+-- addSuffix s ks@(_:_) =
1694+-- let k = last ks
1695+-- in init ks ++ [k {citationSuffix = citationSuffix k ++ s}]
1696+-- addSuffix _ _ = []
1697+--
1698+-- simpleCiteArgs :: PandocMonad m => LP m [Citation]
1699+-- simpleCiteArgs = try $ do
1700+-- first <- optionMaybe $ toList <$> opt
1701+-- second <- optionMaybe $ toList <$> opt
1702+-- keys <- try $ bgroup *> (manyTill citationLabel egroup)
1703+-- let (pre, suf) = case (first , second ) of
1704+-- (Just s , Nothing) -> (mempty, s )
1705+-- (Just s , Just t ) -> (s , t )
1706+-- _ -> (mempty, mempty)
1707+-- conv k = Citation { citationId = k
1708+-- , citationPrefix = []
1709+-- , citationSuffix = []
1710+-- , citationMode = NormalCitation
1711+-- , citationHash = 0
1712+-- , citationNoteNum = 0
1713+-- }
1714+-- return $ addPrefix pre $ addSuffix suf $ map conv keys
1715+--
1716+-- citationLabel :: PandocMonad m => LP m String
1717+-- citationLabel = optional sp *>
1718+-- (many1 (satisfy isBibtexKeyChar)
1719+-- <* optional sp
1720+-- <* optional (char ',')
1721+-- <* optional sp)
1722+-- where isBibtexKeyChar c = isAlphaNum c || c `elem` (".:;?!`'()/*@_+=-[]" :: String)
1723+--
1724+-- cites :: PandocMonad m => CitationMode -> Bool -> LP m [Citation]
1725+-- cites mode multi = try $ do
1726+-- cits <- if multi
1727+-- then many1 simpleCiteArgs
1728+-- else count 1 simpleCiteArgs
1729+-- let cs = concat cits
1730+-- return $ case mode of
1731+-- AuthorInText -> case cs of
1732+-- (c:rest) -> c {citationMode = mode} : rest
1733+-- [] -> []
1734+-- _ -> map (\a -> a {citationMode = mode}) cs
1735+--
1736+-- citation :: PandocMonad m => String -> CitationMode -> Bool -> LP m Inlines
1737+-- citation name mode multi = do
1738+-- (c,raw) <- withRaw $ cites mode multi
1739+-- return $ cite c (rawInline "latex" $ "\\" ++ name ++ raw)
1740+--
1741+-- complexNatbibCitation :: PandocMonad m => CitationMode -> LP m Inlines
1742+-- complexNatbibCitation mode = try $ do
1743+-- let ils = (toList . trimInlines . mconcat) <$>
1744+-- many (notFollowedBy (oneOf "\\};") >> inline)
1745+-- let parseOne = try $ do
1746+-- skipSpaces
1747+-- pref <- ils
1748+-- cit' <- inline -- expect a citation
1749+-- let citlist = toList cit'
1750+-- cits' <- case citlist of
1751+-- [Cite cs _] -> return cs
1752+-- _ -> mzero
1753+-- suff <- ils
1754+-- skipSpaces
1755+-- optional $ char ';'
1756+-- return $ addPrefix pref $ addSuffix suff cits'
1757+-- (c:cits, raw) <- withRaw $ grouped parseOne
1758+-- return $ cite (c{ citationMode = mode }:cits)
1759+-- (rawInline "latex" $ "\\citetext" ++ raw)
1760+--
1761+-- -- tables
1762+--
1763+-- parseAligns :: PandocMonad m => LP m [(Alignment, Double, (String, String))]
1764+-- parseAligns = try $ do
1765+-- bgroup
1766+-- let maybeBar = skipMany $ sp <|> () <$ char '|' <|> () <$ (char '@' >> braced)
1767+-- maybeBar
1768+-- let cAlign = AlignCenter <$ char 'c'
1769+-- let lAlign = AlignLeft <$ char 'l'
1770+-- let rAlign = AlignRight <$ char 'r'
1771+-- let parAlign = AlignLeft <$ char 'p'
1772+-- -- algins from tabularx
1773+-- let xAlign = AlignLeft <$ char 'X'
1774+-- let mAlign = AlignLeft <$ char 'm'
1775+-- let bAlign = AlignLeft <$ char 'b'
1776+-- let alignChar = cAlign <|> lAlign <|> rAlign <|> parAlign
1777+-- <|> xAlign <|> mAlign <|> bAlign
1778+-- let alignPrefix = char '>' >> braced
1779+-- let alignSuffix = char '<' >> braced
1780+-- let colWidth = try $ do
1781+-- char '{'
1782+-- ds <- many1 (oneOf "0123456789.")
1783+-- spaces
1784+-- string "\\linewidth"
1785+-- char '}'
1786+-- case safeRead ds of
1787+-- Just w -> return w
1788+-- Nothing -> return 0.0
1789+-- let alignSpec = do
1790+-- spaces
1791+-- pref <- option "" alignPrefix
1792+-- spaces
1793+-- al <- alignChar
1794+-- width <- colWidth <|> option 0.0 (do s <- braced
1795+-- pos <- getPosition
1796+-- report $ SkippedContent s pos
1797+-- return 0.0)
1798+-- spaces
1799+-- suff <- option "" alignSuffix
1800+-- return (al, width, (pref, suff))
1801+-- aligns' <- sepEndBy alignSpec maybeBar
1802+-- spaces
1803+-- egroup
1804+-- spaces
1805+-- return $ aligns'
1806+--
1807+-- hline :: PandocMonad m => LP m ()
1808+-- hline = try $ do
1809+-- spaces'
1810+-- controlSeq "hline" <|>
1811+-- -- booktabs rules:
1812+-- controlSeq "toprule" <|>
1813+-- controlSeq "bottomrule" <|>
1814+-- controlSeq "midrule" <|>
1815+-- controlSeq "endhead" <|>
1816+-- controlSeq "endfirsthead"
1817+-- spaces'
1818+-- optional $ bracketed (many1 (satisfy (/=']')))
1819+-- return ()
1820+--
1821+-- lbreak :: PandocMonad m => LP m ()
1822+-- lbreak = () <$ try (spaces' *>
1823+-- (controlSeq "\\" <|> controlSeq "tabularnewline") <*
1824+-- spaces')
1825+--
1826+-- amp :: PandocMonad m => LP m ()
1827+-- amp = () <$ try (spaces' *> char '&' <* spaces')
1828+--
1829+-- parseTableRow :: PandocMonad m
1830+-- => String -- ^ table environment name
1831+-- -> [(String, String)] -- ^ pref/suffixes
1832+-- -> LP m [Blocks]
1833+-- parseTableRow envname prefsufs = try $ do
1834+-- let cols = length prefsufs
1835+-- let tableCellRaw = concat <$> many
1836+-- (do notFollowedBy amp
1837+-- notFollowedBy lbreak
1838+-- notFollowedBy $ () <$ try (string ("\\end{" ++ envname ++ "}"))
1839+-- many1 (noneOf "&%\n\r\\")
1840+-- <|> try (string "\\&")
1841+-- <|> count 1 anyChar)
1842+-- let plainify bs = case toList bs of
1843+-- [Para ils] -> plain (fromList ils)
1844+-- _ -> bs
1845+-- rawcells <- sepBy1 tableCellRaw amp
1846+-- guard $ length rawcells == cols
1847+-- let rawcells' = zipWith (\c (p, s) -> p ++ trim c ++ s) rawcells prefsufs
1848+-- let tableCell = plainify <$> blocks
1849+-- cells' <- mapM (parseFromString' tableCell) rawcells'
1850+-- let numcells = length cells'
1851+-- guard $ numcells <= cols && numcells >= 1
1852+-- guard $ cells' /= [mempty]
1853+-- -- note: a & b in a three-column table leaves an empty 3rd cell:
1854+-- let cells'' = cells' ++ replicate (cols - numcells) mempty
1855+-- spaces'
1856+-- return cells''
1857+--
1858+-- spaces' :: PandocMonad m => LP m ()
1859+-- spaces' = spaces *> skipMany (comment *> spaces)
1860+--
1861+-- simpTable :: PandocMonad m => String -> Bool -> LP m Blocks
1862+-- simpTable envname hasWidthParameter = try $ do
1863+-- when hasWidthParameter $ () <$ (spaces' >> tok)
1864+-- skipopts
1865+-- colspecs <- parseAligns
1866+-- let (aligns, widths, prefsufs) = unzip3 colspecs
1867+-- let cols = length colspecs
1868+-- optional $ controlSeq "caption" *> skipopts *> setCaption
1869+-- optional lbreak
1870+-- spaces'
1871+-- skipMany hline
1872+-- spaces'
1873+-- header' <- option [] $ try (parseTableRow envname prefsufs <*
1874+-- lbreak <* many1 hline)
1875+-- spaces'
1876+-- rows <- sepEndBy (parseTableRow envname prefsufs)
1877+-- (lbreak <* optional (skipMany hline))
1878+-- spaces'
1879+-- optional $ controlSeq "caption" *> skipopts *> setCaption
1880+-- optional lbreak
1881+-- spaces'
1882+-- let header'' = if null header'
1883+-- then replicate cols mempty
1884+-- else header'
1885+-- lookAhead $ controlSeq "end" -- make sure we're at end
1886+-- return $ table mempty (zip aligns widths) header'' rows
1887+--
1888+-- removeDoubleQuotes :: String -> String
1889+-- removeDoubleQuotes ('"':xs) =
1890+-- case reverse xs of
1891+-- '"':ys -> reverse ys
1892+-- _ -> '"':xs
1893+-- removeDoubleQuotes xs = xs
1894+--
1895+-- inputListing :: PandocMonad m => LP m Blocks
1896+-- inputListing = do
1897+-- pos <- getPosition
1898+-- options <- option [] keyvals
1899+-- f <- filter (/='"') <$> braced
1900+-- dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
1901+-- mbCode <- readFileFromDirs dirs f
1902+-- codeLines <- case mbCode of
1903+-- Just s -> return $ lines s
1904+-- Nothing -> do
1905+-- report $ CouldNotLoadIncludeFile f pos
1906+-- return []
1907+-- let (ident,classes,kvs) = parseListingsOptions options
1908+-- let language = case lookup "language" options >>= fromListingsLanguage of
1909+-- Just l -> [l]
1910+-- Nothing -> take 1 $ languagesByExtension (takeExtension f)
1911+-- let firstline = fromMaybe 1 $ lookup "firstline" options >>= safeRead
1912+-- let lastline = fromMaybe (length codeLines) $
1913+-- lookup "lastline" options >>= safeRead
1914+-- let codeContents = intercalate "\n" $ take (1 + lastline - firstline) $
1915+-- drop (firstline - 1) codeLines
1916+-- return $ codeBlockWith (ident,ordNub (classes ++ language),kvs) codeContents
1917+--
1918+-- parseListingsOptions :: [(String, String)] -> Attr
1919+-- parseListingsOptions options =
1920+-- let kvs = [ (if k == "firstnumber"
1921+-- then "startFrom"
1922+-- else k, v) | (k,v) <- options ]
1923+-- classes = [ "numberLines" |
1924+-- lookup "numbers" options == Just "left" ]
1925+-- ++ maybeToList (lookup "language" options
1926+-- >>= fromListingsLanguage)
1927+-- in (fromMaybe "" (lookup "label" options), classes, kvs)
1928+-}