aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/MediaBag.hs2
-rw-r--r--src/Text/Pandoc/PDF.hs8
-rw-r--r--src/Text/Pandoc/Pretty.hs36
-rw-r--r--src/Text/Pandoc/Readers/CommonMark.hs4
-rw-r--r--src/Text/Pandoc/Readers/Creole.hs36
-rw-r--r--src/Text/Pandoc/Readers/DocBook.hs40
-rw-r--r--src/Text/Pandoc/Readers/Docx/Combine.hs24
-rw-r--r--src/Text/Pandoc/Readers/Docx/Lists.hs68
-rw-r--r--src/Text/Pandoc/Readers/Docx/Parse.hs26
9 files changed, 118 insertions, 126 deletions
diff --git a/src/Text/Pandoc/MediaBag.hs b/src/Text/Pandoc/MediaBag.hs
index f89c60c9e..1c15d1cee 100644
--- a/src/Text/Pandoc/MediaBag.hs
+++ b/src/Text/Pandoc/MediaBag.hs
@@ -80,4 +80,4 @@ lookupMedia fp (MediaBag mediamap) = M.lookup (splitDirectories fp) mediamap
mediaDirectory :: MediaBag -> [(String, MimeType, Int)]
mediaDirectory (MediaBag mediamap) =
M.foldrWithKey (\fp (mime,contents) ->
- (((Posix.joinPath fp), mime, fromIntegral $ BL.length contents):)) [] mediamap
+ ((Posix.joinPath fp, mime, fromIntegral $ BL.length contents):)) [] mediamap
diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs
index 028d63dcb..cafb4a226 100644
--- a/src/Text/Pandoc/PDF.hs
+++ b/src/Text/Pandoc/PDF.hs
@@ -327,7 +327,7 @@ ms2pdf verbosity args source = do
putStrLn "[makePDF] Environment:"
mapM_ print env'
putStr "\n"
- putStrLn $ "[makePDF] Contents:\n"
+ putStrLn "[makePDF] Contents:\n"
putStr $ T.unpack source
putStr "\n"
(exit, out) <- E.catch
@@ -351,9 +351,7 @@ html2pdf :: Verbosity -- ^ Verbosity level
-> IO (Either ByteString ByteString)
html2pdf verbosity program args source = do
pdfFile <- withTempFile "." "html2pdf.pdf" $ \fp _ -> return fp
- let pdfFileArgName = if program == "prince"
- then ["-o"]
- else []
+ let pdfFileArgName = ["-o" | program == "prince"]
let programArgs = args ++ ["-"] ++ pdfFileArgName ++ [pdfFile]
env' <- getEnvironment
when (verbosity >= INFO) $ do
@@ -363,7 +361,7 @@ html2pdf verbosity program args source = do
putStrLn "[makePDF] Environment:"
mapM_ print env'
putStr "\n"
- putStrLn $ "[makePDF] Contents of intermediate HTML:"
+ putStrLn "[makePDF] Contents of intermediate HTML:"
TextIO.putStr source
putStr "\n"
(exit, out) <- E.catch
diff --git a/src/Text/Pandoc/Pretty.hs b/src/Text/Pandoc/Pretty.hs
index b5600ad39..40a7d018c 100644
--- a/src/Text/Pandoc/Pretty.hs
+++ b/src/Text/Pandoc/Pretty.hs
@@ -78,6 +78,7 @@ module Text.Pandoc.Pretty (
where
import Control.Monad.State.Strict
+import Control.Monad (when)
import Data.Char (isSpace)
import Data.Foldable (toList)
import Data.List (intersperse)
@@ -144,11 +145,10 @@ hcat = mconcat
-- between them.
infixr 6 <+>
(<+>) :: Doc -> Doc -> Doc
-(<+>) x y = if isEmpty x
- then y
- else if isEmpty y
- then x
- else x <> space <> y
+(<+>) x y
+ | isEmpty x = y
+ | isEmpty y = x
+ | otherwise = x <> space <> y
-- | Same as 'cat', but putting breakable spaces between the
-- 'Doc's.
@@ -158,20 +158,18 @@ hsep = foldr (<+>) empty
infixr 5 $$
-- | @a $$ b@ puts @a@ above @b@.
($$) :: Doc -> Doc -> Doc
-($$) x y = if isEmpty x
- then y
- else if isEmpty y
- then x
- else x <> cr <> y
+($$) x y
+ | isEmpty x = y
+ | isEmpty y = x
+ | otherwise = x <> cr <> y
infixr 5 $+$
-- | @a $+$ b@ puts @a@ above @b@, with a blank line between.
($+$) :: Doc -> Doc -> Doc
-($+$) x y = if isEmpty x
- then y
- else if isEmpty y
- then x
- else x <> blankline <> y
+($+$) x y
+ | isEmpty x = y
+ | isEmpty y = x
+ | otherwise = x <> blankline <> y
-- | List version of '$$'.
vcat :: [Doc] -> Doc
@@ -217,9 +215,9 @@ outp off s | off < 0 = do -- offset < 0 means newline characters
outp off s = do -- offset >= 0 (0 might be combining char)
st' <- get
let pref = prefix st'
- when (column st' == 0 && usePrefix st' && not (null pref)) $ do
+ when (column st' == 0 && usePrefix st' && not (null pref)) $
modify $ \st -> st{ output = fromString pref : output st
- , column = column st + realLength pref }
+ , column = column st + realLength pref }
modify $ \st -> st{ output = fromString s : output st
, column = column st + off
, newlines = 0 }
@@ -328,9 +326,7 @@ renderList (BreakingSpace : xs) = do
renderList (AfterBreak s : xs) = do
st <- get
- if newlines st > 0
- then outp (realLength s) s
- else return ()
+ when (newlines st > 0) $ outp (realLength s) s
renderList xs
renderList (Block i1 s1 : Block i2 s2 : xs) =
diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs
index 8189e7760..6b864521f 100644
--- a/src/Text/Pandoc/Readers/CommonMark.hs
+++ b/src/Text/Pandoc/Readers/CommonMark.hs
@@ -132,12 +132,12 @@ addBlock opts (Node _ (LIST listAttrs) nodes) =
setTightness = if listTight listAttrs
then map paraToPlain
else id
- paraToPlain (Para xs) = Plain (xs)
+ paraToPlain (Para xs) = Plain xs
paraToPlain x = x
delim = case listDelim listAttrs of
PERIOD_DELIM -> Period
PAREN_DELIM -> OneParen
-addBlock opts (Node _ (TABLE alignments) nodes) = do
+addBlock opts (Node _ (TABLE alignments) nodes) =
(Table [] aligns widths headers rows :)
where aligns = map fromTableCellAlignment alignments
fromTableCellAlignment NoAlignment = AlignDefault
diff --git a/src/Text/Pandoc/Readers/Creole.hs b/src/Text/Pandoc/Readers/Creole.hs
index 9886394a7..3b330e544 100644
--- a/src/Text/Pandoc/Readers/Creole.hs
+++ b/src/Text/Pandoc/Readers/Creole.hs
@@ -111,7 +111,7 @@ block = do
return res
nowiki :: PandocMonad m => CRLParser m B.Blocks
-nowiki = try $ nowikiStart >> manyTill content nowikiEnd >>= return . B.codeBlock . mconcat
+nowiki = try $ fmap (B.codeBlock . mconcat) (nowikiStart >> manyTill content nowikiEnd)
where
content = brackets <|> line
brackets = try $ option "" ((:[]) <$> newline)
@@ -124,7 +124,8 @@ nowiki = try $ nowikiStart >> manyTill content nowikiEnd >>= return . B.codeBloc
header :: PandocMonad m => CRLParser m B.Blocks
header = try $ do
skipSpaces
- level <- many1 (char '=') >>= return . length
+ level <-
+ fmap length (many1 (char '='))
guard $ level <= 6
skipSpaces
content <- B.str <$> manyTill (noneOf "\n") headerEnd
@@ -145,16 +146,16 @@ anyListItem :: PandocMonad m => Int -> CRLParser m B.Blocks
anyListItem n = listItem '*' n <|> listItem '#' n
list :: PandocMonad m => Char -> ([B.Blocks] -> B.Blocks) -> Int -> CRLParser m B.Blocks
-list c f n = many1 (itemPlusSublist <|> listItem c n)
- >>= return . f
+list c f n =
+ fmap f (many1 (itemPlusSublist <|> listItem c n))
where itemPlusSublist = try $ listItem c n <+> anyList (n+1)
listItem :: PandocMonad m => Char -> Int -> CRLParser m B.Blocks
-listItem c n = (listStart >> many1Till inline itemEnd)
- >>= return . B.plain . B.trimInlines .mconcat
+listItem c n =
+ fmap (B.plain . B.trimInlines .mconcat) (listStart >> many1Till inline itemEnd)
where
listStart = try $ optional newline >> skipSpaces >> count n (char c)
- >> (lookAhead $ noneOf [c]) >> skipSpaces
+ >> lookAhead (noneOf [c]) >> skipSpaces
itemEnd = endOfParaElement <|> nextItem n
<|> if n < 3 then nextItem (n+1)
else nextItem (n+1) <|> nextItem (n-1)
@@ -176,7 +177,7 @@ table = try $ do
cellEnd = lookAhead $ try $ char '|' <|> rowEnd
para :: PandocMonad m => CRLParser m B.Blocks
-para = many1Till inline endOfParaElement >>= return . result . mconcat
+para = fmap (result . mconcat) (many1Till inline endOfParaElement)
where
result content = if F.all (==Space) content
then mempty
@@ -192,7 +193,7 @@ endOfParaElement = lookAhead $ endOfInput <|> endOfPara
startOf :: PandocMonad m => CRLParser m a -> CRLParser m ()
startOf p = try $ blankline >> p >> return mempty
startOfList = startOf $ anyList 1
- startOfTable = startOf $ table
+ startOfTable =startOf table
startOfHeader = startOf header
startOfNowiki = startOf nowiki
hr = startOf horizontalRule
@@ -223,7 +224,8 @@ inline = choice [ whitespace
] <?> "inline"
escapedChar :: PandocMonad m => CRLParser m B.Inlines
-escapedChar = (try $ char '~' >> noneOf "\t\n ") >>= return . B.str . (:[])
+escapedChar =
+ fmap (B.str . (:[])) (try $ char '~' >> noneOf "\t\n ")
escapedLink :: PandocMonad m => CRLParser m B.Inlines
escapedLink = try $ do
@@ -234,7 +236,7 @@ escapedLink = try $ do
image :: PandocMonad m => CRLParser m B.Inlines
image = try $ do
(orig, src) <- wikiImg
- return $ B.image src "" (B.str $ orig)
+ return $ B.image src "" (B.str orig)
where
linkSrc = many $ noneOf "|}\n\r\t"
linkDsc = char '|' >> many (noneOf "}\n\r\t")
@@ -253,7 +255,7 @@ link = try $ do
linkSrc = many $ noneOf "|]\n\r\t"
linkDsc :: PandocMonad m => String -> CRLParser m B.Inlines
linkDsc otxt = B.str
- <$> (try $ option otxt
+ <$> try (option otxt
(char '|' >> many (noneOf "]\n\r\t")))
linkImg = try $ char '|' >> image
wikiLink = try $ do
@@ -270,17 +272,17 @@ inlineNowiki :: PandocMonad m => CRLParser m B.Inlines
inlineNowiki = B.code <$> (start >> manyTill (noneOf "\n\r") end)
where
start = try $ string "{{{"
- end = try $ string "}}}" >> (lookAhead $ noneOf "}")
+ end = try $ string "}}}" >> lookAhead (noneOf "}")
placeholder :: PandocMonad m => CRLParser m B.Inlines
-- The semantics of the placeholder is basicallly implementation
-- dependent, so there is no way to DTRT for all cases.
-- So for now we just drop them.
-placeholder = B.text <$> (try $ string "<<<" >> manyTill anyChar (string ">>>")
+placeholder = B.text <$> try (string "<<<" >> manyTill anyChar (string ">>>")
>> return "")
whitespace :: PandocMonad m => CRLParser m B.Inlines
-whitespace = (lb <|> regsp) >>= return
+whitespace = (lb <|> regsp)
where lb = try $ skipMany spaceChar >> linebreak >> return B.space
regsp = try $ skipMany1 spaceChar >> return B.space
@@ -290,11 +292,11 @@ linebreak = newline >> notFollowedBy newline >> (lastNewline <|> innerNewline)
innerNewline = return B.space
symbol :: PandocMonad m => CRLParser m B.Inlines
-symbol = oneOf specialChars >>= return . B.str . (:[])
+symbol = fmap (B.str . (:[])) (oneOf specialChars)
str :: PandocMonad m => CRLParser m B.Inlines
str = let strChar = noneOf ("\t\n " ++ specialChars) in
- many1 strChar >>= return . B.str
+ fmap B.str (many1 strChar)
bold :: PandocMonad m => CRLParser m B.Inlines
bold = B.strong . mconcat <$>
diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs
index f816a9c47..0f3f6f6e3 100644
--- a/src/Text/Pandoc/Readers/DocBook.hs
+++ b/src/Text/Pandoc/Readers/DocBook.hs
@@ -1,5 +1,5 @@
module Text.Pandoc.Readers.DocBook ( readDocBook ) where
-import Data.Char (toUpper)
+import Data.Char (toUpper, isSpace)
import Text.Pandoc.Shared (safeRead, crFilter)
import Text.Pandoc.Options
import Text.Pandoc.Definition
@@ -8,7 +8,6 @@ import Text.XML.Light
import Text.HTML.TagSoup.Entity (lookupEntity)
import Data.Either (rights)
import Data.Generics
-import Data.Char (isSpace)
import Control.Monad.State.Strict
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
@@ -528,7 +527,7 @@ readDocBook :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
readDocBook _ inp = do
let tree = normalizeTree . parseXML . handleInstructions
$ T.unpack $ crFilter inp
- (bs, st') <- flip runStateT (def{ dbContent = tree }) $ mapM parseBlock $ tree
+ (bs, st') <- flip runStateT (def{ dbContent = tree }) $ mapM parseBlock tree
return $ Pandoc (dbMeta st') (toList . mconcat $ bs)
-- We treat <?asciidoc-br?> specially (issue #1236), converting it
@@ -567,14 +566,12 @@ 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
attrValue attr elt =
- case lookupAttrBy (\x -> qName x == attr) (elAttribs elt) of
- Just z -> z
- Nothing -> ""
+ fromMaybe "" (lookupAttrBy (\x -> qName x == attr) (elAttribs elt))
-- convenience function
named :: String -> Element -> Bool
@@ -654,15 +651,17 @@ getMediaobject e = do
|| named "textobject" x
|| named "alt" x) el of
Nothing -> return mempty
- Just z -> mconcat <$> (mapM parseInline $ elContent z)
+ Just z -> mconcat <$>
+ mapM parseInline (elContent z)
figTitle <- gets dbFigureTitle
let (caption, title) = if isNull figTitle
then (getCaption e, "")
else (return figTitle, "fig:")
- liftM (imageWith attr imageUrl title) caption
+ fmap (imageWith attr imageUrl title) caption
getBlocks :: PandocMonad m => Element -> DB m Blocks
-getBlocks e = mconcat <$> (mapM parseBlock $ elContent e)
+getBlocks e = mconcat <$>
+ mapM parseBlock (elContent e)
parseBlock :: PandocMonad m => Content -> DB m Blocks
@@ -806,7 +805,8 @@ parseBlock (Elem e) =
attrib <- case filterChild (named "attribution") e of
Nothing -> return mempty
Just z -> (para . (str "— " <>) . mconcat)
- <$> (mapM parseInline $ elContent z)
+ <$>
+ mapM parseInline (elContent z)
contents <- getBlocks e
return $ blockQuote (contents <> attrib)
listitems = mapM getBlocks $ filterChildren (named "listitem") e
@@ -906,7 +906,8 @@ parseBlock (Elem e) =
metaBlock = acceptingMetadata (getBlocks e) >> return mempty
getInlines :: PandocMonad m => Element -> DB m Inlines
-getInlines e' = (trimInlines . mconcat) <$> (mapM parseInline $ elContent e')
+getInlines e' = (trimInlines . mconcat) <$>
+ mapM parseInline (elContent e')
strContentRecursive :: Element -> String
strContentRecursive = strContent .
@@ -919,7 +920,7 @@ elementToStr x = x
parseInline :: PandocMonad m => Content -> DB m Inlines
parseInline (Text (CData _ s _)) = return $ text s
parseInline (CRef ref) =
- return $ maybe (text $ map toUpper ref) (text) $ lookupEntity ref
+ return $ maybe (text $ map toUpper ref) text $ lookupEntity ref
parseInline (Elem e) =
case qName (elName e) of
"equation" -> equation displayMath
@@ -960,8 +961,10 @@ parseInline (Elem e) =
"userinput" -> codeWithLang
"varargs" -> return $ code "(...)"
"keycap" -> return (str $ strContent e)
- "keycombo" -> keycombo <$> (mapM parseInline $ elContent e)
- "menuchoice" -> menuchoice <$> (mapM parseInline $
+ "keycombo" -> keycombo <$>
+ mapM parseInline (elContent e)
+ "menuchoice" -> menuchoice <$>
+ mapM parseInline (
filter isGuiMenu $ elContent e)
"xref" -> do
content <- dbContent <$> get
@@ -980,7 +983,7 @@ parseInline (Elem e) =
ils <- innerInlines
let href = case findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e of
Just h -> h
- _ -> ('#' : attrValue "linkend" e)
+ _ -> '#' : attrValue "linkend" e
let ils' = if ils == mempty then str href else ils
let attr = (attrValue "id" e, words $ attrValue "role" e, [])
return $ linkWith attr href "" ils'
@@ -990,7 +993,8 @@ parseInline (Elem e) =
"strong" -> strong <$> innerInlines
"strikethrough" -> strikeout <$> innerInlines
_ -> emph <$> innerInlines
- "footnote" -> (note . mconcat) <$> (mapM parseBlock $ elContent e)
+ "footnote" -> (note . mconcat) <$>
+ mapM parseBlock (elContent e)
"title" -> return mempty
"affiliation" -> return mempty
-- Note: this isn't a real docbook tag; it's what we convert
@@ -999,7 +1003,7 @@ parseInline (Elem e) =
"br" -> return linebreak
_ -> innerInlines
where innerInlines = (trimInlines . mconcat) <$>
- (mapM parseInline $ elContent e)
+ mapM parseInline (elContent e)
equation constructor = return $ mconcat $
map (constructor . writeTeX)
$ rights
diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs
index f516d63d4..003265e6e 100644
--- a/src/Text/Pandoc/Readers/Docx/Combine.hs
+++ b/src/Text/Pandoc/Readers/Docx/Combine.hs
@@ -36,16 +36,16 @@ spaceOutInlines ils =
right = case viewr contents of
(_ :> Space) -> space
_ -> mempty in
- (left, (stackInlines fs $ trimInlines . Many $ contents), right)
+ (left, stackInlines fs $ trimInlines . Many $ contents, right)
stackInlines :: [Modifier Inlines] -> Inlines -> Inlines
stackInlines [] ms = ms
stackInlines (NullModifier : fs) ms = stackInlines fs ms
-stackInlines ((Modifier f) : fs) ms =
+stackInlines (Modifier f : fs) ms =
if isEmpty ms
then stackInlines fs ms
else f $ stackInlines fs ms
-stackInlines ((AttrModifier f attr) : fs) ms = f attr $ stackInlines fs ms
+stackInlines (AttrModifier f attr : fs) ms = f attr $ stackInlines fs ms
unstackInlines :: Inlines -> ([Modifier Inlines], Inlines)
unstackInlines ms = case ilModifier ms of
@@ -97,7 +97,7 @@ combineInlines x y =
let (xs', x') = inlinesR x
(y', ys') = inlinesL y
in
- xs' <> (combineSingletonInlines x' y') <> ys'
+ xs' <> combineSingletonInlines x' y' <> ys'
combineSingletonInlines :: Inlines -> Inlines -> Inlines
combineSingletonInlines x y =
@@ -114,10 +114,10 @@ combineSingletonInlines x y =
stackInlines (x_rem_attr ++ y_rem_attr) mempty
| isEmpty xs ->
let (sp, y') = spaceOutInlinesL y in
- (stackInlines x_rem_attr mempty) <> sp <> y'
+ stackInlines x_rem_attr mempty <> sp <> y'
| isEmpty ys ->
let (x', sp) = spaceOutInlinesR x in
- x' <> sp <> (stackInlines y_rem_attr mempty)
+ x' <> sp <> stackInlines y_rem_attr mempty
| otherwise ->
let (x', xsp) = spaceOutInlinesR x
(ysp, y') = spaceOutInlinesL y
@@ -130,15 +130,15 @@ combineSingletonInlines x y =
combineBlocks :: Blocks -> Blocks -> Blocks
combineBlocks bs cs
- | bs' :> (BlockQuote bs'') <- viewr (unMany bs)
- , (BlockQuote cs'') :< cs' <- viewl (unMany cs) =
- Many $ (bs' |> (BlockQuote (bs'' <> cs''))) >< cs'
+ | bs' :> BlockQuote bs'' <- viewr (unMany bs)
+ , BlockQuote cs'' :< cs' <- viewl (unMany cs) =
+ Many $ (bs' |> BlockQuote (bs'' <> cs'')) >< cs'
combineBlocks bs cs = bs <> cs
instance (Monoid a, Eq a) => Eq (Modifier a) where
- (Modifier f) == (Modifier g) = (f mempty == g mempty)
- (AttrModifier f attr) == (AttrModifier g attr') = (f attr mempty == g attr' mempty)
- (NullModifier) == (NullModifier) = True
+ (Modifier f) == (Modifier g) = f mempty == g mempty
+ (AttrModifier f attr) == (AttrModifier g attr') = f attr mempty == g attr' mempty
+ NullModifier == NullModifier = True
_ == _ = False
isEmpty :: (Monoid a, Eq a) => a -> Bool
diff --git a/src/Text/Pandoc/Readers/Docx/Lists.hs b/src/Text/Pandoc/Readers/Docx/Lists.hs
index 8be2e1894..c7f4adc98 100644
--- a/src/Text/Pandoc/Readers/Docx/Lists.hs
+++ b/src/Text/Pandoc/Readers/Docx/Lists.hs
@@ -33,7 +33,6 @@ module Text.Pandoc.Readers.Docx.Lists ( blocksToBullets
, listParagraphDivs
) where
-import Control.Monad
import Data.List
import Data.Maybe
import Text.Pandoc.Generic (bottomUp)
@@ -45,22 +44,18 @@ isListItem (Div (_, classes, _) _) | "list-item" `elem` classes = True
isListItem _ = False
getLevel :: Block -> Maybe Integer
-getLevel (Div (_, _, kvs) _) = liftM read $ lookup "level" kvs
+getLevel (Div (_, _, kvs) _) = fmap read $ lookup "level" kvs
getLevel _ = Nothing
getLevelN :: Block -> Integer
-getLevelN b = case getLevel b of
- Just n -> n
- Nothing -> -1
+getLevelN b = fromMaybe (-1) (getLevel b)
getNumId :: Block -> Maybe Integer
-getNumId (Div (_, _, kvs) _) = liftM read $ lookup "num-id" kvs
+getNumId (Div (_, _, kvs) _) = fmap read $ lookup "num-id" kvs
getNumId _ = Nothing
getNumIdN :: Block -> Integer
-getNumIdN b = case getNumId b of
- Just n -> n
- Nothing -> -1
+getNumIdN b = fromMaybe (-1) (getNumId b)
getText :: Block -> Maybe String
getText (Div (_, _, kvs) _) = lookup "text" kvs
@@ -109,27 +104,27 @@ listParagraphDivs = ["ListParagraph"]
handleListParagraphs :: [Block] -> [Block]
handleListParagraphs [] = []
handleListParagraphs (
- (Div attr1@(_, classes1, _) blks1) :
- (Div (ident2, classes2, kvs2) blks2) :
+ Div attr1@(_, classes1, _) blks1 :
+ Div (ident2, classes2, kvs2) blks2 :
blks
) | "list-item" `elem` classes1 &&
- not ("list-item" `elem` classes2) &&
+ notElem "list-item" classes2 &&
(not . null) (listParagraphDivs `intersect` classes2) =
-- We don't want to keep this indent.
let newDiv2 =
- (Div (ident2, classes2, filter (\kv -> fst kv /= "indent") kvs2) blks2)
+ Div (ident2, classes2, filter (\kv -> fst kv /= "indent") kvs2) blks2
in
- handleListParagraphs ((Div attr1 (blks1 ++ [newDiv2])) : blks)
-handleListParagraphs (blk:blks) = blk : (handleListParagraphs blks)
+ handleListParagraphs (Div attr1 (blks1 ++ [newDiv2]) : blks)
+handleListParagraphs (blk:blks) = blk : handleListParagraphs blks
separateBlocks' :: Block -> [[Block]] -> [[Block]]
-separateBlocks' blk ([] : []) = [[blk]]
-separateBlocks' b@(BulletList _) acc = (init acc) ++ [(last acc) ++ [b]]
-separateBlocks' b@(OrderedList _ _) acc = (init acc) ++ [(last acc) ++ [b]]
+separateBlocks' blk [[]] = [[blk]]
+separateBlocks' b@(BulletList _) acc = init acc ++ [last acc ++ [b]]
+separateBlocks' b@(OrderedList _ _) acc = init acc ++ [last acc ++ [b]]
-- The following is for the invisible bullet lists. This is how
-- pandoc-generated ooxml does multiparagraph item lists.
-separateBlocks' b acc | liftM trim (getText b) == Just "" =
- (init acc) ++ [(last acc) ++ [b]]
+separateBlocks' b acc | fmap trim (getText b) == Just "" =
+ init acc ++ [last acc ++ [b]]
separateBlocks' b acc = acc ++ [[b]]
separateBlocks :: [Block] -> [[Block]]
@@ -138,38 +133,37 @@ separateBlocks blks = foldr separateBlocks' [[]] (reverse blks)
flatToBullets' :: Integer -> [Block] -> [Block]
flatToBullets' _ [] = []
flatToBullets' num xs@(b : elems)
- | getLevelN b == num = b : (flatToBullets' num elems)
+ | getLevelN b == num = b : flatToBullets' num elems
| otherwise =
let bNumId = getNumIdN b
bLevel = getLevelN b
(children, remaining) =
span
(\b' ->
- ((getLevelN b') > bLevel ||
- ((getLevelN b') == bLevel && (getNumIdN b') == bNumId)))
+ (getLevelN b') > bLevel ||
+ ((getLevelN b') == bLevel && (getNumIdN b') == bNumId))
xs
in
case getListType b of
Just (Enumerated attr) ->
- (OrderedList attr (separateBlocks $ flatToBullets' bLevel children)) :
- (flatToBullets' num remaining)
+ OrderedList attr (separateBlocks $ flatToBullets' bLevel children) :
+ flatToBullets' num remaining
_ ->
- (BulletList (separateBlocks $ flatToBullets' bLevel children)) :
- (flatToBullets' num remaining)
+ BulletList (separateBlocks $ flatToBullets' bLevel children) :
+ flatToBullets' num remaining
flatToBullets :: [Block] -> [Block]
flatToBullets elems = flatToBullets' (-1) elems
singleItemHeaderToHeader :: Block -> Block
-singleItemHeaderToHeader (OrderedList _ [[h@(Header _ _ _)]]) = h
+singleItemHeaderToHeader (OrderedList _ [[h@(Header{})]]) = h
singleItemHeaderToHeader blk = blk
blocksToBullets :: [Block] -> [Block]
blocksToBullets blks =
map singleItemHeaderToHeader $
- bottomUp removeListDivs $
- flatToBullets $ (handleListParagraphs blks)
+ bottomUp removeListDivs $flatToBullets (handleListParagraphs blks)
plainParaInlines :: Block -> [Inline]
plainParaInlines (Plain ils) = ils
@@ -179,18 +173,16 @@ plainParaInlines _ = []
blocksToDefinitions' :: [([Inline], [[Block]])] -> [Block] -> [Block] -> [Block]
blocksToDefinitions' [] acc [] = reverse acc
blocksToDefinitions' defAcc acc [] =
- reverse $ (DefinitionList (reverse defAcc)) : acc
+ reverse $ DefinitionList (reverse defAcc) : acc
blocksToDefinitions' defAcc acc
- ((Div (_, classes1, _) blks1) : (Div (ident2, classes2, kvs2) blks2) : blks)
+ (Div (_, classes1, _) blks1 : Div (ident2, classes2, kvs2) blks2 : blks)
| "DefinitionTerm" `elem` classes1 && "Definition" `elem` classes2 =
let remainingAttr2 = (ident2, delete "Definition" classes2, kvs2)
- pair = case remainingAttr2 == ("", [], []) of
- True -> (concatMap plainParaInlines blks1, [blks2])
- False -> (concatMap plainParaInlines blks1, [[Div remainingAttr2 blks2]])
+ pair = if remainingAttr2 == ("", [], []) then (concatMap plainParaInlines blks1, [blks2]) else (concatMap plainParaInlines blks1, [[Div remainingAttr2 blks2]])
in
blocksToDefinitions' (pair : defAcc) acc blks
blocksToDefinitions' defAcc acc
- ((Div (ident2, classes2, kvs2) blks2) : blks)
+ (Div (ident2, classes2, kvs2) blks2 : blks)
| (not . null) defAcc && "Definition" `elem` classes2 =
let remainingAttr2 = (ident2, delete "Definition" classes2, kvs2)
defItems2 = case remainingAttr2 == ("", [], []) of
@@ -205,14 +197,14 @@ blocksToDefinitions' defAcc acc
blocksToDefinitions' [] acc (b:blks) =
blocksToDefinitions' [] (b:acc) blks
blocksToDefinitions' defAcc acc (b:blks) =
- blocksToDefinitions' [] (b : (DefinitionList (reverse defAcc)) : acc) blks
+ blocksToDefinitions' [] (b : DefinitionList (reverse defAcc) : acc) blks
removeListDivs' :: Block -> [Block]
removeListDivs' (Div (ident, classes, kvs) blks)
| "list-item" `elem` classes =
case delete "list-item" classes of
[] -> blks
- classes' -> [Div (ident, classes', kvs) $ blks]
+ classes' -> [Div (ident, classes', kvs) blks]
removeListDivs' (Div (ident, classes, kvs) blks)
| not $ null $ listParagraphDivs `intersect` classes =
case classes \\ listParagraphDivs of
diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs
index 05ce691a6..1aa69f62e 100644
--- a/src/Text/Pandoc/Readers/Docx/Parse.hs
+++ b/src/Text/Pandoc/Readers/Docx/Parse.hs
@@ -106,7 +106,7 @@ eitherToD (Right b) = return b
eitherToD (Left _) = throwError DocxError
concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
-concatMapM f xs = liftM concat (mapM f xs)
+concatMapM f xs = fmap concat (mapM f xs)
-- This is similar to `mapMaybe`: it maps a function returning the D
@@ -304,7 +304,7 @@ archiveToDocument zf = do
elemToBody :: NameSpaces -> Element -> D Body
elemToBody ns element | isElem ns "w" "body" element =
mapD (elemToBodyPart ns) (elChildren element) >>=
- (\bps -> return $ Body bps)
+ (return . Body)
elemToBody _ _ = throwError WrongElem
archiveToStyles :: Archive -> (CharStyleMap, ParStyleMap)
@@ -329,7 +329,7 @@ isBasedOnStyle ns element parentStyle
, styleType == cStyleType parentStyle
, Just basedOnVal <- findChildByName ns "w" "basedOn" element >>=
findAttrByName ns "w" "val"
- , Just ps <- parentStyle = (basedOnVal == getStyleId ps)
+ , Just ps <- parentStyle = basedOnVal == getStyleId ps
| isElem ns "w" "style" element
, Just styleType <- findAttrByName ns "w" "type" element
, styleType == cStyleType parentStyle
@@ -371,10 +371,10 @@ getStyleChildren ns element parentStyle
buildBasedOnList :: (ElemToStyle a) => NameSpaces -> Element -> Maybe a -> [a]
buildBasedOnList ns element rootStyle =
- case (getStyleChildren ns element rootStyle) of
+ case getStyleChildren ns element rootStyle of
[] -> []
stys -> stys ++
- (concatMap (\s -> buildBasedOnList ns element (Just s)) stys)
+ concatMap (\s -> buildBasedOnList ns element (Just s)) stys
archiveToNotes :: Archive -> Notes
archiveToNotes zf =
@@ -389,8 +389,8 @@ archiveToNotes zf =
Just e -> elemToNameSpaces e
Nothing -> []
ns = unionBy (\x y -> fst x == fst y) fn_namespaces en_namespaces
- fn = fnElem >>= (elemToNotes ns "footnote")
- en = enElem >>= (elemToNotes ns "endnote")
+ fn = fnElem >>= elemToNotes ns "footnote"
+ en = enElem >>= elemToNotes ns "endnote"
in
Notes ns fn en
@@ -401,7 +401,7 @@ archiveToComments zf =
cmts_namespaces = case cmtsElem of
Just e -> elemToNameSpaces e
Nothing -> []
- cmts = (elemToComments cmts_namespaces) <$> cmtsElem
+ cmts = elemToComments cmts_namespaces <$> cmtsElem
in
case cmts of
Just c -> Comments cmts_namespaces c
@@ -442,8 +442,7 @@ lookupLevel :: String -> String -> Numbering -> Maybe Level
lookupLevel numId ilvl (Numbering _ numbs absNumbs) = do
absNumId <- lookup numId $ map (\(Numb nid absnumid) -> (nid, absnumid)) numbs
lvls <- lookup absNumId $ map (\(AbstractNumb aid ls) -> (aid, ls)) absNumbs
- lvl <- lookup ilvl $ map (\l@(i, _, _, _) -> (i, l)) lvls
- return lvl
+ lookup ilvl $ map (\l@(i, _, _, _) -> (i, l)) lvls
numElemToNum :: NameSpaces -> Element -> Maybe Numb
@@ -479,7 +478,7 @@ levelElemToLevel ns element
levelElemToLevel _ _ = Nothing
archiveToNumbering' :: Archive -> Maybe Numbering
-archiveToNumbering' zf = do
+archiveToNumbering' zf =
case findEntryByPath "word/numbering.xml" zf of
Nothing -> Just $ Numbering [] [] []
Just entry -> do
@@ -503,7 +502,8 @@ elemToNotes ns notetype element
(\a -> Just (a, e)))
(findChildrenByName ns "w" notetype element)
in
- Just $ M.fromList $ pairs
+ Just $
+ M.fromList pairs
elemToNotes _ _ _ = Nothing
elemToComments :: NameSpaces -> Element -> M.Map String Element
@@ -514,7 +514,7 @@ elemToComments ns element
(\a -> Just (a, e)))
(findChildrenByName ns "w" "comment" element)
in
- M.fromList $ pairs
+ M.fromList pairs
elemToComments _ _ = M.empty