@@ -42,20 +42,18 @@ import Text.Pandoc.Options
4242import Text.Pandoc.Parsing hiding ((<|>), many, optional, space,
4343 mathDisplay, mathInline)
4444import qualified Text.Pandoc.UTF8 as UTF8
45−import Data.Char ( chr, ord )
45+import Data.Char ( chr, ord, isLetter, isAlphaNum )
4646import Control.Monad.Trans (lift)
4747import Control.Monad
4848import Text.Pandoc.Builder
49−import Data.Char (isLetter, isAlphaNum)
5049import Control.Applicative
5150import Data.Monoid
52−import Data.Maybe (fromMaybe)
51+import Data.Maybe (fromMaybe, maybeToList)
5352import System.Environment (getEnv)
54−import System.FilePath (replaceExtension, (</>))
55−import Data.List (intercalate, intersperse)
53+import System.FilePath (replaceExtension, (</>), takeExtension, addExtension)
54+import Data.List (intercalate)
5655import qualified Data.Map as M
5756import qualified Control.Exception as E
58−import System.FilePath (takeExtension, addExtension)
5957import Text.Pandoc.Highlighting (fromListingsLanguage)
6058import Text.Pandoc.Error
6159
@@ -74,17 +72,16 @@ parseLaTeX = do
7472 let (Pandoc _ bs') = doc bs
7573 return $ Pandoc meta bs'
7674
77−type LP = Parser [Char] ParserState
75+type LP = Parser String ParserState
7876
7977anyControlSeq :: LP String
8078anyControlSeq = do
8179 char '\\'
8280 next <- option '\n' anyChar
83− name <- case next of
84− '\n' -> return ""
85− c | isLetter c -> (c:) <$> (many letter <* optional sp)
86− | otherwise -> return [c]
87− return name
81+ case next of
82+ '\n' -> return ""
83+ c | isLetter c -> (c:) <$> (many letter <* optional sp)
84+ | otherwise -> return [c]
8885
8986controlSeq :: String -> LP String
9087controlSeq name = try $ do
@@ -104,7 +101,7 @@ dimenarg = try $ do
104101
105102sp :: LP ()
106103sp = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t')
107− <|> (try $ newline <* lookAhead anyChar <* notFollowedBy blankline)
104+ <|> try (newline <* lookAhead anyChar <* notFollowedBy blankline)
108105
109106isLowerHex :: Char -> Bool
110107isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
@@ -162,30 +159,28 @@ mathInline :: LP String -> LP Inlines
162159mathInline p = math <$> (try p >>= applyMacros')
163160
164161mathChars :: LP String
165−mathChars = concat <$>
166− many ( many1 (satisfy (\c -> c /= '$' && c /='\\'))
167− <|> (\c -> ['\\',c]) <$> (try $ char '\\' *> anyChar)
168− )
162+mathChars = (concat <$>) $
163+ many $
164+ many1 (satisfy (\c -> c /= '$' && c /='\\'))
165+ <|> (\c -> ['\\',c]) <$> try (char '\\' *> anyChar)
169166
170167quoted' :: (Inlines -> Inlines) -> LP String -> LP () -> LP Inlines
171168quoted' f starter ender = do
172169 startchs <- starter
173170 try ((f . mconcat) <$> manyTill inline ender) <|> lit startchs
174171
175−double_quote :: LP Inlines
176−double_quote =
177− ( quoted' doubleQuoted (try $ string "``") (void $ try $ string "''")
172+doubleQuote :: LP Inlines
173+doubleQuote =
174+ quoted' doubleQuoted (try $ string "``") (void $ try $ string "''")
178175 <|> quoted' doubleQuoted (string "“") (void $ char '”')
179176 -- the following is used by babel for localized quotes:
180177 <|> quoted' doubleQuoted (try $ string "\"`") (void $ try $ string "\"'")
181178 <|> quoted' doubleQuoted (string "\"") (void $ char '"')
182− )
183179
184−single_quote :: LP Inlines
185−single_quote =
186− ( quoted' singleQuoted (string "`") (try $ char '\'' >> notFollowedBy letter)
180+singleQuote :: LP Inlines
181+singleQuote =
182+ quoted' singleQuoted (string "`") (try $ char '\'' >> notFollowedBy letter)
187183 <|> quoted' singleQuoted (string "‘") (try $ char '’' >> notFollowedBy letter)
188− )
189184
190185inline :: LP Inlines
191186inline = (mempty <$ comment)
@@ -195,17 +190,17 @@ inline = (mempty <$ comment)
195190 <|> inlineEnvironment
196191 <|> inlineGroup
197192 <|> (char '-' *> option (str "-")
198− ((char '-') *> option (str "–") (str "—" <$ char '-')))
199− <|> double_quote
200− <|> single_quote
193+ (char '-' *> option (str "–") (str "—" <$ char '-')))
194+ <|> doubleQuote
195+ <|> singleQuote
201196 <|> (str "”" <$ try (string "''"))
202197 <|> (str "”" <$ char '”')
203198 <|> (str "’" <$ char '\'')
204199 <|> (str "’" <$ char '’')
205200 <|> (str "\160" <$ char '~')
206− <|> (mathDisplay $ string "$$" *> mathChars <* string "$$")
207− <|> (mathInline $ char '$' *> mathChars <* char '$')
208− <|> (superscript <$> (char '^' *> tok))
201+ <|> mathDisplay (string "$$" *> mathChars <* string "$$")
202+ <|> mathInline (char '$' *> mathChars <* char '$')
203+ <|> try (superscript <$> (char '^' *> tok))
209204 <|> (subscript <$> (char '_' *> tok))
210205 <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)
211206 <|> (str . (:[]) <$> tildeEscape)
@@ -244,6 +239,11 @@ getRawCommand name' = do
244239 rawargs <- withRaw (skipopts *> option "" dimenarg *> many braced)
245240 return $ '\\' : name' ++ snd rawargs
246241
242+lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
243+lookupListDefault d = (fromMaybe d .) . lookupList
244+ where
245+ lookupList l m = msum $ map (`M.lookup` m) l
246+
247247blockCommand :: LP Blocks
248248blockCommand = try $ do
249249 name <- anyControlSeq
@@ -256,14 +256,10 @@ blockCommand = try $ do
256256 guard $ transformed /= rawcommand
257257 notFollowedBy $ parseFromString inlines transformed
258258 parseFromString blocks transformed
259− case M.lookup name' blockCommands of
260− Just p -> p
261− Nothing -> case M.lookup name blockCommands of
262− Just p -> p
263− Nothing -> raw
259+ lookupListDefault raw [name',name] blockCommands
264260
265261inBrackets :: Inlines -> Inlines
266−inBrackets x = (str "[") <> x <> (str "]")
262+inBrackets x = str "[" <> x <> str "]"
267263
268264-- eat an optional argument and one or more arguments in braces
269265ignoreInlines :: String -> (String, LP Inlines)
@@ -271,14 +267,14 @@ ignoreInlines name = (name, doraw <|> (mempty <$ optargs))
271267 where optargs = skipopts *> skipMany (try $ optional sp *> braced)
272268 contseq = '\\':name
273269 doraw = (rawInline "latex" . (contseq ++) . snd) <$>
274− (getOption readerParseRaw >>= guard >> (withRaw optargs))
270+ (getOption readerParseRaw >>= guard >> withRaw optargs)
275271
276272ignoreBlocks :: String -> (String, LP Blocks)
277273ignoreBlocks name = (name, doraw <|> (mempty <$ optargs))
278274 where optargs = skipopts *> skipMany (try $ optional sp *> braced)
279275 contseq = '\\':name
280276 doraw = (rawBlock "latex" . (contseq ++) . snd) <$>
281− (getOption readerParseRaw >>= guard >> (withRaw optargs))
277+ (getOption readerParseRaw >>= guard >> withRaw optargs)
282278
283279blockCommands :: M.Map String (LP Blocks)
284280blockCommands = M.fromList $
@@ -316,7 +312,7 @@ blockCommands = M.fromList $
316312 --
317313 , ("hrule", pure horizontalRule)
318314 , ("rule", skipopts *> tok *> tok *> pure horizontalRule)
319− , ("item", skipopts *> loose_item)
315+ , ("item", skipopts *> looseItem)
320316 , ("documentclass", skipopts *> braced *> preamble)
321317 , ("centerline", (para . trimInlines) <$> (skipopts *> tok))
322318 , ("caption", skipopts *> setCaption)
@@ -403,17 +399,14 @@ inlineCommand = try $ do
403399 else if parseRaw
404400 then return $ rawInline "latex" rawcommand
405401 else return mempty
406− case M.lookup name' inlineCommands of
407− Just p -> p <|> raw
408− Nothing -> case M.lookup name inlineCommands of
409− Just p -> p <|> raw
410− Nothing -> raw
402+ lookupListDefault mzero [name',name] inlineCommands
403+ <|> raw
411404
412405unlessParseRaw :: LP ()
413406unlessParseRaw = getOption readerParseRaw >>= guard . not
414407
415408isBlockCommand :: String -> Bool
416−isBlockCommand s = maybe False (const True) $ M.lookup s blockCommands
409+isBlockCommand s = s `M.member` blockCommands
417410
418411
419412inlineEnvironments :: M.Map String (LP Inlines)
@@ -459,7 +452,7 @@ inlineCommands = M.fromList $
459452 , ("cref", unlessParseRaw >> (inBrackets <$> tok)) -- from cleveref.sty
460453 , ("(", mathInline $ manyTill anyChar (try $ string "\\)"))
461454 , ("[", mathDisplay $ manyTill anyChar (try $ string "\\]"))
462− , ("ensuremath", mathInline $ braced)
455+ , ("ensuremath", mathInline braced)
463456 , ("texorpdfstring", (\_ x -> x) <$> tok <*> tok)
464457 , ("P", lit "¶")
465458 , ("S", lit "§")
@@ -631,7 +624,7 @@ lit = pure . str
631624accent :: (Char -> String) -> Inlines -> LP Inlines
632625accent f ils =
633626 case toList ils of
634− (Str (x:xs) : ys) -> return $ fromList $ (Str (f x ++ xs) : ys)
627+ (Str (x:xs) : ys) -> return $ fromList (Str (f x ++ xs) : ys)
635628 [] -> mzero
636629 _ -> return ils
637630
@@ -820,7 +813,7 @@ breve 'u' = "ŭ"
820813breve c = [c]
821814
822815tok :: LP Inlines
823−tok = try $ grouped inline <|> inlineCommand <|> str <$> (count 1 $ inlineChar)
816+tok = try $ grouped inline <|> inlineCommand <|> str <$> count 1 inlineChar
824817
825818opt :: LP Inlines
826819opt = bracketed inline <* optional sp
@@ -838,17 +831,14 @@ environment :: LP Blocks
838831environment = do
839832 controlSeq "begin"
840833 name <- braced
841− case M.lookup name environments of
842− Just p -> p <|> rawEnv name
843− Nothing -> rawEnv name
834+ M.findWithDefault mzero name environments
835+ <|> rawEnv name
844836
845837inlineEnvironment :: LP Inlines
846838inlineEnvironment = try $ do
847839 controlSeq "begin"
848840 name <- braced
849− case M.lookup name inlineEnvironments of
850− Just p -> p
851− Nothing -> mzero
841+ M.findWithDefault mzero name inlineEnvironments
852842
853843rawEnv :: String -> LP Blocks
854844rawEnv name = do
@@ -861,7 +851,7 @@ rawEnv name = do
861851
862852----
863853
864−type IncludeParser = ParserT [Char] [String] IO String
854+type IncludeParser = ParserT String [String] IO String
865855
866856-- | Replace "include" commands with file contents.
867857handleIncludes :: String -> IO (Either PandocError String)
@@ -921,7 +911,7 @@ include' = do
921911 <|> try (string "input")
922912 <|> string "usepackage"
923913 -- skip options
924− skipMany $ try $ char '[' *> (manyTill anyChar (char ']'))
914+ skipMany $ try $ char '[' *> manyTill anyChar (char ']')
925915 fs <- (map trim . splitBy (==',')) <$> braced'
926916 return $ if name == "usepackage"
927917 then map (maybeAddExtension ".sty") fs
@@ -994,14 +984,14 @@ keyvals = try $ char '[' *> manyTill keyval (char ']')
994984alltt :: String -> LP Blocks
995985alltt t = walk strToCode <$> parseFromString blocks
996986 (substitute " " "\\ " $ substitute "%" "\\%" $
997− concat $ intersperse "\\\\\n" $ lines t)
987+ intercalate "\\\\\n" $ lines t)
998988 where strToCode (Str s) = Code nullAttr s
999989 strToCode x = x
1000990
1001−rawLaTeXBlock :: Parser [Char] ParserState String
991+rawLaTeXBlock :: LP String
1002992rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))
1003993
1004−rawLaTeXInline :: Parser [Char] ParserState Inline
994+rawLaTeXInline :: LP Inline
1005995rawLaTeXInline = do
1006996 raw <- (snd <$> withRaw inlineCommand) <|> (snd <$> withRaw blockCommand)
1007997 RawInline "latex" <$> applyMacros' raw
@@ -1010,24 +1000,24 @@ addImageCaption :: Blocks -> LP Blocks
10101000addImageCaption = walkM go
10111001 where go (Image alt (src,tit)) = do
10121002 mbcapt <- stateCaption <$> getState
1013− case mbcapt of
1014− Just ils -> return (Image (toList ils) (src, "fig:"))
1015− Nothing -> return (Image alt (src,tit))
1003+ return $ case mbcapt of
1004+ Just ils -> Image (toList ils) (src, "fig:")
1005+ Nothing -> Image alt (src,tit)
10161006 go x = return x
10171007
10181008addTableCaption :: Blocks -> LP Blocks
10191009addTableCaption = walkM go
10201010 where go (Table c als ws hs rs) = do
10211011 mbcapt <- stateCaption <$> getState
1022− case mbcapt of
1023− Just ils -> return (Table (toList ils) als ws hs rs)
1024− Nothing -> return (Table c als ws hs rs)
1012+ return $ case mbcapt of
1013+ Just ils -> Table (toList ils) als ws hs rs
1014+ Nothing -> Table c als ws hs rs
10251015 go x = return x
10261016
10271017environments :: M.Map String (LP Blocks)
10281018environments = M.fromList
10291019 [ ("document", env "document" blocks <* skipMany anyChar)
1030− , ("letter", env "letter" letter_contents)
1020+ , ("letter", env "letter" letterContents)
10311021 , ("figure", env "figure" $
10321022 resetCaption *> skipopts *> blocks >>= addImageCaption)
10331023 , ("center", env "center" blocks)
@@ -1040,12 +1030,12 @@ environments = M.fromList
10401030 , ("verse", blockQuote <$> env "verse" blocks)
10411031 , ("itemize", bulletList <$> listenv "itemize" (many item))
10421032 , ("description", definitionList <$> listenv "description" (many descItem))
1043− , ("enumerate", ordered_list)
1033+ , ("enumerate", orderedList')
10441034 , ("alltt", alltt =<< verbEnv "alltt")
10451035 , ("code", guardEnabled Ext_literate_haskell *>
10461036 (codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
10471037 verbEnv "code"))
1048− , ("verbatim", codeBlock <$> (verbEnv "verbatim"))
1038+ , ("verbatim", codeBlock <$> verbEnv "verbatim")
10491039 , ("Verbatim", do options <- option [] keyvals
10501040 let kvs = [ (if k == "firstnumber"
10511041 then "startFrom"
@@ -1053,17 +1043,17 @@ environments = M.fromList
10531043 let classes = [ "numberLines" |
10541044 lookup "numbers" options == Just "left" ]
10551045 let attr = ("",classes,kvs)
1056− codeBlockWith attr <$> (verbEnv "Verbatim"))
1046+ codeBlockWith attr <$> verbEnv "Verbatim")
10571047 , ("lstlisting", do options <- option [] keyvals
10581048 let kvs = [ (if k == "firstnumber"
10591049 then "startFrom"
10601050 else k, v) | (k,v) <- options ]
10611051 let classes = [ "numberLines" |
10621052 lookup "numbers" options == Just "left" ]
1063− ++ maybe [] (:[]) (lookup "language" options
1053+ ++ maybeToList (lookup "language" options
10641054 >>= fromListingsLanguage)
10651055 let attr = (fromMaybe "" (lookup "label" options),classes,kvs)
1066− codeBlockWith attr <$> (verbEnv "lstlisting"))
1056+ codeBlockWith attr <$> verbEnv "lstlisting")
10671057 , ("minted", do options <- option [] keyvals
10681058 lang <- grouped (many1 $ satisfy (/='}'))
10691059 let kvs = [ (if k == "firstnumber"
@@ -1073,7 +1063,7 @@ environments = M.fromList
10731063 [ "numberLines" |
10741064 lookup "linenos" options == Just "true" ]
10751065 let attr = ("",classes,kvs)
1076− codeBlockWith attr <$> (verbEnv "minted"))
1066+ codeBlockWith attr <$> verbEnv "minted")
10771067 , ("obeylines", parseFromString
10781068 (para . trimInlines . mconcat <$> many inline) =<<
10791069 intercalate "\\\\\n" . lines <$> verbEnv "obeylines")
@@ -1092,8 +1082,8 @@ environments = M.fromList
10921082 , ("alignat*", mathEnv para (Just "aligned") "alignat*")
10931083 ]
10941084
1095−letter_contents :: LP Blocks
1096−letter_contents = do
1085+letterContents :: LP Blocks
1086+letterContents = do
10971087 bs <- blocks
10981088 st <- getState
10991089 -- add signature (author) and address (title)
@@ -1120,8 +1110,8 @@ closing = do
11201110item :: LP Blocks
11211111item = blocks *> controlSeq "item" *> skipopts *> blocks
11221112
1123−loose_item :: LP Blocks
1124−loose_item = do
1113+looseItem :: LP Blocks
1114+looseItem = do
11251115 ctx <- stateParserContext `fmap` getState
11261116 if ctx == ListItemState
11271117 then mzero
@@ -1164,8 +1154,8 @@ verbEnv name = do
11641154 res <- manyTill anyChar endEnv
11651155 return $ stripTrailingNewlines res
11661156
1167−ordered_list :: LP Blocks
1168−ordered_list = do
1157+orderedList' :: LP Blocks
1158+orderedList' = do
11691159 optional sp
11701160 (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $
11711161 try $ char '[' *> anyOrderedListMarker <* char ']'
@@ -1177,7 +1167,7 @@ ordered_list = do
11771167 optional sp
11781168 num <- grouped (many1 digit)
11791169 spaces
1180− return $ (read num + 1 :: Int)
1170+ return (read num + 1 :: Int)
11811171 bs <- listenv "enumerate" (many item)
11821172 return $ orderedListWith (start, style, delim) bs
11831173
@@ -1191,14 +1181,14 @@ paragraph = do
11911181preamble :: LP Blocks
11921182preamble = mempty <$> manyTill preambleBlock beginDoc
11931183 where beginDoc = lookAhead $ try $ controlSeq "begin" *> string "{document}"
1194− preambleBlock = (void comment)
1195− <|> (void sp)
1196− <|> (void blanklines)
1197− <|> (void macro)
1198− <|> (void blockCommand)
1199− <|> (void anyControlSeq)
1200− <|> (void braced)
1201− <|> (void anyChar)
1184+ preambleBlock = void comment
1185+ <|> void sp
1186+ <|> void blanklines
1187+ <|> void macro
1188+ <|> void blockCommand
1189+ <|> void anyControlSeq
1190+ <|> void braced
1191+ <|> void anyChar
12021192
12031193-------
12041194
@@ -1274,7 +1264,7 @@ complexNatbibCitation mode = try $ do
12741264 suff <- ils
12751265 skipSpaces
12761266 optional $ char ';'
1277− return $ addPrefix pref $ addSuffix suff $ cits'
1267+ return $ addPrefix pref $ addSuffix suff cits'
12781268 (c:cits, raw) <- withRaw $ grouped parseOne
12791269 return $ cite (c{ citationMode = mode }:cits)
12801270 (rawInline "latex" $ "\\citetext" ++ raw)
@@ -1298,13 +1288,13 @@ parseAligns = try $ do
12981288 return aligns'
12991289
13001290hline :: LP ()
1301−hline = () <$ (try $ spaces' *> controlSeq "hline" <* spaces')
1291+hline = () <$ try (spaces' *> controlSeq "hline" <* spaces')
13021292
13031293lbreak :: LP ()
1304−lbreak = () <$ (try $ spaces' *> controlSeq "\\" <* spaces')
1294+lbreak = () <$ try (spaces' *> controlSeq "\\" <* spaces')
13051295
13061296amp :: LP ()
1307−amp = () <$ (try $ spaces' *> char '&')
1297+amp = () <$ try (spaces' *> char '&')
13081298
13091299parseTableRow :: Int -- ^ number of columns
13101300 -> LP [Blocks]