From b8ffd834cff717fe424f22e506351f2ecec4655a Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 19 Jan 2018 21:25:24 -0800 Subject: hlint code improvements. --- src/Text/Pandoc/Writers/AsciiDoc.hs | 5 +- src/Text/Pandoc/Writers/Docx.hs | 13 ++-- src/Text/Pandoc/Writers/FB2.hs | 3 +- src/Text/Pandoc/Writers/HTML.hs | 13 ++-- src/Text/Pandoc/Writers/Haddock.hs | 3 +- src/Text/Pandoc/Writers/ICML.hs | 4 +- src/Text/Pandoc/Writers/LaTeX.hs | 8 +-- src/Text/Pandoc/Writers/Man.hs | 2 +- src/Text/Pandoc/Writers/Muse.hs | 2 +- src/Text/Pandoc/Writers/OOXML.hs | 2 +- src/Text/Pandoc/Writers/OpenDocument.hs | 2 +- src/Text/Pandoc/Writers/Powerpoint.hs | 2 +- src/Text/Pandoc/Writers/Powerpoint/Presentation.hs | 74 +++++++++++----------- src/Text/Pandoc/Writers/RST.hs | 15 ++--- src/Text/Pandoc/Writers/RTF.hs | 8 +-- src/Text/Pandoc/Writers/Texinfo.hs | 2 +- 16 files changed, 75 insertions(+), 83 deletions(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index a6906eb68..b8f647b66 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -265,8 +265,7 @@ blockToAsciiDoc opts (OrderedList (_start, sty, _delim) items) = do let markers' = map (\m -> if length m < 3 then m ++ replicate (3 - length m) ' ' else m) markers - contents <- mapM (uncurry (orderedListItemToAsciiDoc opts)) $ - zip markers' items + contents <- zipWithM (orderedListItemToAsciiDoc opts) markers' items return $ cat contents <> blankline blockToAsciiDoc opts (DefinitionList items) = do contents <- mapM (definitionListItemToAsciiDoc opts) items @@ -452,7 +451,7 @@ inlineToAsciiDoc opts (Link _ txt (src, _tit)) = do else prefix <> text src <> "[" <> linktext <> "]" inlineToAsciiDoc opts (Image attr alternate (src, tit)) = do -- image:images/logo.png[Company logo, title="blah"] - let txt = if (null alternate) || (alternate == [Str ""]) + let txt = if null alternate || (alternate == [Str ""]) then [Str "image"] else alternate linktext <- inlineListToAsciiDoc opts txt diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index adf5f232a..928eaa712 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -1057,12 +1057,9 @@ getParaProps displayMathPara = do props <- asks envParaProperties listLevel <- asks envListLevel numid <- asks envListNumId - let listPr = if listLevel >= 0 && not displayMathPara - then [ mknode "w:numPr" [] - [ mknode "w:numId" [("w:val",show numid)] () - , mknode "w:ilvl" [("w:val",show listLevel)] () ] - ] - else [] + let listPr = [mknode "w:numPr" [] + [ mknode "w:numId" [("w:val",show numid)] () + , mknode "w:ilvl" [("w:val",show listLevel)] () ] | listLevel >= 0 && not displayMathPara] return $ case props ++ listPr of [] -> [] ps -> [mknode "w:pPr" [] ps] @@ -1145,7 +1142,7 @@ inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do return $ \f -> do x <- f return [ mknode "w:ins" - [("w:id", (show insId)), + [("w:id", show insId), ("w:author", author), ("w:date", date)] x ] else return id @@ -1272,7 +1269,7 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do Nothing -> catchError (do (img, mt) <- P.fetchItem src - ident <- ("rId"++) `fmap` ((lift . lift) getUniqueId) + ident <- ("rId"++) `fmap` (lift . lift) getUniqueId let (xpt,ypt) = desiredSizeInPoints opts attr (either (const def) id (imageSize opts img)) -- 12700 emu = 1 pt diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index b1e8c8575..e322c7d98 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -131,8 +131,7 @@ description meta' = do _ -> return [] return $ el "description" [ el "title-info" (genre : (bt ++ as ++ dd ++ lang)) - , el "document-info" ([ el "program-used" "pandoc" ] -- FIXME: +version - ++ coverpage) + , el "document-info" (el "program-used" "pandoc" : coverpage) ] booktitle :: PandocMonad m => Meta -> FBM m [Content] diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 5d5c88dd9..9e2347798 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -56,7 +56,8 @@ import qualified Data.Text.Lazy as TL import Network.HTTP (urlEncode) import Network.URI (URI (..), parseURIReference, unEscapeString) import Numeric (showHex) -import Text.Blaze.Internal (customLeaf, MarkupM(Empty)) +import Text.Blaze.Internal + (customLeaf, MarkupM(Empty), preEscapedString, preEscapedText) import Text.Blaze.Html hiding (contents) import Text.Pandoc.Definition import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtmlInline, highlight, @@ -424,7 +425,7 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen modify (\st -> st{ stElement = False}) return res - let isSec (Sec{}) = True + let isSec Sec{} = True isSec (Blk _) = False let isPause (Blk x) = x == Para [Str ".",Space,Str ".",Space,Str "."] isPause _ = False @@ -618,7 +619,7 @@ imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf", treatAsImage :: FilePath -> Bool treatAsImage fp = - let path = fromMaybe fp (uriPath `fmap` parseURIReference fp) + let path = maybe fp uriPath (parseURIReference fp) ext = map toLower $ drop 1 $ takeExtension path in null ext || ext `elem` imageExts @@ -797,8 +798,8 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do let numstyle' = case numstyle of Example -> "decimal" _ -> camelCaseToHyphenated $ show numstyle - let attribs = ([A.start $ toValue startnum | startnum /= 1]) ++ - ([A.class_ "example" | numstyle == Example]) ++ + let attribs = [A.start $ toValue startnum | startnum /= 1] ++ + [A.class_ "example" | numstyle == Example] ++ (if numstyle /= DefaultStyle then if html5 then [A.type_ $ @@ -819,7 +820,7 @@ blockToHtml opts (DefinitionList lst) = do do term' <- if null term then return mempty else liftM H.dt $ inlineListToHtml opts term - defs' <- mapM (liftM (\x -> H.dd $ (x >> nl opts)) . + defs' <- mapM (liftM (\x -> H.dd (x >> nl opts)) . blockListToHtml opts) defs return $ mconcat $ nl opts : term' : nl opts : intersperse (nl opts) defs') lst diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index 9ed3be6cf..688c1f390 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -168,8 +168,7 @@ blockToHaddock opts (OrderedList (start,_,delim) items) = do let markers' = map (\m -> if length m < 3 then m ++ replicate (3 - length m) ' ' else m) markers - contents <- mapM (uncurry (orderedListItemToHaddock opts)) $ - zip markers' items + contents <- zipWithM (orderedListItemToHaddock opts) markers' items return $ cat contents <> blankline blockToHaddock opts (DefinitionList items) = do contents <- mapM (definitionListItemToHaddock opts) items diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 80d2fcbef..a5d851e40 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -154,7 +154,7 @@ writeICML opts (Pandoc meta blocks) = do -- | Auxilary functions for parStylesToDoc and charStylesToDoc. contains :: String -> (String, (String, String)) -> [(String, String)] contains s rule = - [snd rule | isInfixOf (fst rule) s] + [snd rule | (fst rule) `isInfixOf` s] -- | The monospaced font to use as default. monospacedFont :: Doc @@ -282,7 +282,7 @@ hyperlinksToDoc (x:xs) = hyp x $$ hyperlinksToDoc xs ("Source","htss-"++show ident), ("Visible","true"), ("DestinationUniqueKey","1")] $ inTags True "Properties" [] $ inTags False "BorderColor" [("type","enumeration")] (text "Black") - $$ inTags False "Destination" [("type","object")] (text $ "HyperlinkURLDestination/"++(escapeColons (escapeStringForXML url))) -- HyperlinkURLDestination with more than one colon crashes CS6 + $$ inTags False "Destination" [("type","object")] (text $ "HyperlinkURLDestination/"++escapeColons (escapeStringForXML url)) -- HyperlinkURLDestination with more than one colon crashes CS6 -- | Convert a list of Pandoc blocks to ICML. diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index de2cc3480..fa72f0f1a 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -41,7 +41,7 @@ import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isPunctuation, ord, toLower) import Data.List (foldl', intercalate, intersperse, isInfixOf, nubBy, stripPrefix, (\\)) -import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe) +import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe, isNothing) import Data.Text (Text) import qualified Data.Text as T import Network.URI (unEscapeString) @@ -401,7 +401,7 @@ elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts) let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "fragile", "b", "c", "t", "environment", "label", "plain", "shrink", "standout"] - let optionslist = ["fragile" | fragile && lookup "fragile" kvs == Nothing] ++ + let optionslist = ["fragile" | fragile && isNothing (lookup "fragile" kvs)] ++ [k | k <- classes, k `elem` frameoptions] ++ [k ++ "=" ++ v | (k,v) <- kvs, k `elem` frameoptions] let options = if null optionslist @@ -819,7 +819,7 @@ listItemToLaTeX lst -- we need to put some text before a header if it's the first -- element in an item. This will look ugly in LaTeX regardless, but -- this will keep the typesetter from throwing an error. - | (Header _ _ _ :_) <- lst = + | (Header{} :_) <- lst = blockListToLaTeX lst >>= return . (text "\\item ~" $$) . nest 2 | otherwise = blockListToLaTeX lst >>= return . (text "\\item" $$) . nest 2 @@ -856,7 +856,7 @@ sectionHeader unnumbered ident level lst = do plain <- stringToLaTeX TextString $ concatMap stringify lst let removeInvalidInline (Note _) = [] removeInvalidInline (Span (id', _, _) _) | not (null id') = [] - removeInvalidInline (Image{}) = [] + removeInvalidInline Image{} = [] removeInvalidInline x = [x] let lstNoNotes = foldr (mappend . (\x -> walkM removeInvalidInline x)) mempty lst txtNoNotes <- inlineListToLaTeX lstNoNotes diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index c1427b15c..1be955fe3 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -114,7 +114,7 @@ notesToMan :: PandocMonad m => WriterOptions -> [[Block]] -> StateT WriterState notesToMan opts notes = if null notes then return empty - else mapM (uncurry (noteToMan opts)) (zip [1..] notes) >>= + else zipWithM (noteToMan opts) [1..] notes >>= return . (text ".SH NOTES" $$) . vcat -- | Return man representation of a note. diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index 7c4865da8..fbebe5c20 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -218,7 +218,7 @@ blockToMuse (DefinitionList items) = do descriptionToMuse :: PandocMonad m => [Block] -> StateT WriterState m Doc - descriptionToMuse desc = (hang 4 " :: ") <$> blockListToMuse desc + descriptionToMuse desc = hang 4 " :: " <$> blockListToMuse desc blockToMuse (Header level (ident,_,_) inlines) = do opts <- gets stOptions contents <- inlineListToMuse inlines diff --git a/src/Text/Pandoc/Writers/OOXML.hs b/src/Text/Pandoc/Writers/OOXML.hs index 2a9b9bc84..30d8d72dd 100644 --- a/src/Text/Pandoc/Writers/OOXML.hs +++ b/src/Text/Pandoc/Writers/OOXML.hs @@ -104,5 +104,5 @@ fitToPage :: (Double, Double) -> Integer -> (Integer, Integer) fitToPage (x, y) pageWidth -- Fixes width to the page width and scales the height | x > fromIntegral pageWidth = - (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y) + (pageWidth, floor $ (fromIntegral pageWidth / x) * y) | otherwise = (floor x, floor y) diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index e0097f507..17edc0cbd 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -594,7 +594,7 @@ paraStyle attrs = do tight = if t then [ ("fo:margin-top" , "0in" ) , ("fo:margin-bottom" , "0in" )] else [] - indent = if (i /= 0 || b) + indent = if i /= 0 || b then [ ("fo:margin-left" , indentVal) , ("fo:margin-right" , "0in" ) , ("fo:text-indent" , "0in" ) diff --git a/src/Text/Pandoc/Writers/Powerpoint.hs b/src/Text/Pandoc/Writers/Powerpoint.hs index acb33f582..645a4cb86 100644 --- a/src/Text/Pandoc/Writers/Powerpoint.hs +++ b/src/Text/Pandoc/Writers/Powerpoint.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternGuards #-} + {- Copyright (C) 2017-2018 Jesse Rosenthal diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index f5f7d850f..0cf01ee01 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -72,7 +72,7 @@ import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element" import Text.Pandoc.Writers.Shared (metaValueToInlines) import qualified Data.Map as M import qualified Data.Set as S -import Data.Maybe (maybeToList) +import Data.Maybe (maybeToList, fromMaybe) import Text.Pandoc.Highlighting import qualified Data.Text as T import Control.Applicative ((<|>)) @@ -136,7 +136,7 @@ reservedSlideIds = S.fromList [ metadataSlideId uniqueSlideId' :: Integer -> S.Set SlideId -> String -> SlideId uniqueSlideId' n idSet s = - let s' = if n == 0 then s else (s ++ "-" ++ show n) + let s' = if n == 0 then s else s ++ "-" ++ show n in if SlideId s' `S.member` idSet then uniqueSlideId' (n+1) idSet s else SlideId s' @@ -152,7 +152,7 @@ runUniqueSlideId s = do return sldId addLogMessage :: LogMessage -> Pres () -addLogMessage msg = modify $ \st -> st{stLog = msg : (stLog st)} +addLogMessage msg = modify $ \st -> st{stLog = msg : stLog st} type Pres = ReaderT WriterEnv (State WriterState) @@ -180,7 +180,7 @@ data DocProps = DocProps { dcTitle :: Maybe String data Slide = Slide { slideId :: SlideId , slideLayout :: Layout - , slideNotes :: (Maybe Notes) + , slideNotes :: Maybe Notes } deriving (Show, Eq) newtype SlideId = SlideId String @@ -345,12 +345,12 @@ inlineToParElems (SmallCaps ils) = inlineToParElems Space = inlineToParElems (Str " ") inlineToParElems SoftBreak = inlineToParElems (Str " ") inlineToParElems LineBreak = return [Break] -inlineToParElems (Link _ ils (url, title)) = do +inlineToParElems (Link _ ils (url, title)) = local (\r ->r{envRunProps = (envRunProps r){rLink = Just $ ExternalTarget (url, title)}}) $ - inlinesToParElems ils -inlineToParElems (Code _ str) = do + inlinesToParElems ils +inlineToParElems (Code _ str) = local (\r ->r{envRunProps = (envRunProps r){rPropCode = True}}) $ - inlineToParElems $ Str str + inlineToParElems $ Str str inlineToParElems (Math mathtype str) = return [MathElem mathtype (TeXString str)] inlineToParElems (Note blks) = do @@ -409,7 +409,7 @@ blockToParagraphs (CodeBlock attr str) = Just sty -> case highlight synMap (formatSourceLines sty) attr str of Right pElems -> do pProps <- asks envParaProps - return $ [Paragraph pProps pElems] + return [Paragraph pProps pElems] Left _ -> blockToParagraphs $ Para [Str str] Nothing -> blockToParagraphs $ Para [Str str] -- We can't yet do incremental lists, but we should render a @@ -463,7 +463,7 @@ blockToParagraphs (DefinitionList entries) = do definition <- concatMapM (blockToParagraphs . BlockQuote) blksLst return $ term ++ definition concatMapM go entries -blockToParagraphs (Div (_, ("notes" : []), _) _) = return [] +blockToParagraphs (Div (_, "notes" : [], _) _) = return [] blockToParagraphs (Div _ blks) = concatMapM blockToParagraphs blks blockToParagraphs blk = do addLogMessage $ BlockNotRendered blk @@ -481,7 +481,7 @@ multiParBullet (b:bs) = do cellToParagraphs :: Alignment -> TableCell -> Pres [Paragraph] cellToParagraphs algn tblCell = do - paras <- mapM (blockToParagraphs) tblCell + paras <- mapM blockToParagraphs tblCell let alignment = case algn of AlignLeft -> Just AlgnLeft AlignRight -> Just AlgnRight @@ -494,7 +494,7 @@ rowToParagraphs :: [Alignment] -> [TableCell] -> Pres [[Paragraph]] rowToParagraphs algns tblCells = do -- We have to make sure we have the right number of alignments let pairs = zip (algns ++ repeat AlignDefault) tblCells - mapM (\(a, tc) -> cellToParagraphs a tc) pairs + mapM (uncurry cellToParagraphs) pairs withAttr :: Attr -> Shape -> Shape withAttr attr (Pic picPr url caption) = @@ -507,17 +507,17 @@ withAttr _ sp = sp blockToShape :: Block -> Pres Shape blockToShape (Plain (il:_)) | Image attr ils (url, _) <- il = - (withAttr attr . Pic def url) <$> (inlinesToParElems ils) + (withAttr attr . Pic def url) <$> inlinesToParElems ils blockToShape (Para (il:_)) | Image attr ils (url, _) <- il = - (withAttr attr . Pic def url) <$> (inlinesToParElems ils) + (withAttr attr . Pic def url) <$> inlinesToParElems ils blockToShape (Plain (il:_)) | Link _ (il':_) target <- il , Image attr ils (url, _) <- il' = (withAttr attr . Pic def {picPropLink = Just $ ExternalTarget target} url) <$> - (inlinesToParElems ils) + inlinesToParElems ils blockToShape (Para (il:_)) | Link _ (il':_) target <- il , Image attr ils (url, _) <- il' = (withAttr attr . Pic def{picPropLink = Just $ ExternalTarget target} url) <$> - (inlinesToParElems ils) + inlinesToParElems ils blockToShape (Table caption algn _ hdrCells rows) = do caption' <- inlinesToParElems caption hdrCells' <- rowToParagraphs algn hdrCells @@ -537,11 +537,11 @@ blockToShape blk = do paras <- blockToParagraphs blk combineShapes :: [Shape] -> [Shape] combineShapes [] = [] -combineShapes (s : []) = [s] -combineShapes (pic@(Pic _ _ _) : ss) = pic : combineShapes ss -combineShapes ((TextBox []) : ss) = combineShapes ss +combineShapes[s] = [s] +combineShapes (pic@(Pic{}) : ss) = pic : combineShapes ss +combineShapes (TextBox [] : ss) = combineShapes ss combineShapes (s : TextBox [] : ss) = combineShapes (s : ss) -combineShapes ((TextBox (p:ps)) : (TextBox (p':ps')) : ss) = +combineShapes (TextBox (p:ps) : TextBox (p':ps') : ss) = combineShapes $ TextBox ((p:ps) ++ (p':ps')) : ss combineShapes (s:ss) = s : combineShapes ss @@ -549,8 +549,8 @@ blocksToShapes :: [Block] -> Pres [Shape] blocksToShapes blks = combineShapes <$> mapM blockToShape blks isImage :: Inline -> Bool -isImage (Image _ _ _) = True -isImage (Link _ ((Image _ _ _) : _) _) = True +isImage (Image{}) = True +isImage (Link _ (Image _ _ _ : _) _) = True isImage _ = False splitBlocks' :: [Block] -> [[Block]] -> [Block] -> Pres [[Block]] @@ -565,27 +565,27 @@ splitBlocks' cur acc (h@(Header n _ _) : blks) = do GT -> splitBlocks' (cur ++ [h]) acc blks -- `blockToParagraphs` treats Plain and Para the same, so we can save -- some code duplication by treating them the same here. -splitBlocks' cur acc ((Plain ils) : blks) = splitBlocks' cur acc ((Para ils) : blks) -splitBlocks' cur acc ((Para (il:ils)) : blks) | isImage il = do +splitBlocks' cur acc (Plain ils : blks) = splitBlocks' cur acc (Para ils : blks) +splitBlocks' cur acc (Para (il:ils) : blks) | isImage il = do slideLevel <- asks envSlideLevel case cur of - (Header n _ _) : [] | n == slideLevel -> + [(Header n _ _)] | n == slideLevel -> splitBlocks' [] (acc ++ [cur ++ [Para [il]]]) - (if null ils then blks else (Para ils) : blks) + (if null ils then blks else Para ils : blks) _ -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[Para [il]]]) - (if null ils then blks else (Para ils) : blks) -splitBlocks' cur acc (tbl@(Table _ _ _ _ _) : blks) = do + (if null ils then blks else Para ils : blks) +splitBlocks' cur acc (tbl@(Table{}) : blks) = do slideLevel <- asks envSlideLevel case cur of - (Header n _ _) : [] | n == slideLevel -> + [(Header n _ _)] | n == slideLevel -> splitBlocks' [] (acc ++ [cur ++ [tbl]]) blks _ -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[tbl]]) blks splitBlocks' cur acc (d@(Div (_, classes, _) _): blks) | "columns" `elem` classes = do slideLevel <- asks envSlideLevel case cur of - (Header n _ _) : [] | n == slideLevel -> + [(Header n _ _)] | n == slideLevel -> splitBlocks' [] (acc ++ [cur ++ [d]]) blks _ -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[d]]) blks splitBlocks' cur acc (blk : blks) = splitBlocks' (cur ++ [blk]) acc blks @@ -594,12 +594,12 @@ splitBlocks :: [Block] -> Pres [[Block]] splitBlocks = splitBlocks' [] [] blocksToSlide' :: Int -> [Block] -> Pres Slide -blocksToSlide' lvl ((Header n (ident, _, _) ils) : blks) +blocksToSlide' lvl (Header n (ident, _, _) ils : blks) | n < lvl = do registerAnchorId ident sldId <- asks envCurSlideId hdr <- inlinesToParElems ils - return $ Slide sldId (TitleSlide {titleSlideHeader = hdr}) Nothing + return $ Slide sldId TitleSlide {titleSlideHeader = hdr} Nothing | n == lvl = do registerAnchorId ident hdr <- inlinesToParElems ils @@ -614,7 +614,7 @@ blocksToSlide' lvl ((Header n (ident, _, _) ils) : blks) blocksToSlide' _ (blk : blks) | Div (_, classes, _) divBlks <- blk , "columns" `elem` classes - , (Div (_, clsL, _) blksL) : (Div (_, clsR, _) blksR) : remaining <- divBlks + , Div (_, clsL, _) blksL : Div (_, clsR, _) blksR : remaining <- divBlks , "column" `elem` clsL, "column" `elem` clsR = do unless (null blks) (mapM (addLogMessage . BlockNotRendered) blks >> return ()) @@ -672,7 +672,7 @@ makeNoteEntry n blks = in case blks of (Para ils : blks') -> (Para $ enum : Space : ils) : blks' - _ -> (Para [enum]) : blks + _ -> Para [enum] : blks forceFontSize :: Pixels -> Pres a -> Pres a forceFontSize px x = do @@ -860,7 +860,7 @@ blocksToPresentationSlides blks = do (\env -> env { envCurSlideId = endNotesSlideId , envInNoteSlide = True }) - (blocksToSlide $ endNotesSlideBlocks) + (blocksToSlide endNotesSlideBlocks) return [endNotesSlide] let slides = metadataslides ++ tocSlides ++ bodyslides ++ endNotesSlides @@ -889,9 +889,7 @@ documentToPresentation :: WriterOptions documentToPresentation opts (Pandoc meta blks) = let env = def { envOpts = opts , envMetadata = meta - , envSlideLevel = case writerSlideLevel opts of - Just lvl -> lvl - Nothing -> getSlideLevel blks + , envSlideLevel = fromMaybe (getSlideLevel blks) (writerSlideLevel opts) } (presSlides, msgs) = runPres env def $ blocksToPresentationSlides blks docProps = metaToDocProps meta diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index a57527aa8..95cb46643 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -132,7 +132,7 @@ keyToRST (label, (src, _)) = do -- | Return RST representation of notes. notesToRST :: PandocMonad m => [[Block]] -> RST m Doc notesToRST notes = - mapM (uncurry noteToRST) (zip [1..] notes) >>= + zipWithM noteToRST [1..] notes >>= return . vsep -- | Return RST representation of a note. @@ -306,8 +306,7 @@ blockToRST (OrderedList (start, style', delim) items) = do let maxMarkerLength = maximum $ map length markers let markers' = map (\m -> let s = maxMarkerLength - length m in m ++ replicate s ' ') markers - contents <- mapM (uncurry orderedListItemToRST) $ - zip markers' items + contents <- zipWithM orderedListItemToRST markers' items -- ensure that sublists have preceding blank line return $ blankline $$ chomp (vcat contents) $$ blankline blockToRST (DefinitionList items) = do @@ -356,12 +355,12 @@ blockListToRST' topLevel blocks = do let fixBlocks (b1:b2@(BlockQuote _):bs) | toClose b1 = b1 : commentSep : b2 : fixBlocks bs where - toClose (Plain{}) = False - toClose (Header{}) = False - toClose (LineBlock{}) = False - toClose (HorizontalRule) = False + toClose Plain{} = False + toClose Header{} = False + toClose LineBlock{} = False + toClose HorizontalRule = False toClose (Para [Image _ _ (_,'f':'i':'g':':':_)]) = True - toClose (Para{}) = False + toClose Para{} = False toClose _ = True commentSep = RawBlock "rst" "..\n\n" fixBlocks (b:bs) = b : fixBlocks bs diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 790bebc01..7006b58d1 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -31,6 +31,7 @@ Conversion of 'Pandoc' documents to RTF (rich text format). module Text.Pandoc.Writers.RTF ( writeRTF ) where import Control.Monad.Except (catchError, throwError) +import Control.Monad import qualified Data.ByteString as B import Data.Char (chr, isDigit, ord) import Data.List (intercalate, isSuffixOf) @@ -278,8 +279,7 @@ blockToRTF indent alignment (BulletList lst) = (spaceAtEnd . concat) <$> mapM (listItemToRTF alignment indent (bulletMarker indent)) lst blockToRTF indent alignment (OrderedList attribs lst) = (spaceAtEnd . concat) <$> - mapM (uncurry (listItemToRTF alignment indent)) - (zip (orderedMarkers indent attribs) lst) + zipWithM (listItemToRTF alignment indent) (orderedMarkers indent attribs) lst blockToRTF indent alignment (DefinitionList lst) = (spaceAtEnd . concat) <$> mapM (definitionListItemToRTF alignment indent) lst blockToRTF indent _ HorizontalRule = return $ @@ -303,8 +303,8 @@ tableRowToRTF header indent aligns sizes' cols = do let sizes = if all (== 0) sizes' then replicate (length cols) (1.0 / fromIntegral (length cols)) else sizes' - columns <- concat <$> mapM (uncurry (tableItemToRTF indent)) - (zip aligns cols) + columns <- concat <$> + zipWithM (tableItemToRTF indent) aligns cols let rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips)) (0 :: Integer) sizes let cellDefs = map (\edge -> (if header diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index b5d72aa56..bf434642e 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -475,7 +475,7 @@ inlineToTexinfo (Link _ txt (src@('#':_), _)) = do inlineToTexinfo (Link _ txt (src, _)) = case txt of [Str x] | escapeURI x == src -> -- autolink - do return $ text $ "@url{" ++ x ++ "}" + return $ text $ "@url{" ++ x ++ "}" _ -> do contents <- escapeCommas $ inlineListToTexinfo txt let src1 = stringToTexinfo src return $ text ("@uref{" ++ src1 ++ ",") <> contents <> -- cgit v1.2.3