@@ -38,8 +38,9 @@ module Text.Pandoc.Readers.LaTeX ( readLaTeX,
3838import Control.Applicative (many, optional, (<|>))
3939import Control.Monad
4040import Control.Monad.Except (throwError)
41−import Data.Char (chr, isAlphaNum, isLetter, ord)
41+import Data.Char (chr, isAlphaNum, isLetter, ord, isDigit)
4242import Data.Text (Text, unpack)
43+import qualified Data.Text as T
4344import Data.List (intercalate, isPrefixOf)
4445import qualified Data.Map as M
4546import Data.Maybe (fromMaybe, maybeToList)
@@ -47,15 +48,21 @@ import Safe (minimumDef)
4748import System.FilePath (addExtension, replaceExtension, takeExtension)
4849import Text.Pandoc.Builder
4950import Text.Pandoc.Class (PandocMonad, PandocPure, lookupEnv, readFileFromDirs,
50− report, setResourcePath, getResourcePath)
51+ report, setResourcePath, getResourcePath,
52+ runIOorExplode, PandocIO)
5153import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)
5254import Text.Pandoc.ImageSize (numUnit, showFl)
5355import Text.Pandoc.Logging
5456import Text.Pandoc.Options
55−import Text.Pandoc.Parsing hiding (many, mathDisplay, mathInline, optional,
56− space, (<|>))
57+import Text.Pandoc.Parsing hiding (many, optional, withRaw,
58+ mathInline, mathDisplay,
59+ space, (<|>), spaces, blankline)
5760import Text.Pandoc.Shared
5861import Text.Pandoc.Walk
62+import Text.Pandoc.Error (PandocError(PandocParsecError))
63+
64+import Text.Pandoc.Extensions (getDefaultExtensions)
65+import Debug.Trace (traceShowId)
5966
6067-- | Parse LaTeX from string and return 'Pandoc' document.
6168readLaTeX :: PandocMonad m
@@ -63,11 +70,11 @@ readLaTeX :: PandocMonad m
6370 -> Text -- ^ String to parse (assumes @'\n'@ line endings)
6471 -> m Pandoc
6572readLaTeX opts ltx = do
66− parsed <- readWithM parseLaTeX def{ stateOptions = opts }
67− (unpack (crFilter ltx))
73+ parsed <- runParserT parseLaTeX def{ stateOptions = opts } "source"
74+ (tokenize (crFilter ltx))
6875 case parsed of
6976 Right result -> return result
70− Left e -> throwError e
77+ Left e -> throwError $ PandocParsecError (T.unpack ltx) e
7178
7279parseLaTeX :: PandocMonad m => LP m Pandoc
7380parseLaTeX = do
@@ -88,177 +95,249 @@ parseLaTeX = do
8895 else id) doc'
8996 return $ Pandoc meta bs'
9097
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
98+testParser :: LP PandocIO a -> Text -> IO a
99+testParser p t = do
100+ res <- runIOorExplode (runParserT p defaultParserState{
101+ stateOptions = def{ readerExtensions =
102+ getDefaultExtensions "latex" }} "name" (tokenize t))
103+ case res of
104+ Left e -> error (show e)
105+ Right r -> return r
106+
107+type LP m = ParserT [Tok] ParserState m
108+
109+rawLaTeXBlock :: PandocMonad m => ParserT String ParserState m String
110+rawLaTeXBlock = mzero
111+
112+rawLaTeXInline :: PandocMonad m => ParserT String ParserState m Inline
113+rawLaTeXInline = mzero
114+
115+inlineCommand :: PandocMonad m => ParserT String ParserState m Inlines
116+inlineCommand = mzero
117+
118+data TokType = CtrlSeq | Spaces | Newline | Symbol | Word | Comment |
119+ Esc1 | Esc2
120+ deriving (Eq, Ord, Show)
121+
122+data Tok = Tok (Line, Column) TokType Text
123+ deriving (Eq, Ord, Show)
124+
125+tokenize :: Text -> [Tok]
126+tokenize = totoks (1, 1)
127+
128+totoks :: (Line, Column) -> Text -> [Tok]
129+totoks (lin,col) t =
130+ case T.uncons t of
131+ Nothing -> []
132+ Just (c, rest)
133+ | c == '\n' ->
134+ Tok (lin, col) Newline (T.singleton '\n')
135+ : totoks (lin + 1,1) rest
136+ | isSpaceOrTab c ->
137+ let (sps, rest') = T.span isSpaceOrTab t
138+ in Tok (lin, col) Spaces sps
139+ : totoks (lin, col + T.length sps) rest'
140+ | isAlphaNum c ->
141+ let (ws, rest') = T.span isAlphaNum t
142+ in Tok (lin, col) Word ws
143+ : totoks (lin, col + T.length ws) rest'
144+ | c == '%' ->
145+ let (cs, rest') = T.break (== '\n') rest
146+ in Tok (lin, col) Comment (T.singleton '%' <> cs)
147+ : totoks (lin, col + 1 + T.length cs) rest'
148+ | c == '\\' ->
149+ case T.uncons rest of
150+ Nothing -> [Tok (lin, col) Symbol (T.singleton c)]
151+ Just (d, rest')
152+ | isLetter d ->
153+ let (ws, rest'') = T.span isLetter rest
154+ in Tok (lin, col) CtrlSeq (T.singleton '\\' <> ws)
155+ : totoks (lin, col + 1 + T.length ws) rest''
156+ | d == '\t' || d == '\n' ->
157+ Tok (lin, col) Symbol (T.singleton '\\')
158+ : totoks (lin, col + 1) rest
159+ | otherwise ->
160+ Tok (lin, col) CtrlSeq (T.pack [c,d])
161+ : totoks (lin, col + 2) rest'
162+ | c == '^' ->
163+ case T.uncons rest of
164+ Just ('^', rest') ->
165+ case T.uncons rest' of
166+ Just (d, rest'')
167+ | isLowerHex d ->
168+ case T.uncons rest'' of
169+ Just (e, rest''') | isLowerHex e ->
170+ Tok (lin, col) Esc2 (T.pack ['^','^',d,e])
171+ : totoks (lin, col + 4) rest'''
172+ _ ->
173+ Tok (lin, col) Esc1 (T.pack ['^','^',d])
174+ : totoks (lin, col + 3) rest''
175+ | d < '\128' ->
176+ Tok (lin, col) Esc1 (T.pack ['^','^',d])
177+ : totoks (lin, col + 3) rest''
178+ _ -> [Tok (lin, col) Symbol (T.singleton '^'),
179+ Tok (lin, col + 1) Symbol (T.singleton '^')]
180+ _ -> Tok (lin, col) Symbol (T.singleton '^')
181+ : totoks (lin, col + 1) rest
182+ | otherwise ->
183+ Tok (lin, col) Symbol (T.singleton c) : totoks (lin, col + 1) rest
184+
185+ where isSpaceOrTab ' ' = True
186+ isSpaceOrTab '\t' = True
187+ isSpaceOrTab _ = False
188+
189+isLowerHex :: Char -> Bool
190+isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
191+
192+untokenize :: [Tok] -> Text
193+untokenize = mconcat . map untoken
194+
195+untoken :: Tok -> Text
196+untoken (Tok _ _ t) = t
197+
198+satisfyTok :: Monad m
199+ => (Tok -> Bool)
200+ -> ParserT [Tok] u m Tok
201+satisfyTok f = tokenPrim (T.unpack . untoken) updatePos matcher
202+ where matcher t | f t = Just t
203+ | otherwise = Nothing
204+ updatePos :: SourcePos -> Tok -> [Tok] -> SourcePos
205+ updatePos spos _ (Tok (lin,col) _ _ : _) =
206+ setSourceColumn (setSourceLine spos lin) col
207+ updatePos spos _ [] = spos
208+
209+anyControlSeq :: PandocMonad m => LP m Tok
210+anyControlSeq = satisfyTok isCtrlSeq <* optional sp
211+ where isCtrlSeq (Tok _ CtrlSeq _) = True
212+ isCtrlSeq _ = False
213+
214+anySymbol :: PandocMonad m => LP m Tok
215+anySymbol = satisfyTok isSym
216+ where isSym (Tok _ Symbol _) = True
217+ isSym _ = False
218+
219+spaces :: PandocMonad m => LP m ()
220+spaces = skipMany (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
221+
222+spaces1 :: PandocMonad m => LP m ()
223+spaces1 = skipMany1 (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
224+
225+tokTypeIn :: [TokType] -> Tok -> Bool
226+tokTypeIn toktypes (Tok _ tt _) = tt `elem` toktypes
227+
228+controlSeq :: PandocMonad m => Text -> LP m Tok
229+controlSeq name = satisfyTok isNamed
230+ where isNamed (Tok _ CtrlSeq n) = n == T.singleton '\\' <> name
231+ isNamed _ = False
232+
233+symbol :: PandocMonad m => Char -> LP m Tok
234+symbol c = satisfyTok isc
235+ where isc (Tok _ Symbol d) = case T.uncons d of
236+ Just (c',_) -> c == c'
237+ _ -> False
238+ isc _ = False
239+
240+symbolIn :: PandocMonad m => [Char] -> LP m Tok
241+symbolIn cs = satisfyTok isInCs
242+ where isInCs (Tok _ Symbol d) = case T.uncons d of
243+ Just (c,_) -> c `elem` cs
244+ _ -> False
245+ isInCs _ = False
117246
118247sp :: PandocMonad m => LP m ()
119248sp = whitespace <|> endline
120249
121250whitespace :: PandocMonad m => LP m ()
122−whitespace = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t')
251+whitespace = () <$ satisfyTok isSpaceTok
252+ where isSpaceTok (Tok _ Spaces _) = True
253+ isSpaceTok _ = False
123254
124−endline :: PandocMonad m => LP m ()
125−endline = try (newline >> lookAhead anyChar >> notFollowedBy blankline)
255+newlineTok :: PandocMonad m => LP m ()
256+newlineTok = () <$ satisfyTok isNewlineTok
126257
127−isLowerHex :: Char -> Bool
128−isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
129−
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)
258+isNewlineTok :: Tok -> Bool
259+isNewlineTok (Tok _ Newline _) = True
260+isNewlineTok _ = False
142261
143262comment :: PandocMonad m => LP m ()
144−comment = do
145− char '%'
146− skipMany (satisfy (/='\n'))
147− optional newline
148− return ()
263+comment = () <$ satisfyTok isCommentTok
264+ where isCommentTok (Tok _ Comment _) = True
265+ isCommentTok _ = False
266+
267+anyTok :: PandocMonad m => LP m Tok
268+anyTok = satisfyTok (const True)
269+
270+endline :: PandocMonad m => LP m ()
271+endline = try $ do
272+ newlineTok
273+ lookAhead anyTok
274+ notFollowedBy blankline
275+
276+blankline :: PandocMonad m => LP m ()
277+blankline = try $ do
278+ skipMany (satisfyTok (tokTypeIn [Spaces, Newline]))
279+ newlineTok
280+
281+primEscape :: PandocMonad m => LP m Char
282+primEscape = do
283+ Tok _ toktype t <- satisfyTok (tokTypeIn [Esc1, Esc2])
284+ case toktype of
285+ Esc1 -> case T.uncons t of
286+ Just (c, _)
287+ | c >= '\64' && c <= '\127' -> return (chr (ord c - 64))
288+ | otherwise -> return (chr (ord c + 64))
289+ Nothing -> fail "Empty content of Esc1"
290+ Esc2 -> case safeRead ('0':'x':T.unpack (T.drop 2 t)) of
291+ Just x -> return (chr x)
292+ Nothing -> fail $ "Could not read: " ++ T.unpack t
293+ _ -> fail "Expected an Esc1 or Esc2 token" -- should not happen
149294
150295bgroup :: PandocMonad m => LP m ()
151296bgroup = try $ do
152− skipMany (spaceChar <|> try (newline <* notFollowedBy blankline))
153− () <$ char '{'
154− <|> () <$ controlSeq "bgroup"
155− <|> () <$ controlSeq "begingroup"
297+ skipMany sp
298+ symbol '{' <|> controlSeq "bgroup" <|> controlSeq "begingroup"
299+ return ()
156300
157301egroup :: PandocMonad m => LP m ()
158−egroup = () <$ char '}'
159− <|> () <$ controlSeq "egroup"
160− <|> () <$ controlSeq "endgroup"
302+egroup = () <$ (symbol '}' <|> controlSeq "egroup" <|> controlSeq "endgroup")
161303
162−grouped :: PandocMonad m => Monoid a => LP m a -> LP m a
304+grouped :: (PandocMonad m, Monoid a) => LP m a -> LP m a
163305grouped parser = try $ do
164306 bgroup
165307 -- first we check for an inner 'grouped', because
166308 -- {{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
309+ try (grouped parser <* egroup) <|> (mconcat <$> manyTill parser egroup)
310+
311+braced :: PandocMonad m => LP m [Tok]
312+braced = try $ do
313+ bgroup
314+ -- {{a,b}} should be parsed the same as {a,b}
315+ try (braced <* egroup) <|> manyTill anyTok egroup
179316
180317bracketed :: 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
318+bracketed parser = try $ do
319+ symbol '['
320+ mconcat <$> manyTill parser (symbol ']')
217321
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 '"')
322+dimenarg :: PandocMonad m => LP m Text
323+dimenarg = try $ do
324+ ch <- option False $ True <$ symbol '='
325+ Tok _ _ s <- satisfyTok isWordTok
326+ guard $ (T.take 2 (T.reverse s)) `elem`
327+ ["pt","pc","in","bp","cm","mm","dd","cc","sp"]
328+ let num = T.take (T.length s - 2) s
329+ guard $ T.length num > 0
330+ guard $ T.all isDigit num
331+ return $ T.pack ['=' | ch] <> s
225332
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 "`\'‘’")
333+-- inline elements:
233334
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])
335+inlineText :: PandocMonad m => LP m Inlines
336+inlineText = (str . T.unpack . untoken) <$> satisfyTok isWordTok
259337
260−inlines :: PandocMonad m => LP m Inlines
261−inlines = mconcat <$> many (notFollowedBy (char '}') *> inline)
338+isWordTok :: Tok -> Bool
339+isWordTok (Tok _ Word _) = True
340+isWordTok _ = False
262341
263342inlineGroup :: PandocMonad m => LP m Inlines
264343inlineGroup = do
@@ -269,460 +348,57 @@ inlineGroup = do
269348 -- we need the span so we can detitlecase bibtex entries;
270349 -- we need to know when something is {C}apitalized
271350
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
284−
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
291−
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
296−
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
310−
311−inBrackets :: Inlines -> Inlines
312−inBrackets x = str "[" <> x <> str "]"
313−
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
322−
323−guardRaw :: PandocMonad m => LP m ()
324−guardRaw = getOption readerExtensions >>= guard . extensionEnabled Ext_raw_tex
325−
326−optargs :: PandocMonad m => LP m String
327−optargs = snd <$> withRaw (skipopts *> skipMany (try $ optional sp *> braced))
328−
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
334−
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
342−
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− ]
416−
417−graphicsPath :: PandocMonad m => LP m Blocks
418−graphicsPath = do
419− ps <- bgroup *> (manyTill braced egroup)
420− getResourcePath >>= setResourcePath . (++ ps)
421− return mempty
422−
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
441−
442−resetCaption :: PandocMonad m => LP m ()
443−resetCaption = updateState $ \st -> st{ stateCaption = Nothing }
444−
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)
455−
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
463−
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
470− 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
491−
492−isBlockCommand :: String -> Bool
493−isBlockCommand s = s `M.member` (blockCommands :: M.Map String (LP PandocPure Blocks))
494−
495−
496−inlineEnvironments :: PandocMonad m => M.Map String (LP m Inlines)
497−inlineEnvironments = M.fromList
498− [ ("displaymath", mathEnvWith id Nothing "displaymath")
499− , ("math", math <$> mathEnv "math")
500− , ("equation", mathEnvWith id Nothing "equation")
501− , ("equation*", mathEnvWith id Nothing "equation*")
502− , ("gather", mathEnvWith id (Just "gathered") "gather")
503− , ("gather*", mathEnvWith id (Just "gathered") "gather*")
504− , ("multline", mathEnvWith id (Just "gathered") "multline")
505− , ("multline*", mathEnvWith id (Just "gathered") "multline*")
506− , ("eqnarray", mathEnvWith id (Just "aligned") "eqnarray")
507− , ("eqnarray*", mathEnvWith id (Just "aligned") "eqnarray*")
508− , ("align", mathEnvWith id (Just "aligned") "align")
509− , ("align*", mathEnvWith id (Just "aligned") "align*")
510− , ("alignat", mathEnvWith id (Just "aligned") "alignat")
511− , ("alignat*", mathEnvWith id (Just "aligned") "alignat*")
512− ]
351+doLHSverb :: PandocMonad m => LP m Inlines
352+doLHSverb =
353+ (codeWith ("",["haskell"],[]) . T.unpack . untokenize)
354+ <$> manyTill (satisfyTok (not . isNewlineTok)) (symbol '|')
513355
514−inlineCommands :: PandocMonad m => M.Map String (LP m Inlines)
515−inlineCommands = M.fromList $
516− [ ("emph", extractSpaces emph <$> tok)
517− , ("textit", extractSpaces emph <$> tok)
518− , ("textsl", extractSpaces emph <$> tok)
519− , ("textsc", extractSpaces smallcaps <$> tok)
520− , ("textsf", extractSpaces (spanWith ("",["sans-serif"],[])) <$> tok)
521− , ("textmd", extractSpaces (spanWith ("",["medium"],[])) <$> tok)
522− , ("textrm", extractSpaces (spanWith ("",["roman"],[])) <$> tok)
523− , ("textup", extractSpaces (spanWith ("",["upright"],[])) <$> tok)
524− , ("texttt", ttfamily)
525− , ("sout", extractSpaces strikeout <$> tok)
526− , ("textsuperscript", extractSpaces superscript <$> tok)
527− , ("textsubscript", extractSpaces subscript <$> tok)
528− , ("textbackslash", lit "\\")
529− , ("backslash", lit "\\")
530− , ("slash", lit "/")
531− , ("textbf", extractSpaces strong <$> tok)
532− , ("textnormal", extractSpaces (spanWith ("",["nodecor"],[])) <$> tok)
533− , ("ldots", lit "…")
534− , ("vdots", lit "\8942")
535− , ("dots", lit "…")
536− , ("mdots", lit "…")
537− , ("sim", lit "~")
538− , ("label", rawInlineOr "label" (inBrackets <$> tok))
539− , ("ref", rawInlineOr "ref" (inBrackets <$> tok))
540− , ("textgreek", tok)
541− , ("sep", lit ",")
542− , ("cref", rawInlineOr "cref" (inBrackets <$> tok)) -- from cleveref.sty
543− , ("(", mathInline $ manyTill anyChar (try $ string "\\)"))
544− , ("[", mathDisplay $ manyTill anyChar (try $ string "\\]"))
545− , ("ensuremath", mathInline braced)
546− , ("texorpdfstring", (\_ x -> x) <$> tok <*> tok)
547− , ("P", lit "¶")
548− , ("S", lit "§")
549− , ("$", lit "$")
550− , ("%", lit "%")
551− , ("&", lit "&")
552− , ("#", lit "#")
553− , ("_", lit "_")
554− , ("{", lit "{")
555− , ("}", lit "}")
556− -- old TeX commands
557− , ("em", extractSpaces emph <$> inlines)
558− , ("it", extractSpaces emph <$> inlines)
559− , ("sl", extractSpaces emph <$> inlines)
560− , ("bf", extractSpaces strong <$> inlines)
561− , ("rm", inlines)
562− , ("itshape", extractSpaces emph <$> inlines)
563− , ("slshape", extractSpaces emph <$> inlines)
564− , ("scshape", extractSpaces smallcaps <$> inlines)
565− , ("bfseries", extractSpaces strong <$> inlines)
566− , ("/", pure mempty) -- italic correction
567− , ("aa", lit "å")
568− , ("AA", lit "Å")
569− , ("ss", lit "ß")
570− , ("o", lit "ø")
571− , ("O", lit "Ø")
572− , ("L", lit "Ł")
573− , ("l", lit "ł")
574− , ("ae", lit "æ")
575− , ("AE", lit "Æ")
576− , ("oe", lit "œ")
577− , ("OE", lit "Œ")
578− , ("pounds", lit "£")
579− , ("euro", lit "€")
580− , ("copyright", lit "©")
581− , ("textasciicircum", lit "^")
582− , ("textasciitilde", lit "~")
583− , ("H", try $ tok >>= accent hungarumlaut)
584− , ("`", option (str "`") $ try $ tok >>= accent grave)
585− , ("'", option (str "'") $ try $ tok >>= accent acute)
586− , ("^", option (str "^") $ try $ tok >>= accent circ)
587− , ("~", option (str "~") $ try $ tok >>= accent tilde)
588− , ("\"", option (str "\"") $ try $ tok >>= accent umlaut)
589− , (".", option (str ".") $ try $ tok >>= accent dot)
590− , ("=", option (str "=") $ try $ tok >>= accent macron)
591− , ("c", option (str "c") $ try $ tok >>= accent cedilla)
592− , ("v", option (str "v") $ try $ tok >>= accent hacek)
593− , ("u", option (str "u") $ try $ tok >>= accent breve)
594− , ("i", lit "i")
595− , ("\\", linebreak <$ (optional (bracketed inline) *> spaces'))
596− , (",", lit "\8198")
597− , ("@", pure mempty)
598− , (" ", lit "\160")
599− , ("ps", pure $ str "PS." <> space)
600− , ("TeX", lit "TeX")
601− , ("LaTeX", lit "LaTeX")
602− , ("bar", lit "|")
603− , ("textless", lit "<")
604− , ("textgreater", lit ">")
605− , ("thanks", note <$> grouped block)
606− , ("footnote", note <$> grouped block)
607− , ("verb", doverb)
608− , ("lstinline", dolstinline)
609− , ("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)
618− , ("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"))
674− , ("hypertarget", braced >> tok)
675− -- siuntix
676− , ("SI", dosiunitx)
677− -- hyphenat
678− , ("bshyp", lit "\\\173")
679− , ("fshyp", lit "/\173")
680− , ("dothyp", lit ".\173")
681− , ("colonhyp", lit ":\173")
682− , ("hyp", lit "-")
683− , ("nohyphens", tok)
684− , ("textnhtt", ttfamily)
685− , ("nhttfamily", ttfamily)
686− -- fontawesome
687− , ("faCheck", lit "\10003")
688− , ("faClose", lit "\10007")
689− ] ++ map ignoreInlines
690− -- these commands will be ignored unless --parse-raw is specified,
691− -- in which case they will appear as raw latex blocks:
692− [ "index"
693− , "hspace"
694− , "vspace"
695− , "newpage"
696− , "clearpage"
697− , "pagebreak"
698− ]
356+lit :: String -> LP m Inlines
357+lit = pure . str
699358
700−ttfamily :: PandocMonad m => LP m Inlines
701−ttfamily = (code . stringify . toList) <$> tok
359+doubleQuote :: PandocMonad m => LP m Inlines
360+doubleQuote = do
361+ quoted' doubleQuoted (try $ count 2 $ symbol '`')
362+ (void $ try $ count 2 $ symbol '\'')
363+ <|> quoted' doubleQuoted ((:[]) <$> symbol '“') (void $ symbol '”')
364+ -- the following is used by babel for localized quotes:
365+ <|> quoted' doubleQuoted (try $ sequence [symbol '"', symbol '`'])
366+ (void $ try $ sequence [symbol '"', symbol '\''])
367+ <|> quoted' doubleQuoted ((:[]) <$> symbol '"')
368+ (void $ symbol '"')
702369
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 [] = ""
370+singleQuote :: PandocMonad m => LP m Inlines
371+singleQuote = do
372+ quoted' singleQuoted ((:[]) <$> symbol '`')
373+ (try $ symbol '\'' >>
374+ notFollowedBy (satisfyTok startsWithLetter))
375+ <|> quoted' singleQuoted ((:[]) <$> symbol '‘')
376+ (try $ symbol '’' >>
377+ notFollowedBy (satisfyTok startsWithLetter))
378+ where startsWithLetter (Tok _ Word t) =
379+ case T.uncons t of
380+ Just (c, _) | isLetter c -> True
381+ _ -> False
382+ startsWithLetter _ = False
383+
384+quoted' :: PandocMonad m
385+ => (Inlines -> Inlines)
386+ -> LP m [Tok]
387+ -> LP m ()
388+ -> LP m Inlines
389+quoted' f starter ender = do
390+ startchs <- (T.unpack . untokenize) <$> starter
391+ smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
392+ if smart
393+ then do
394+ ils <- many (notFollowedBy ender >> inline)
395+ (ender >> return (f (mconcat ils))) <|>
396+ (<> mconcat ils) <$>
397+ lit (case startchs of
398+ "``" -> "“"
399+ "`" -> "‘"
400+ cs -> cs)
401+ else lit startchs
726402
727403enquote :: PandocMonad m => LP m Inlines
728404enquote = do
@@ -734,36 +410,51 @@ enquote = do
734410
735411doverb :: PandocMonad m => LP m Inlines
736412doverb = do
737− marker <- anyChar
738− code <$> manyTill (satisfy (/='\n')) (char marker)
413+ Tok _ Symbol t <- anySymbol
414+ marker <- case T.uncons t of
415+ Just (c, ts) | T.null ts -> return c
416+ _ -> mzero
417+ (code . T.unpack . untokenize) <$> manyTill (verbTok marker) (symbol marker)
418+
419+verbTok :: PandocMonad m => Char -> LP m Tok
420+verbTok stopchar = do
421+ t@(Tok (lin, col) toktype txt) <- satisfyTok (not . isNewlineTok)
422+ case T.findIndex (== stopchar) txt of
423+ Nothing -> return t
424+ Just i -> do
425+ let (t1, t2) = T.splitAt i txt
426+ inp <- getInput
427+ setInput $ traceShowId $ Tok (lin, col + i) Symbol (T.singleton stopchar)
428+ : (totoks (lin, col + i + 1) (T.drop 1 t2)) ++ inp
429+ return $ Tok (lin, col) toktype t1
739430
740431dolstinline :: PandocMonad m => LP m Inlines
741432dolstinline = do
742433 options <- option [] keyvals
743434 let classes = maybeToList $ lookup "language" options >>= fromListingsLanguage
744− marker <- char '{' <|> anyChar
745− codeWith ("",classes,[]) <$> manyTill (satisfy (/='\n')) (char '}' <|> char marker)
746−
747−doLHSverb :: PandocMonad m => LP m Inlines
748−doLHSverb = codeWith ("",["haskell"],[]) <$> manyTill (satisfy (/='\n')) (char '|')
435+ Tok _ Symbol t <- anySymbol
436+ marker <- case T.uncons t of
437+ Just (c, ts) | T.null ts -> return c
438+ _ -> mzero
439+ let stopchar = if marker == '{' then '}' else marker
440+ (codeWith ("",classes,[]) . T.unpack . untokenize) <$>
441+ manyTill (verbTok stopchar) (symbol stopchar)
749442
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]
443+keyval :: PandocMonad m => LP m (String, String)
444+keyval = try $ do
445+ Tok _ Word key <- satisfyTok isWordTok
446+ let isSpecSym (Tok _ Symbol t) = t `elem` [".",":","-","|","\\"]
447+ isSpecSym _ = False
448+ val <- option [] $ do
449+ symbol '='
450+ braced <|> (many1 (satisfyTok isWordTok <|> satisfyTok isSpecSym))
451+ optional sp
452+ optional (symbol ',')
453+ optional sp
454+ return (T.unpack key, T.unpack . untokenize $ val)
764455
765−lit :: String -> LP m Inlines
766−lit = pure . str
456+keyvals :: PandocMonad m => LP m [(String, String)]
457+keyvals = try $ symbol '[' >> manyTill keyval (symbol ']')
767458
768459accent :: (Char -> String) -> Inlines -> LP m Inlines
769460accent f ils =
@@ -971,374 +662,387 @@ breve 'U' = "Ŭ"
971662breve 'u' = "ŭ"
972663breve c = [c]
973664
665+mathDisplay :: [Tok] -> Inlines
666+mathDisplay = displayMath . trim . T.unpack . untokenize
667+-- TODO we shouldn't need applyMacros
668+-- mathDisplay p = displayMath <$> (try p >>= applyMacros' . trim)
669+
670+mathInline :: [Tok] -> Inlines
671+mathInline = math . trim . T.unpack . untokenize
672+-- TODO we shouldn't need applyMacros
673+-- mathInline p = math <$> (try p >>= applyMacros')
674+
675+dollarsMath :: PandocMonad m => LP m Inlines
676+dollarsMath = do
677+ symbol '$'
678+ display <- option False (True <$ symbol '$')
679+ contents <- many1Till anyTok (symbol '$')
680+ when display (() <$ symbol '$')
681+ let constructor = if display then mathDisplay else mathInline
682+ return $ constructor contents
683+
684+inlineCommand' :: PandocMonad m => LP m Inlines
685+inlineCommand' = try $ do
686+ cs@(Tok _ CtrlSeq t) <- anyControlSeq
687+ let name = T.drop 1 t
688+ guard $ name /= "begin" && name /= "end"
689+ mbstar <- option Nothing (Just <$> symbol '*')
690+ let names = name : maybe [] (const [name <> "*"]) mbstar
691+ optional $ try $ symbol '{' >> symbol '}'
692+ let raw = do
693+ guard $ not (isBlockCommand name)
694+ (_, rawargs) <- withRaw
695+ (skipangles *> skipopts *> option "" dimenarg *> many braced)
696+ let rawcommand = T.unpack $ untokenize $
697+ cs : maybe [] (:[]) mbstar ++ rawargs
698+ (guardEnabled Ext_raw_tex >> return (rawInline "latex" rawcommand))
699+ <|> ignore rawcommand
700+ -- transformed <- applyMacros' rawcommand -- TODO or get rid of
701+ -- exts <- getOption readerExtensions
702+ -- if transformed /= rawcommand
703+ -- then parseFromString' inlines transformed
704+ -- else if extensionEnabled Ext_raw_tex exts
705+ -- then return $ rawInline "latex" rawcommand
706+ -- else ignore rawcommand
707+ lookupListDefault raw names inlineCommands
708+
974709tok :: PandocMonad m => LP m Inlines
975−tok = try $ grouped inline <|> inlineCommand <|> str <$> count 1 inlineChar
710+tok = try $ grouped inline <|> inlineCommand' <|> singleChar
711+ where singleChar = do
712+ Tok (lin,col) toktype t <- satisfyTok (tokTypeIn [Word, Symbol])
713+ if T.length t > 1
714+ then do
715+ let (t1, t2) = (T.take 1 t, T.drop 1 t)
716+ inp <- getInput
717+ setInput $ (Tok (lin, col + 1) toktype t2) : inp
718+ return $ str (T.unpack t1)
719+ else return $ str (T.unpack t)
976720
977721opt :: PandocMonad m => LP m Inlines
978722opt = bracketed inline
979723
980−rawopt :: PandocMonad m => LP m String
724+rawopt :: PandocMonad m => LP m Text
981725rawopt = do
982− contents <- bracketed (many1 (noneOf "[]") <|> try (string "\\]") <|>
983− try (string "\\[") <|> rawopt)
726+ symbol '['
727+ inner <- untokenize <$> manyTill anyTok (symbol ']')
984728 optional sp
985− return $ "[" ++ contents ++ "]"
729+ return $ "[" <> inner <> "]"
986730
987731skipopts :: PandocMonad m => LP m ()
988732skipopts = skipMany rawopt
989733
734+-- eat an optional argument and one or more arguments in braces
735+ignoreInlines :: PandocMonad m => Text -> (Text, LP m Inlines)
736+ignoreInlines name = (name, p)
737+ where p = do oa <- optargs
738+ let rawCommand = '\\' : T.unpack (name <> oa)
739+ let doraw = guardRaw >> return (rawInline "latex" rawCommand)
740+ doraw <|> ignore rawCommand
741+
742+guardRaw :: PandocMonad m => LP m ()
743+guardRaw = getOption readerExtensions >>= guard . extensionEnabled Ext_raw_tex
744+
745+optargs :: PandocMonad m => LP m Text
746+optargs = do
747+ (_, raw) <- withRaw (skipopts *> skipMany (try $ optional sp *> braced))
748+ return $ untokenize raw
749+
990750-- opts in angle brackets are used in beamer
991751rawangle :: PandocMonad m => LP m ()
992752rawangle = try $ do
993− char '<'
994− skipMany (noneOf ">")
995− char '>'
996− return ()
753+ symbol '<'
754+ () <$ manyTill anyTok (symbol '>')
997755
998756skipangles :: PandocMonad m => LP m ()
999757skipangles = skipMany rawangle
1000758
1001−inlineText :: PandocMonad m => LP m Inlines
1002−inlineText = str <$> many1 inlineChar
759+ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a
760+ignore raw = do
761+ pos <- getPosition
762+ report $ SkippedContent raw pos
763+ return mempty
1003764
1004−inlineChar :: PandocMonad m => LP m Char
1005−inlineChar = noneOf "\\$%&~#{}^'`\"‘’“”-[] \t\n"
765+withRaw :: PandocMonad m => LP m a -> LP m (a, [Tok])
766+withRaw parser = do
767+ inp <- getInput
768+ result <- parser
769+ nxt <- option (Tok (0,0) Word "") (lookAhead anyTok)
770+ let raw = takeWhile (/= nxt) inp
771+ return (result, raw)
1006772
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
773+inBrackets :: Inlines -> Inlines
774+inBrackets x = str "[" <> x <> str "]"
1013775
1014776inlineEnvironment :: PandocMonad m => LP m Inlines
1015777inlineEnvironment = try $ do
1016778 controlSeq "begin"
1017− name <- braced
779+ name <- untokenize <$> braced
1018780 M.findWithDefault mzero name inlineEnvironments
1019781
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
782+inlineEnvironments :: PandocMonad m => M.Map Text (LP m Inlines)
783+inlineEnvironments = M.fromList [
784+-- ("displaymath", mathEnvWith id Nothing "displaymath")
785+-- , ("math", math <$> mathEnv "math")
786+-- , ("equation", mathEnvWith id Nothing "equation")
787+-- , ("equation*", mathEnvWith id Nothing "equation*")
788+-- , ("gather", mathEnvWith id (Just "gathered") "gather")
789+-- , ("gather*", mathEnvWith id (Just "gathered") "gather*")
790+-- , ("multline", mathEnvWith id (Just "gathered") "multline")
791+-- , ("multline*", mathEnvWith id (Just "gathered") "multline*")
792+-- , ("eqnarray", mathEnvWith id (Just "aligned") "eqnarray")
793+-- , ("eqnarray*", mathEnvWith id (Just "aligned") "eqnarray*")
794+-- , ("align", mathEnvWith id (Just "aligned") "align")
795+-- , ("align*", mathEnvWith id (Just "aligned") "align*")
796+-- , ("alignat", mathEnvWith id (Just "aligned") "alignat")
797+-- , ("alignat*", mathEnvWith id (Just "aligned") "alignat*")
798+ ]
799+
800+inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)
801+inlineCommands = M.fromList $
802+ [ ("emph", extractSpaces emph <$> tok)
803+ , ("textit", extractSpaces emph <$> tok)
804+ , ("textsl", extractSpaces emph <$> tok)
805+ , ("textsc", extractSpaces smallcaps <$> tok)
806+ , ("textsf", extractSpaces (spanWith ("",["sans-serif"],[])) <$> tok)
807+ , ("textmd", extractSpaces (spanWith ("",["medium"],[])) <$> tok)
808+ , ("textrm", extractSpaces (spanWith ("",["roman"],[])) <$> tok)
809+ , ("textup", extractSpaces (spanWith ("",["upright"],[])) <$> tok)
810+ , ("texttt", ttfamily)
811+ , ("sout", extractSpaces strikeout <$> tok)
812+ , ("textsuperscript", extractSpaces superscript <$> tok)
813+ , ("textsubscript", extractSpaces subscript <$> tok)
814+ , ("textbackslash", lit "\\")
815+ , ("backslash", lit "\\")
816+ , ("slash", lit "/")
817+ , ("textbf", extractSpaces strong <$> tok)
818+ , ("textnormal", extractSpaces (spanWith ("",["nodecor"],[])) <$> tok)
819+ , ("ldots", lit "…")
820+ , ("vdots", lit "\8942")
821+ , ("dots", lit "…")
822+ , ("mdots", lit "…")
823+ , ("sim", lit "~")
824+ , ("label", rawInlineOr "label" (inBrackets <$> tok))
825+ , ("ref", rawInlineOr "ref" (inBrackets <$> tok))
826+ , ("textgreek", tok)
827+ , ("sep", lit ",")
828+-- , ("cref", rawInlineOr "cref" (inBrackets <$> tok)) -- from cleveref.sty
829+ , ("(", mathInline <$> manyTill anyTok (controlSeq ")"))
830+ , ("[", mathDisplay <$> manyTill anyTok (controlSeq "]"))
831+ , ("ensuremath", mathInline <$> braced)
832+ , ("texorpdfstring", (\_ x -> x) <$> tok <*> tok)
833+ , ("P", lit "¶")
834+ , ("S", lit "§")
835+ , ("$", lit "$")
836+ , ("%", lit "%")
837+ , ("&", lit "&")
838+ , ("#", lit "#")
839+ , ("_", lit "_")
840+ , ("{", lit "{")
841+ , ("}", lit "}")
842+ -- old TeX commands
843+ , ("em", extractSpaces emph <$> inlines)
844+ , ("it", extractSpaces emph <$> inlines)
845+ , ("sl", extractSpaces emph <$> inlines)
846+ , ("bf", extractSpaces strong <$> inlines)
847+ , ("rm", inlines)
848+ , ("itshape", extractSpaces emph <$> inlines)
849+ , ("slshape", extractSpaces emph <$> inlines)
850+ , ("scshape", extractSpaces smallcaps <$> inlines)
851+ , ("bfseries", extractSpaces strong <$> inlines)
852+ , ("/", pure mempty) -- italic correction
853+ , ("aa", lit "å")
854+ , ("AA", lit "Å")
855+ , ("ss", lit "ß")
856+ , ("o", lit "ø")
857+ , ("O", lit "Ø")
858+ , ("L", lit "Ł")
859+ , ("l", lit "ł")
860+ , ("ae", lit "æ")
861+ , ("AE", lit "Æ")
862+ , ("oe", lit "œ")
863+ , ("OE", lit "Œ")
864+ , ("pounds", lit "£")
865+ , ("euro", lit "€")
866+ , ("copyright", lit "©")
867+ , ("textasciicircum", lit "^")
868+ , ("textasciitilde", lit "~")
869+ , ("H", try $ tok >>= accent hungarumlaut)
870+ , ("`", option (str "`") $ try $ tok >>= accent grave)
871+ , ("'", option (str "'") $ try $ tok >>= accent acute)
872+ , ("^", option (str "^") $ try $ tok >>= accent circ)
873+ , ("~", option (str "~") $ try $ tok >>= accent tilde)
874+ , ("\"", option (str "\"") $ try $ tok >>= accent umlaut)
875+ , (".", option (str ".") $ try $ tok >>= accent dot)
876+ , ("=", option (str "=") $ try $ tok >>= accent macron)
877+ , ("c", option (str "c") $ try $ tok >>= accent cedilla)
878+ , ("v", option (str "v") $ try $ tok >>= accent hacek)
879+ , ("u", option (str "u") $ try $ tok >>= accent breve)
880+ , ("i", lit "i")
881+-- , ("\\", linebreak <$ (optional (bracketed inline) *> spaces'))
882+ , (",", lit "\8198")
883+ , ("@", pure mempty)
884+ , (" ", lit "\160")
885+ , ("ps", pure $ str "PS." <> space)
886+ , ("TeX", lit "TeX")
887+ , ("LaTeX", lit "LaTeX")
888+ , ("bar", lit "|")
889+ , ("textless", lit "<")
890+ , ("textgreater", lit ">")
891+ , ("thanks", note <$> grouped block)
892+ , ("footnote", note <$> grouped block)
893+ , ("verb", doverb)
894+ , ("lstinline", dolstinline)
895+ , ("Verb", doverb)
896+-- , ("url", (unescapeURL <$> braced) >>= \url ->
897+-- pure (link url "" (str url)))
898+-- , ("href", (unescapeURL <$> braced <* optional sp) >>= \url ->
899+-- tok >>= \lab ->
900+-- pure (link url "" lab))
901+-- , ("includegraphics", do options <- option [] keyvals
902+-- src <- unescapeURL . removeDoubleQuotes <$> braced
903+-- mkImage options src)
904+ , ("enquote", enquote)
905+-- , ("cite", citation "cite" NormalCitation False)
906+-- , ("Cite", citation "Cite" NormalCitation False)
907+-- , ("citep", citation "citep" NormalCitation False)
908+-- , ("citep*", citation "citep*" NormalCitation False)
909+-- , ("citeal", citation "citeal" NormalCitation False)
910+-- , ("citealp", citation "citealp" NormalCitation False)
911+-- , ("citealp*", citation "citealp*" NormalCitation False)
912+-- , ("autocite", citation "autocite" NormalCitation False)
913+-- , ("smartcite", citation "smartcite" NormalCitation False)
914+-- , ("footcite", inNote <$> citation "footcite" NormalCitation False)
915+-- , ("parencite", citation "parencite" NormalCitation False)
916+-- , ("supercite", citation "supercite" NormalCitation False)
917+-- , ("footcitetext", inNote <$> citation "footcitetext" NormalCitation False)
918+-- , ("citeyearpar", citation "citeyearpar" SuppressAuthor False)
919+-- , ("citeyear", citation "citeyear" SuppressAuthor False)
920+-- , ("autocite*", citation "autocite*" SuppressAuthor False)
921+-- , ("cite*", citation "cite*" SuppressAuthor False)
922+-- , ("parencite*", citation "parencite*" SuppressAuthor False)
923+-- , ("textcite", citation "textcite" AuthorInText False)
924+-- , ("citet", citation "citet" AuthorInText False)
925+-- , ("citet*", citation "citet*" AuthorInText False)
926+-- , ("citealt", citation "citealt" AuthorInText False)
927+-- , ("citealt*", citation "citealt*" AuthorInText False)
928+-- , ("textcites", citation "textcites" AuthorInText True)
929+-- , ("cites", citation "cites" NormalCitation True)
930+-- , ("autocites", citation "autocites" NormalCitation True)
931+-- , ("footcites", inNote <$> citation "footcites" NormalCitation True)
932+-- , ("parencites", citation "parencites" NormalCitation True)
933+-- , ("supercites", citation "supercites" NormalCitation True)
934+-- , ("footcitetexts", inNote <$> citation "footcitetexts" NormalCitation True)
935+-- , ("Autocite", citation "Autocite" NormalCitation False)
936+-- , ("Smartcite", citation "Smartcite" NormalCitation False)
937+-- , ("Footcite", citation "Footcite" NormalCitation False)
938+-- , ("Parencite", citation "Parencite" NormalCitation False)
939+-- , ("Supercite", citation "Supercite" NormalCitation False)
940+-- , ("Footcitetext", inNote <$> citation "Footcitetext" NormalCitation False)
941+-- , ("Citeyearpar", citation "Citeyearpar" SuppressAuthor False)
942+-- , ("Citeyear", citation "Citeyear" SuppressAuthor False)
943+-- , ("Autocite*", citation "Autocite*" SuppressAuthor False)
944+-- , ("Cite*", citation "Cite*" SuppressAuthor False)
945+-- , ("Parencite*", citation "Parencite*" SuppressAuthor False)
946+-- , ("Textcite", citation "Textcite" AuthorInText False)
947+-- , ("Textcites", citation "Textcites" AuthorInText True)
948+-- , ("Cites", citation "Cites" NormalCitation True)
949+-- , ("Autocites", citation "Autocites" NormalCitation True)
950+-- , ("Footcites", citation "Footcites" NormalCitation True)
951+-- , ("Parencites", citation "Parencites" NormalCitation True)
952+-- , ("Supercites", citation "Supercites" NormalCitation True)
953+-- , ("Footcitetexts", inNote <$> citation "Footcitetexts" NormalCitation True)
954+-- , ("citetext", complexNatbibCitation NormalCitation)
955+-- , ("citeauthor", (try (tok *> optional sp *> controlSeq "citetext") *>
956+-- complexNatbibCitation AuthorInText)
957+-- <|> citation "citeauthor" AuthorInText False)
958+-- , ("nocite", mempty <$ (citation "nocite" NormalCitation False >>=
959+-- addMeta "nocite"))
960+ , ("hypertarget", braced >> tok)
961+-- -- siuntix
962+-- , ("SI", dosiunitx)
963+ -- hyphenat
964+ , ("bshyp", lit "\\\173")
965+ , ("fshyp", lit "/\173")
966+ , ("dothyp", lit ".\173")
967+ , ("colonhyp", lit ":\173")
968+ , ("hyp", lit "-")
969+ , ("nohyphens", tok)
970+ , ("textnhtt", ttfamily)
971+ , ("nhttfamily", ttfamily)
972+ -- fontawesome
973+ , ("faCheck", lit "\10003")
974+ , ("faClose", lit "\10007")
975+ ] ++ map ignoreInlines
976+ -- these commands will be ignored unless --parse-raw is specified,
977+ -- in which case they will appear as raw latex blocks:
978+ [ "index"
979+ , "hspace"
980+ , "vspace"
981+ , "newpage"
982+ , "clearpage"
983+ , "pagebreak"
984+ ]
1052985
1053−----
986+ttfamily :: PandocMonad m => LP m Inlines
987+ttfamily = (code . stringify . toList) <$> tok
1054988
1055−maybeAddExtension :: String -> FilePath -> FilePath
1056−maybeAddExtension ext fp =
1057− if null (takeExtension fp)
1058− then addExtension fp ext
1059− else fp
989+rawInlineOr :: PandocMonad m => String -> LP m Inlines -> LP m Inlines
990+rawInlineOr name' fallback = do
991+ parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
992+ if parseRaw
993+ then rawInline "latex" <$> getRawCommand name'
994+ else fallback
1060995
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'
996+getRawCommand :: PandocMonad m => String -> LP m String
997+getRawCommand name' = do
998+ (_, rawargs) <- withRaw
999+ (many (try (optional sp *> opt)) *>
1000+ option "" (try (optional sp *> dimenarg)) *>
1001+ many braced)
1002+ return $ '\\' : name' ++ T.unpack (untokenize rawargs)
10771003
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−----
1004+isBlockCommand :: Text -> Bool
1005+isBlockCommand s =
1006+ s `M.member` (blockCommands :: M.Map Text (LP PandocPure Blocks))
11131007
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)
1008+lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
1009+lookupListDefault d = (fromMaybe d .) . lookupList
1010+ where
1011+ lookupList l m = msum $ map (`M.lookup` m) l
11221012
1013+inline :: PandocMonad m => LP m Inlines
1014+inline = (mempty <$ comment)
1015+ <|> (space <$ whitespace)
1016+ <|> (softbreak <$ endline)
1017+ <|> inlineText
1018+ <|> inlineCommand'
1019+ <|> inlineEnvironment
1020+ <|> inlineGroup
1021+ <|> (symbol '-' *>
1022+ option (str "-") (symbol '-' *>
1023+ option (str "–") (str "—" <$ symbol '-')))
1024+ <|> doubleQuote
1025+ <|> singleQuote
1026+ <|> (str "”" <$ try (symbol '\'' >> symbol '\''))
1027+ <|> (str "”" <$ symbol '”')
1028+ <|> (str "’" <$ symbol '\'')
1029+ <|> (str "’" <$ symbol '’')
1030+ <|> (str "\160" <$ symbol '~')
1031+ <|> dollarsMath
1032+ <|> (guardEnabled Ext_literate_haskell *> symbol '|' *> doLHSverb)
1033+ <|> (str . (:[]) <$> primEscape)
1034+ <|> (do res <- symbolIn "#&~^'`\"[]"
1035+ pos <- getPosition
1036+ let s = T.unpack (untoken res)
1037+ report $ ParsingUnescaped s pos
1038+ return $ str s)
11231039
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− ]
1040+inlines :: PandocMonad m => LP m Inlines
1041+inlines = mconcat <$> many inline
12241042
1225−figure :: PandocMonad m => LP m Blocks
1226−figure = try $ do
1227− resetCaption
1228− blocks >>= addImageCaption
1043+-- PREVIOUSLY HAD (notFollowedBy (char '}') *> inline)
12291044
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
1240−
1241−closing :: PandocMonad m => LP m Blocks
1242−closing = do
1243− contents <- tok
1244− st <- getState
1245− let extractInlines (MetaBlocks [Plain ys]) = ys
1246− extractInlines (MetaBlocks [Para ys ]) = ys
1247− extractInlines _ = []
1248− let sigs = case lookupMeta "author" (stateMeta st) of
1249− Just (MetaList xs) ->
1250− para $ trimInlines $ fromList $
1251− intercalate [LineBreak] $ map extractInlines xs
1252− _ -> mempty
1253− return $ para (trimInlines contents) <> sigs
1254−
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
1264−
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])
1273−
1274−env :: PandocMonad m => String -> LP m a -> LP m a
1275−env 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
1314−
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
1045+-- block elements:
13421046
13431047paragraph :: PandocMonad m => LP m Blocks
13441048paragraph = do
@@ -1347,226 +1051,1282 @@ paragraph = do
13471051 then return mempty
13481052 else return $ para x
13491053
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 ()
1054+include :: PandocMonad m => LP m Blocks
1055+include = do
1056+ (Tok _ _ name) <- controlSeq "include" <|> controlSeq "input" <|>
1057+ controlSeq "subfile" <|> controlSeq "usepackage"
1058+ skipMany $ bracketed inline -- skip options
1059+ fs <- (map trim . splitBy (==',') . T.unpack . untokenize) <$> braced
1060+ let fs' = if name == "\\usepackage"
1061+ then map (maybeAddExtension ".sty") fs
1062+ else map (maybeAddExtension ".tex") fs
1063+ dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
1064+ mconcat <$> mapM (insertIncludedFile blocks (tokenize . T.pack) dirs) fs'
14991065
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
1066+maybeAddExtension :: String -> FilePath -> FilePath
1067+maybeAddExtension ext fp =
1068+ if null (takeExtension fp)
1069+ then addExtension fp ext
1070+ else fp
1071+
1072+blockCommands :: PandocMonad m => M.Map Text (LP m Blocks)
1073+blockCommands = M.empty
1074+
1075+block :: PandocMonad m => LP m Blocks
1076+block = (mempty <$ spaces1)
1077+ -- <|> environment
1078+ <|> include
1079+ -- <|> macro
1080+ -- <|> blockCommand
1081+ <|> paragraph
1082+ <|> grouped block
1083+
1084+blocks :: PandocMonad m => LP m Blocks
1085+blocks = mconcat <$> many block
1086+
1087+
1088+-- -- | Parse LaTeX from string and return 'Pandoc' document.
1089+-- readLaTeX :: PandocMonad m
1090+-- => ReaderOptions -- ^ Reader options
1091+-- -> Text -- ^ String to parse (assumes @'\n'@ line endings)
1092+-- -> m Pandoc
1093+-- readLaTeX opts ltx = do
1094+-- parsed <- readWithM parseLaTeX def{ stateOptions = opts }
1095+-- (unpack (crFilter ltx))
1096+-- case parsed of
1097+-- Right result -> return result
1098+-- Left e -> throwError e
1099+--
1100+--
1101+-- parseLaTeX :: PandocMonad m => LP m Pandoc
1102+-- parseLaTeX = do
1103+-- bs <- blocks
1104+-- eof
1105+-- st <- getState
1106+-- let meta = stateMeta st
1107+-- let doc' = doc bs
1108+-- let headerLevel (Header n _ _) = [n]
1109+-- headerLevel _ = []
1110+-- let bottomLevel = minimumDef 1 $ query headerLevel doc'
1111+-- let adjustHeaders m (Header n attr ils) = Header (n+m) attr ils
1112+-- adjustHeaders _ x = x
1113+-- let (Pandoc _ bs') =
1114+-- -- handle the case where you have \part or \chapter
1115+-- (if bottomLevel < 1
1116+-- then walk (adjustHeaders (1 - bottomLevel))
1117+-- else id) doc'
1118+-- return $ Pandoc meta bs'
1119+--
1120+-- anyControlSeq :: PandocMonad m => LP m String
1121+-- anyControlSeq = do
1122+-- char '\\'
1123+-- next <- option '\n' anyChar
1124+-- case next of
1125+-- '\n' -> return ""
1126+-- c | isLetter c -> (c:) <$> (many letter <* optional sp)
1127+-- | otherwise -> return [c]
1128+--
1129+-- controlSeq :: PandocMonad m => String -> LP m String
1130+-- controlSeq name = try $ do
1131+-- char '\\'
1132+-- case name of
1133+-- "" -> mzero
1134+-- [c] | not (isLetter c) -> string [c]
1135+-- cs -> string cs <* notFollowedBy letter <* optional sp
1136+-- return name
1137+--
1138+-- dimenarg :: PandocMonad m => LP m String
1139+-- dimenarg = try $ do
1140+-- ch <- option "" $ string "="
1141+-- num <- many1 digit
1142+-- dim <- oneOfStrings ["pt","pc","in","bp","cm","mm","dd","cc","sp"]
1143+-- return $ ch ++ num ++ dim
1144+--
1145+-- sp :: PandocMonad m => LP m ()
1146+-- sp = whitespace <|> endline
1147+--
1148+-- whitespace :: PandocMonad m => LP m ()
1149+-- whitespace = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t')
1150+--
1151+-- endline :: PandocMonad m => LP m ()
1152+-- endline = try (newline >> lookAhead anyChar >> notFollowedBy blankline)
1153+--
1154+-- isLowerHex :: Char -> Bool
1155+-- isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
1156+--
1157+-- primEscape :: PandocMonad m => LP m Char
1158+-- primEscape = try $ do
1159+-- string "^^"
1160+-- c <- satisfy (\x -> x >= '\0' && x <= '\128')
1161+-- d <- if isLowerHex c
1162+-- then option "" $ count 1 (satisfy isLowerHex)
1163+-- else return ""
1164+-- if null d
1165+-- then case ord c of
1166+-- x | x >= 64 && x <= 127 -> return $ chr (x - 64)
1167+-- | otherwise -> return $ chr (x + 64)
1168+-- else return $ chr $ read ('0':'x':c:d)
1169+--
1170+-- comment :: PandocMonad m => LP m ()
1171+-- comment = do
1172+-- char '%'
1173+-- skipMany (satisfy (/='\n'))
1174+-- optional newline
1175+-- return ()
1176+--
1177+-- bgroup :: PandocMonad m => LP m ()
1178+-- bgroup = try $ do
1179+-- skipMany (spaceChar <|> try (newline <* notFollowedBy blankline))
1180+-- () <$ char '{'
1181+-- <|> () <$ controlSeq "bgroup"
1182+-- <|> () <$ controlSeq "begingroup"
1183+--
1184+-- egroup :: PandocMonad m => LP m ()
1185+-- egroup = () <$ char '}'
1186+-- <|> () <$ controlSeq "egroup"
1187+-- <|> () <$ controlSeq "endgroup"
1188+--
1189+-- grouped :: PandocMonad m => Monoid a => LP m a -> LP m a
1190+-- grouped parser = try $ do
1191+-- bgroup
1192+-- -- first we check for an inner 'grouped', because
1193+-- -- {{a,b}} should be parsed the same as {a,b}
1194+-- try (grouped parser <* egroup)
1195+-- <|> (mconcat <$> manyTill parser egroup)
1196+--
1197+-- braced :: PandocMonad m => LP m String
1198+-- braced = grouped chunk
1199+-- where chunk =
1200+-- many1 (satisfy (\c -> c /= '\\' && c /= '}' && c /= '{'))
1201+-- <|> try (string "\\}")
1202+-- <|> try (string "\\{")
1203+-- <|> try (string "\\\\")
1204+-- <|> ((\x -> "{" ++ x ++ "}") <$> braced)
1205+-- <|> count 1 anyChar
1206+--
1207+-- bracketed :: PandocMonad m => Monoid a => LP m a -> LP m a
1208+-- bracketed parser = try $ char '[' *> (mconcat <$> manyTill parser (char ']'))
1209+--
1210+-- mathDisplay :: PandocMonad m => LP m String -> LP m Inlines
1211+-- mathDisplay p = displayMath <$> (try p >>= applyMacros' . trim)
1212+--
1213+-- mathInline :: PandocMonad m => LP m String -> LP m Inlines
1214+-- mathInline p = math <$> (try p >>= applyMacros')
1215+--
1216+-- mathChars :: PandocMonad m => LP m String
1217+-- mathChars =
1218+-- concat <$> many (escapedChar
1219+-- <|> (snd <$> withRaw braced)
1220+-- <|> many1 (satisfy isOrdChar))
1221+-- where escapedChar = try $ do char '\\'
1222+-- c <- anyChar
1223+-- return ['\\',c]
1224+-- isOrdChar '$' = False
1225+-- isOrdChar '{' = False
1226+-- isOrdChar '}' = False
1227+-- isOrdChar '\\' = False
1228+-- isOrdChar _ = True
1229+--
1230+-- inline :: PandocMonad m => LP m Inlines
1231+-- inline = (mempty <$ comment)
1232+-- <|> (space <$ whitespace)
1233+-- <|> (softbreak <$ endline)
1234+-- <|> inlineText
1235+-- <|> inlineCommand
1236+-- <|> inlineEnvironment
1237+-- <|> inlineGroup
1238+-- <|> (char '-' *> option (str "-")
1239+-- (char '-' *> option (str "–") (str "—" <$ char '-')))
1240+-- <|> doubleQuote
1241+-- <|> singleQuote
1242+-- <|> (str "”" <$ try (string "''"))
1243+-- <|> (str "”" <$ char '”')
1244+-- <|> (str "’" <$ char '\'')
1245+-- <|> (str "’" <$ char '’')
1246+-- <|> (str "\160" <$ char '~')
1247+-- <|> mathDisplay (string "$$" *> mathChars <* string "$$")
1248+-- <|> mathInline (char '$' *> mathChars <* char '$')
1249+-- <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)
1250+-- <|> (str . (:[]) <$> primEscape)
1251+-- <|> (do res <- oneOf "#&~^'`\"[]"
1252+-- pos <- getPosition
1253+-- report $ ParsingUnescaped [res] pos
1254+-- return $ str [res])
1255+--
1256+-- inlines :: PandocMonad m => LP m Inlines
1257+-- inlines = mconcat <$> many (notFollowedBy (char '}') *> inline)
1258+--
1259+-- inlineGroup :: PandocMonad m => LP m Inlines
1260+-- inlineGroup = do
1261+-- ils <- grouped inline
1262+-- if isNull ils
1263+-- then return mempty
1264+-- else return $ spanWith nullAttr ils
1265+-- -- we need the span so we can detitlecase bibtex entries;
1266+-- -- we need to know when something is {C}apitalized
1267+--
1268+-- block :: PandocMonad m => LP m Blocks
1269+-- block = (mempty <$ comment)
1270+-- <|> (mempty <$ ((spaceChar <|> newline) *> spaces))
1271+-- <|> environment
1272+-- <|> include
1273+-- <|> macro
1274+-- <|> blockCommand
1275+-- <|> paragraph
1276+-- <|> grouped block
1277+--
1278+-- blocks :: PandocMonad m => LP m Blocks
1279+-- blocks = mconcat <$> many block
1280+--
1281+-- getRawCommand :: PandocMonad m => String -> LP m String
1282+-- getRawCommand name' = do
1283+-- rawargs <- withRaw (many (try (optional sp *> opt)) *>
1284+-- option "" (try (optional sp *> dimenarg)) *>
1285+-- many braced)
1286+-- return $ '\\' : name' ++ snd rawargs
1287+--
1288+-- lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
1289+-- lookupListDefault d = (fromMaybe d .) . lookupList
1290+-- where
1291+-- lookupList l m = msum $ map (`M.lookup` m) l
1292+--
1293+-- blockCommand :: PandocMonad m => LP m Blocks
1294+-- blockCommand = try $ do
1295+-- name <- anyControlSeq
1296+-- guard $ name /= "begin" && name /= "end"
1297+-- star <- option "" (string "*" <* optional sp)
1298+-- let name' = name ++ star
1299+-- let raw = do
1300+-- rawcommand <- getRawCommand name'
1301+-- transformed <- applyMacros' rawcommand
1302+-- guard $ transformed /= rawcommand
1303+-- notFollowedBy $ parseFromString' inlines transformed
1304+-- parseFromString' blocks transformed
1305+-- lookupListDefault raw [name',name] blockCommands
1306+--
1307+-- inBrackets :: Inlines -> Inlines
1308+-- inBrackets x = str "[" <> x <> str "]"
1309+--
1310+-- -- eat an optional argument and one or more arguments in braces
1311+-- ignoreInlines :: PandocMonad m => Text -> (Text, LP m Inlines)
1312+-- ignoreInlines name = (name, p)
1313+-- where
1314+-- p = do oa <- optargs
1315+-- let rawCommand = '\\':name ++ oa
1316+-- let doraw = guardRaw >> return (rawInline "latex" rawCommand)
1317+-- doraw <|> ignore rawCommand
1318+--
1319+-- guardRaw :: PandocMonad m => LP m ()
1320+-- guardRaw = getOption readerExtensions >>= guard . extensionEnabled Ext_raw_tex
1321+--
1322+-- optargs :: PandocMonad m => LP m String
1323+-- optargs = snd <$> withRaw (skipopts *> skipMany (try $ optional sp *> braced))
1324+--
1325+-- ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a
1326+-- ignore raw = do
1327+-- pos <- getPosition
1328+-- report $ SkippedContent raw pos
1329+-- return mempty
1330+--
1331+-- ignoreBlocks :: PandocMonad m => String -> (String, LP m Blocks)
1332+-- ignoreBlocks name = (name, p)
1333+-- where
1334+-- p = do oa <- optargs
1335+-- let rawCommand = '\\':name ++ oa
1336+-- let doraw = guardRaw >> return (rawBlock "latex" rawCommand)
1337+-- doraw <|> ignore rawCommand
1338+--
1339+-- blockCommands :: PandocMonad m => M.Map String (LP m Blocks)
1340+-- blockCommands = M.fromList $
1341+-- [ ("par", mempty <$ skipopts)
1342+-- , ("parbox", braced >> grouped blocks)
1343+-- , ("title", mempty <$ (skipopts *>
1344+-- (grouped inline >>= addMeta "title")
1345+-- <|> (grouped block >>= addMeta "title")))
1346+-- , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle"))
1347+-- , ("author", mempty <$ (skipopts *> authors))
1348+-- -- -- in letter class, temp. store address & sig as title, author
1349+-- , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))
1350+-- , ("signature", mempty <$ (skipopts *> authors))
1351+-- , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))
1352+-- -- Koma-script metadata commands
1353+-- , ("dedication", mempty <$ (skipopts *> tok >>= addMeta "dedication"))
1354+-- -- sectioning
1355+-- , ("part", section nullAttr (-1))
1356+-- , ("part*", section nullAttr (-1))
1357+-- , ("chapter", section nullAttr 0)
1358+-- , ("chapter*", section ("",["unnumbered"],[]) 0)
1359+-- , ("section", section nullAttr 1)
1360+-- , ("section*", section ("",["unnumbered"],[]) 1)
1361+-- , ("subsection", section nullAttr 2)
1362+-- , ("subsection*", section ("",["unnumbered"],[]) 2)
1363+-- , ("subsubsection", section nullAttr 3)
1364+-- , ("subsubsection*", section ("",["unnumbered"],[]) 3)
1365+-- , ("paragraph", section nullAttr 4)
1366+-- , ("paragraph*", section ("",["unnumbered"],[]) 4)
1367+-- , ("subparagraph", section nullAttr 5)
1368+-- , ("subparagraph*", section ("",["unnumbered"],[]) 5)
1369+-- -- beamer slides
1370+-- , ("frametitle", section nullAttr 3)
1371+-- , ("framesubtitle", section nullAttr 4)
1372+-- -- letters
1373+-- , ("opening", (para . trimInlines) <$> (skipopts *> tok))
1374+-- , ("closing", skipopts *> closing)
1375+-- --
1376+-- , ("hrule", pure horizontalRule)
1377+-- , ("strut", pure mempty)
1378+-- , ("rule", skipopts *> tok *> tok *> pure horizontalRule)
1379+-- , ("item", skipopts *> looseItem)
1380+-- , ("documentclass", skipopts *> braced *> preamble)
1381+-- , ("centerline", (para . trimInlines) <$> (skipopts *> tok))
1382+-- , ("caption", skipopts *> setCaption)
1383+-- , ("bibliography", mempty <$ (skipopts *> braced >>=
1384+-- addMeta "bibliography" . splitBibs))
1385+-- , ("addbibresource", mempty <$ (skipopts *> braced >>=
1386+-- addMeta "bibliography" . splitBibs))
1387+-- -- includes
1388+-- , ("lstinputlisting", inputListing)
1389+-- , ("graphicspath", graphicsPath)
1390+-- -- hyperlink
1391+-- , ("hypertarget", braced >> grouped block)
1392+-- ] ++ map ignoreBlocks
1393+-- -- these commands will be ignored unless --parse-raw is specified,
1394+-- -- in which case they will appear as raw latex blocks
1395+-- [ "newcommand", "renewcommand", "newenvironment", "renewenvironment"
1396+-- -- newcommand, etc. should be parsed by macro, but we need this
1397+-- -- here so these aren't parsed as inline commands to ignore
1398+-- , "special", "pdfannot", "pdfstringdef"
1399+-- , "bibliographystyle"
1400+-- , "maketitle", "makeindex", "makeglossary"
1401+-- , "addcontentsline", "addtocontents", "addtocounter"
1402+-- -- \ignore{} is used conventionally in literate haskell for definitions
1403+-- -- that are to be processed by the compiler but not printed.
1404+-- , "ignore"
1405+-- , "hyperdef"
1406+-- , "markboth", "markright", "markleft"
1407+-- , "hspace", "vspace"
1408+-- , "newpage"
1409+-- , "clearpage"
1410+-- , "pagebreak"
1411+-- ]
1412+--
1413+-- graphicsPath :: PandocMonad m => LP m Blocks
1414+-- graphicsPath = do
1415+-- ps <- bgroup *> (manyTill braced egroup)
1416+-- getResourcePath >>= setResourcePath . (++ ps)
1417+-- return mempty
1418+--
1419+-- addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()
1420+-- addMeta field val = updateState $ \st ->
1421+-- st{ stateMeta = addMetaField field val $ stateMeta st }
1422+--
1423+-- splitBibs :: String -> [Inlines]
1424+-- splitBibs = map (str . flip replaceExtension "bib" . trim) . splitBy (==',')
1425+--
1426+-- setCaption :: PandocMonad m => LP m Blocks
1427+-- setCaption = do
1428+-- ils <- tok
1429+-- mblabel <- option Nothing $
1430+-- try $ spaces' >> controlSeq "label" >> (Just <$> tok)
1431+-- let ils' = case mblabel of
1432+-- Just lab -> ils <> spanWith
1433+-- ("",[],[("data-label", stringify lab)]) mempty
1434+-- Nothing -> ils
1435+-- updateState $ \st -> st{ stateCaption = Just ils' }
1436+-- return mempty
1437+--
1438+-- resetCaption :: PandocMonad m => LP m ()
1439+-- resetCaption = updateState $ \st -> st{ stateCaption = Nothing }
1440+--
1441+-- authors :: PandocMonad m => LP m ()
1442+-- authors = try $ do
1443+-- bgroup
1444+-- let oneAuthor = mconcat <$>
1445+-- many1 (notFollowedBy' (controlSeq "and") >>
1446+-- (inline <|> mempty <$ blockCommand))
1447+-- -- skip e.g. \vspace{10pt}
1448+-- auths <- sepBy oneAuthor (controlSeq "and")
1449+-- egroup
1450+-- addMeta "author" (map trimInlines auths)
1451+--
1452+-- section :: PandocMonad m => Attr -> Int -> LP m Blocks
1453+-- section (ident, classes, kvs) lvl = do
1454+-- skipopts
1455+-- contents <- grouped inline
1456+-- lab <- option ident $ try (spaces' >> controlSeq "label" >> spaces' >> braced)
1457+-- attr' <- registerHeader (lab, classes, kvs) contents
1458+-- return $ headerWith attr' lvl contents
1459+--
1460+-- inlineCommand :: PandocMonad m => LP m Inlines
1461+-- inlineCommand = try $ do
1462+-- (name, raw') <- withRaw anyControlSeq
1463+-- guard $ name /= "begin" && name /= "end"
1464+-- star <- option "" (string "*")
1465+-- let name' = name ++ star
1466+-- let raw = do
1467+-- guard $ not (isBlockCommand name)
1468+-- rawargs <- withRaw
1469+-- (skipangles *> skipopts *> option "" dimenarg *> many braced)
1470+-- let rawcommand = raw' ++ star ++ snd rawargs
1471+-- transformed <- applyMacros' rawcommand
1472+-- exts <- getOption readerExtensions
1473+-- if transformed /= rawcommand
1474+-- then parseFromString' inlines transformed
1475+-- else if extensionEnabled Ext_raw_tex exts
1476+-- then return $ rawInline "latex" rawcommand
1477+-- else ignore rawcommand
1478+-- (lookupListDefault raw [name',name] inlineCommands <*
1479+-- optional (try (string "{}")))
1480+--
1481+-- rawInlineOr :: PandocMonad m => String -> LP m Inlines -> LP m Inlines
1482+-- rawInlineOr name' fallback = do
1483+-- parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
1484+-- if parseRaw
1485+-- then rawInline "latex" <$> getRawCommand name'
1486+-- else fallback
1487+--
1488+-- isBlockCommand :: String -> Bool
1489+-- isBlockCommand s = s `M.member` (blockCommands :: M.Map String (LP PandocPure Blocks))
1490+--
1491+--
1492+-- inlineEnvironments :: PandocMonad m => M.Map String (LP m Inlines)
1493+-- inlineEnvironments = M.fromList
1494+-- [ ("displaymath", mathEnvWith id Nothing "displaymath")
1495+-- , ("math", math <$> mathEnv "math")
1496+-- , ("equation", mathEnvWith id Nothing "equation")
1497+-- , ("equation*", mathEnvWith id Nothing "equation*")
1498+-- , ("gather", mathEnvWith id (Just "gathered") "gather")
1499+-- , ("gather*", mathEnvWith id (Just "gathered") "gather*")
1500+-- , ("multline", mathEnvWith id (Just "gathered") "multline")
1501+-- , ("multline*", mathEnvWith id (Just "gathered") "multline*")
1502+-- , ("eqnarray", mathEnvWith id (Just "aligned") "eqnarray")
1503+-- , ("eqnarray*", mathEnvWith id (Just "aligned") "eqnarray*")
1504+-- , ("align", mathEnvWith id (Just "aligned") "align")
1505+-- , ("align*", mathEnvWith id (Just "aligned") "align*")
1506+-- , ("alignat", mathEnvWith id (Just "aligned") "alignat")
1507+-- , ("alignat*", mathEnvWith id (Just "aligned") "alignat*")
1508+-- ]
1509+--
1510+-- mkImage :: PandocMonad m => [(String, String)] -> String -> LP m Inlines
1511+-- mkImage options src = do
1512+-- let replaceTextwidth (k,v) = case numUnit v of
1513+-- Just (num, "\\textwidth") -> (k, showFl (num * 100) ++ "%")
1514+-- _ -> (k, v)
1515+-- let kvs = map replaceTextwidth $ filter (\(k,_) -> k `elem` ["width", "height"]) options
1516+-- let attr = ("",[], kvs)
1517+-- let alt = str "image"
1518+-- case takeExtension src of
1519+-- "" -> do
1520+-- defaultExt <- getOption readerDefaultImageExtension
1521+-- return $ imageWith attr (addExtension src defaultExt) "" alt
1522+-- _ -> return $ imageWith attr src "" alt
1523+--
1524+-- inNote :: Inlines -> Inlines
1525+-- inNote ils =
1526+-- note $ para $ ils <> str "."
1527+--
1528+-- unescapeURL :: String -> String
1529+-- unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs
1530+-- where isEscapable c = c `elem` ("#$%&~_^\\{}" :: String)
1531+-- unescapeURL (x:xs) = x:unescapeURL xs
1532+-- unescapeURL [] = ""
1533+--
1534+-- -- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"
1535+-- dosiunitx :: PandocMonad m => LP m Inlines
1536+-- dosiunitx = do
1537+-- skipopts
1538+-- value <- tok
1539+-- valueprefix <- option "" $ char '[' >> (mconcat <$> manyTill tok (char ']'))
1540+-- unit <- tok
1541+-- let emptyOr160 "" = ""
1542+-- emptyOr160 _ = "\160"
1543+-- return . mconcat $ [valueprefix,
1544+-- emptyOr160 valueprefix,
1545+-- value,
1546+-- emptyOr160 unit,
1547+-- unit]
1548+--
1549+-- accent :: (Char -> String) -> Inlines -> LP m Inlines
1550+-- accent f ils =
1551+-- case toList ils of
1552+-- (Str (x:xs) : ys) -> return $ fromList (Str (f x ++ xs) : ys)
1553+-- [] -> mzero
1554+-- _ -> return ils
1555+--
1556+-- grave :: Char -> String
1557+-- grave 'A' = "À"
1558+-- grave 'E' = "È"
1559+-- grave 'I' = "Ì"
1560+-- grave 'O' = "Ò"
1561+-- grave 'U' = "Ù"
1562+-- grave 'a' = "à"
1563+-- grave 'e' = "è"
1564+-- grave 'i' = "ì"
1565+-- grave 'o' = "ò"
1566+-- grave 'u' = "ù"
1567+-- grave c = [c]
1568+--
1569+-- acute :: Char -> String
1570+-- acute 'A' = "Á"
1571+-- acute 'E' = "É"
1572+-- acute 'I' = "Í"
1573+-- acute 'O' = "Ó"
1574+-- acute 'U' = "Ú"
1575+-- acute 'Y' = "Ý"
1576+-- acute 'a' = "á"
1577+-- acute 'e' = "é"
1578+-- acute 'i' = "í"
1579+-- acute 'o' = "ó"
1580+-- acute 'u' = "ú"
1581+-- acute 'y' = "ý"
1582+-- acute 'C' = "Ć"
1583+-- acute 'c' = "ć"
1584+-- acute 'L' = "Ĺ"
1585+-- acute 'l' = "ĺ"
1586+-- acute 'N' = "Ń"
1587+-- acute 'n' = "ń"
1588+-- acute 'R' = "Ŕ"
1589+-- acute 'r' = "ŕ"
1590+-- acute 'S' = "Ś"
1591+-- acute 's' = "ś"
1592+-- acute 'Z' = "Ź"
1593+-- acute 'z' = "ź"
1594+-- acute c = [c]
1595+--
1596+-- circ :: Char -> String
1597+-- circ 'A' = "Â"
1598+-- circ 'E' = "Ê"
1599+-- circ 'I' = "Î"
1600+-- circ 'O' = "Ô"
1601+-- circ 'U' = "Û"
1602+-- circ 'a' = "â"
1603+-- circ 'e' = "ê"
1604+-- circ 'i' = "î"
1605+-- circ 'o' = "ô"
1606+-- circ 'u' = "û"
1607+-- circ 'C' = "Ĉ"
1608+-- circ 'c' = "ĉ"
1609+-- circ 'G' = "Ĝ"
1610+-- circ 'g' = "ĝ"
1611+-- circ 'H' = "Ĥ"
1612+-- circ 'h' = "ĥ"
1613+-- circ 'J' = "Ĵ"
1614+-- circ 'j' = "ĵ"
1615+-- circ 'S' = "Ŝ"
1616+-- circ 's' = "ŝ"
1617+-- circ 'W' = "Ŵ"
1618+-- circ 'w' = "ŵ"
1619+-- circ 'Y' = "Ŷ"
1620+-- circ 'y' = "ŷ"
1621+-- circ c = [c]
1622+--
1623+-- tilde :: Char -> String
1624+-- tilde 'A' = "Ã"
1625+-- tilde 'a' = "ã"
1626+-- tilde 'O' = "Õ"
1627+-- tilde 'o' = "õ"
1628+-- tilde 'I' = "Ĩ"
1629+-- tilde 'i' = "ĩ"
1630+-- tilde 'U' = "Ũ"
1631+-- tilde 'u' = "ũ"
1632+-- tilde 'N' = "Ñ"
1633+-- tilde 'n' = "ñ"
1634+-- tilde c = [c]
1635+--
1636+-- umlaut :: Char -> String
1637+-- umlaut 'A' = "Ä"
1638+-- umlaut 'E' = "Ë"
1639+-- umlaut 'I' = "Ï"
1640+-- umlaut 'O' = "Ö"
1641+-- umlaut 'U' = "Ü"
1642+-- umlaut 'a' = "ä"
1643+-- umlaut 'e' = "ë"
1644+-- umlaut 'i' = "ï"
1645+-- umlaut 'o' = "ö"
1646+-- umlaut 'u' = "ü"
1647+-- umlaut c = [c]
1648+--
1649+-- hungarumlaut :: Char -> String
1650+-- hungarumlaut 'A' = "A̋"
1651+-- hungarumlaut 'E' = "E̋"
1652+-- hungarumlaut 'I' = "I̋"
1653+-- hungarumlaut 'O' = "Ő"
1654+-- hungarumlaut 'U' = "Ű"
1655+-- hungarumlaut 'Y' = "ӳ"
1656+-- hungarumlaut 'a' = "a̋"
1657+-- hungarumlaut 'e' = "e̋"
1658+-- hungarumlaut 'i' = "i̋"
1659+-- hungarumlaut 'o' = "ő"
1660+-- hungarumlaut 'u' = "ű"
1661+-- hungarumlaut 'y' = "ӳ"
1662+-- hungarumlaut c = [c]
1663+--
1664+-- dot :: Char -> String
1665+-- dot 'C' = "Ċ"
1666+-- dot 'c' = "ċ"
1667+-- dot 'E' = "Ė"
1668+-- dot 'e' = "ė"
1669+-- dot 'G' = "Ġ"
1670+-- dot 'g' = "ġ"
1671+-- dot 'I' = "İ"
1672+-- dot 'Z' = "Ż"
1673+-- dot 'z' = "ż"
1674+-- dot c = [c]
1675+--
1676+-- macron :: Char -> String
1677+-- macron 'A' = "Ā"
1678+-- macron 'E' = "Ē"
1679+-- macron 'I' = "Ī"
1680+-- macron 'O' = "Ō"
1681+-- macron 'U' = "Ū"
1682+-- macron 'a' = "ā"
1683+-- macron 'e' = "ē"
1684+-- macron 'i' = "ī"
1685+-- macron 'o' = "ō"
1686+-- macron 'u' = "ū"
1687+-- macron c = [c]
1688+--
1689+-- cedilla :: Char -> String
1690+-- cedilla 'c' = "ç"
1691+-- cedilla 'C' = "Ç"
1692+-- cedilla 's' = "ş"
1693+-- cedilla 'S' = "Ş"
1694+-- cedilla 't' = "ţ"
1695+-- cedilla 'T' = "Ţ"
1696+-- cedilla 'e' = "ȩ"
1697+-- cedilla 'E' = "Ȩ"
1698+-- cedilla 'h' = "ḩ"
1699+-- cedilla 'H' = "Ḩ"
1700+-- cedilla 'o' = "o̧"
1701+-- cedilla 'O' = "O̧"
1702+-- cedilla c = [c]
1703+--
1704+-- hacek :: Char -> String
1705+-- hacek 'A' = "Ǎ"
1706+-- hacek 'a' = "ǎ"
1707+-- hacek 'C' = "Č"
1708+-- hacek 'c' = "č"
1709+-- hacek 'D' = "Ď"
1710+-- hacek 'd' = "ď"
1711+-- hacek 'E' = "Ě"
1712+-- hacek 'e' = "ě"
1713+-- hacek 'G' = "Ǧ"
1714+-- hacek 'g' = "ǧ"
1715+-- hacek 'H' = "Ȟ"
1716+-- hacek 'h' = "ȟ"
1717+-- hacek 'I' = "Ǐ"
1718+-- hacek 'i' = "ǐ"
1719+-- hacek 'j' = "ǰ"
1720+-- hacek 'K' = "Ǩ"
1721+-- hacek 'k' = "ǩ"
1722+-- hacek 'L' = "Ľ"
1723+-- hacek 'l' = "ľ"
1724+-- hacek 'N' = "Ň"
1725+-- hacek 'n' = "ň"
1726+-- hacek 'O' = "Ǒ"
1727+-- hacek 'o' = "ǒ"
1728+-- hacek 'R' = "Ř"
1729+-- hacek 'r' = "ř"
1730+-- hacek 'S' = "Š"
1731+-- hacek 's' = "š"
1732+-- hacek 'T' = "Ť"
1733+-- hacek 't' = "ť"
1734+-- hacek 'U' = "Ǔ"
1735+-- hacek 'u' = "ǔ"
1736+-- hacek 'Z' = "Ž"
1737+-- hacek 'z' = "ž"
1738+-- hacek c = [c]
1739+--
1740+-- breve :: Char -> String
1741+-- breve 'A' = "Ă"
1742+-- breve 'a' = "ă"
1743+-- breve 'E' = "Ĕ"
1744+-- breve 'e' = "ĕ"
1745+-- breve 'G' = "Ğ"
1746+-- breve 'g' = "ğ"
1747+-- breve 'I' = "Ĭ"
1748+-- breve 'i' = "ĭ"
1749+-- breve 'O' = "Ŏ"
1750+-- breve 'o' = "ŏ"
1751+-- breve 'U' = "Ŭ"
1752+-- breve 'u' = "ŭ"
1753+-- breve c = [c]
1754+--
1755+-- tok :: PandocMonad m => LP m Inlines
1756+-- tok = try $ grouped inline <|> inlineCommand <|> str <$> count 1 inlineChar
1757+--
1758+-- opt :: PandocMonad m => LP m Inlines
1759+-- opt = bracketed inline
1760+--
1761+-- rawopt :: PandocMonad m => LP m String
1762+-- rawopt = do
1763+-- contents <- bracketed (many1 (noneOf "[]") <|> try (string "\\]") <|>
1764+-- try (string "\\[") <|> rawopt)
1765+-- optional sp
1766+-- return $ "[" ++ contents ++ "]"
1767+--
1768+-- skipopts :: PandocMonad m => LP m ()
1769+-- skipopts = skipMany rawopt
1770+--
1771+-- -- opts in angle brackets are used in beamer
1772+-- rawangle :: PandocMonad m => LP m ()
1773+-- rawangle = try $ do
1774+-- char '<'
1775+-- skipMany (noneOf ">")
1776+-- char '>'
1777+-- return ()
1778+--
1779+-- skipangles :: PandocMonad m => LP m ()
1780+-- skipangles = skipMany rawangle
1781+--
1782+-- inlineText :: PandocMonad m => LP m Inlines
1783+-- inlineText = str <$> many1 inlineChar
1784+--
1785+-- inlineChar :: PandocMonad m => LP m Char
1786+-- inlineChar = noneOf "\\$%&~#{}^'`\"‘’“”-[] \t\n"
1787+--
1788+-- environment :: PandocMonad m => LP m Blocks
1789+-- environment = do
1790+-- controlSeq "begin"
1791+-- name <- braced
1792+-- M.findWithDefault mzero name environments
1793+-- <|> rawEnv name
1794+--
1795+-- inlineEnvironment :: PandocMonad m => LP m Inlines
1796+-- inlineEnvironment = try $ do
1797+-- controlSeq "begin"
1798+-- name <- braced
1799+-- M.findWithDefault mzero name inlineEnvironments
1800+--
1801+-- rawEnv :: PandocMonad m => String -> LP m Blocks
1802+-- rawEnv name = do
1803+-- exts <- getOption readerExtensions
1804+-- let parseRaw = extensionEnabled Ext_raw_tex exts
1805+-- rawOptions <- mconcat <$> many rawopt
1806+-- let beginCommand = "\\begin{" ++ name ++ "}" ++ rawOptions
1807+-- pos1 <- getPosition
1808+-- (bs, raw) <- withRaw $ env name blocks
1809+-- raw' <- applyMacros' $ beginCommand ++ raw
1810+-- if raw' /= beginCommand ++ raw
1811+-- then parseFromString' blocks raw'
1812+-- else if parseRaw
1813+-- then return $ rawBlock "latex" $ beginCommand ++ raw'
1814+-- else do
1815+-- unless parseRaw $ do
1816+-- report $ SkippedContent beginCommand pos1
1817+-- pos2 <- getPosition
1818+-- report $ SkippedContent ("\\end{" ++ name ++ "}") pos2
1819+-- return bs
1820+--
1821+-- rawVerbEnv :: PandocMonad m => String -> LP m Blocks
1822+-- rawVerbEnv name = do
1823+-- pos <- getPosition
1824+-- (_, raw) <- withRaw $ verbEnv name
1825+-- let raw' = "\\begin{tikzpicture}" ++ raw
1826+-- exts <- getOption readerExtensions
1827+-- let parseRaw = extensionEnabled Ext_raw_tex exts
1828+-- if parseRaw
1829+-- then return $ rawBlock "latex" raw'
1830+-- else do
1831+-- report $ SkippedContent raw' pos
1832+-- return mempty
1833+--
1834+-- ----
1835+--
1836+-- ----
1837+--
1838+-- keyval :: PandocMonad m => LP m (String, String)
1839+-- keyval = try $ do
1840+-- key <- many1 alphaNum
1841+-- val <- option "" $ char '=' >> braced <|> (many1 (alphaNum <|> oneOf ".:-|\\"))
1842+-- skipMany spaceChar
1843+-- optional (char ',')
1844+-- skipMany spaceChar
1845+-- return (key, val)
1846+--
1847+--
1848+-- keyvals :: PandocMonad m => LP m [(String, String)]
1849+-- keyvals = try $ char '[' *> manyTill keyval (char ']')
1850+--
1851+-- alltt :: PandocMonad m => String -> LP m Blocks
1852+-- alltt t = walk strToCode <$> parseFromString' blocks
1853+-- (substitute " " "\\ " $ substitute "%" "\\%" $
1854+-- intercalate "\\\\\n" $ lines t)
1855+-- where strToCode (Str s) = Code nullAttr s
1856+-- strToCode x = x
1857+--
1858+-- rawLaTeXBlock :: PandocMonad m => ParserT String ParserState String
1859+-- rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))
1860+--
1861+-- rawLaTeXInline :: PandocMonad m => ParserT String ParserState Inline
1862+-- rawLaTeXInline = do
1863+-- raw <- (snd <$> withRaw inlineCommand)
1864+-- <|> (snd <$> withRaw inlineEnvironment)
1865+-- <|> (snd <$> withRaw blockCommand)
1866+-- RawInline "latex" <$> applyMacros' raw
1867+--
1868+-- addImageCaption :: PandocMonad m => Blocks -> LP m Blocks
1869+-- addImageCaption = walkM go
1870+-- where go (Image attr alt (src,tit))
1871+-- | not ("fig:" `isPrefixOf` tit) = do
1872+-- mbcapt <- stateCaption <$> getState
1873+-- return $ case mbcapt of
1874+-- Just ils -> Image attr (toList ils) (src, "fig:" ++ tit)
1875+-- Nothing -> Image attr alt (src,tit)
1876+-- go x = return x
1877+--
1878+-- addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
1879+-- addTableCaption = walkM go
1880+-- where go (Table c als ws hs rs) = do
1881+-- mbcapt <- stateCaption <$> getState
1882+-- return $ case mbcapt of
1883+-- Just ils -> Table (toList ils) als ws hs rs
1884+-- Nothing -> Table c als ws hs rs
1885+-- go x = return x
1886+--
1887+-- environments :: PandocMonad m => M.Map String (LP m Blocks)
1888+-- environments = M.fromList
1889+-- [ ("document", env "document" blocks <* skipMany anyChar)
1890+-- , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))
1891+-- , ("letter", env "letter" letterContents)
1892+-- , ("minipage", env "minipage" $
1893+-- skipopts *> spaces' *> optional braced *> spaces' *> blocks)
1894+-- , ("figure", env "figure" $ skipopts *> figure)
1895+-- , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)
1896+-- , ("center", env "center" blocks)
1897+-- , ("longtable", env "longtable" $
1898+-- resetCaption *> simpTable "longtable" False >>= addTableCaption)
1899+-- , ("table", env "table" $
1900+-- resetCaption *> skipopts *> blocks >>= addTableCaption)
1901+-- , ("tabular*", env "tabular" $ simpTable "tabular*" True)
1902+-- , ("tabularx", env "tabularx" $ simpTable "tabularx" True)
1903+-- , ("tabular", env "tabular" $ simpTable "tabular" False)
1904+-- , ("quote", blockQuote <$> env "quote" blocks)
1905+-- , ("quotation", blockQuote <$> env "quotation" blocks)
1906+-- , ("verse", blockQuote <$> env "verse" blocks)
1907+-- , ("itemize", bulletList <$> listenv "itemize" (many item))
1908+-- , ("description", definitionList <$> listenv "description" (many descItem))
1909+-- , ("enumerate", orderedList')
1910+-- , ("alltt", alltt =<< verbEnv "alltt")
1911+-- , ("code", guardEnabled Ext_literate_haskell *>
1912+-- (codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
1913+-- verbEnv "code"))
1914+-- , ("comment", mempty <$ verbEnv "comment")
1915+-- , ("verbatim", codeBlock <$> verbEnv "verbatim")
1916+-- , ("Verbatim", fancyverbEnv "Verbatim")
1917+-- , ("BVerbatim", fancyverbEnv "BVerbatim")
1918+-- , ("lstlisting", do attr <- parseListingsOptions <$> option [] keyvals
1919+-- codeBlockWith attr <$> verbEnv "lstlisting")
1920+-- , ("minted", do options <- option [] keyvals
1921+-- lang <- grouped (many1 $ satisfy (/='}'))
1922+-- let kvs = [ (if k == "firstnumber"
1923+-- then "startFrom"
1924+-- else k, v) | (k,v) <- options ]
1925+-- let classes = [ lang | not (null lang) ] ++
1926+-- [ "numberLines" |
1927+-- lookup "linenos" options == Just "true" ]
1928+-- let attr = ("",classes,kvs)
1929+-- codeBlockWith attr <$> verbEnv "minted")
1930+-- , ("obeylines", parseFromString
1931+-- (para . trimInlines . mconcat <$> many inline) =<<
1932+-- intercalate "\\\\\n" . lines <$> verbEnv "obeylines")
1933+-- , ("displaymath", mathEnvWith para Nothing "displaymath")
1934+-- , ("equation", mathEnvWith para Nothing "equation")
1935+-- , ("equation*", mathEnvWith para Nothing "equation*")
1936+-- , ("gather", mathEnvWith para (Just "gathered") "gather")
1937+-- , ("gather*", mathEnvWith para (Just "gathered") "gather*")
1938+-- , ("multline", mathEnvWith para (Just "gathered") "multline")
1939+-- , ("multline*", mathEnvWith para (Just "gathered") "multline*")
1940+-- , ("eqnarray", mathEnvWith para (Just "aligned") "eqnarray")
1941+-- , ("eqnarray*", mathEnvWith para (Just "aligned") "eqnarray*")
1942+-- , ("align", mathEnvWith para (Just "aligned") "align")
1943+-- , ("align*", mathEnvWith para (Just "aligned") "align*")
1944+-- , ("alignat", mathEnvWith para (Just "aligned") "alignat")
1945+-- , ("alignat*", mathEnvWith para (Just "aligned") "alignat*")
1946+-- , ("tikzpicture", rawVerbEnv "tikzpicture")
1947+-- ]
1948+--
1949+-- figure :: PandocMonad m => LP m Blocks
1950+-- figure = try $ do
1951+-- resetCaption
1952+-- blocks >>= addImageCaption
1953+--
1954+-- letterContents :: PandocMonad m => LP m Blocks
1955+-- letterContents = do
1956+-- bs <- blocks
1957+-- st <- getState
1958+-- -- add signature (author) and address (title)
1959+-- let addr = case lookupMeta "address" (stateMeta st) of
1960+-- Just (MetaBlocks [Plain xs]) ->
1961+-- para $ trimInlines $ fromList xs
1962+-- _ -> mempty
1963+-- return $ addr <> bs -- sig added by \closing
1964+--
1965+-- closing :: PandocMonad m => LP m Blocks
1966+-- closing = do
1967+-- contents <- tok
1968+-- st <- getState
1969+-- let extractInlines (MetaBlocks [Plain ys]) = ys
1970+-- extractInlines (MetaBlocks [Para ys ]) = ys
1971+-- extractInlines _ = []
1972+-- let sigs = case lookupMeta "author" (stateMeta st) of
1973+-- Just (MetaList xs) ->
1974+-- para $ trimInlines $ fromList $
1975+-- intercalate [LineBreak] $ map extractInlines xs
1976+-- _ -> mempty
1977+-- return $ para (trimInlines contents) <> sigs
1978+--
1979+-- item :: PandocMonad m => LP m Blocks
1980+-- item = blocks *> controlSeq "item" *> skipopts *> blocks
1981+--
1982+-- looseItem :: PandocMonad m => LP m Blocks
1983+-- looseItem = do
1984+-- ctx <- stateParserContext `fmap` getState
1985+-- if ctx == ListItemState
1986+-- then mzero
1987+-- else return mempty
1988+--
1989+-- descItem :: PandocMonad m => LP m (Inlines, [Blocks])
1990+-- descItem = do
1991+-- blocks -- skip blocks before item
1992+-- controlSeq "item"
1993+-- optional sp
1994+-- ils <- opt
1995+-- bs <- blocks
1996+-- return (ils, [bs])
1997+--
1998+-- env :: PandocMonad m => String -> LP m a -> LP m a
1999+-- env name p = p <*
2000+-- (try (controlSeq "end" *> braced >>= guard . (== name))
2001+-- <?> ("\\end{" ++ name ++ "}"))
2002+--
2003+-- listenv :: PandocMonad m => String -> LP m a -> LP m a
2004+-- listenv name p = try $ do
2005+-- oldCtx <- stateParserContext `fmap` getState
2006+-- updateState $ \st -> st{ stateParserContext = ListItemState }
2007+-- res <- env name p
2008+-- updateState $ \st -> st{ stateParserContext = oldCtx }
2009+-- return res
2010+--
2011+-- mathEnvWith :: PandocMonad m
2012+-- => (Inlines -> a) -> Maybe String -> String -> LP m a
2013+-- mathEnvWith f innerEnv name = f <$> mathDisplay (inner <$> mathEnv name)
2014+-- where inner x = case innerEnv of
2015+-- Nothing -> x
2016+-- Just y -> "\\begin{" ++ y ++ "}\n" ++ x ++
2017+-- "\\end{" ++ y ++ "}"
2018+--
2019+-- mathEnv :: PandocMonad m => String -> LP m String
2020+-- mathEnv name = do
2021+-- skipopts
2022+-- optional blankline
2023+-- let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
2024+-- charMuncher = skipMany comment *>
2025+-- (many1 (noneOf "\\%") <|> try (string "\\%")
2026+-- <|> try (string "\\\\") <|> count 1 anyChar)
2027+-- res <- concat <$> manyTill charMuncher endEnv
2028+-- return $ stripTrailingNewlines res
2029+--
2030+-- verbEnv :: PandocMonad m => String -> LP m String
2031+-- verbEnv name = do
2032+-- skipopts
2033+-- optional blankline
2034+-- let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
2035+-- charMuncher = anyChar
2036+-- res <- manyTill charMuncher endEnv
2037+-- return $ stripTrailingNewlines res
2038+--
2039+-- fancyverbEnv :: PandocMonad m => String -> LP m Blocks
2040+-- fancyverbEnv name = do
2041+-- options <- option [] keyvals
2042+-- let kvs = [ (if k == "firstnumber"
2043+-- then "startFrom"
2044+-- else k, v) | (k,v) <- options ]
2045+-- let classes = [ "numberLines" |
2046+-- lookup "numbers" options == Just "left" ]
2047+-- let attr = ("",classes,kvs)
2048+-- codeBlockWith attr <$> verbEnv name
2049+--
2050+-- orderedList' :: PandocMonad m => LP m Blocks
2051+-- orderedList' = try $ do
2052+-- optional sp
2053+-- (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $
2054+-- try $ char '[' *> anyOrderedListMarker <* char ']'
2055+-- spaces
2056+-- optional $ try $ controlSeq "setlength" *> grouped (controlSeq "itemindent") *> braced
2057+-- spaces
2058+-- start <- option 1 $ try $ do controlSeq "setcounter"
2059+-- grouped (string "enum" *> many1 (oneOf "iv"))
2060+-- optional sp
2061+-- num <- grouped (many1 digit)
2062+-- spaces
2063+-- return (read num + 1 :: Int)
2064+-- bs <- listenv "enumerate" (many item)
2065+-- return $ orderedListWith (start, style, delim) bs
2066+--
2067+-- paragraph :: PandocMonad m => LP m Blocks
2068+-- paragraph = do
2069+-- x <- trimInlines . mconcat <$> many1 inline
2070+-- if x == mempty
2071+-- then return mempty
2072+-- else return $ para x
2073+--
2074+-- preamble :: PandocMonad m => LP m Blocks
2075+-- preamble = mempty <$> manyTill preambleBlock beginDoc
2076+-- where beginDoc = lookAhead $ try $ controlSeq "begin" *> string "{document}"
2077+-- preambleBlock = void comment
2078+-- <|> void sp
2079+-- <|> void blanklines
2080+-- <|> void include
2081+-- <|> void macro
2082+-- <|> void blockCommand
2083+-- <|> void anyControlSeq
2084+-- <|> void braced
2085+-- <|> void anyChar
2086+--
2087+-- -------
2088+--
2089+-- -- citations
2090+--
2091+-- addPrefix :: [Inline] -> [Citation] -> [Citation]
2092+-- addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks
2093+-- addPrefix _ _ = []
2094+--
2095+-- addSuffix :: [Inline] -> [Citation] -> [Citation]
2096+-- addSuffix s ks@(_:_) =
2097+-- let k = last ks
2098+-- in init ks ++ [k {citationSuffix = citationSuffix k ++ s}]
2099+-- addSuffix _ _ = []
2100+--
2101+-- simpleCiteArgs :: PandocMonad m => LP m [Citation]
2102+-- simpleCiteArgs = try $ do
2103+-- first <- optionMaybe $ toList <$> opt
2104+-- second <- optionMaybe $ toList <$> opt
2105+-- keys <- try $ bgroup *> (manyTill citationLabel egroup)
2106+-- let (pre, suf) = case (first , second ) of
2107+-- (Just s , Nothing) -> (mempty, s )
2108+-- (Just s , Just t ) -> (s , t )
2109+-- _ -> (mempty, mempty)
2110+-- conv k = Citation { citationId = k
2111+-- , citationPrefix = []
2112+-- , citationSuffix = []
2113+-- , citationMode = NormalCitation
2114+-- , citationHash = 0
2115+-- , citationNoteNum = 0
2116+-- }
2117+-- return $ addPrefix pre $ addSuffix suf $ map conv keys
2118+--
2119+-- citationLabel :: PandocMonad m => LP m String
2120+-- citationLabel = optional sp *>
2121+-- (many1 (satisfy isBibtexKeyChar)
2122+-- <* optional sp
2123+-- <* optional (char ',')
2124+-- <* optional sp)
2125+-- where isBibtexKeyChar c = isAlphaNum c || c `elem` (".:;?!`'()/*@_+=-[]" :: String)
2126+--
2127+-- cites :: PandocMonad m => CitationMode -> Bool -> LP m [Citation]
2128+-- cites mode multi = try $ do
2129+-- cits <- if multi
2130+-- then many1 simpleCiteArgs
2131+-- else count 1 simpleCiteArgs
2132+-- let cs = concat cits
2133+-- return $ case mode of
2134+-- AuthorInText -> case cs of
2135+-- (c:rest) -> c {citationMode = mode} : rest
2136+-- [] -> []
2137+-- _ -> map (\a -> a {citationMode = mode}) cs
2138+--
2139+-- citation :: PandocMonad m => String -> CitationMode -> Bool -> LP m Inlines
2140+-- citation name mode multi = do
2141+-- (c,raw) <- withRaw $ cites mode multi
2142+-- return $ cite c (rawInline "latex" $ "\\" ++ name ++ raw)
2143+--
2144+-- complexNatbibCitation :: PandocMonad m => CitationMode -> LP m Inlines
2145+-- complexNatbibCitation mode = try $ do
2146+-- let ils = (toList . trimInlines . mconcat) <$>
2147+-- many (notFollowedBy (oneOf "\\};") >> inline)
2148+-- let parseOne = try $ do
2149+-- skipSpaces
2150+-- pref <- ils
2151+-- cit' <- inline -- expect a citation
2152+-- let citlist = toList cit'
2153+-- cits' <- case citlist of
2154+-- [Cite cs _] -> return cs
2155+-- _ -> mzero
2156+-- suff <- ils
2157+-- skipSpaces
2158+-- optional $ char ';'
2159+-- return $ addPrefix pref $ addSuffix suff cits'
2160+-- (c:cits, raw) <- withRaw $ grouped parseOne
2161+-- return $ cite (c{ citationMode = mode }:cits)
2162+-- (rawInline "latex" $ "\\citetext" ++ raw)
2163+--
2164+-- -- tables
2165+--
2166+-- parseAligns :: PandocMonad m => LP m [(Alignment, Double, (String, String))]
2167+-- parseAligns = try $ do
2168+-- bgroup
2169+-- let maybeBar = skipMany $ sp <|> () <$ char '|' <|> () <$ (char '@' >> braced)
2170+-- maybeBar
2171+-- let cAlign = AlignCenter <$ char 'c'
2172+-- let lAlign = AlignLeft <$ char 'l'
2173+-- let rAlign = AlignRight <$ char 'r'
2174+-- let parAlign = AlignLeft <$ char 'p'
2175+-- -- algins from tabularx
2176+-- let xAlign = AlignLeft <$ char 'X'
2177+-- let mAlign = AlignLeft <$ char 'm'
2178+-- let bAlign = AlignLeft <$ char 'b'
2179+-- let alignChar = cAlign <|> lAlign <|> rAlign <|> parAlign
2180+-- <|> xAlign <|> mAlign <|> bAlign
2181+-- let alignPrefix = char '>' >> braced
2182+-- let alignSuffix = char '<' >> braced
2183+-- let colWidth = try $ do
2184+-- char '{'
2185+-- ds <- many1 (oneOf "0123456789.")
2186+-- spaces
2187+-- string "\\linewidth"
2188+-- char '}'
2189+-- case safeRead ds of
2190+-- Just w -> return w
2191+-- Nothing -> return 0.0
2192+-- let alignSpec = do
2193+-- spaces
2194+-- pref <- option "" alignPrefix
2195+-- spaces
2196+-- al <- alignChar
2197+-- width <- colWidth <|> option 0.0 (do s <- braced
2198+-- pos <- getPosition
2199+-- report $ SkippedContent s pos
2200+-- return 0.0)
2201+-- spaces
2202+-- suff <- option "" alignSuffix
2203+-- return (al, width, (pref, suff))
2204+-- aligns' <- sepEndBy alignSpec maybeBar
2205+-- spaces
2206+-- egroup
2207+-- spaces
2208+-- return $ aligns'
2209+--
2210+-- hline :: PandocMonad m => LP m ()
2211+-- hline = try $ do
2212+-- spaces'
2213+-- controlSeq "hline" <|>
2214+-- -- booktabs rules:
2215+-- controlSeq "toprule" <|>
2216+-- controlSeq "bottomrule" <|>
2217+-- controlSeq "midrule" <|>
2218+-- controlSeq "endhead" <|>
2219+-- controlSeq "endfirsthead"
2220+-- spaces'
2221+-- optional $ bracketed (many1 (satisfy (/=']')))
2222+-- return ()
2223+--
2224+-- lbreak :: PandocMonad m => LP m ()
2225+-- lbreak = () <$ try (spaces' *>
2226+-- (controlSeq "\\" <|> controlSeq "tabularnewline") <*
2227+-- spaces')
2228+--
2229+-- amp :: PandocMonad m => LP m ()
2230+-- amp = () <$ try (spaces' *> char '&' <* spaces')
2231+--
2232+-- parseTableRow :: PandocMonad m
2233+-- => String -- ^ table environment name
2234+-- -> [(String, String)] -- ^ pref/suffixes
2235+-- -> LP m [Blocks]
2236+-- parseTableRow envname prefsufs = try $ do
2237+-- let cols = length prefsufs
2238+-- let tableCellRaw = concat <$> many
2239+-- (do notFollowedBy amp
2240+-- notFollowedBy lbreak
2241+-- notFollowedBy $ () <$ try (string ("\\end{" ++ envname ++ "}"))
2242+-- many1 (noneOf "&%\n\r\\")
2243+-- <|> try (string "\\&")
2244+-- <|> count 1 anyChar)
2245+-- let plainify bs = case toList bs of
2246+-- [Para ils] -> plain (fromList ils)
2247+-- _ -> bs
2248+-- rawcells <- sepBy1 tableCellRaw amp
2249+-- guard $ length rawcells == cols
2250+-- let rawcells' = zipWith (\c (p, s) -> p ++ trim c ++ s) rawcells prefsufs
2251+-- let tableCell = plainify <$> blocks
2252+-- cells' <- mapM (parseFromString' tableCell) rawcells'
2253+-- let numcells = length cells'
2254+-- guard $ numcells <= cols && numcells >= 1
2255+-- guard $ cells' /= [mempty]
2256+-- -- note: a & b in a three-column table leaves an empty 3rd cell:
2257+-- let cells'' = cells' ++ replicate (cols - numcells) mempty
2258+-- spaces'
2259+-- return cells''
2260+--
2261+-- spaces' :: PandocMonad m => LP m ()
2262+-- spaces' = spaces *> skipMany (comment *> spaces)
2263+--
2264+-- simpTable :: PandocMonad m => String -> Bool -> LP m Blocks
2265+-- simpTable envname hasWidthParameter = try $ do
2266+-- when hasWidthParameter $ () <$ (spaces' >> tok)
2267+-- skipopts
2268+-- colspecs <- parseAligns
2269+-- let (aligns, widths, prefsufs) = unzip3 colspecs
2270+-- let cols = length colspecs
2271+-- optional $ controlSeq "caption" *> skipopts *> setCaption
2272+-- optional lbreak
2273+-- spaces'
2274+-- skipMany hline
2275+-- spaces'
2276+-- header' <- option [] $ try (parseTableRow envname prefsufs <*
2277+-- lbreak <* many1 hline)
2278+-- spaces'
2279+-- rows <- sepEndBy (parseTableRow envname prefsufs)
2280+-- (lbreak <* optional (skipMany hline))
2281+-- spaces'
2282+-- optional $ controlSeq "caption" *> skipopts *> setCaption
2283+-- optional lbreak
2284+-- spaces'
2285+-- let header'' = if null header'
2286+-- then replicate cols mempty
2287+-- else header'
2288+-- lookAhead $ controlSeq "end" -- make sure we're at end
2289+-- return $ table mempty (zip aligns widths) header'' rows
2290+--
2291+-- removeDoubleQuotes :: String -> String
2292+-- removeDoubleQuotes ('"':xs) =
2293+-- case reverse xs of
2294+-- '"':ys -> reverse ys
2295+-- _ -> '"':xs
2296+-- removeDoubleQuotes xs = xs
2297+--
2298+-- inputListing :: PandocMonad m => LP m Blocks
2299+-- inputListing = do
2300+-- pos <- getPosition
2301+-- options <- option [] keyvals
2302+-- f <- filter (/='"') <$> braced
2303+-- dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
2304+-- mbCode <- readFileFromDirs dirs f
2305+-- codeLines <- case mbCode of
2306+-- Just s -> return $ lines s
2307+-- Nothing -> do
2308+-- report $ CouldNotLoadIncludeFile f pos
2309+-- return []
2310+-- let (ident,classes,kvs) = parseListingsOptions options
2311+-- let language = case lookup "language" options >>= fromListingsLanguage of
2312+-- Just l -> [l]
2313+-- Nothing -> take 1 $ languagesByExtension (takeExtension f)
2314+-- let firstline = fromMaybe 1 $ lookup "firstline" options >>= safeRead
2315+-- let lastline = fromMaybe (length codeLines) $
2316+-- lookup "lastline" options >>= safeRead
2317+-- let codeContents = intercalate "\n" $ take (1 + lastline - firstline) $
2318+-- drop (firstline - 1) codeLines
2319+-- return $ codeBlockWith (ident,ordNub (classes ++ language),kvs) codeContents
2320+--
2321+-- parseListingsOptions :: [(String, String)] -> Attr
2322+-- parseListingsOptions options =
2323+-- let kvs = [ (if k == "firstnumber"
2324+-- then "startFrom"
2325+-- else k, v) | (k,v) <- options ]
2326+-- classes = [ "numberLines" |
2327+-- lookup "numbers" options == Just "left" ]
2328+-- ++ maybeToList (lookup "language" options
2329+-- >>= fromListingsLanguage)
2330+-- in (fromMaybe "" (lookup "label" options), classes, kvs)
2331+--
2332+--