@@ -31,20 +31,21 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
3131Conversion from reStructuredText to 'Pandoc' document.
3232-}
3333module Text.Pandoc.Readers.RST ( readRST ) where
34+import Control.Arrow (second)
3435import Control.Monad (forM_, guard, liftM, mplus, mzero, when)
3536import Control.Monad.Except (throwError)
3637import Control.Monad.Identity (Identity (..))
3738import Data.Char (isHexDigit, isSpace, toLower, toUpper)
38−import Data.List (deleteFirstsBy, findIndex, intercalate, isInfixOf, isSuffixOf,
39− nub, sort, transpose, union)
39+import Data.List (deleteFirstsBy, intercalate, isInfixOf,
40+ elemIndex, isSuffixOf, nub, sort, transpose, union)
4041import qualified Data.Map as M
4142import Data.Maybe (fromMaybe, isJust)
4243import Data.Monoid ((<>))
4344import Data.Sequence (ViewR (..), viewr)
4445import Data.Text (Text)
4546import qualified Data.Text as T
46−import Text.Pandoc.Builder (fromList, setMeta)
47−import Text.Pandoc.Builder (Blocks, Inlines, trimInlines)
47+import Text.Pandoc.Builder
48+ (fromList, setMeta, Blocks, Inlines, trimInlines)
4849import qualified Text.Pandoc.Builder as B
4950import Text.Pandoc.Class (PandocMonad, fetchItem, readFileFromDirs)
5051import Text.Pandoc.CSV (CSVOptions (..), defaultCSVOptions, parseCSV)
@@ -67,7 +68,7 @@ readRST :: PandocMonad m
6768 -> Text -- ^ String to parse (assuming @'\n'@ line endings)
6869 -> m Pandoc
6970readRST opts s = do
70− parsed <- (readWithM parseRST) def{ stateOptions = opts }
71+ parsed <- readWithM parseRST def{ stateOptions = opts }
7172 (T.unpack (crFilter s) ++ "\n\n")
7273 case parsed of
7374 Right result -> return result
@@ -100,9 +101,9 @@ isHeader _ _ = False
100101-- | Promote all headers in a list of blocks. (Part of
101102-- title transformation for RST.)
102103promoteHeaders :: Int -> [Block] -> [Block]
103−promoteHeaders num ((Header level attr text):rest) =
104− (Header (level - num) attr text):(promoteHeaders num rest)
105−promoteHeaders num (other:rest) = other:(promoteHeaders num rest)
104+promoteHeaders num (Header level attr text:rest) =
105+ Header (level - num) attr text:promoteHeaders num rest
106+promoteHeaders num (other:rest) = other:promoteHeaders num rest
106107promoteHeaders _ [] = []
107108
108109-- | If list of blocks starts with a header (or a header and subheader)
@@ -114,11 +115,11 @@ titleTransform :: ([Block], Meta) -- ^ list of blocks, metadata
114115titleTransform (bs, meta) =
115116 let (bs', meta') =
116117 case bs of
117− ((Header 1 _ head1):(Header 2 _ head2):rest)
118+ (Header 1 _ head1:Header 2 _ head2:rest)
118119 | not (any (isHeader 1) rest || any (isHeader 2) rest) -> -- tit/sub
119120 (promoteHeaders 2 rest, setMeta "title" (fromList head1) $
120121 setMeta "subtitle" (fromList head2) meta)
121− ((Header 1 _ head1):rest)
122+ (Header 1 _ head1:rest)
122123 | not (any (isHeader 1) rest) -> -- title only
123124 (promoteHeaders 1 rest,
124125 setMeta "title" (fromList head1) meta)
@@ -137,8 +138,7 @@ metaFromDefList ds meta = adjustAuthors $ foldr f meta ds
137138 $ M.mapKeys (\k ->
138139 if k == "authors"
139140 then "author"
140− else k)
141− $ metamap
141+ else k) metamap
142142 toPlain (MetaBlocks [Para xs]) = MetaInlines xs
143143 toPlain x = x
144144 splitAuthors (MetaBlocks [Para xs])
@@ -201,7 +201,7 @@ parseCitation :: PandocMonad m
201201 => (String, String) -> RSTParser m (Inlines, [Blocks])
202202parseCitation (ref, raw) = do
203203 contents <- parseFromString' parseBlocks raw
204− return $ (B.spanWith (ref, ["citation-label"], []) (B.str ref),
204+ return (B.spanWith (ref, ["citation-label"], []) (B.str ref),
205205 [contents])
206206
207207
@@ -289,7 +289,7 @@ para = try $ do
289289 newline
290290 blanklines
291291 case viewr (B.unMany result) of
292− ys :> (Str xs) | "::" `isSuffixOf` xs -> do
292+ ys :> Str xs | "::" `isSuffixOf` xs -> do
293293 raw <- option mempty codeBlockBody
294294 return $ B.para (B.Many ys <> B.str (take (length xs - 1) xs))
295295 <> raw
@@ -313,9 +313,9 @@ doubleHeader = do
313313 -- if so, get appropriate level. if not, add to list.
314314 state <- getState
315315 let headerTable = stateHeaderTable state
316− let (headerTable',level) = case findIndex (== DoubleHeader c) headerTable of
316+ let (headerTable',level) = case elemIndex (DoubleHeader c) headerTable of
317317 Just ind -> (headerTable, ind + 1)
318− Nothing -> (headerTable ++ [DoubleHeader c], (length headerTable) + 1)
318+ Nothing -> (headerTable ++ [DoubleHeader c], length headerTable + 1)
319319 setState (state { stateHeaderTable = headerTable' })
320320 attr <- registerHeader nullAttr txt
321321 return $ B.headerWith attr level txt
@@ -329,8 +329,8 @@ doubleHeader' = try $ do
329329 newline
330330 txt <- trimInlines . mconcat <$> many1 (notFollowedBy blankline >> inline)
331331 pos <- getPosition
332− let len = (sourceColumn pos) - 1
333− if (len > lenTop) then fail "title longer than border" else return ()
332+ let len = sourceColumn pos - 1
333+ when (len > lenTop) $ fail "title longer than border"
334334 blankline -- spaces and newline
335335 count lenTop (char c) -- the bottom line
336336 blanklines
@@ -342,9 +342,9 @@ singleHeader = do
342342 (txt, c) <- singleHeader'
343343 state <- getState
344344 let headerTable = stateHeaderTable state
345− let (headerTable',level) = case findIndex (== SingleHeader c) headerTable of
345+ let (headerTable',level) = case elemIndex (SingleHeader c) headerTable of
346346 Just ind -> (headerTable, ind + 1)
347− Nothing -> (headerTable ++ [SingleHeader c], (length headerTable) + 1)
347+ Nothing -> (headerTable ++ [SingleHeader c], length headerTable + 1)
348348 setState (state { stateHeaderTable = headerTable' })
349349 attr <- registerHeader nullAttr txt
350350 return $ B.headerWith attr level txt
@@ -355,7 +355,7 @@ singleHeader' = try $ do
355355 lookAhead $ anyLine >> oneOf underlineChars
356356 txt <- trimInlines . mconcat <$> many1 (do {notFollowedBy newline; inline})
357357 pos <- getPosition
358− let len = (sourceColumn pos) - 1
358+ let len = sourceColumn pos - 1
359359 blankline
360360 c <- oneOf underlineChars
361361 count (len - 1) (char c)
@@ -491,8 +491,7 @@ includeDirective top fields body = do
491491 Just x | x >= 0 -> x
492492 | otherwise -> numLines + x -- negative from end
493493 let contentLines' = drop (startLine' - 1)
494− $ take (endLine' - 1)
495− $ contentLines
494+ $ take (endLine' - 1) contentLines
496495 let contentLines'' = (case trim <$> lookup "end-before" fields of
497496 Just patt -> takeWhile (not . (patt `isInfixOf`))
498497 Nothing -> id) .
@@ -692,7 +691,7 @@ directive' = do
692691 "csv-table" -> csvTableDirective top fields body'
693692 "line-block" -> lineBlockDirective body'
694693 "raw" -> return $ B.rawBlock (trim top) (stripTrailingNewlines body)
695− "role" -> addNewRole top $ map (\(k,v) -> (k, trim v)) fields
694+ "role" -> addNewRole top $ map (second trim) fields
696695 "container" -> parseFromString' parseBlocks body'
697696 "replace" -> B.para <$> -- consumed by substKey
698697 parseInlineFromString (trim top)
@@ -733,7 +732,7 @@ directive' = do
733732 codeblock (words $ fromMaybe [] $ lookup "class" fields)
734733 (lookup "number-lines" fields) (trim top) body
735734 "aafig" -> do
736− let attribs = ("", ["aafig"], map (\(k,v) -> (k, trimr v)) fields)
735+ let attribs = ("", ["aafig"], map (second trimr) fields)
737736 return $ B.codeBlockWith attribs $ stripTrailingNewlines body
738737 "math" -> return $ B.para $ mconcat $ map B.displayMath
739738 $ toChunks $ top ++ "\n\n" ++ body
@@ -752,8 +751,8 @@ directive' = do
752751 $ B.imageWith attr src "" alt
753752 Nothing -> B.imageWith attr src "" alt
754753 "class" -> do
755− let attrs = ("", (splitBy isSpace $ trim top),
756− map (\(k,v) -> (k, trimr v)) fields)
754+ let attrs = ("", splitBy isSpace $ trim top,
755+ map (second trimr) fields)
757756 -- directive content or the first immediately following element
758757 children <- case body of
759758 "" -> block
@@ -857,7 +856,7 @@ csvTableDirective top fields rawcsv = do
857856 Just h -> h ++ "\n" ++ rawcsv'
858857 Nothing -> rawcsv')
859858 case res of
860− Left e -> do
859+ Left e ->
861860 throwError $ PandocParsecError "csv table" e
862861 Right rawrows -> do
863862 let parseCell = parseFromString' (plain <|> return mempty) . T.unpack
@@ -909,13 +908,13 @@ addNewRole roleString fields = do
909908 in (ident, nub . (role :) . annotate $ classes, keyValues)
910909
911910 -- warn about syntax we ignore
912− flip mapM_ fields $ \(key, _) -> case key of
913− "language" -> when (baseRole /= "code") $ logMessage $
914− SkippedContent ":language: [because parent of role is not :code:]"
915− pos
916− "format" -> when (baseRole /= "raw") $ logMessage $
917− SkippedContent ":format: [because parent of role is not :raw:]" pos
918− _ -> logMessage $ SkippedContent (":" ++ key ++ ":") pos
911+ forM_ fields $ \(key, _) -> case key of
912+ "language" -> when (baseRole /= "code") $ logMessage $
913+ SkippedContent ":language: [because parent of role is not :code:]"
914+ pos
915+ "format" -> when (baseRole /= "raw") $ logMessage $
916+ SkippedContent ":format: [because parent of role is not :raw:]" pos
917+ _ -> logMessage $ SkippedContent (":" ++ key ++ ":") pos
919918 when (parentRole == "raw" && countKeys "format" > 1) $
920919 logMessage $ SkippedContent
921920 ":format: [after first in definition of role]"
@@ -983,7 +982,7 @@ codeblock classes numberLines lang body =
983982 return $ B.codeBlockWith attribs $ stripTrailingNewlines body
984983 where attribs = ("", classes', kvs)
985984 classes' = "sourceCode" : lang
986− : maybe [] (\_ -> ["numberLines"]) numberLines
985+ : maybe [] (const ["numberLines"]) numberLines
987986 ++ classes
988987 kvs = case numberLines of
989988 Just "" -> []
@@ -1038,7 +1037,8 @@ noteMarker :: Monad m => RSTParser m [Char]
10381037noteMarker = do
10391038 char '['
10401039 res <- many1 digit
1041− <|> (try $ char '#' >> liftM ('#':) simpleReferenceName')
1040+ <|>
1041+ try (char '#' >> liftM ('#':) simpleReferenceName')
10421042 <|> count 1 (oneOf "#*")
10431043 char ']'
10441044 return res
@@ -1050,13 +1050,11 @@ noteMarker = do
10501050quotedReferenceName :: PandocMonad m => RSTParser m Inlines
10511051quotedReferenceName = try $ do
10521052 char '`' >> notFollowedBy (char '`') -- `` means inline code!
1053− label' <- trimInlines . mconcat <$> many1Till inline (char '`')
1054− return label'
1053+ trimInlines . mconcat <$> many1Till inline (char '`')
10551054
10561055unquotedReferenceName :: PandocMonad m => RSTParser m Inlines
1057−unquotedReferenceName = try $ do
1058− label' <- trimInlines . mconcat <$> many1Till inline (lookAhead $ char ':')
1059− return label'
1056+unquotedReferenceName = try $ do -- `` means inline code!
1057+ trimInlines . mconcat <$> many1Till inline (lookAhead $ char ':')
10601058
10611059-- Simple reference names are single words consisting of alphanumerics
10621060-- plus isolated (no two adjacent) internal hyphens, underscores,
@@ -1066,7 +1064,8 @@ simpleReferenceName' :: Monad m => ParserT [Char] st m String
10661064simpleReferenceName' = do
10671065 x <- alphaNum
10681066 xs <- many $ alphaNum
1069− <|> (try $ oneOf "-_:+." <* lookAhead alphaNum)
1067+ <|>
1068+ try (oneOf "-_:+." <* lookAhead alphaNum)
10701069 return (x:xs)
10711070
10721071simpleReferenceName :: Monad m => ParserT [Char] st m Inlines
@@ -1074,7 +1073,7 @@ simpleReferenceName = B.str <$> simpleReferenceName'
10741073
10751074referenceName :: PandocMonad m => RSTParser m Inlines
10761075referenceName = quotedReferenceName <|>
1077− (try $ simpleReferenceName <* lookAhead (char ':')) <|>
1076+ try (simpleReferenceName <* lookAhead (char ':')) <|>
10781077 unquotedReferenceName
10791078
10801079referenceKey :: PandocMonad m => RSTParser m [Char]
@@ -1093,7 +1092,7 @@ targetURI = do
10931092 contents <- many1 (try (many spaceChar >> newline >>
10941093 many1 spaceChar >> noneOf " \t\n") <|> noneOf "\n")
10951094 blanklines
1096− return $ escapeURI $ trim $ contents
1095+ return $ escapeURI $ trim contents
10971096
10981097substKey :: PandocMonad m => RSTParser m ()
10991098substKey = try $ do
@@ -1258,8 +1257,7 @@ simpleTableHeader headless = try $ do
12581257 let rawHeads = if headless
12591258 then replicate (length dashes) ""
12601259 else simpleTableSplitLine indices rawContent
1261− heads <- mapM (parseFromString' (mconcat <$> many plain)) $
1262− map trim rawHeads
1260+ heads <- mapM ( (parseFromString' (mconcat <$> many plain)) . trim) rawHeads
12631261 return (heads, aligns, indices)
12641262
12651263-- Parse a simple table.
@@ -1450,10 +1448,8 @@ endline = try $ do
14501448 notFollowedBy blankline
14511449 -- parse potential list-starts at beginning of line differently in a list:
14521450 st <- getState
1453− if (stateParserContext st) == ListItemState
1454− then notFollowedBy (anyOrderedListMarker >> spaceChar) >>
1451+ when ((stateParserContext st) == ListItemState) $ notFollowedBy (anyOrderedListMarker >> spaceChar) >>
14551452 notFollowedBy' bulletListStart
1456− else return ()
14571453 return B.softbreak
14581454
14591455--