aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Readers/LaTeX.hs4
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs4
-rw-r--r--src/Text/Pandoc/Readers/Muse.hs4
-rw-r--r--src/Text/Pandoc/Readers/OPML.hs2
-rw-r--r--src/Text/Pandoc/Readers/Odt/StyleReader.hs2
-rw-r--r--src/Text/Pandoc/Readers/RST.hs96
6 files changed, 54 insertions, 58 deletions
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs
index c91e8bd79..d6a3de2f1 100644
--- a/src/Text/Pandoc/Readers/LaTeX.hs
+++ b/src/Text/Pandoc/Readers/LaTeX.hs
@@ -665,7 +665,7 @@ removeDoubleQuotes t =
Data.Maybe.fromMaybe t $ T.stripPrefix "\"" t >>= T.stripSuffix "\""
doubleQuote :: PandocMonad m => LP m Inlines
-doubleQuote =
+doubleQuote =
quoted' doubleQuoted (try $ count 2 $ symbol '`')
(void $ try $ count 2 $ symbol '\'')
<|> quoted' doubleQuoted ((:[]) <$> symbol '“') (void $ symbol '”')
@@ -674,7 +674,7 @@ doubleQuote =
(void $ try $ sequence [symbol '"', symbol '\''])
singleQuote :: PandocMonad m => LP m Inlines
-singleQuote =
+singleQuote =
quoted' singleQuoted ((:[]) <$> symbol '`')
(try $ symbol '\'' >>
notFollowedBy (satisfyTok startsWithLetter))
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 69e70f9f5..2a88b39ec 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -241,7 +241,7 @@ yamlMetaBlock = try $ do
case Yaml.decodeEither' $ UTF8.fromString rawYaml of
Right (Yaml.Object hashmap) -> do
let alist = H.toList hashmap
- mapM_ (\(k, v) ->
+ mapM_ (\(k, v) ->
if ignorable k
then return ()
else do
@@ -320,7 +320,7 @@ yamlToMeta (Yaml.Array xs) = do
return $ B.toMetaValue xs''
yamlToMeta (Yaml.Object o) = do
let alist = H.toList o
- foldM (\m (k,v) ->
+ foldM (\m (k,v) ->
if ignorable k
then return m
else do
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index 6cc505e3b..3bb4b64e6 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -240,7 +240,7 @@ exampleTag = do
chop = lchop . rchop
literal :: PandocMonad m => MuseParser m (F Blocks)
-literal = fmap (return . rawBlock) $ htmlElement "literal"
+literal = (return . rawBlock) <$> htmlElement "literal"
where
format (_, _, kvs) = fromMaybe "html" $ lookup "format" kvs
rawBlock (attrs, content) = B.rawBlock (format attrs) content
@@ -658,7 +658,7 @@ str :: PandocMonad m => MuseParser m (F Inlines)
str = fmap (return . B.str) (many1 alphaNum <|> count 1 characterReference)
symbol :: PandocMonad m => MuseParser m (F Inlines)
-symbol = fmap (return . B.str) $ count 1 nonspaceChar
+symbol = (return . B.str) <$> count 1 nonspaceChar
link :: PandocMonad m => MuseParser m (F Inlines)
link = try $ do
diff --git a/src/Text/Pandoc/Readers/OPML.hs b/src/Text/Pandoc/Readers/OPML.hs
index e3ef67bc1..1a1375b16 100644
--- a/src/Text/Pandoc/Readers/OPML.hs
+++ b/src/Text/Pandoc/Readers/OPML.hs
@@ -58,7 +58,7 @@ normalizeTree = everywhere (mkT go)
go xs = xs
convertEntity :: String -> String
-convertEntity e = maybe (map toUpper e) id (lookupEntity e)
+convertEntity e = Data.Maybe.fromMaybe (map toUpper e) (lookupEntity e)
-- convenience function to get an attribute value, defaulting to ""
attrValue :: String -> Element -> String
diff --git a/src/Text/Pandoc/Readers/Odt/StyleReader.hs b/src/Text/Pandoc/Readers/Odt/StyleReader.hs
index abb131983..1384072d1 100644
--- a/src/Text/Pandoc/Readers/Odt/StyleReader.hs
+++ b/src/Text/Pandoc/Readers/Odt/StyleReader.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE Arrows #-}
-{-# LANGUAGE PatternGuards #-}
+
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index dae9fe40a..070a05df1 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -31,20 +31,21 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Conversion from reStructuredText to 'Pandoc' document.
-}
module Text.Pandoc.Readers.RST ( readRST ) where
+import Control.Arrow (second)
import Control.Monad (forM_, guard, liftM, mplus, mzero, when)
import Control.Monad.Except (throwError)
import Control.Monad.Identity (Identity (..))
import Data.Char (isHexDigit, isSpace, toLower, toUpper)
-import Data.List (deleteFirstsBy, findIndex, intercalate, isInfixOf, isSuffixOf,
- nub, sort, transpose, union)
+import Data.List (deleteFirstsBy, intercalate, isInfixOf,
+ elemIndex, isSuffixOf, nub, sort, transpose, union)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust)
import Data.Monoid ((<>))
import Data.Sequence (ViewR (..), viewr)
import Data.Text (Text)
import qualified Data.Text as T
-import Text.Pandoc.Builder (fromList, setMeta)
-import Text.Pandoc.Builder (Blocks, Inlines, trimInlines)
+import Text.Pandoc.Builder
+ (fromList, setMeta, Blocks, Inlines, trimInlines)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad, fetchItem, readFileFromDirs)
import Text.Pandoc.CSV (CSVOptions (..), defaultCSVOptions, parseCSV)
@@ -67,7 +68,7 @@ readRST :: PandocMonad m
-> Text -- ^ String to parse (assuming @'\n'@ line endings)
-> m Pandoc
readRST opts s = do
- parsed <- (readWithM parseRST) def{ stateOptions = opts }
+ parsed <- readWithM parseRST def{ stateOptions = opts }
(T.unpack (crFilter s) ++ "\n\n")
case parsed of
Right result -> return result
@@ -100,9 +101,9 @@ isHeader _ _ = False
-- | Promote all headers in a list of blocks. (Part of
-- title transformation for RST.)
promoteHeaders :: Int -> [Block] -> [Block]
-promoteHeaders num ((Header level attr text):rest) =
- (Header (level - num) attr text):(promoteHeaders num rest)
-promoteHeaders num (other:rest) = other:(promoteHeaders num rest)
+promoteHeaders num (Header level attr text:rest) =
+ Header (level - num) attr text:promoteHeaders num rest
+promoteHeaders num (other:rest) = other:promoteHeaders num rest
promoteHeaders _ [] = []
-- | If list of blocks starts with a header (or a header and subheader)
@@ -114,11 +115,11 @@ titleTransform :: ([Block], Meta) -- ^ list of blocks, metadata
titleTransform (bs, meta) =
let (bs', meta') =
case bs of
- ((Header 1 _ head1):(Header 2 _ head2):rest)
+ (Header 1 _ head1:Header 2 _ head2:rest)
| not (any (isHeader 1) rest || any (isHeader 2) rest) -> -- tit/sub
(promoteHeaders 2 rest, setMeta "title" (fromList head1) $
setMeta "subtitle" (fromList head2) meta)
- ((Header 1 _ head1):rest)
+ (Header 1 _ head1:rest)
| not (any (isHeader 1) rest) -> -- title only
(promoteHeaders 1 rest,
setMeta "title" (fromList head1) meta)
@@ -137,8 +138,7 @@ metaFromDefList ds meta = adjustAuthors $ foldr f meta ds
$ M.mapKeys (\k ->
if k == "authors"
then "author"
- else k)
- $ metamap
+ else k) metamap
toPlain (MetaBlocks [Para xs]) = MetaInlines xs
toPlain x = x
splitAuthors (MetaBlocks [Para xs])
@@ -201,7 +201,7 @@ parseCitation :: PandocMonad m
=> (String, String) -> RSTParser m (Inlines, [Blocks])
parseCitation (ref, raw) = do
contents <- parseFromString' parseBlocks raw
- return $ (B.spanWith (ref, ["citation-label"], []) (B.str ref),
+ return (B.spanWith (ref, ["citation-label"], []) (B.str ref),
[contents])
@@ -289,7 +289,7 @@ para = try $ do
newline
blanklines
case viewr (B.unMany result) of
- ys :> (Str xs) | "::" `isSuffixOf` xs -> do
+ ys :> Str xs | "::" `isSuffixOf` xs -> do
raw <- option mempty codeBlockBody
return $ B.para (B.Many ys <> B.str (take (length xs - 1) xs))
<> raw
@@ -313,9 +313,9 @@ doubleHeader = do
-- if so, get appropriate level. if not, add to list.
state <- getState
let headerTable = stateHeaderTable state
- let (headerTable',level) = case findIndex (== DoubleHeader c) headerTable of
+ let (headerTable',level) = case elemIndex (DoubleHeader c) headerTable of
Just ind -> (headerTable, ind + 1)
- Nothing -> (headerTable ++ [DoubleHeader c], (length headerTable) + 1)
+ Nothing -> (headerTable ++ [DoubleHeader c], length headerTable + 1)
setState (state { stateHeaderTable = headerTable' })
attr <- registerHeader nullAttr txt
return $ B.headerWith attr level txt
@@ -329,8 +329,8 @@ doubleHeader' = try $ do
newline
txt <- trimInlines . mconcat <$> many1 (notFollowedBy blankline >> inline)
pos <- getPosition
- let len = (sourceColumn pos) - 1
- if (len > lenTop) then fail "title longer than border" else return ()
+ let len = sourceColumn pos - 1
+ when (len > lenTop) $ fail "title longer than border"
blankline -- spaces and newline
count lenTop (char c) -- the bottom line
blanklines
@@ -342,9 +342,9 @@ singleHeader = do
(txt, c) <- singleHeader'
state <- getState
let headerTable = stateHeaderTable state
- let (headerTable',level) = case findIndex (== SingleHeader c) headerTable of
+ let (headerTable',level) = case elemIndex (SingleHeader c) headerTable of
Just ind -> (headerTable, ind + 1)
- Nothing -> (headerTable ++ [SingleHeader c], (length headerTable) + 1)
+ Nothing -> (headerTable ++ [SingleHeader c], length headerTable + 1)
setState (state { stateHeaderTable = headerTable' })
attr <- registerHeader nullAttr txt
return $ B.headerWith attr level txt
@@ -355,7 +355,7 @@ singleHeader' = try $ do
lookAhead $ anyLine >> oneOf underlineChars
txt <- trimInlines . mconcat <$> many1 (do {notFollowedBy newline; inline})
pos <- getPosition
- let len = (sourceColumn pos) - 1
+ let len = sourceColumn pos - 1
blankline
c <- oneOf underlineChars
count (len - 1) (char c)
@@ -491,8 +491,7 @@ includeDirective top fields body = do
Just x | x >= 0 -> x
| otherwise -> numLines + x -- negative from end
let contentLines' = drop (startLine' - 1)
- $ take (endLine' - 1)
- $ contentLines
+ $ take (endLine' - 1) contentLines
let contentLines'' = (case trim <$> lookup "end-before" fields of
Just patt -> takeWhile (not . (patt `isInfixOf`))
Nothing -> id) .
@@ -692,7 +691,7 @@ directive' = do
"csv-table" -> csvTableDirective top fields body'
"line-block" -> lineBlockDirective body'
"raw" -> return $ B.rawBlock (trim top) (stripTrailingNewlines body)
- "role" -> addNewRole top $ map (\(k,v) -> (k, trim v)) fields
+ "role" -> addNewRole top $ map (second trim) fields
"container" -> parseFromString' parseBlocks body'
"replace" -> B.para <$> -- consumed by substKey
parseInlineFromString (trim top)
@@ -733,7 +732,7 @@ directive' = do
codeblock (words $ fromMaybe [] $ lookup "class" fields)
(lookup "number-lines" fields) (trim top) body
"aafig" -> do
- let attribs = ("", ["aafig"], map (\(k,v) -> (k, trimr v)) fields)
+ let attribs = ("", ["aafig"], map (second trimr) fields)
return $ B.codeBlockWith attribs $ stripTrailingNewlines body
"math" -> return $ B.para $ mconcat $ map B.displayMath
$ toChunks $ top ++ "\n\n" ++ body
@@ -752,8 +751,8 @@ directive' = do
$ B.imageWith attr src "" alt
Nothing -> B.imageWith attr src "" alt
"class" -> do
- let attrs = ("", (splitBy isSpace $ trim top),
- map (\(k,v) -> (k, trimr v)) fields)
+ let attrs = ("", splitBy isSpace $ trim top,
+ map (second trimr) fields)
-- directive content or the first immediately following element
children <- case body of
"" -> block
@@ -857,7 +856,7 @@ csvTableDirective top fields rawcsv = do
Just h -> h ++ "\n" ++ rawcsv'
Nothing -> rawcsv')
case res of
- Left e -> do
+ Left e ->
throwError $ PandocParsecError "csv table" e
Right rawrows -> do
let parseCell = parseFromString' (plain <|> return mempty) . T.unpack
@@ -909,13 +908,13 @@ addNewRole roleString fields = do
in (ident, nub . (role :) . annotate $ classes, keyValues)
-- warn about syntax we ignore
- flip mapM_ fields $ \(key, _) -> case key of
- "language" -> when (baseRole /= "code") $ logMessage $
- SkippedContent ":language: [because parent of role is not :code:]"
- pos
- "format" -> when (baseRole /= "raw") $ logMessage $
- SkippedContent ":format: [because parent of role is not :raw:]" pos
- _ -> logMessage $ SkippedContent (":" ++ key ++ ":") pos
+ forM_ fields $ \(key, _) -> case key of
+ "language" -> when (baseRole /= "code") $ logMessage $
+ SkippedContent ":language: [because parent of role is not :code:]"
+ pos
+ "format" -> when (baseRole /= "raw") $ logMessage $
+ SkippedContent ":format: [because parent of role is not :raw:]" pos
+ _ -> logMessage $ SkippedContent (":" ++ key ++ ":") pos
when (parentRole == "raw" && countKeys "format" > 1) $
logMessage $ SkippedContent
":format: [after first in definition of role]"
@@ -983,7 +982,7 @@ codeblock classes numberLines lang body =
return $ B.codeBlockWith attribs $ stripTrailingNewlines body
where attribs = ("", classes', kvs)
classes' = "sourceCode" : lang
- : maybe [] (\_ -> ["numberLines"]) numberLines
+ : maybe [] (const ["numberLines"]) numberLines
++ classes
kvs = case numberLines of
Just "" -> []
@@ -1038,7 +1037,8 @@ noteMarker :: Monad m => RSTParser m [Char]
noteMarker = do
char '['
res <- many1 digit
- <|> (try $ char '#' >> liftM ('#':) simpleReferenceName')
+ <|>
+ try (char '#' >> liftM ('#':) simpleReferenceName')
<|> count 1 (oneOf "#*")
char ']'
return res
@@ -1050,13 +1050,11 @@ noteMarker = do
quotedReferenceName :: PandocMonad m => RSTParser m Inlines
quotedReferenceName = try $ do
char '`' >> notFollowedBy (char '`') -- `` means inline code!
- label' <- trimInlines . mconcat <$> many1Till inline (char '`')
- return label'
+ trimInlines . mconcat <$> many1Till inline (char '`')
unquotedReferenceName :: PandocMonad m => RSTParser m Inlines
-unquotedReferenceName = try $ do
- label' <- trimInlines . mconcat <$> many1Till inline (lookAhead $ char ':')
- return label'
+unquotedReferenceName = try $ do -- `` means inline code!
+ trimInlines . mconcat <$> many1Till inline (lookAhead $ char ':')
-- Simple reference names are single words consisting of alphanumerics
-- plus isolated (no two adjacent) internal hyphens, underscores,
@@ -1066,7 +1064,8 @@ simpleReferenceName' :: Monad m => ParserT [Char] st m String
simpleReferenceName' = do
x <- alphaNum
xs <- many $ alphaNum
- <|> (try $ oneOf "-_:+." <* lookAhead alphaNum)
+ <|>
+ try (oneOf "-_:+." <* lookAhead alphaNum)
return (x:xs)
simpleReferenceName :: Monad m => ParserT [Char] st m Inlines
@@ -1074,7 +1073,7 @@ simpleReferenceName = B.str <$> simpleReferenceName'
referenceName :: PandocMonad m => RSTParser m Inlines
referenceName = quotedReferenceName <|>
- (try $ simpleReferenceName <* lookAhead (char ':')) <|>
+ try (simpleReferenceName <* lookAhead (char ':')) <|>
unquotedReferenceName
referenceKey :: PandocMonad m => RSTParser m [Char]
@@ -1093,7 +1092,7 @@ targetURI = do
contents <- many1 (try (many spaceChar >> newline >>
many1 spaceChar >> noneOf " \t\n") <|> noneOf "\n")
blanklines
- return $ escapeURI $ trim $ contents
+ return $ escapeURI $ trim contents
substKey :: PandocMonad m => RSTParser m ()
substKey = try $ do
@@ -1258,8 +1257,7 @@ simpleTableHeader headless = try $ do
let rawHeads = if headless
then replicate (length dashes) ""
else simpleTableSplitLine indices rawContent
- heads <- mapM (parseFromString' (mconcat <$> many plain)) $
- map trim rawHeads
+ heads <- mapM ( (parseFromString' (mconcat <$> many plain)) . trim) rawHeads
return (heads, aligns, indices)
-- Parse a simple table.
@@ -1450,10 +1448,8 @@ endline = try $ do
notFollowedBy blankline
-- parse potential list-starts at beginning of line differently in a list:
st <- getState
- if (stateParserContext st) == ListItemState
- then notFollowedBy (anyOrderedListMarker >> spaceChar) >>
+ when ((stateParserContext st) == ListItemState) $ notFollowedBy (anyOrderedListMarker >> spaceChar) >>
notFollowedBy' bulletListStart
- else return ()
return B.softbreak
--