@@ -55,18 +55,45 @@ import Text.Pandoc.ImageSize (numUnit, showFl)
5555import Text.Pandoc.Logging
5656import Text.Pandoc.Options
5757import Text.Pandoc.Parsing hiding (many, optional, withRaw,
58+ mathInline, mathDisplay,
5859 space, (<|>), spaces, blankline)
5960import Text.Pandoc.Shared
6061import Text.Pandoc.Walk
62+import Text.Pandoc.Error (PandocError(PandocParsecError))
6163
6264import Text.Pandoc.Extensions (getDefaultExtensions)
65+import Debug.Trace (traceShowId)
6366
6467-- | Parse LaTeX from string and return 'Pandoc' document.
6568readLaTeX :: PandocMonad m
6669 => ReaderOptions -- ^ Reader options
6770 -> Text -- ^ String to parse (assumes @'\n'@ line endings)
6871 -> m Pandoc
69−readLaTeX opts ltx = undefined
72+readLaTeX opts ltx = do
73+ parsed <- runParserT parseLaTeX def{ stateOptions = opts } "source"
74+ (tokenize (crFilter ltx))
75+ case parsed of
76+ Right result -> return result
77+ Left e -> throwError $ PandocParsecError (T.unpack ltx) e
78+
79+parseLaTeX :: PandocMonad m => LP m Pandoc
80+parseLaTeX = do
81+ bs <- blocks
82+ eof
83+ st <- getState
84+ let meta = stateMeta st
85+ let doc' = doc bs
86+ let headerLevel (Header n _ _) = [n]
87+ headerLevel _ = []
88+ let bottomLevel = minimumDef 1 $ query headerLevel doc'
89+ let adjustHeaders m (Header n attr ils) = Header (n+m) attr ils
90+ adjustHeaders _ x = x
91+ let (Pandoc _ bs') =
92+ -- handle the case where you have \part or \chapter
93+ (if bottomLevel < 1
94+ then walk (adjustHeaders (1 - bottomLevel))
95+ else id) doc'
96+ return $ Pandoc meta bs'
7097
7198testParser :: LP PandocIO a -> Text -> IO a
7299testParser p t = do
@@ -184,6 +211,11 @@ anyControlSeq = satisfyTok isCtrlSeq <* optional sp
184211 where isCtrlSeq (Tok _ CtrlSeq _) = True
185212 isCtrlSeq _ = False
186213
214+anySymbol :: PandocMonad m => LP m Tok
215+anySymbol = satisfyTok isSym
216+ where isSym (Tok _ Symbol _) = True
217+ isSym _ = False
218+
187219spaces :: PandocMonad m => LP m ()
188220spaces = skipMany (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
189221
@@ -192,11 +224,10 @@ spaces1 = skipMany1 (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
192224
193225tokTypeIn :: [TokType] -> Tok -> Bool
194226tokTypeIn toktypes (Tok _ tt _) = tt `elem` toktypes
195−tokTypeIn _ _ = False
196227
197228controlSeq :: PandocMonad m => Text -> LP m Tok
198229controlSeq name = satisfyTok isNamed
199− where isNamed t@(Tok _ CtrlSeq n) = n == T.singleton '\\' <> name
230+ where isNamed (Tok _ CtrlSeq n) = n == T.singleton '\\' <> name
200231 isNamed _ = False
201232
202233symbol :: PandocMonad m => Char -> LP m Tok
@@ -369,6 +400,62 @@ quoted' f starter ender = do
369400 cs -> cs)
370401 else lit startchs
371402
403+enquote :: PandocMonad m => LP m Inlines
404+enquote = do
405+ skipopts
406+ context <- stateQuoteContext <$> getState
407+ if context == InDoubleQuote
408+ then singleQuoted <$> withQuoteContext InSingleQuote tok
409+ else doubleQuoted <$> withQuoteContext InDoubleQuote tok
410+
411+doverb :: PandocMonad m => LP m Inlines
412+doverb = do
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
430+
431+dolstinline :: PandocMonad m => LP m Inlines
432+dolstinline = do
433+ options <- option [] keyvals
434+ let classes = maybeToList $ lookup "language" options >>= fromListingsLanguage
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)
442+
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)
455+
456+keyvals :: PandocMonad m => LP m [(String, String)]
457+keyvals = try $ symbol '[' >> manyTill keyval (symbol ']')
458+
372459accent :: (Char -> String) -> Inlines -> LP m Inlines
373460accent f ils =
374461 case toList ils of
@@ -575,6 +662,15 @@ breve 'U' = "Ŭ"
575662breve 'u' = "ŭ"
576663breve c = [c]
577664
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')
578674
579675dollarsMath :: PandocMonad m => LP m Inlines
580676dollarsMath = do
@@ -582,8 +678,8 @@ dollarsMath = do
582678 display <- option False (True <$ symbol '$')
583679 contents <- many1Till anyTok (symbol '$')
584680 when display (() <$ symbol '$')
585− let constructor = if display then displayMath else math
586− return $ constructor $ T.unpack $ untokenize contents
681+ let constructor = if display then mathDisplay else mathInline
682+ return $ constructor contents
587683
588684inlineCommand' :: PandocMonad m => LP m Inlines
589685inlineCommand' = try $ do
@@ -668,7 +764,6 @@ ignore raw = do
668764
669765withRaw :: PandocMonad m => LP m a -> LP m (a, [Tok])
670766withRaw parser = do
671− pos1 <- getPosition
672767 inp <- getInput
673768 result <- parser
674769 nxt <- option (Tok (0,0) Word "") (lookAhead anyTok)
@@ -731,9 +826,9 @@ inlineCommands = M.fromList $
731826 , ("textgreek", tok)
732827 , ("sep", lit ",")
733828-- , ("cref", rawInlineOr "cref" (inBrackets <$> tok)) -- from cleveref.sty
734−-- , ("(", mathInline $ manyTill anyChar (try $ string "\\)"))
735−-- , ("[", mathDisplay $ manyTill anyChar (try $ string "\\]"))
736−-- , ("ensuremath", mathInline braced)
829+ , ("(", mathInline <$> manyTill anyTok (controlSeq ")"))
830+ , ("[", mathDisplay <$> manyTill anyTok (controlSeq "]"))
831+ , ("ensuremath", mathInline <$> braced)
737832 , ("texorpdfstring", (\_ x -> x) <$> tok <*> tok)
738833 , ("P", lit "¶")
739834 , ("S", lit "§")
@@ -795,9 +890,9 @@ inlineCommands = M.fromList $
795890 , ("textgreater", lit ">")
796891 , ("thanks", note <$> grouped block)
797892 , ("footnote", note <$> grouped block)
798−-- , ("verb", doverb)
799−-- , ("lstinline", dolstinline)
800−-- , ("Verb", doverb)
893+ , ("verb", doverb)
894+ , ("lstinline", dolstinline)
895+ , ("Verb", doverb)
801896-- , ("url", (unescapeURL <$> braced) >>= \url ->
802897-- pure (link url "" (str url)))
803898-- , ("href", (unescapeURL <$> braced <* optional sp) >>= \url ->
@@ -806,7 +901,7 @@ inlineCommands = M.fromList $
806901-- , ("includegraphics", do options <- option [] keyvals
807902-- src <- unescapeURL . removeDoubleQuotes <$> braced
808903-- mkImage options src)
809−-- , ("enquote", enquote)
904+ , ("enquote", enquote)
810905-- , ("cite", citation "cite" NormalCitation False)
811906-- , ("Cite", citation "Cite" NormalCitation False)
812907-- , ("citep", citation "citep" NormalCitation False)
@@ -990,1463 +1085,1248 @@ blocks :: PandocMonad m => LP m Blocks
9901085blocks = mconcat <$> many block
9911086
9921087
993−{-
994−
995−-}
996−
997−{-
998−-- | Parse LaTeX from string and return 'Pandoc' document.
999−readLaTeX :: PandocMonad m
1000− => ReaderOptions -- ^ Reader options
1001− -> Text -- ^ String to parse (assumes @'\n'@ line endings)
1002− -> m Pandoc
1003−readLaTeX opts ltx = do
1004− parsed <- readWithM parseLaTeX def{ stateOptions = opts }
1005− (unpack (crFilter ltx))
1006− case parsed of
1007− Right result -> return result
1008− Left e -> throwError e
1009−
1010−
1011−parseLaTeX :: PandocMonad m => LP m Pandoc
1012−parseLaTeX = do
1013− bs <- blocks
1014− eof
1015− st <- getState
1016− let meta = stateMeta st
1017− let doc' = doc bs
1018− let headerLevel (Header n _ _) = [n]
1019− headerLevel _ = []
1020− let bottomLevel = minimumDef 1 $ query headerLevel doc'
1021− let adjustHeaders m (Header n attr ils) = Header (n+m) attr ils
1022− adjustHeaders _ x = x
1023− let (Pandoc _ bs') =
1024− -- handle the case where you have \part or \chapter
1025− (if bottomLevel < 1
1026− then walk (adjustHeaders (1 - bottomLevel))
1027− else id) doc'
1028− return $ Pandoc meta bs'
1029−
1030−anyControlSeq :: PandocMonad m => LP m String
1031−anyControlSeq = do
1032− char '\\'
1033− next <- option '\n' anyChar
1034− case next of
1035− '\n' -> return ""
1036− c | isLetter c -> (c:) <$> (many letter <* optional sp)
1037− | otherwise -> return [c]
1038−
1039−controlSeq :: PandocMonad m => String -> LP m String
1040−controlSeq name = try $ do
1041− char '\\'
1042− case name of
1043− "" -> mzero
1044− [c] | not (isLetter c) -> string [c]
1045− cs -> string cs <* notFollowedBy letter <* optional sp
1046− return name
1047−
1048−dimenarg :: PandocMonad m => LP m String
1049−dimenarg = try $ do
1050− ch <- option "" $ string "="
1051− num <- many1 digit
1052− dim <- oneOfStrings ["pt","pc","in","bp","cm","mm","dd","cc","sp"]
1053− return $ ch ++ num ++ dim
1054−
1055−sp :: PandocMonad m => LP m ()
1056−sp = whitespace <|> endline
1057−
1058−whitespace :: PandocMonad m => LP m ()
1059−whitespace = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t')
1060−
1061−endline :: PandocMonad m => LP m ()
1062−endline = try (newline >> lookAhead anyChar >> notFollowedBy blankline)
1063−
1064−isLowerHex :: Char -> Bool
1065−isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
1066−
1067−primEscape :: PandocMonad m => LP m Char
1068−primEscape = try $ do
1069− string "^^"
1070− c <- satisfy (\x -> x >= '\0' && x <= '\128')
1071− d <- if isLowerHex c
1072− then option "" $ count 1 (satisfy isLowerHex)
1073− else return ""
1074− if null d
1075− then case ord c of
1076− x | x >= 64 && x <= 127 -> return $ chr (x - 64)
1077− | otherwise -> return $ chr (x + 64)
1078− else return $ chr $ read ('0':'x':c:d)
1079−
1080−comment :: PandocMonad m => LP m ()
1081−comment = do
1082− char '%'
1083− skipMany (satisfy (/='\n'))
1084− optional newline
1085− return ()
1086−
1087−bgroup :: PandocMonad m => LP m ()
1088−bgroup = try $ do
1089− skipMany (spaceChar <|> try (newline <* notFollowedBy blankline))
1090− () <$ char '{'
1091− <|> () <$ controlSeq "bgroup"
1092− <|> () <$ controlSeq "begingroup"
1093−
1094−egroup :: PandocMonad m => LP m ()
1095−egroup = () <$ char '}'
1096− <|> () <$ controlSeq "egroup"
1097− <|> () <$ controlSeq "endgroup"
1098−
1099−grouped :: PandocMonad m => Monoid a => LP m a -> LP m a
1100−grouped parser = try $ do
1101− bgroup
1102− -- first we check for an inner 'grouped', because
1103− -- {{a,b}} should be parsed the same as {a,b}
1104− try (grouped parser <* egroup)
1105− <|> (mconcat <$> manyTill parser egroup)
1106−
1107−braced :: PandocMonad m => LP m String
1108−braced = grouped chunk
1109− where chunk =
1110− many1 (satisfy (\c -> c /= '\\' && c /= '}' && c /= '{'))
1111− <|> try (string "\\}")
1112− <|> try (string "\\{")
1113− <|> try (string "\\\\")
1114− <|> ((\x -> "{" ++ x ++ "}") <$> braced)
1115− <|> count 1 anyChar
1116−
1117−bracketed :: PandocMonad m => Monoid a => LP m a -> LP m a
1118−bracketed parser = try $ char '[' *> (mconcat <$> manyTill parser (char ']'))
1119−
1120−mathDisplay :: PandocMonad m => LP m String -> LP m Inlines
1121−mathDisplay p = displayMath <$> (try p >>= applyMacros' . trim)
1122−
1123−mathInline :: PandocMonad m => LP m String -> LP m Inlines
1124−mathInline p = math <$> (try p >>= applyMacros')
1125−
1126−mathChars :: PandocMonad m => LP m String
1127−mathChars =
1128− concat <$> many (escapedChar
1129− <|> (snd <$> withRaw braced)
1130− <|> many1 (satisfy isOrdChar))
1131− where escapedChar = try $ do char '\\'
1132− c <- anyChar
1133− return ['\\',c]
1134− isOrdChar '$' = False
1135− isOrdChar '{' = False
1136− isOrdChar '}' = False
1137− isOrdChar '\\' = False
1138− isOrdChar _ = True
1139−
1140−inline :: PandocMonad m => LP m Inlines
1141−inline = (mempty <$ comment)
1142− <|> (space <$ whitespace)
1143− <|> (softbreak <$ endline)
1144− <|> inlineText
1145− <|> inlineCommand
1146− <|> inlineEnvironment
1147− <|> inlineGroup
1148− <|> (char '-' *> option (str "-")
1149− (char '-' *> option (str "–") (str "—" <$ char '-')))
1150− <|> doubleQuote
1151− <|> singleQuote
1152− <|> (str "”" <$ try (string "''"))
1153− <|> (str "”" <$ char '”')
1154− <|> (str "’" <$ char '\'')
1155− <|> (str "’" <$ char '’')
1156− <|> (str "\160" <$ char '~')
1157− <|> mathDisplay (string "$$" *> mathChars <* string "$$")
1158− <|> mathInline (char '$' *> mathChars <* char '$')
1159− <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)
1160− <|> (str . (:[]) <$> primEscape)
1161− <|> (do res <- oneOf "#&~^'`\"[]"
1162− pos <- getPosition
1163− report $ ParsingUnescaped [res] pos
1164− return $ str [res])
1165−
1166−inlines :: PandocMonad m => LP m Inlines
1167−inlines = mconcat <$> many (notFollowedBy (char '}') *> inline)
1168−
1169−inlineGroup :: PandocMonad m => LP m Inlines
1170−inlineGroup = do
1171− ils <- grouped inline
1172− if isNull ils
1173− then return mempty
1174− else return $ spanWith nullAttr ils
1175− -- we need the span so we can detitlecase bibtex entries;
1176− -- we need to know when something is {C}apitalized
1177−
1178−block :: PandocMonad m => LP m Blocks
1179−block = (mempty <$ comment)
1180− <|> (mempty <$ ((spaceChar <|> newline) *> spaces))
1181− <|> environment
1182− <|> include
1183− <|> macro
1184− <|> blockCommand
1185− <|> paragraph
1186− <|> grouped block
1187−
1188−blocks :: PandocMonad m => LP m Blocks
1189−blocks = mconcat <$> many block
1190−
1191−getRawCommand :: PandocMonad m => String -> LP m String
1192−getRawCommand name' = do
1193− rawargs <- withRaw (many (try (optional sp *> opt)) *>
1194− option "" (try (optional sp *> dimenarg)) *>
1195− many braced)
1196− return $ '\\' : name' ++ snd rawargs
1197−
1198−lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
1199−lookupListDefault d = (fromMaybe d .) . lookupList
1200− where
1201− lookupList l m = msum $ map (`M.lookup` m) l
1202−
1203−blockCommand :: PandocMonad m => LP m Blocks
1204−blockCommand = try $ do
1205− name <- anyControlSeq
1206− guard $ name /= "begin" && name /= "end"
1207− star <- option "" (string "*" <* optional sp)
1208− let name' = name ++ star
1209− let raw = do
1210− rawcommand <- getRawCommand name'
1211− transformed <- applyMacros' rawcommand
1212− guard $ transformed /= rawcommand
1213− notFollowedBy $ parseFromString' inlines transformed
1214− parseFromString' blocks transformed
1215− lookupListDefault raw [name',name] blockCommands
1216−
1217−inBrackets :: Inlines -> Inlines
1218−inBrackets x = str "[" <> x <> str "]"
1219−
1220−-- eat an optional argument and one or more arguments in braces
1221−ignoreInlines :: PandocMonad m => Text -> (Text, LP m Inlines)
1222−ignoreInlines name = (name, p)
1223− where
1224− p = do oa <- optargs
1225− let rawCommand = '\\':name ++ oa
1226− let doraw = guardRaw >> return (rawInline "latex" rawCommand)
1227− doraw <|> ignore rawCommand
1228−
1229−guardRaw :: PandocMonad m => LP m ()
1230−guardRaw = getOption readerExtensions >>= guard . extensionEnabled Ext_raw_tex
1231−
1232−optargs :: PandocMonad m => LP m String
1233−optargs = snd <$> withRaw (skipopts *> skipMany (try $ optional sp *> braced))
1234−
1235−ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a
1236−ignore raw = do
1237− pos <- getPosition
1238− report $ SkippedContent raw pos
1239− return mempty
1240−
1241−ignoreBlocks :: PandocMonad m => String -> (String, LP m Blocks)
1242−ignoreBlocks name = (name, p)
1243− where
1244− p = do oa <- optargs
1245− let rawCommand = '\\':name ++ oa
1246− let doraw = guardRaw >> return (rawBlock "latex" rawCommand)
1247− doraw <|> ignore rawCommand
1248−
1249−blockCommands :: PandocMonad m => M.Map String (LP m Blocks)
1250−blockCommands = M.fromList $
1251− [ ("par", mempty <$ skipopts)
1252− , ("parbox", braced >> grouped blocks)
1253− , ("title", mempty <$ (skipopts *>
1254− (grouped inline >>= addMeta "title")
1255− <|> (grouped block >>= addMeta "title")))
1256− , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle"))
1257− , ("author", mempty <$ (skipopts *> authors))
1258− -- -- in letter class, temp. store address & sig as title, author
1259− , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))
1260− , ("signature", mempty <$ (skipopts *> authors))
1261− , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))
1262− -- Koma-script metadata commands
1263− , ("dedication", mempty <$ (skipopts *> tok >>= addMeta "dedication"))
1264− -- sectioning
1265− , ("part", section nullAttr (-1))
1266− , ("part*", section nullAttr (-1))
1267− , ("chapter", section nullAttr 0)
1268− , ("chapter*", section ("",["unnumbered"],[]) 0)
1269− , ("section", section nullAttr 1)
1270− , ("section*", section ("",["unnumbered"],[]) 1)
1271− , ("subsection", section nullAttr 2)
1272− , ("subsection*", section ("",["unnumbered"],[]) 2)
1273− , ("subsubsection", section nullAttr 3)
1274− , ("subsubsection*", section ("",["unnumbered"],[]) 3)
1275− , ("paragraph", section nullAttr 4)
1276− , ("paragraph*", section ("",["unnumbered"],[]) 4)
1277− , ("subparagraph", section nullAttr 5)
1278− , ("subparagraph*", section ("",["unnumbered"],[]) 5)
1279− -- beamer slides
1280− , ("frametitle", section nullAttr 3)
1281− , ("framesubtitle", section nullAttr 4)
1282− -- letters
1283− , ("opening", (para . trimInlines) <$> (skipopts *> tok))
1284− , ("closing", skipopts *> closing)
1285− --
1286− , ("hrule", pure horizontalRule)
1287− , ("strut", pure mempty)
1288− , ("rule", skipopts *> tok *> tok *> pure horizontalRule)
1289− , ("item", skipopts *> looseItem)
1290− , ("documentclass", skipopts *> braced *> preamble)
1291− , ("centerline", (para . trimInlines) <$> (skipopts *> tok))
1292− , ("caption", skipopts *> setCaption)
1293− , ("bibliography", mempty <$ (skipopts *> braced >>=
1294− addMeta "bibliography" . splitBibs))
1295− , ("addbibresource", mempty <$ (skipopts *> braced >>=
1296− addMeta "bibliography" . splitBibs))
1297− -- includes
1298− , ("lstinputlisting", inputListing)
1299− , ("graphicspath", graphicsPath)
1300− -- hyperlink
1301− , ("hypertarget", braced >> grouped block)
1302− ] ++ map ignoreBlocks
1303− -- these commands will be ignored unless --parse-raw is specified,
1304− -- in which case they will appear as raw latex blocks
1305− [ "newcommand", "renewcommand", "newenvironment", "renewenvironment"
1306− -- newcommand, etc. should be parsed by macro, but we need this
1307− -- here so these aren't parsed as inline commands to ignore
1308− , "special", "pdfannot", "pdfstringdef"
1309− , "bibliographystyle"
1310− , "maketitle", "makeindex", "makeglossary"
1311− , "addcontentsline", "addtocontents", "addtocounter"
1312− -- \ignore{} is used conventionally in literate haskell for definitions
1313− -- that are to be processed by the compiler but not printed.
1314− , "ignore"
1315− , "hyperdef"
1316− , "markboth", "markright", "markleft"
1317− , "hspace", "vspace"
1318− , "newpage"
1319− , "clearpage"
1320− , "pagebreak"
1321− ]
1322−
1323−graphicsPath :: PandocMonad m => LP m Blocks
1324−graphicsPath = do
1325− ps <- bgroup *> (manyTill braced egroup)
1326− getResourcePath >>= setResourcePath . (++ ps)
1327− return mempty
1328−
1329−addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()
1330−addMeta field val = updateState $ \st ->
1331− st{ stateMeta = addMetaField field val $ stateMeta st }
1332−
1333−splitBibs :: String -> [Inlines]
1334−splitBibs = map (str . flip replaceExtension "bib" . trim) . splitBy (==',')
1335−
1336−setCaption :: PandocMonad m => LP m Blocks
1337−setCaption = do
1338− ils <- tok
1339− mblabel <- option Nothing $
1340− try $ spaces' >> controlSeq "label" >> (Just <$> tok)
1341− let ils' = case mblabel of
1342− Just lab -> ils <> spanWith
1343− ("",[],[("data-label", stringify lab)]) mempty
1344− Nothing -> ils
1345− updateState $ \st -> st{ stateCaption = Just ils' }
1346− return mempty
1347−
1348−resetCaption :: PandocMonad m => LP m ()
1349−resetCaption = updateState $ \st -> st{ stateCaption = Nothing }
1350−
1351−authors :: PandocMonad m => LP m ()
1352−authors = try $ do
1353− bgroup
1354− let oneAuthor = mconcat <$>
1355− many1 (notFollowedBy' (controlSeq "and") >>
1356− (inline <|> mempty <$ blockCommand))
1357− -- skip e.g. \vspace{10pt}
1358− auths <- sepBy oneAuthor (controlSeq "and")
1359− egroup
1360− addMeta "author" (map trimInlines auths)
1361−
1362−section :: PandocMonad m => Attr -> Int -> LP m Blocks
1363−section (ident, classes, kvs) lvl = do
1364− skipopts
1365− contents <- grouped inline
1366− lab <- option ident $ try (spaces' >> controlSeq "label" >> spaces' >> braced)
1367− attr' <- registerHeader (lab, classes, kvs) contents
1368− return $ headerWith attr' lvl contents
1369−
1370−inlineCommand :: PandocMonad m => LP m Inlines
1371−inlineCommand = try $ do
1372− (name, raw') <- withRaw anyControlSeq
1373− guard $ name /= "begin" && name /= "end"
1374− star <- option "" (string "*")
1375− let name' = name ++ star
1376− let raw = do
1377− guard $ not (isBlockCommand name)
1378− rawargs <- withRaw
1379− (skipangles *> skipopts *> option "" dimenarg *> many braced)
1380− let rawcommand = raw' ++ star ++ snd rawargs
1381− transformed <- applyMacros' rawcommand
1382− exts <- getOption readerExtensions
1383− if transformed /= rawcommand
1384− then parseFromString' inlines transformed
1385− else if extensionEnabled Ext_raw_tex exts
1386− then return $ rawInline "latex" rawcommand
1387− else ignore rawcommand
1388− (lookupListDefault raw [name',name] inlineCommands <*
1389− optional (try (string "{}")))
1390−
1391−rawInlineOr :: PandocMonad m => String -> LP m Inlines -> LP m Inlines
1392−rawInlineOr name' fallback = do
1393− parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
1394− if parseRaw
1395− then rawInline "latex" <$> getRawCommand name'
1396− else fallback
1397−
1398−isBlockCommand :: String -> Bool
1399−isBlockCommand s = s `M.member` (blockCommands :: M.Map String (LP PandocPure Blocks))
1400−
1401−
1402−inlineEnvironments :: PandocMonad m => M.Map String (LP m Inlines)
1403−inlineEnvironments = M.fromList
1404− [ ("displaymath", mathEnvWith id Nothing "displaymath")
1405− , ("math", math <$> mathEnv "math")
1406− , ("equation", mathEnvWith id Nothing "equation")
1407− , ("equation*", mathEnvWith id Nothing "equation*")
1408− , ("gather", mathEnvWith id (Just "gathered") "gather")
1409− , ("gather*", mathEnvWith id (Just "gathered") "gather*")
1410− , ("multline", mathEnvWith id (Just "gathered") "multline")
1411− , ("multline*", mathEnvWith id (Just "gathered") "multline*")
1412− , ("eqnarray", mathEnvWith id (Just "aligned") "eqnarray")
1413− , ("eqnarray*", mathEnvWith id (Just "aligned") "eqnarray*")
1414− , ("align", mathEnvWith id (Just "aligned") "align")
1415− , ("align*", mathEnvWith id (Just "aligned") "align*")
1416− , ("alignat", mathEnvWith id (Just "aligned") "alignat")
1417− , ("alignat*", mathEnvWith id (Just "aligned") "alignat*")
1418− ]
1419−
1420−inlineCommands :: PandocMonad m => M.Map String (LP m Inlines)
1421−inlineCommands = M.fromList $
1422− [ ("emph", extractSpaces emph <$> tok)
1423− , ("textit", extractSpaces emph <$> tok)
1424− , ("textsl", extractSpaces emph <$> tok)
1425− , ("textsc", extractSpaces smallcaps <$> tok)
1426− , ("textsf", extractSpaces (spanWith ("",["sans-serif"],[])) <$> tok)
1427− , ("textmd", extractSpaces (spanWith ("",["medium"],[])) <$> tok)
1428− , ("textrm", extractSpaces (spanWith ("",["roman"],[])) <$> tok)
1429− , ("textup", extractSpaces (spanWith ("",["upright"],[])) <$> tok)
1430− , ("texttt", ttfamily)
1431− , ("sout", extractSpaces strikeout <$> tok)
1432− , ("textsuperscript", extractSpaces superscript <$> tok)
1433− , ("textsubscript", extractSpaces subscript <$> tok)
1434− , ("textbackslash", lit "\\")
1435− , ("backslash", lit "\\")
1436− , ("slash", lit "/")
1437− , ("textbf", extractSpaces strong <$> tok)
1438− , ("textnormal", extractSpaces (spanWith ("",["nodecor"],[])) <$> tok)
1439− , ("ldots", lit "…")
1440− , ("vdots", lit "\8942")
1441− , ("dots", lit "…")
1442− , ("mdots", lit "…")
1443− , ("sim", lit "~")
1444− , ("label", rawInlineOr "label" (inBrackets <$> tok))
1445− , ("ref", rawInlineOr "ref" (inBrackets <$> tok))
1446− , ("textgreek", tok)
1447− , ("sep", lit ",")
1448− , ("cref", rawInlineOr "cref" (inBrackets <$> tok)) -- from cleveref.sty
1449− , ("(", mathInline $ manyTill anyChar (try $ string "\\)"))
1450− , ("[", mathDisplay $ manyTill anyChar (try $ string "\\]"))
1451− , ("ensuremath", mathInline braced)
1452− , ("texorpdfstring", (\_ x -> x) <$> tok <*> tok)
1453− , ("P", lit "¶")
1454− , ("S", lit "§")
1455− , ("$", lit "$")
1456− , ("%", lit "%")
1457− , ("&", lit "&")
1458− , ("#", lit "#")
1459− , ("_", lit "_")
1460− , ("{", lit "{")
1461− , ("}", lit "}")
1462− -- old TeX commands
1463− , ("em", extractSpaces emph <$> inlines)
1464− , ("it", extractSpaces emph <$> inlines)
1465− , ("sl", extractSpaces emph <$> inlines)
1466− , ("bf", extractSpaces strong <$> inlines)
1467− , ("rm", inlines)
1468− , ("itshape", extractSpaces emph <$> inlines)
1469− , ("slshape", extractSpaces emph <$> inlines)
1470− , ("scshape", extractSpaces smallcaps <$> inlines)
1471− , ("bfseries", extractSpaces strong <$> inlines)
1472− , ("/", pure mempty) -- italic correction
1473− , ("aa", lit "å")
1474− , ("AA", lit "Å")
1475− , ("ss", lit "ß")
1476− , ("o", lit "ø")
1477− , ("O", lit "Ø")
1478− , ("L", lit "Ł")
1479− , ("l", lit "ł")
1480− , ("ae", lit "æ")
1481− , ("AE", lit "Æ")
1482− , ("oe", lit "œ")
1483− , ("OE", lit "Œ")
1484− , ("pounds", lit "£")
1485− , ("euro", lit "€")
1486− , ("copyright", lit "©")
1487− , ("textasciicircum", lit "^")
1488− , ("textasciitilde", lit "~")
1489− , ("H", try $ tok >>= accent hungarumlaut)
1490− , ("`", option (str "`") $ try $ tok >>= accent grave)
1491− , ("'", option (str "'") $ try $ tok >>= accent acute)
1492− , ("^", option (str "^") $ try $ tok >>= accent circ)
1493− , ("~", option (str "~") $ try $ tok >>= accent tilde)
1494− , ("\"", option (str "\"") $ try $ tok >>= accent umlaut)
1495− , (".", option (str ".") $ try $ tok >>= accent dot)
1496− , ("=", option (str "=") $ try $ tok >>= accent macron)
1497− , ("c", option (str "c") $ try $ tok >>= accent cedilla)
1498− , ("v", option (str "v") $ try $ tok >>= accent hacek)
1499− , ("u", option (str "u") $ try $ tok >>= accent breve)
1500− , ("i", lit "i")
1501− , ("\\", linebreak <$ (optional (bracketed inline) *> spaces'))
1502− , (",", lit "\8198")
1503− , ("@", pure mempty)
1504− , (" ", lit "\160")
1505− , ("ps", pure $ str "PS." <> space)
1506− , ("TeX", lit "TeX")
1507− , ("LaTeX", lit "LaTeX")
1508− , ("bar", lit "|")
1509− , ("textless", lit "<")
1510− , ("textgreater", lit ">")
1511− , ("thanks", note <$> grouped block)
1512− , ("footnote", note <$> grouped block)
1513− , ("verb", doverb)
1514− , ("lstinline", dolstinline)
1515− , ("Verb", doverb)
1516− , ("url", (unescapeURL <$> braced) >>= \url ->
1517− pure (link url "" (str url)))
1518− , ("href", (unescapeURL <$> braced <* optional sp) >>= \url ->
1519− tok >>= \lab ->
1520− pure (link url "" lab))
1521− , ("includegraphics", do options <- option [] keyvals
1522− src <- unescapeURL . removeDoubleQuotes <$> braced
1523− mkImage options src)
1524− , ("enquote", enquote)
1525− , ("cite", citation "cite" NormalCitation False)
1526− , ("Cite", citation "Cite" NormalCitation False)
1527− , ("citep", citation "citep" NormalCitation False)
1528− , ("citep*", citation "citep*" NormalCitation False)
1529− , ("citeal", citation "citeal" NormalCitation False)
1530− , ("citealp", citation "citealp" NormalCitation False)
1531− , ("citealp*", citation "citealp*" NormalCitation False)
1532− , ("autocite", citation "autocite" NormalCitation False)
1533− , ("smartcite", citation "smartcite" NormalCitation False)
1534− , ("footcite", inNote <$> citation "footcite" NormalCitation False)
1535− , ("parencite", citation "parencite" NormalCitation False)
1536− , ("supercite", citation "supercite" NormalCitation False)
1537− , ("footcitetext", inNote <$> citation "footcitetext" NormalCitation False)
1538− , ("citeyearpar", citation "citeyearpar" SuppressAuthor False)
1539− , ("citeyear", citation "citeyear" SuppressAuthor False)
1540− , ("autocite*", citation "autocite*" SuppressAuthor False)
1541− , ("cite*", citation "cite*" SuppressAuthor False)
1542− , ("parencite*", citation "parencite*" SuppressAuthor False)
1543− , ("textcite", citation "textcite" AuthorInText False)
1544− , ("citet", citation "citet" AuthorInText False)
1545− , ("citet*", citation "citet*" AuthorInText False)
1546− , ("citealt", citation "citealt" AuthorInText False)
1547− , ("citealt*", citation "citealt*" AuthorInText False)
1548− , ("textcites", citation "textcites" AuthorInText True)
1549− , ("cites", citation "cites" NormalCitation True)
1550− , ("autocites", citation "autocites" NormalCitation True)
1551− , ("footcites", inNote <$> citation "footcites" NormalCitation True)
1552− , ("parencites", citation "parencites" NormalCitation True)
1553− , ("supercites", citation "supercites" NormalCitation True)
1554− , ("footcitetexts", inNote <$> citation "footcitetexts" NormalCitation True)
1555− , ("Autocite", citation "Autocite" NormalCitation False)
1556− , ("Smartcite", citation "Smartcite" NormalCitation False)
1557− , ("Footcite", citation "Footcite" NormalCitation False)
1558− , ("Parencite", citation "Parencite" NormalCitation False)
1559− , ("Supercite", citation "Supercite" NormalCitation False)
1560− , ("Footcitetext", inNote <$> citation "Footcitetext" NormalCitation False)
1561− , ("Citeyearpar", citation "Citeyearpar" SuppressAuthor False)
1562− , ("Citeyear", citation "Citeyear" SuppressAuthor False)
1563− , ("Autocite*", citation "Autocite*" SuppressAuthor False)
1564− , ("Cite*", citation "Cite*" SuppressAuthor False)
1565− , ("Parencite*", citation "Parencite*" SuppressAuthor False)
1566− , ("Textcite", citation "Textcite" AuthorInText False)
1567− , ("Textcites", citation "Textcites" AuthorInText True)
1568− , ("Cites", citation "Cites" NormalCitation True)
1569− , ("Autocites", citation "Autocites" NormalCitation True)
1570− , ("Footcites", citation "Footcites" NormalCitation True)
1571− , ("Parencites", citation "Parencites" NormalCitation True)
1572− , ("Supercites", citation "Supercites" NormalCitation True)
1573− , ("Footcitetexts", inNote <$> citation "Footcitetexts" NormalCitation True)
1574− , ("citetext", complexNatbibCitation NormalCitation)
1575− , ("citeauthor", (try (tok *> optional sp *> controlSeq "citetext") *>
1576− complexNatbibCitation AuthorInText)
1577− <|> citation "citeauthor" AuthorInText False)
1578− , ("nocite", mempty <$ (citation "nocite" NormalCitation False >>=
1579− addMeta "nocite"))
1580− , ("hypertarget", braced >> tok)
1581− -- siuntix
1582− , ("SI", dosiunitx)
1583− -- hyphenat
1584− , ("bshyp", lit "\\\173")
1585− , ("fshyp", lit "/\173")
1586− , ("dothyp", lit ".\173")
1587− , ("colonhyp", lit ":\173")
1588− , ("hyp", lit "-")
1589− , ("nohyphens", tok)
1590− , ("textnhtt", ttfamily)
1591− , ("nhttfamily", ttfamily)
1592− -- fontawesome
1593− , ("faCheck", lit "\10003")
1594− , ("faClose", lit "\10007")
1595− ] ++ map ignoreInlines
1596− -- these commands will be ignored unless --parse-raw is specified,
1597− -- in which case they will appear as raw latex blocks:
1598− [ "index"
1599− , "hspace"
1600− , "vspace"
1601− , "newpage"
1602− , "clearpage"
1603− , "pagebreak"
1604− ]
1605−
1606−ttfamily :: PandocMonad m => LP m Inlines
1607−ttfamily = (code . stringify . toList) <$> tok
1608−
1609−mkImage :: PandocMonad m => [(String, String)] -> String -> LP m Inlines
1610−mkImage options src = do
1611− let replaceTextwidth (k,v) = case numUnit v of
1612− Just (num, "\\textwidth") -> (k, showFl (num * 100) ++ "%")
1613− _ -> (k, v)
1614− let kvs = map replaceTextwidth $ filter (\(k,_) -> k `elem` ["width", "height"]) options
1615− let attr = ("",[], kvs)
1616− let alt = str "image"
1617− case takeExtension src of
1618− "" -> do
1619− defaultExt <- getOption readerDefaultImageExtension
1620− return $ imageWith attr (addExtension src defaultExt) "" alt
1621− _ -> return $ imageWith attr src "" alt
1622−
1623−inNote :: Inlines -> Inlines
1624−inNote ils =
1625− note $ para $ ils <> str "."
1626−
1627−unescapeURL :: String -> String
1628−unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs
1629− where isEscapable c = c `elem` ("#$%&~_^\\{}" :: String)
1630−unescapeURL (x:xs) = x:unescapeURL xs
1631−unescapeURL [] = ""
1632−
1633−enquote :: PandocMonad m => LP m Inlines
1634−enquote = do
1635− skipopts
1636− context <- stateQuoteContext <$> getState
1637− if context == InDoubleQuote
1638− then singleQuoted <$> withQuoteContext InSingleQuote tok
1639− else doubleQuoted <$> withQuoteContext InDoubleQuote tok
1640−
1641−doverb :: PandocMonad m => LP m Inlines
1642−doverb = do
1643− marker <- anyChar
1644− code <$> manyTill (satisfy (/='\n')) (char marker)
1645−
1646−dolstinline :: PandocMonad m => LP m Inlines
1647−dolstinline = do
1648− options <- option [] keyvals
1649− let classes = maybeToList $ lookup "language" options >>= fromListingsLanguage
1650− marker <- char '{' <|> anyChar
1651− codeWith ("",classes,[]) <$> manyTill (satisfy (/='\n')) (char '}' <|> char marker)
1652−
1653−-- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"
1654−dosiunitx :: PandocMonad m => LP m Inlines
1655−dosiunitx = do
1656− skipopts
1657− value <- tok
1658− valueprefix <- option "" $ char '[' >> (mconcat <$> manyTill tok (char ']'))
1659− unit <- tok
1660− let emptyOr160 "" = ""
1661− emptyOr160 _ = "\160"
1662− return . mconcat $ [valueprefix,
1663− emptyOr160 valueprefix,
1664− value,
1665− emptyOr160 unit,
1666− unit]
1667−
1668−accent :: (Char -> String) -> Inlines -> LP m Inlines
1669−accent f ils =
1670− case toList ils of
1671− (Str (x:xs) : ys) -> return $ fromList (Str (f x ++ xs) : ys)
1672− [] -> mzero
1673− _ -> return ils
1674−
1675−grave :: Char -> String
1676−grave 'A' = "À"
1677−grave 'E' = "È"
1678−grave 'I' = "Ì"
1679−grave 'O' = "Ò"
1680−grave 'U' = "Ù"
1681−grave 'a' = "à"
1682−grave 'e' = "è"
1683−grave 'i' = "ì"
1684−grave 'o' = "ò"
1685−grave 'u' = "ù"
1686−grave c = [c]
1687−
1688−acute :: Char -> String
1689−acute 'A' = "Á"
1690−acute 'E' = "É"
1691−acute 'I' = "Í"
1692−acute 'O' = "Ó"
1693−acute 'U' = "Ú"
1694−acute 'Y' = "Ý"
1695−acute 'a' = "á"
1696−acute 'e' = "é"
1697−acute 'i' = "í"
1698−acute 'o' = "ó"
1699−acute 'u' = "ú"
1700−acute 'y' = "ý"
1701−acute 'C' = "Ć"
1702−acute 'c' = "ć"
1703−acute 'L' = "Ĺ"
1704−acute 'l' = "ĺ"
1705−acute 'N' = "Ń"
1706−acute 'n' = "ń"
1707−acute 'R' = "Ŕ"
1708−acute 'r' = "ŕ"
1709−acute 'S' = "Ś"
1710−acute 's' = "ś"
1711−acute 'Z' = "Ź"
1712−acute 'z' = "ź"
1713−acute c = [c]
1714−
1715−circ :: Char -> String
1716−circ 'A' = "Â"
1717−circ 'E' = "Ê"
1718−circ 'I' = "Î"
1719−circ 'O' = "Ô"
1720−circ 'U' = "Û"
1721−circ 'a' = "â"
1722−circ 'e' = "ê"
1723−circ 'i' = "î"
1724−circ 'o' = "ô"
1725−circ 'u' = "û"
1726−circ 'C' = "Ĉ"
1727−circ 'c' = "ĉ"
1728−circ 'G' = "Ĝ"
1729−circ 'g' = "ĝ"
1730−circ 'H' = "Ĥ"
1731−circ 'h' = "ĥ"
1732−circ 'J' = "Ĵ"
1733−circ 'j' = "ĵ"
1734−circ 'S' = "Ŝ"
1735−circ 's' = "ŝ"
1736−circ 'W' = "Ŵ"
1737−circ 'w' = "ŵ"
1738−circ 'Y' = "Ŷ"
1739−circ 'y' = "ŷ"
1740−circ c = [c]
1741−
1742−tilde :: Char -> String
1743−tilde 'A' = "Ã"
1744−tilde 'a' = "ã"
1745−tilde 'O' = "Õ"
1746−tilde 'o' = "õ"
1747−tilde 'I' = "Ĩ"
1748−tilde 'i' = "ĩ"
1749−tilde 'U' = "Ũ"
1750−tilde 'u' = "ũ"
1751−tilde 'N' = "Ñ"
1752−tilde 'n' = "ñ"
1753−tilde c = [c]
1754−
1755−umlaut :: Char -> String
1756−umlaut 'A' = "Ä"
1757−umlaut 'E' = "Ë"
1758−umlaut 'I' = "Ï"
1759−umlaut 'O' = "Ö"
1760−umlaut 'U' = "Ü"
1761−umlaut 'a' = "ä"
1762−umlaut 'e' = "ë"
1763−umlaut 'i' = "ï"
1764−umlaut 'o' = "ö"
1765−umlaut 'u' = "ü"
1766−umlaut c = [c]
1767−
1768−hungarumlaut :: Char -> String
1769−hungarumlaut 'A' = "A̋"
1770−hungarumlaut 'E' = "E̋"
1771−hungarumlaut 'I' = "I̋"
1772−hungarumlaut 'O' = "Ő"
1773−hungarumlaut 'U' = "Ű"
1774−hungarumlaut 'Y' = "ӳ"
1775−hungarumlaut 'a' = "a̋"
1776−hungarumlaut 'e' = "e̋"
1777−hungarumlaut 'i' = "i̋"
1778−hungarumlaut 'o' = "ő"
1779−hungarumlaut 'u' = "ű"
1780−hungarumlaut 'y' = "ӳ"
1781−hungarumlaut c = [c]
1782−
1783−dot :: Char -> String
1784−dot 'C' = "Ċ"
1785−dot 'c' = "ċ"
1786−dot 'E' = "Ė"
1787−dot 'e' = "ė"
1788−dot 'G' = "Ġ"
1789−dot 'g' = "ġ"
1790−dot 'I' = "İ"
1791−dot 'Z' = "Ż"
1792−dot 'z' = "ż"
1793−dot c = [c]
1794−
1795−macron :: Char -> String
1796−macron 'A' = "Ā"
1797−macron 'E' = "Ē"
1798−macron 'I' = "Ī"
1799−macron 'O' = "Ō"
1800−macron 'U' = "Ū"
1801−macron 'a' = "ā"
1802−macron 'e' = "ē"
1803−macron 'i' = "ī"
1804−macron 'o' = "ō"
1805−macron 'u' = "ū"
1806−macron c = [c]
1807−
1808−cedilla :: Char -> String
1809−cedilla 'c' = "ç"
1810−cedilla 'C' = "Ç"
1811−cedilla 's' = "ş"
1812−cedilla 'S' = "Ş"
1813−cedilla 't' = "ţ"
1814−cedilla 'T' = "Ţ"
1815−cedilla 'e' = "ȩ"
1816−cedilla 'E' = "Ȩ"
1817−cedilla 'h' = "ḩ"
1818−cedilla 'H' = "Ḩ"
1819−cedilla 'o' = "o̧"
1820−cedilla 'O' = "O̧"
1821−cedilla c = [c]
1822−
1823−hacek :: Char -> String
1824−hacek 'A' = "Ǎ"
1825−hacek 'a' = "ǎ"
1826−hacek 'C' = "Č"
1827−hacek 'c' = "č"
1828−hacek 'D' = "Ď"
1829−hacek 'd' = "ď"
1830−hacek 'E' = "Ě"
1831−hacek 'e' = "ě"
1832−hacek 'G' = "Ǧ"
1833−hacek 'g' = "ǧ"
1834−hacek 'H' = "Ȟ"
1835−hacek 'h' = "ȟ"
1836−hacek 'I' = "Ǐ"
1837−hacek 'i' = "ǐ"
1838−hacek 'j' = "ǰ"
1839−hacek 'K' = "Ǩ"
1840−hacek 'k' = "ǩ"
1841−hacek 'L' = "Ľ"
1842−hacek 'l' = "ľ"
1843−hacek 'N' = "Ň"
1844−hacek 'n' = "ň"
1845−hacek 'O' = "Ǒ"
1846−hacek 'o' = "ǒ"
1847−hacek 'R' = "Ř"
1848−hacek 'r' = "ř"
1849−hacek 'S' = "Š"
1850−hacek 's' = "š"
1851−hacek 'T' = "Ť"
1852−hacek 't' = "ť"
1853−hacek 'U' = "Ǔ"
1854−hacek 'u' = "ǔ"
1855−hacek 'Z' = "Ž"
1856−hacek 'z' = "ž"
1857−hacek c = [c]
1858−
1859−breve :: Char -> String
1860−breve 'A' = "Ă"
1861−breve 'a' = "ă"
1862−breve 'E' = "Ĕ"
1863−breve 'e' = "ĕ"
1864−breve 'G' = "Ğ"
1865−breve 'g' = "ğ"
1866−breve 'I' = "Ĭ"
1867−breve 'i' = "ĭ"
1868−breve 'O' = "Ŏ"
1869−breve 'o' = "ŏ"
1870−breve 'U' = "Ŭ"
1871−breve 'u' = "ŭ"
1872−breve c = [c]
1873−
1874−tok :: PandocMonad m => LP m Inlines
1875−tok = try $ grouped inline <|> inlineCommand <|> str <$> count 1 inlineChar
1876−
1877−opt :: PandocMonad m => LP m Inlines
1878−opt = bracketed inline
1879−
1880−rawopt :: PandocMonad m => LP m String
1881−rawopt = do
1882− contents <- bracketed (many1 (noneOf "[]") <|> try (string "\\]") <|>
1883− try (string "\\[") <|> rawopt)
1884− optional sp
1885− return $ "[" ++ contents ++ "]"
1886−
1887−skipopts :: PandocMonad m => LP m ()
1888−skipopts = skipMany rawopt
1889−
1890−-- opts in angle brackets are used in beamer
1891−rawangle :: PandocMonad m => LP m ()
1892−rawangle = try $ do
1893− char '<'
1894− skipMany (noneOf ">")
1895− char '>'
1896− return ()
1897−
1898−skipangles :: PandocMonad m => LP m ()
1899−skipangles = skipMany rawangle
1900−
1901−inlineText :: PandocMonad m => LP m Inlines
1902−inlineText = str <$> many1 inlineChar
1903−
1904−inlineChar :: PandocMonad m => LP m Char
1905−inlineChar = noneOf "\\$%&~#{}^'`\"‘’“”-[] \t\n"
1906−
1907−environment :: PandocMonad m => LP m Blocks
1908−environment = do
1909− controlSeq "begin"
1910− name <- braced
1911− M.findWithDefault mzero name environments
1912− <|> rawEnv name
1913−
1914−inlineEnvironment :: PandocMonad m => LP m Inlines
1915−inlineEnvironment = try $ do
1916− controlSeq "begin"
1917− name <- braced
1918− M.findWithDefault mzero name inlineEnvironments
1919−
1920−rawEnv :: PandocMonad m => String -> LP m Blocks
1921−rawEnv name = do
1922− exts <- getOption readerExtensions
1923− let parseRaw = extensionEnabled Ext_raw_tex exts
1924− rawOptions <- mconcat <$> many rawopt
1925− let beginCommand = "\\begin{" ++ name ++ "}" ++ rawOptions
1926− pos1 <- getPosition
1927− (bs, raw) <- withRaw $ env name blocks
1928− raw' <- applyMacros' $ beginCommand ++ raw
1929− if raw' /= beginCommand ++ raw
1930− then parseFromString' blocks raw'
1931− else if parseRaw
1932− then return $ rawBlock "latex" $ beginCommand ++ raw'
1933− else do
1934− unless parseRaw $ do
1935− report $ SkippedContent beginCommand pos1
1936− pos2 <- getPosition
1937− report $ SkippedContent ("\\end{" ++ name ++ "}") pos2
1938− return bs
1939−
1940−rawVerbEnv :: PandocMonad m => String -> LP m Blocks
1941−rawVerbEnv name = do
1942− pos <- getPosition
1943− (_, raw) <- withRaw $ verbEnv name
1944− let raw' = "\\begin{tikzpicture}" ++ raw
1945− exts <- getOption readerExtensions
1946− let parseRaw = extensionEnabled Ext_raw_tex exts
1947− if parseRaw
1948− then return $ rawBlock "latex" raw'
1949− else do
1950− report $ SkippedContent raw' pos
1951− return mempty
1952−
1953−----
1954−
1955−----
1956−
1957−keyval :: PandocMonad m => LP m (String, String)
1958−keyval = try $ do
1959− key <- many1 alphaNum
1960− val <- option "" $ char '=' >> braced <|> (many1 (alphaNum <|> oneOf ".:-|\\"))
1961− skipMany spaceChar
1962− optional (char ',')
1963− skipMany spaceChar
1964− return (key, val)
1965−
1966−
1967−keyvals :: PandocMonad m => LP m [(String, String)]
1968−keyvals = try $ char '[' *> manyTill keyval (char ']')
1969−
1970−alltt :: PandocMonad m => String -> LP m Blocks
1971−alltt t = walk strToCode <$> parseFromString' blocks
1972− (substitute " " "\\ " $ substitute "%" "\\%" $
1973− intercalate "\\\\\n" $ lines t)
1974− where strToCode (Str s) = Code nullAttr s
1975− strToCode x = x
1976−
1977−rawLaTeXBlock :: PandocMonad m => ParserT String ParserState String
1978−rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))
1979−
1980−rawLaTeXInline :: PandocMonad m => ParserT String ParserState Inline
1981−rawLaTeXInline = do
1982− raw <- (snd <$> withRaw inlineCommand)
1983− <|> (snd <$> withRaw inlineEnvironment)
1984− <|> (snd <$> withRaw blockCommand)
1985− RawInline "latex" <$> applyMacros' raw
1986−
1987−addImageCaption :: PandocMonad m => Blocks -> LP m Blocks
1988−addImageCaption = walkM go
1989− where go (Image attr alt (src,tit))
1990− | not ("fig:" `isPrefixOf` tit) = do
1991− mbcapt <- stateCaption <$> getState
1992− return $ case mbcapt of
1993− Just ils -> Image attr (toList ils) (src, "fig:" ++ tit)
1994− Nothing -> Image attr alt (src,tit)
1995− go x = return x
1996−
1997−addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
1998−addTableCaption = walkM go
1999− where go (Table c als ws hs rs) = do
2000− mbcapt <- stateCaption <$> getState
2001− return $ case mbcapt of
2002− Just ils -> Table (toList ils) als ws hs rs
2003− Nothing -> Table c als ws hs rs
2004− go x = return x
2005−
2006−environments :: PandocMonad m => M.Map String (LP m Blocks)
2007−environments = M.fromList
2008− [ ("document", env "document" blocks <* skipMany anyChar)
2009− , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))
2010− , ("letter", env "letter" letterContents)
2011− , ("minipage", env "minipage" $
2012− skipopts *> spaces' *> optional braced *> spaces' *> blocks)
2013− , ("figure", env "figure" $ skipopts *> figure)
2014− , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)
2015− , ("center", env "center" blocks)
2016− , ("longtable", env "longtable" $
2017− resetCaption *> simpTable "longtable" False >>= addTableCaption)
2018− , ("table", env "table" $
2019− resetCaption *> skipopts *> blocks >>= addTableCaption)
2020− , ("tabular*", env "tabular" $ simpTable "tabular*" True)
2021− , ("tabularx", env "tabularx" $ simpTable "tabularx" True)
2022− , ("tabular", env "tabular" $ simpTable "tabular" False)
2023− , ("quote", blockQuote <$> env "quote" blocks)
2024− , ("quotation", blockQuote <$> env "quotation" blocks)
2025− , ("verse", blockQuote <$> env "verse" blocks)
2026− , ("itemize", bulletList <$> listenv "itemize" (many item))
2027− , ("description", definitionList <$> listenv "description" (many descItem))
2028− , ("enumerate", orderedList')
2029− , ("alltt", alltt =<< verbEnv "alltt")
2030− , ("code", guardEnabled Ext_literate_haskell *>
2031− (codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
2032− verbEnv "code"))
2033− , ("comment", mempty <$ verbEnv "comment")
2034− , ("verbatim", codeBlock <$> verbEnv "verbatim")
2035− , ("Verbatim", fancyverbEnv "Verbatim")
2036− , ("BVerbatim", fancyverbEnv "BVerbatim")
2037− , ("lstlisting", do attr <- parseListingsOptions <$> option [] keyvals
2038− codeBlockWith attr <$> verbEnv "lstlisting")
2039− , ("minted", do options <- option [] keyvals
2040− lang <- grouped (many1 $ satisfy (/='}'))
2041− let kvs = [ (if k == "firstnumber"
2042− then "startFrom"
2043− else k, v) | (k,v) <- options ]
2044− let classes = [ lang | not (null lang) ] ++
2045− [ "numberLines" |
2046− lookup "linenos" options == Just "true" ]
2047− let attr = ("",classes,kvs)
2048− codeBlockWith attr <$> verbEnv "minted")
2049− , ("obeylines", parseFromString
2050− (para . trimInlines . mconcat <$> many inline) =<<
2051− intercalate "\\\\\n" . lines <$> verbEnv "obeylines")
2052− , ("displaymath", mathEnvWith para Nothing "displaymath")
2053− , ("equation", mathEnvWith para Nothing "equation")
2054− , ("equation*", mathEnvWith para Nothing "equation*")
2055− , ("gather", mathEnvWith para (Just "gathered") "gather")
2056− , ("gather*", mathEnvWith para (Just "gathered") "gather*")
2057− , ("multline", mathEnvWith para (Just "gathered") "multline")
2058− , ("multline*", mathEnvWith para (Just "gathered") "multline*")
2059− , ("eqnarray", mathEnvWith para (Just "aligned") "eqnarray")
2060− , ("eqnarray*", mathEnvWith para (Just "aligned") "eqnarray*")
2061− , ("align", mathEnvWith para (Just "aligned") "align")
2062− , ("align*", mathEnvWith para (Just "aligned") "align*")
2063− , ("alignat", mathEnvWith para (Just "aligned") "alignat")
2064− , ("alignat*", mathEnvWith para (Just "aligned") "alignat*")
2065− , ("tikzpicture", rawVerbEnv "tikzpicture")
2066− ]
2067−
2068−figure :: PandocMonad m => LP m Blocks
2069−figure = try $ do
2070− resetCaption
2071− blocks >>= addImageCaption
2072−
2073−letterContents :: PandocMonad m => LP m Blocks
2074−letterContents = do
2075− bs <- blocks
2076− st <- getState
2077− -- add signature (author) and address (title)
2078− let addr = case lookupMeta "address" (stateMeta st) of
2079− Just (MetaBlocks [Plain xs]) ->
2080− para $ trimInlines $ fromList xs
2081− _ -> mempty
2082− return $ addr <> bs -- sig added by \closing
2083−
2084−closing :: PandocMonad m => LP m Blocks
2085−closing = do
2086− contents <- tok
2087− st <- getState
2088− let extractInlines (MetaBlocks [Plain ys]) = ys
2089− extractInlines (MetaBlocks [Para ys ]) = ys
2090− extractInlines _ = []
2091− let sigs = case lookupMeta "author" (stateMeta st) of
2092− Just (MetaList xs) ->
2093− para $ trimInlines $ fromList $
2094− intercalate [LineBreak] $ map extractInlines xs
2095− _ -> mempty
2096− return $ para (trimInlines contents) <> sigs
2097−
2098−item :: PandocMonad m => LP m Blocks
2099−item = blocks *> controlSeq "item" *> skipopts *> blocks
2100−
2101−looseItem :: PandocMonad m => LP m Blocks
2102−looseItem = do
2103− ctx <- stateParserContext `fmap` getState
2104− if ctx == ListItemState
2105− then mzero
2106− else return mempty
2107−
2108−descItem :: PandocMonad m => LP m (Inlines, [Blocks])
2109−descItem = do
2110− blocks -- skip blocks before item
2111− controlSeq "item"
2112− optional sp
2113− ils <- opt
2114− bs <- blocks
2115− return (ils, [bs])
2116−
2117−env :: PandocMonad m => String -> LP m a -> LP m a
2118−env name p = p <*
2119− (try (controlSeq "end" *> braced >>= guard . (== name))
2120− <?> ("\\end{" ++ name ++ "}"))
2121−
2122−listenv :: PandocMonad m => String -> LP m a -> LP m a
2123−listenv name p = try $ do
2124− oldCtx <- stateParserContext `fmap` getState
2125− updateState $ \st -> st{ stateParserContext = ListItemState }
2126− res <- env name p
2127− updateState $ \st -> st{ stateParserContext = oldCtx }
2128− return res
2129−
2130−mathEnvWith :: PandocMonad m
2131− => (Inlines -> a) -> Maybe String -> String -> LP m a
2132−mathEnvWith f innerEnv name = f <$> mathDisplay (inner <$> mathEnv name)
2133− where inner x = case innerEnv of
2134− Nothing -> x
2135− Just y -> "\\begin{" ++ y ++ "}\n" ++ x ++
2136− "\\end{" ++ y ++ "}"
2137−
2138−mathEnv :: PandocMonad m => String -> LP m String
2139−mathEnv name = do
2140− skipopts
2141− optional blankline
2142− let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
2143− charMuncher = skipMany comment *>
2144− (many1 (noneOf "\\%") <|> try (string "\\%")
2145− <|> try (string "\\\\") <|> count 1 anyChar)
2146− res <- concat <$> manyTill charMuncher endEnv
2147− return $ stripTrailingNewlines res
2148−
2149−verbEnv :: PandocMonad m => String -> LP m String
2150−verbEnv name = do
2151− skipopts
2152− optional blankline
2153− let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
2154− charMuncher = anyChar
2155− res <- manyTill charMuncher endEnv
2156− return $ stripTrailingNewlines res
2157−
2158−fancyverbEnv :: PandocMonad m => String -> LP m Blocks
2159−fancyverbEnv name = do
2160− options <- option [] keyvals
2161− let kvs = [ (if k == "firstnumber"
2162− then "startFrom"
2163− else k, v) | (k,v) <- options ]
2164− let classes = [ "numberLines" |
2165− lookup "numbers" options == Just "left" ]
2166− let attr = ("",classes,kvs)
2167− codeBlockWith attr <$> verbEnv name
2168−
2169−orderedList' :: PandocMonad m => LP m Blocks
2170−orderedList' = try $ do
2171− optional sp
2172− (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $
2173− try $ char '[' *> anyOrderedListMarker <* char ']'
2174− spaces
2175− optional $ try $ controlSeq "setlength" *> grouped (controlSeq "itemindent") *> braced
2176− spaces
2177− start <- option 1 $ try $ do controlSeq "setcounter"
2178− grouped (string "enum" *> many1 (oneOf "iv"))
2179− optional sp
2180− num <- grouped (many1 digit)
2181− spaces
2182− return (read num + 1 :: Int)
2183− bs <- listenv "enumerate" (many item)
2184− return $ orderedListWith (start, style, delim) bs
2185−
2186−paragraph :: PandocMonad m => LP m Blocks
2187−paragraph = do
2188− x <- trimInlines . mconcat <$> many1 inline
2189− if x == mempty
2190− then return mempty
2191− else return $ para x
2192−
2193−preamble :: PandocMonad m => LP m Blocks
2194−preamble = mempty <$> manyTill preambleBlock beginDoc
2195− where beginDoc = lookAhead $ try $ controlSeq "begin" *> string "{document}"
2196− preambleBlock = void comment
2197− <|> void sp
2198− <|> void blanklines
2199− <|> void include
2200− <|> void macro
2201− <|> void blockCommand
2202− <|> void anyControlSeq
2203− <|> void braced
2204− <|> void anyChar
2205−
2206−-------
2207−
2208−-- citations
2209−
2210−addPrefix :: [Inline] -> [Citation] -> [Citation]
2211−addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks
2212−addPrefix _ _ = []
2213−
2214−addSuffix :: [Inline] -> [Citation] -> [Citation]
2215−addSuffix s ks@(_:_) =
2216− let k = last ks
2217− in init ks ++ [k {citationSuffix = citationSuffix k ++ s}]
2218−addSuffix _ _ = []
2219−
2220−simpleCiteArgs :: PandocMonad m => LP m [Citation]
2221−simpleCiteArgs = try $ do
2222− first <- optionMaybe $ toList <$> opt
2223− second <- optionMaybe $ toList <$> opt
2224− keys <- try $ bgroup *> (manyTill citationLabel egroup)
2225− let (pre, suf) = case (first , second ) of
2226− (Just s , Nothing) -> (mempty, s )
2227− (Just s , Just t ) -> (s , t )
2228− _ -> (mempty, mempty)
2229− conv k = Citation { citationId = k
2230− , citationPrefix = []
2231− , citationSuffix = []
2232− , citationMode = NormalCitation
2233− , citationHash = 0
2234− , citationNoteNum = 0
2235− }
2236− return $ addPrefix pre $ addSuffix suf $ map conv keys
2237−
2238−citationLabel :: PandocMonad m => LP m String
2239−citationLabel = optional sp *>
2240− (many1 (satisfy isBibtexKeyChar)
2241− <* optional sp
2242− <* optional (char ',')
2243− <* optional sp)
2244− where isBibtexKeyChar c = isAlphaNum c || c `elem` (".:;?!`'()/*@_+=-[]" :: String)
2245−
2246−cites :: PandocMonad m => CitationMode -> Bool -> LP m [Citation]
2247−cites mode multi = try $ do
2248− cits <- if multi
2249− then many1 simpleCiteArgs
2250− else count 1 simpleCiteArgs
2251− let cs = concat cits
2252− return $ case mode of
2253− AuthorInText -> case cs of
2254− (c:rest) -> c {citationMode = mode} : rest
2255− [] -> []
2256− _ -> map (\a -> a {citationMode = mode}) cs
2257−
2258−citation :: PandocMonad m => String -> CitationMode -> Bool -> LP m Inlines
2259−citation name mode multi = do
2260− (c,raw) <- withRaw $ cites mode multi
2261− return $ cite c (rawInline "latex" $ "\\" ++ name ++ raw)
2262−
2263−complexNatbibCitation :: PandocMonad m => CitationMode -> LP m Inlines
2264−complexNatbibCitation mode = try $ do
2265− let ils = (toList . trimInlines . mconcat) <$>
2266− many (notFollowedBy (oneOf "\\};") >> inline)
2267− let parseOne = try $ do
2268− skipSpaces
2269− pref <- ils
2270− cit' <- inline -- expect a citation
2271− let citlist = toList cit'
2272− cits' <- case citlist of
2273− [Cite cs _] -> return cs
2274− _ -> mzero
2275− suff <- ils
2276− skipSpaces
2277− optional $ char ';'
2278− return $ addPrefix pref $ addSuffix suff cits'
2279− (c:cits, raw) <- withRaw $ grouped parseOne
2280− return $ cite (c{ citationMode = mode }:cits)
2281− (rawInline "latex" $ "\\citetext" ++ raw)
2282−
2283−-- tables
2284−
2285−parseAligns :: PandocMonad m => LP m [(Alignment, Double, (String, String))]
2286−parseAligns = try $ do
2287− bgroup
2288− let maybeBar = skipMany $ sp <|> () <$ char '|' <|> () <$ (char '@' >> braced)
2289− maybeBar
2290− let cAlign = AlignCenter <$ char 'c'
2291− let lAlign = AlignLeft <$ char 'l'
2292− let rAlign = AlignRight <$ char 'r'
2293− let parAlign = AlignLeft <$ char 'p'
2294− -- algins from tabularx
2295− let xAlign = AlignLeft <$ char 'X'
2296− let mAlign = AlignLeft <$ char 'm'
2297− let bAlign = AlignLeft <$ char 'b'
2298− let alignChar = cAlign <|> lAlign <|> rAlign <|> parAlign
2299− <|> xAlign <|> mAlign <|> bAlign
2300− let alignPrefix = char '>' >> braced
2301− let alignSuffix = char '<' >> braced
2302− let colWidth = try $ do
2303− char '{'
2304− ds <- many1 (oneOf "0123456789.")
2305− spaces
2306− string "\\linewidth"
2307− char '}'
2308− case safeRead ds of
2309− Just w -> return w
2310− Nothing -> return 0.0
2311− let alignSpec = do
2312− spaces
2313− pref <- option "" alignPrefix
2314− spaces
2315− al <- alignChar
2316− width <- colWidth <|> option 0.0 (do s <- braced
2317− pos <- getPosition
2318− report $ SkippedContent s pos
2319− return 0.0)
2320− spaces
2321− suff <- option "" alignSuffix
2322− return (al, width, (pref, suff))
2323− aligns' <- sepEndBy alignSpec maybeBar
2324− spaces
2325− egroup
2326− spaces
2327− return $ aligns'
2328−
2329−hline :: PandocMonad m => LP m ()
2330−hline = try $ do
2331− spaces'
2332− controlSeq "hline" <|>
2333− -- booktabs rules:
2334− controlSeq "toprule" <|>
2335− controlSeq "bottomrule" <|>
2336− controlSeq "midrule" <|>
2337− controlSeq "endhead" <|>
2338− controlSeq "endfirsthead"
2339− spaces'
2340− optional $ bracketed (many1 (satisfy (/=']')))
2341− return ()
2342−
2343−lbreak :: PandocMonad m => LP m ()
2344−lbreak = () <$ try (spaces' *>
2345− (controlSeq "\\" <|> controlSeq "tabularnewline") <*
2346− spaces')
2347−
2348−amp :: PandocMonad m => LP m ()
2349−amp = () <$ try (spaces' *> char '&' <* spaces')
2350−
2351−parseTableRow :: PandocMonad m
2352− => String -- ^ table environment name
2353− -> [(String, String)] -- ^ pref/suffixes
2354− -> LP m [Blocks]
2355−parseTableRow envname prefsufs = try $ do
2356− let cols = length prefsufs
2357− let tableCellRaw = concat <$> many
2358− (do notFollowedBy amp
2359− notFollowedBy lbreak
2360− notFollowedBy $ () <$ try (string ("\\end{" ++ envname ++ "}"))
2361− many1 (noneOf "&%\n\r\\")
2362− <|> try (string "\\&")
2363− <|> count 1 anyChar)
2364− let plainify bs = case toList bs of
2365− [Para ils] -> plain (fromList ils)
2366− _ -> bs
2367− rawcells <- sepBy1 tableCellRaw amp
2368− guard $ length rawcells == cols
2369− let rawcells' = zipWith (\c (p, s) -> p ++ trim c ++ s) rawcells prefsufs
2370− let tableCell = plainify <$> blocks
2371− cells' <- mapM (parseFromString' tableCell) rawcells'
2372− let numcells = length cells'
2373− guard $ numcells <= cols && numcells >= 1
2374− guard $ cells' /= [mempty]
2375− -- note: a & b in a three-column table leaves an empty 3rd cell:
2376− let cells'' = cells' ++ replicate (cols - numcells) mempty
2377− spaces'
2378− return cells''
2379−
2380−spaces' :: PandocMonad m => LP m ()
2381−spaces' = spaces *> skipMany (comment *> spaces)
2382−
2383−simpTable :: PandocMonad m => String -> Bool -> LP m Blocks
2384−simpTable envname hasWidthParameter = try $ do
2385− when hasWidthParameter $ () <$ (spaces' >> tok)
2386− skipopts
2387− colspecs <- parseAligns
2388− let (aligns, widths, prefsufs) = unzip3 colspecs
2389− let cols = length colspecs
2390− optional $ controlSeq "caption" *> skipopts *> setCaption
2391− optional lbreak
2392− spaces'
2393− skipMany hline
2394− spaces'
2395− header' <- option [] $ try (parseTableRow envname prefsufs <*
2396− lbreak <* many1 hline)
2397− spaces'
2398− rows <- sepEndBy (parseTableRow envname prefsufs)
2399− (lbreak <* optional (skipMany hline))
2400− spaces'
2401− optional $ controlSeq "caption" *> skipopts *> setCaption
2402− optional lbreak
2403− spaces'
2404− let header'' = if null header'
2405− then replicate cols mempty
2406− else header'
2407− lookAhead $ controlSeq "end" -- make sure we're at end
2408− return $ table mempty (zip aligns widths) header'' rows
2409−
2410−removeDoubleQuotes :: String -> String
2411−removeDoubleQuotes ('"':xs) =
2412− case reverse xs of
2413− '"':ys -> reverse ys
2414− _ -> '"':xs
2415−removeDoubleQuotes xs = xs
2416−
2417−inputListing :: PandocMonad m => LP m Blocks
2418−inputListing = do
2419− pos <- getPosition
2420− options <- option [] keyvals
2421− f <- filter (/='"') <$> braced
2422− dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
2423− mbCode <- readFileFromDirs dirs f
2424− codeLines <- case mbCode of
2425− Just s -> return $ lines s
2426− Nothing -> do
2427− report $ CouldNotLoadIncludeFile f pos
2428− return []
2429− let (ident,classes,kvs) = parseListingsOptions options
2430− let language = case lookup "language" options >>= fromListingsLanguage of
2431− Just l -> [l]
2432− Nothing -> take 1 $ languagesByExtension (takeExtension f)
2433− let firstline = fromMaybe 1 $ lookup "firstline" options >>= safeRead
2434− let lastline = fromMaybe (length codeLines) $
2435− lookup "lastline" options >>= safeRead
2436− let codeContents = intercalate "\n" $ take (1 + lastline - firstline) $
2437− drop (firstline - 1) codeLines
2438− return $ codeBlockWith (ident,ordNub (classes ++ language),kvs) codeContents
2439−
2440−parseListingsOptions :: [(String, String)] -> Attr
2441−parseListingsOptions options =
2442− let kvs = [ (if k == "firstnumber"
2443− then "startFrom"
2444− else k, v) | (k,v) <- options ]
2445− classes = [ "numberLines" |
2446− lookup "numbers" options == Just "left" ]
2447− ++ maybeToList (lookup "language" options
2448− >>= fromListingsLanguage)
2449− in (fromMaybe "" (lookup "label" options), classes, kvs)
2450−
2451−
2452−-}
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+--