From f270dd9b18de69e87198216f13943b2ceefea8f8 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sun, 29 Oct 2017 14:18:06 -0700 Subject: hlint suggestions. --- src/Text/Pandoc/Writers/AsciiDoc.hs | 2 +- src/Text/Pandoc/Writers/Custom.hs | 2 +- src/Text/Pandoc/Writers/Docbook.hs | 42 +++--- src/Text/Pandoc/Writers/Docx.hs | 228 ++++++++++++++++---------------- src/Text/Pandoc/Writers/DokuWiki.hs | 24 ++-- src/Text/Pandoc/Writers/EPUB.hs | 49 +++---- src/Text/Pandoc/Writers/FB2.hs | 8 +- src/Text/Pandoc/Writers/HTML.hs | 101 +++++++------- src/Text/Pandoc/Writers/Haddock.hs | 30 ++--- src/Text/Pandoc/Writers/ICML.hs | 76 +++++------ src/Text/Pandoc/Writers/JATS.hs | 37 +++--- src/Text/Pandoc/Writers/LaTeX.hs | 102 +++++++------- src/Text/Pandoc/Writers/Man.hs | 34 ++--- src/Text/Pandoc/Writers/Math.hs | 4 +- src/Text/Pandoc/Writers/Ms.hs | 43 +++--- src/Text/Pandoc/Writers/Native.hs | 9 +- src/Text/Pandoc/Writers/ODT.hs | 20 ++- src/Text/Pandoc/Writers/OPML.hs | 10 +- src/Text/Pandoc/Writers/OpenDocument.hs | 29 ++-- src/Text/Pandoc/Writers/RST.hs | 36 ++--- src/Text/Pandoc/Writers/RTF.hs | 55 ++++---- src/Text/Pandoc/Writers/Shared.hs | 10 +- src/Text/Pandoc/Writers/TEI.hs | 33 ++--- src/Text/Pandoc/Writers/Texinfo.hs | 26 ++-- src/Text/Pandoc/Writers/Textile.hs | 6 +- src/Text/Pandoc/Writers/ZimWiki.hs | 53 ++++---- 26 files changed, 527 insertions(+), 542 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index 82d422f93..bf58a755f 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -100,7 +100,7 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do let context = defField "body" main $ defField "toc" (writerTableOfContents opts && - Data.Maybe.isJust (writerTemplate opts)) + isJust (writerTemplate opts)) $defField "titleblock" titleblock metadata' case writerTemplate opts of Nothing -> return main diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 09cf3fac8..87b97dcee 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -235,7 +235,7 @@ inlineToCustom (Math InlineMath str) = inlineToCustom (RawInline format str) = callFunc "RawInline" format str -inlineToCustom (LineBreak) = callFunc "LineBreak" +inlineToCustom LineBreak = callFunc "LineBreak" inlineToCustom (Link attr txt (src,tit)) = callFunc "Link" txt src tit (attrToMap attr) diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index d6b7f7cad..24df7e2b4 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -33,7 +33,7 @@ module Text.Pandoc.Writers.Docbook ( writeDocbook4, writeDocbook5 ) where import Control.Monad.Reader import Data.Char (toLower) import Data.Generics (everywhere, mkT) -import Data.List (intercalate, isPrefixOf, isSuffixOf, stripPrefix) +import Data.List (isPrefixOf, isSuffixOf, stripPrefix) import Data.Monoid (Any (..)) import Data.Text (Text) import qualified Text.Pandoc.Builder as B @@ -78,7 +78,7 @@ authorToDocbook opts name' = do (firstname, lastname) = case lengthname of 0 -> ("","") 1 -> ("", name) - n -> (intercalate " " (take (n-1) namewords), last namewords) + n -> (unwords (take (n-1) namewords), last namewords) in inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$ inTagsSimple "surname" (text $ escapeStringForXML lastname) @@ -99,9 +99,9 @@ writeDocbook opts (Pandoc meta blocks) = do else Nothing let render' :: Doc -> Text render' = render colwidth - let opts' = if (maybe False (("/book>" `isSuffixOf`) . trimr) + let opts' = if maybe False (("/book>" `isSuffixOf`) . trimr) (writerTemplate opts) && - TopLevelDefault == writerTopLevelDivision opts) + TopLevelDefault == writerTopLevelDivision opts then opts{ writerTopLevelDivision = TopLevelChapter } else opts -- The numbering here follows LaTeX's internal numbering @@ -114,16 +114,16 @@ writeDocbook opts (Pandoc meta blocks) = do let meta' = B.setMeta "author" auths' meta metadata <- metaToJSON opts (fmap (render' . vcat) . - (mapM (elementToDocbook opts' startLvl) . - hierarchicalize)) + mapM (elementToDocbook opts' startLvl) . + hierarchicalize) (fmap render' . inlinesToDocbook opts') meta' - main <- (render' . vcat) <$> (mapM (elementToDocbook opts' startLvl) elements) + main <- (render' . vcat) <$> mapM (elementToDocbook opts' startLvl) elements let context = defField "body" main - $ defField "mathml" (case writerHTMLMathMethod opts of - MathML -> True - _ -> False) - $ metadata + $ + defField "mathml" (case writerHTMLMathMethod opts of + MathML -> True + _ -> False) metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -170,7 +170,7 @@ plainToPara x = x deflistItemsToDocbook :: PandocMonad m => WriterOptions -> [([Inline],[[Block]])] -> DB m Doc deflistItemsToDocbook opts items = - vcat <$> mapM (\(term, defs) -> deflistItemToDocbook opts term defs) items + vcat <$> mapM (uncurry (deflistItemToDocbook opts)) items -- | Convert a term and a list of blocks into a Docbook varlistentry. deflistItemToDocbook :: PandocMonad m @@ -196,7 +196,7 @@ imageToDocbook _ attr src = selfClosingTag "imagedata" $ ("fileref", src) : idAndRole attr ++ dims where dims = go Width "width" ++ go Height "depth" - go dir dstr = case (dimension dir attr) of + go dir dstr = case dimension dir attr of Just a -> [(dstr, show a)] Nothing -> [] @@ -217,7 +217,7 @@ blockToDocbook opts (Div (ident,_,_) bs) = do (if null ident then mempty else selfClosingTag "anchor" [("id", ident)]) $$ contents -blockToDocbook _ h@(Header _ _ _) = do +blockToDocbook _ h@Header{} = do -- should not occur after hierarchicalize, except inside lists/blockquotes report $ BlockNotRendered h return empty @@ -230,9 +230,9 @@ blockToDocbook opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) = do else inTagsSimple "title" alt return $ inTagsIndented "figure" $ capt $$ - (inTagsIndented "mediaobject" $ - (inTagsIndented "imageobject" - (imageToDocbook opts attr src)) $$ + inTagsIndented "mediaobject" ( + inTagsIndented "imageobject" + (imageToDocbook opts attr src) $$ inTagsSimple "textobject" (inTagsSimple "phrase" alt)) blockToDocbook opts (Para lst) | hasLineBreaks lst = (flush . nowrap . inTagsSimple "literallayout") @@ -275,7 +275,7 @@ blockToDocbook opts (OrderedList (start, numstyle, _) (first:rest)) = do first' <- blocksToDocbook opts (map plainToPara first) rest' <- listItemsToDocbook opts rest return $ - (inTags True "listitem" [("override",show start)] first') $$ + inTags True "listitem" [("override",show start)] first' $$ rest' return $ inTags True "orderedlist" attribs items blockToDocbook opts (DefinitionList lst) = do @@ -308,7 +308,7 @@ blockToDocbook opts (Table caption aligns widths headers rows) = do body' <- (inTagsIndented "tbody" . vcat) <$> mapM (tableRowToDocbook opts) rows return $ inTagsIndented tableType $ captionDoc $$ - (inTags True "tgroup" [("cols", show (length headers))] $ + inTags True "tgroup" [("cols", show (length headers))] ( coltags $$ head' $$ body') hasLineBreaks :: [Inline] -> Bool @@ -406,7 +406,7 @@ inlineToDocbook _ SoftBreak = return space inlineToDocbook opts (Link attr txt (src, _)) | Just email <- stripPrefix "mailto:" src = let emailLink = inTagsSimple "email" $ text $ - escapeStringForXML $ email + escapeStringForXML email in case txt of [Str s] | escapeURI s == email -> return emailLink _ -> do contents <- inlinesToDocbook opts txt @@ -414,7 +414,7 @@ inlineToDocbook opts (Link attr txt (src, _)) char '(' <> emailLink <> char ')' | otherwise = do version <- ask - (if isPrefixOf "#" src + (if "#" `isPrefixOf` src then inTags False "link" $ ("linkend", writerIdentifierPrefix opts ++ drop 1 src) : idAndRole attr else if version == DocBook5 then inTags False "link" $ ("xlink:href", src) : idAndRole attr diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 3ab4548a2..d146ebf84 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveFunctor #-} + {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -177,16 +177,16 @@ renumIdMap :: Int -> [Element] -> M.Map String String renumIdMap _ [] = M.empty renumIdMap n (e:es) | Just oldId <- findAttr (QName "Id" Nothing Nothing) e = - M.insert oldId ("rId" ++ (show n)) (renumIdMap (n+1) es) + M.insert oldId ("rId" ++ show n) (renumIdMap (n+1) es) | otherwise = renumIdMap n es replaceAttr :: (QName -> Bool) -> String -> [XML.Attr] -> [XML.Attr] replaceAttr _ _ [] = [] replaceAttr f val (a:as) | f (attrKey a) = - (XML.Attr (attrKey a) val) : (replaceAttr f val as) - | otherwise = a : (replaceAttr f val as) + XML.Attr (attrKey a) val : replaceAttr f val as + | otherwise = a : replaceAttr f val as -renumId :: (QName -> Bool) -> (M.Map String String) -> Element -> Element +renumId :: (QName -> Bool) -> M.Map String String -> Element -> Element renumId f renumMap e | Just oldId <- findAttrBy f e , Just newId <- M.lookup oldId renumMap = @@ -195,7 +195,7 @@ renumId f renumMap e e { elAttribs = attrs' } | otherwise = e -renumIds :: (QName -> Bool) -> (M.Map String String) -> [Element] -> [Element] +renumIds :: (QName -> Bool) -> M.Map String String -> [Element] -> [Element] renumIds f renumMap = map (renumId f renumMap) -- | Certain characters are invalid in XML even if escaped. @@ -228,7 +228,7 @@ writeDocx :: (PandocMonad m) -> Pandoc -- ^ Document to convert -> m BL.ByteString writeDocx opts doc@(Pandoc meta _) = do - let doc' = walk fixDisplayMath $ doc + let doc' = walk fixDisplayMath doc username <- P.lookupEnv "USERNAME" utctime <- P.getCurrentTime distArchive <- (toArchive . BL.fromStrict) <$> @@ -243,12 +243,12 @@ writeDocx opts doc@(Pandoc meta _) = do let mbsectpr = filterElementName (wname (=="sectPr")) parsedDoc -- Gets the template size - let mbpgsz = mbsectpr >>= (filterElementName (wname (=="pgSz"))) - let mbAttrSzWidth = (elAttribs <$> mbpgsz) >>= (lookupAttrBy ((=="w") . qName)) + let mbpgsz = mbsectpr >>= filterElementName (wname (=="pgSz")) + let mbAttrSzWidth = (elAttribs <$> mbpgsz) >>= lookupAttrBy ((=="w") . qName) - let mbpgmar = mbsectpr >>= (filterElementName (wname (=="pgMar"))) - let mbAttrMarLeft = (elAttribs <$> mbpgmar) >>= (lookupAttrBy ((=="left") . qName)) - let mbAttrMarRight = (elAttribs <$> mbpgmar) >>= (lookupAttrBy ((=="right") . qName)) + let mbpgmar = mbsectpr >>= filterElementName (wname (=="pgMar")) + let mbAttrMarLeft = (elAttribs <$> mbpgmar) >>= lookupAttrBy ((=="left") . qName) + let mbAttrMarRight = (elAttribs <$> mbpgmar) >>= lookupAttrBy ((=="right") . qName) -- Get the avaible area (converting the size and the margins to int and -- doing the difference @@ -303,7 +303,7 @@ writeDocx opts doc@(Pandoc meta _) = do envRTL = isRTLmeta , envChangesAuthor = fromMaybe "unknown" username , envChangesDate = formatTime defaultTimeLocale "%FT%XZ" utctime - , envPrintWidth = (maybe 420 (\x -> quot x 20) pgContentWidth) + , envPrintWidth = maybe 420 (\x -> quot x 20) pgContentWidth } @@ -446,7 +446,7 @@ writeDocx opts doc@(Pandoc meta _) = do (elChildren sectpr') in add_attrs (elAttribs sectpr') $ mknode "w:sectPr" [] cs - Nothing -> (mknode "w:sectPr" [] ()) + Nothing -> mknode "w:sectPr" [] () -- let sectpr = fromMaybe (mknode "w:sectPr" [] ()) mbsectpr' let contents' = contents ++ [sectpr] @@ -489,7 +489,7 @@ writeDocx opts doc@(Pandoc meta _) = do map newTextPropToOpenXml newDynamicTextProps ++ (case writerHighlightStyle opts of Nothing -> [] - Just sty -> (styleToOpenXml styleMaps sty)) + Just sty -> styleToOpenXml styleMaps sty) let styledoc' = styledoc{ elContent = elContent styledoc ++ map Elem newstyles } let styleEntry = toEntry stylepath epochtime $ renderXml styledoc' @@ -641,8 +641,8 @@ styleToOpenXml sm style = , mknode "w:link" [("w:val","VerbatimChar")] () , mknode "w:pPr" [] $ mknode "w:wordWrap" [("w:val","off")] () - : ( maybe [] (\col -> [mknode "w:shd" [("w:val","clear"),("w:fill",drop 1 $ fromColor col)] ()]) - $ backgroundColor style ) + : + maybe [] (\col -> [mknode "w:shd" [("w:val","clear"),("w:fill",drop 1 $ fromColor col)] ()]) (backgroundColor style) ] copyChildren :: (PandocMonad m) => Archive -> Archive -> String -> Integer -> [String] -> m Entry @@ -747,11 +747,11 @@ getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists makeTOC :: (PandocMonad m) => WriterOptions -> WS m [Element] makeTOC opts | writerTableOfContents opts = do - let depth = "1-"++(show (writerTOCDepth opts)) + let depth = "1-"++show (writerTOCDepth opts) let tocCmd = "TOC \\o \""++depth++"\" \\h \\z \\u" tocTitle <- gets stTocTitle title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para tocTitle]) - return $ + return [mknode "w:sdt" [] ([ mknode "w:sdtPr" [] ( mknode "w:docPartObj" [] ( @@ -803,7 +803,7 @@ writeOpenXML opts (Pandoc meta blocks) = do convertSpace (Str x : Str y : xs) = Str (x ++ y) : xs convertSpace xs = xs let blocks' = bottomUp convertSpace blocks - doc' <- (setFirstPara >> blocksToOpenXML opts blocks') + doc' <- setFirstPara >> blocksToOpenXML opts blocks' notes' <- reverse <$> gets stFootnotes comments <- reverse <$> gets stComments let toComment (kvs, ils) = do @@ -1106,7 +1106,7 @@ formattedString str = [w] -> formattedString' w ws -> do sh <- formattedRun [mknode "w:softHyphen" [] ()] - (intercalate sh) <$> mapM formattedString' ws + intercalate sh <$> mapM formattedString' ws formattedString' :: PandocMonad m => String -> WS m [Element] formattedString' str = do @@ -1134,13 +1134,13 @@ inlineToOpenXML' opts SoftBreak = inlineToOpenXML opts (Str " ") inlineToOpenXML' _ (Span (ident,["comment-start"],kvs) ils) = do modify $ \st -> st{ stComments = (("id",ident):kvs, ils) : stComments st } return [ mknode "w:commentRangeStart" [("w:id", ident)] () ] -inlineToOpenXML' _ (Span (ident,["comment-end"],_) _) = do +inlineToOpenXML' _ (Span (ident,["comment-end"],_) _) = return [ mknode "w:commentRangeEnd" [("w:id", ident)] () - , mknode "w:r" [] - [ mknode "w:rPr" [] - [ mknode "w:rStyle" [("w:val", "CommentReference")] () ] - , mknode "w:commentReference" [("w:id", ident)] () ] - ] + , mknode "w:r" [] + [ mknode "w:rPr" [] + [ mknode "w:rStyle" [("w:val", "CommentReference")] () ] + , mknode "w:commentReference" [("w:id", ident)] () ] + ] inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do stylemod <- case lookup dynamicStyleKey kvs of Just sty -> do @@ -1166,13 +1166,13 @@ inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do let author = fromMaybe defaultAuthor (lookup "author" kvs) date = fromMaybe defaultDate (lookup "date" kvs) insId <- gets stInsId - modify $ \s -> s{stInsId = (insId + 1)} + modify $ \s -> s{stInsId = insId + 1} return $ \f -> do x <- f - return $ [ mknode "w:ins" + return [ mknode "w:ins" [("w:id", (show insId)), ("w:author", author), - ("w:date", date)] x] + ("w:date", date)] x ] else return id delmod <- if "insertion" `elem` classes then do @@ -1181,11 +1181,11 @@ inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do let author = fromMaybe defaultAuthor (lookup "author" kvs) date = fromMaybe defaultDate (lookup "date" kvs) insId <- gets stInsId - modify $ \s -> s{stInsId = (insId + 1)} + modify $ \s -> s{stInsId = insId + 1} 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 @@ -1235,7 +1235,7 @@ inlineToOpenXML' opts (Math mathType str) = do inlineToOpenXML' opts (Cite _ lst) = inlinesToOpenXML opts lst inlineToOpenXML' opts (Code attrs str) = do let unhighlighted = intercalate [br] `fmap` - (mapM formattedString $ lines str) + mapM formattedString (lines str) formatOpenXML _fmtOpts = intercalate [br] . map (map toHlTok) toHlTok (toktype,tok) = mknode "w:r" [] [ mknode "w:rPr" [] @@ -1267,7 +1267,7 @@ inlineToOpenXML' opts (Note bs) = do , envTextProperties = [] }) (withParaPropM (pStyleM "Footnote Text") $ blocksToOpenXML opts $ insertNoteRef bs) - let newnote = mknode "w:footnote" [("w:id", notenum)] $ contents + let newnote = mknode "w:footnote" [("w:id", notenum)] contents modify $ \s -> s{ stFootnotes = newnote : notes } return [ mknode "w:r" [] [ mknode "w:rPr" [] footnoteStyle @@ -1283,7 +1283,7 @@ inlineToOpenXML' opts (Link _ txt (src,_)) = do id' <- case M.lookup src extlinks of Just i -> return i Nothing -> do - i <- ("rId"++) `fmap` ((lift . lift) getUniqueId) + i <- ("rId"++) `fmap` (lift . lift) getUniqueId modify $ \st -> st{ stExternalLinks = M.insert src i extlinks } return i @@ -1294,81 +1294,81 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do imgs <- gets stImages case M.lookup src imgs of Just (_,_,_,elt,_) -> return [elt] - Nothing -> do + Nothing -> catchError - (do (img, mt) <- P.fetchItem src - ident <- ("rId"++) `fmap` ((lift . lift) getUniqueId) - let (xpt,ypt) = desiredSizeInPoints opts attr - (either (const def) id (imageSize opts img)) - -- 12700 emu = 1 pt - let (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) - (pageWidth * 12700) - let cNvPicPr = mknode "pic:cNvPicPr" [] $ - mknode "a:picLocks" [("noChangeArrowheads","1") - ,("noChangeAspect","1")] () - let nvPicPr = mknode "pic:nvPicPr" [] - [ mknode "pic:cNvPr" - [("descr",src),("id","0"),("name","Picture")] () - , cNvPicPr ] - let blipFill = mknode "pic:blipFill" [] - [ mknode "a:blip" [("r:embed",ident)] () - , mknode "a:stretch" [] $ - mknode "a:fillRect" [] () ] - let xfrm = mknode "a:xfrm" [] - [ mknode "a:off" [("x","0"),("y","0")] () - , mknode "a:ext" [("cx",show xemu) - ,("cy",show yemu)] () ] - let prstGeom = mknode "a:prstGeom" [("prst","rect")] $ - mknode "a:avLst" [] () - let ln = mknode "a:ln" [("w","9525")] - [ mknode "a:noFill" [] () - , mknode "a:headEnd" [] () - , mknode "a:tailEnd" [] () ] - let spPr = mknode "pic:spPr" [("bwMode","auto")] - [xfrm, prstGeom, mknode "a:noFill" [] (), ln] - let graphic = mknode "a:graphic" [] $ - mknode "a:graphicData" - [("uri","http://schemas.openxmlformats.org/drawingml/2006/picture")] - [ mknode "pic:pic" [] - [ nvPicPr - , blipFill - , spPr ] ] - let imgElt = mknode "w:r" [] $ - mknode "w:drawing" [] $ - mknode "wp:inline" [] - [ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] () - , mknode "wp:effectExtent" - [("b","0"),("l","0"),("r","0"),("t","0")] () - , mknode "wp:docPr" [("descr",stringify alt) - ,("title", title) - ,("id","1") - ,("name","Picture")] () - , graphic ] - let imgext = case mt >>= extensionFromMimeType of - Just x -> '.':x - Nothing -> case imageType img of - Just Png -> ".png" - Just Jpeg -> ".jpeg" - Just Gif -> ".gif" - Just Pdf -> ".pdf" - Just Eps -> ".eps" - Just Svg -> ".svg" - Nothing -> "" - if null imgext - then -- without an extension there is no rule for content type - inlinesToOpenXML opts alt -- return alt to avoid corrupted docx - else do - let imgpath = "media/" ++ ident ++ imgext - let mbMimeType = mt <|> getMimeType imgpath - -- insert mime type to use in constructing [Content_Types].xml - modify $ \st -> st{ stImages = - M.insert src (ident, imgpath, mbMimeType, imgElt, img) - $ stImages st } - return [imgElt]) - (\e -> do - report $ CouldNotFetchResource src (show e) - -- emit alt text - inlinesToOpenXML opts alt) + (do (img, mt) <- P.fetchItem src + ident <- ("rId"++) `fmap` ((lift . lift) getUniqueId) + let (xpt,ypt) = desiredSizeInPoints opts attr + (either (const def) id (imageSize opts img)) + -- 12700 emu = 1 pt + let (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) + (pageWidth * 12700) + let cNvPicPr = mknode "pic:cNvPicPr" [] $ + mknode "a:picLocks" [("noChangeArrowheads","1") + ,("noChangeAspect","1")] () + let nvPicPr = mknode "pic:nvPicPr" [] + [ mknode "pic:cNvPr" + [("descr",src),("id","0"),("name","Picture")] () + , cNvPicPr ] + let blipFill = mknode "pic:blipFill" [] + [ mknode "a:blip" [("r:embed",ident)] () + , mknode "a:stretch" [] $ + mknode "a:fillRect" [] () ] + let xfrm = mknode "a:xfrm" [] + [ mknode "a:off" [("x","0"),("y","0")] () + , mknode "a:ext" [("cx",show xemu) + ,("cy",show yemu)] () ] + let prstGeom = mknode "a:prstGeom" [("prst","rect")] $ + mknode "a:avLst" [] () + let ln = mknode "a:ln" [("w","9525")] + [ mknode "a:noFill" [] () + , mknode "a:headEnd" [] () + , mknode "a:tailEnd" [] () ] + let spPr = mknode "pic:spPr" [("bwMode","auto")] + [xfrm, prstGeom, mknode "a:noFill" [] (), ln] + let graphic = mknode "a:graphic" [] $ + mknode "a:graphicData" + [("uri","http://schemas.openxmlformats.org/drawingml/2006/picture")] + [ mknode "pic:pic" [] + [ nvPicPr + , blipFill + , spPr ] ] + let imgElt = mknode "w:r" [] $ + mknode "w:drawing" [] $ + mknode "wp:inline" [] + [ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] () + , mknode "wp:effectExtent" + [("b","0"),("l","0"),("r","0"),("t","0")] () + , mknode "wp:docPr" [("descr",stringify alt) + ,("title", title) + ,("id","1") + ,("name","Picture")] () + , graphic ] + let imgext = case mt >>= extensionFromMimeType of + Just x -> '.':x + Nothing -> case imageType img of + Just Png -> ".png" + Just Jpeg -> ".jpeg" + Just Gif -> ".gif" + Just Pdf -> ".pdf" + Just Eps -> ".eps" + Just Svg -> ".svg" + Nothing -> "" + if null imgext + then -- without an extension there is no rule for content type + inlinesToOpenXML opts alt -- return alt to avoid corrupted docx + else do + let imgpath = "media/" ++ ident ++ imgext + let mbMimeType = mt <|> getMimeType imgpath + -- insert mime type to use in constructing [Content_Types].xml + modify $ \st -> st{ stImages = + M.insert src (ident, imgpath, mbMimeType, imgElt, img) + $ stImages st } + return [imgElt]) + (\e -> do + report $ CouldNotFetchResource src (show e) + -- emit alt text + inlinesToOpenXML opts alt) br :: Element br = breakElement "textWrapping" @@ -1382,12 +1382,12 @@ breakElement kind = mknode "w:r" [] [mknode "w:br" [("w:type",kind)] () ] -- problems. So we want to make sure we insert them into our document. defaultFootnotes :: [Element] defaultFootnotes = [ mknode "w:footnote" - [("w:type", "separator"), ("w:id", "-1")] $ + [("w:type", "separator"), ("w:id", "-1")] [ mknode "w:p" [] $ [mknode "w:r" [] $ [ mknode "w:separator" [] ()]]] , mknode "w:footnote" - [("w:type", "continuationSeparator"), ("w:id", "0")] $ + [("w:type", "continuationSeparator"), ("w:id", "0")] [ mknode "w:p" [] $ [ mknode "w:r" [] $ [ mknode "w:continuationSeparator" [] ()]]]] @@ -1407,7 +1407,7 @@ 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) withDirection :: PandocMonad m => WS m a -> WS m a @@ -1423,8 +1423,8 @@ withDirection x = do if isRTL -- if we are going right-to-left, we (re?)add the properties. then flip local x $ - \env -> env { envParaProperties = (mknode "w:bidi" [] ()) : paraProps' - , envTextProperties = (mknode "w:rtl" [] ()) : textProps' + \env -> env { envParaProperties = mknode "w:bidi" [] () : paraProps' + , envTextProperties = mknode "w:rtl" [] () : textProps' } else flip local x $ \env -> env { envParaProperties = paraProps' , envTextProperties = textProps' diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index 43e2952de..09dd846ba 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -93,14 +93,9 @@ pandocToDokuWiki opts (Pandoc meta blocks) = do meta body <- blockListToDokuWiki opts blocks notesExist <- gets stNotes - let notes = if notesExist - then "" -- TODO Was "\n" Check whether I can really remove this: - -- if it is definitely to do with footnotes, can remove this whole bit - else "" - let main = pack $ body ++ notes + let main = pack body let context = defField "body" main - $ defField "toc" (writerTableOfContents opts) - $ metadata + $ defField "toc" (writerTableOfContents opts) metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -155,7 +150,8 @@ blockToDokuWiki _ b@(RawBlock f str) -- See https://www.dokuwiki.org/wiki:syntax -- use uppercase HTML tag for block-level content: | f == Format "html" = return $ "\n" ++ str ++ "\n" - | otherwise = "" <$ (report $ BlockNotRendered b) + | otherwise = "" <$ + report (BlockNotRendered b) blockToDokuWiki _ HorizontalRule = return "\n----\n" @@ -199,7 +195,7 @@ blockToDokuWiki opts (Table capt aligns _ headers rows) = do rows' <- mapM (zipWithM (tableItemToDokuWiki opts) aligns) rows let widths = map (maximum . map length) $ transpose (headers':rows') let padTo (width, al) s = - case (width - length s) of + case width - length s of x | x > 0 -> if al == AlignLeft || al == AlignDefault then s ++ replicate x ' ' @@ -294,7 +290,7 @@ listItemToDokuWiki opts items = do _ -> vcat bs indent <- stIndent <$> ask backSlash <- stBackSlashLB <$> ask - let indent' = if backSlash then (drop 2 indent) else indent + let indent' = if backSlash then drop 2 indent else indent return $ indent' ++ "* " ++ contents -- | Convert ordered list item (list of blocks) to DokuWiki. @@ -308,7 +304,7 @@ orderedListItemToDokuWiki opts items = do else do indent <- stIndent <$> ask backSlash <- stBackSlashLB <$> ask - let indent' = if backSlash then (drop 2 indent) else indent + let indent' = if backSlash then drop 2 indent else indent return $ indent' ++ "- " ++ contents -- | Convert definition list item (label, list of blocks) to DokuWiki. @@ -322,11 +318,11 @@ definitionListItemToDokuWiki opts (label, items) = do useTags <- stUseTags <$> ask if useTags then return $ "
" ++ labelText ++ "
\n" ++ - (intercalate "\n" $ map (\d -> "
" ++ d ++ "
") contents) + intercalate "\n" (map (\d -> "
" ++ d ++ "
") contents) else do indent <- stIndent <$> ask backSlash <- stBackSlashLB <$> ask - let indent' = if backSlash then (drop 2 indent) else indent + let indent' = if backSlash then drop 2 indent else indent return $ indent' ++ "* **" ++ labelText ++ "** " ++ concat contents -- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed. @@ -419,7 +415,7 @@ consolidateRawBlocks (x:xs) = x : consolidateRawBlocks xs inlineListToDokuWiki :: PandocMonad m => WriterOptions -> [Inline] -> DokuWiki m String inlineListToDokuWiki opts lst = - concat <$> (mapM (inlineToDokuWiki opts) lst) + concat <$> mapM (inlineToDokuWiki opts) lst -- | Convert Pandoc inline element to DokuWiki. inlineToDokuWiki :: PandocMonad m diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index d28187bf0..6bfd78d3c 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -43,7 +43,7 @@ import qualified Data.ByteString.Lazy.Char8 as B8 import Data.Char (isAlphaNum, isAscii, isDigit, toLower) import Data.List (intercalate, isInfixOf, isPrefixOf) import qualified Data.Map as M -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (fromMaybe, mapMaybe, isNothing) import qualified Data.Set as Set import qualified Data.Text as TS import qualified Data.Text.Lazy as TL @@ -280,11 +280,10 @@ getCreator s meta = getList s meta handleMetaValue getDate :: String -> Meta -> [Date] getDate s meta = getList s meta handleMetaValue where handleMetaValue (MetaMap m) = - Date{ dateText = maybe "" id $ + Date{ dateText = fromMaybe "" $ M.lookup "text" m >>= normalizeDate' . metaValueToString , dateEvent = metaValueToString <$> M.lookup "event" m } - handleMetaValue mv = Date { dateText = maybe "" - id $ normalizeDate' $ metaValueToString mv + handleMetaValue mv = Date { dateText = fromMaybe "" $ normalizeDate' $ metaValueToString mv , dateEvent = Nothing } simpleList :: String -> Meta -> [String] @@ -334,7 +333,7 @@ metadataFromMeta opts meta = EPUBMetadata{ rights = metaValueToString <$> lookupMeta "rights" meta coverImage = lookup "epub-cover-image" (writerVariables opts) `mplus` (metaValueToString <$> lookupMeta "cover-image" meta) - stylesheets = maybe [] id + stylesheets = fromMaybe [] (metaValueToPaths <$> lookupMeta "stylesheet" meta) ++ [f | ("css",f) <- writerVariables opts] pageDirection = case map toLower . metaValueToString <$> @@ -434,7 +433,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do -- mediaRef <- P.newIORef [] Pandoc _ blocks <- walkM (transformInline opts') doc >>= walkM transformBlock - picEntries <- (catMaybes . map (snd . snd)) <$> (gets stMediaPaths) + picEntries <- (mapMaybe (snd . snd)) <$> gets stMediaPaths -- handle fonts let matchingGlob f = do xs <- lift $ P.glob f @@ -479,7 +478,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do mbnum <- if "unnumbered" `elem` classes then return Nothing else case splitAt (n - 1) nums of - (ks, (m:_)) -> do + (ks, m:_) -> do let nums' = ks ++ [m+1] put nums' return $ Just (ks ++ [m]) @@ -528,22 +527,23 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do let chapToEntry num (Chapter mbnum bs) = mkEntry ("text/" ++ showChapter num) <$> - (writeHtml opts'{ writerNumberOffset = fromMaybe [] mbnum } - $ case bs of - (Header _ _ xs : _) -> - -- remove notes or we get doubled footnotes - Pandoc (setMeta "title" (walk removeNote $ fromList xs) - nullMeta) bs - _ -> - Pandoc nullMeta bs) + writeHtml opts'{ writerNumberOffset = fromMaybe [] mbnum } (case bs of + (Header _ _ xs : _) -> + -- remove notes or we get doubled footnotes + Pandoc (setMeta "title" (walk removeNote $ fromList xs) + nullMeta) bs + _ -> + Pandoc nullMeta bs) chapterEntries <- lift $ zipWithM chapToEntry [1..] chapters -- incredibly inefficient (TODO): let containsMathML ent = epub3 && - " return $ identifierText x -- use first identifier as UUID [] -> throwError $ PandocShouldNeverHappenError "epubIdentifier is null" -- shouldn't happen - currentTime <- lift $ P.getCurrentTime + currentTime <- lift P.getCurrentTime let contentsData = UTF8.fromStringLazy $ ppTopElement $ unode "package" ! [("version", case version of EPUB2 -> "2.0" @@ -594,8 +594,8 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do ,("media-type","application/xhtml+xml")] ++ [("properties","nav") | epub3 ]) $ () ] ++ - [ (unode "item" ! [("id","style"), ("href",fp) - ,("media-type","text/css")] $ ()) | + [ unode "item" ! [("id","style"), ("href",fp) + ,("media-type","text/css")] $ () | fp <- map eRelativePath stylesheetEntries ] ++ map chapterNode (cpgEntry ++ (tpEntry : chapterEntries)) ++ (case cpicEntry of @@ -605,7 +605,8 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do (pictureNode x)]) ++ map pictureNode picEntries ++ map fontNode fontEntries - , unode "spine" ! ([("toc","ncx")] ++ progressionDirection) $ + , unode "spine" ! ( + ("toc","ncx") : progressionDirection) $ case epubCoverImage metadata of Nothing -> [] Just _ -> [ unode "itemref" ! @@ -684,7 +685,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do Nothing -> [] Just img -> [unode "meta" ! [("name","cover"), ("content", toId img)] $ ()] - , unode "docTitle" $ unode "text" $ plainTitle + , unode "docTitle" $ unode "text" plainTitle , unode "navMap" $ tpNode : navMap ] @@ -826,7 +827,7 @@ metadataElement version md currentTime = ("content",toId img)] $ ()]) $ epubCoverImage md modifiedNodes = [ unode "meta" ! [("property", "dcterms:modified")] $ - (showDateTimeISO8601 currentTime) | version == EPUB3 ] + showDateTimeISO8601 currentTime | version == EPUB3 ] dcTag n s = unode ("dc:" ++ n) s dcTag' n s = [dcTag n s] toIdentifierNode id' (Identifier txt scheme) @@ -895,7 +896,7 @@ transformTag :: PandocMonad m -> E m (Tag String) transformTag tag@(TagOpen name attr) | name `elem` ["video", "source", "img", "audio"] && - lookup "data-external" attr == Nothing = do + isNothing (lookup "data-external" attr) = do let src = fromAttrib "src" tag let poster = fromAttrib "poster" tag newsrc <- modifyMediaRef src diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 6d61ea62c..cf96393ca 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -344,7 +344,7 @@ blockToXml (OrderedList a bss) = do item <- cMapM blockToXml $ plainToPara $ indentBlocks (mrk ++ " ") bs modify (\s -> s { parentListMarker = pmrk }) -- old parent marker return item - concat <$> (zipWithM mkitem markers bss) + concat <$> zipWithM mkitem markers bss blockToXml (BulletList bss) = do state <- get let level = parentBulletLevel state @@ -408,7 +408,7 @@ blockToXml Null = return [] paraToPlain :: [Block] -> [Block] paraToPlain [] = [] paraToPlain (Para inlines : rest) = - Plain (inlines) : Plain ([LineBreak]) : paraToPlain rest + Plain inlines : Plain [LineBreak] : paraToPlain rest paraToPlain (p:rest) = p : paraToPlain rest -- Replace plain text with paragraphs and add line break after paragraphs. @@ -416,9 +416,9 @@ paraToPlain (p:rest) = p : paraToPlain rest plainToPara :: [Block] -> [Block] plainToPara [] = [] plainToPara (Plain inlines : rest) = - Para (inlines) : plainToPara rest + Para inlines : plainToPara rest plainToPara (Para inlines : rest) = - Para (inlines) : Plain [LineBreak] : plainToPara rest + Para inlines : Plain [LineBreak] : plainToPara rest plainToPara (p:rest) = p : plainToPara rest -- Simulate increased indentation level. Will not really work diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 9cb3aced8..ddbd9e972 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -215,7 +215,7 @@ writeHtmlString' st opts d = do defField "body" (renderHtml' body) context' writeHtml' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Html -writeHtml' st opts d = do +writeHtml' st opts d = case writerTemplate opts of Just _ -> preEscapedText <$> writeHtmlString' st opts d Nothing -> do @@ -274,7 +274,8 @@ pandocToHtml opts (Pandoc meta blocks) = do (H.script ! A.src (toValue $ url ++ "contrib/auto-render.min.js") $ mempty) <> - (H.script $ + ( + H.script "document.addEventListener(\"DOMContentLoaded\", function() {\n renderMathInElement(document.body);\n});") <> (H.link ! A.rel "stylesheet" ! A.href (toValue $ url ++ "katex.min.css")) @@ -315,7 +316,7 @@ pandocToHtml opts (Pandoc meta blocks) = do defField "slideous-url" ("slideous" :: String) $ defField "revealjs-url" ("reveal.js" :: String) $ defField "s5-url" ("s5/default" :: String) $ - defField "html5" (stHtml5 st) $ + defField "html5" (stHtml5 st) metadata return (thebody, context) @@ -334,9 +335,9 @@ toList :: PandocMonad m toList listop opts items = do slideVariant <- gets stSlideVariant return $ - if (writerIncremental opts) - then if (slideVariant /= RevealJsSlides) - then (listop $ mconcat items) ! A.class_ "incremental" + if writerIncremental opts + then if slideVariant /= RevealJsSlides + then listop (mconcat items) ! A.class_ "incremental" else listop $ mconcat $ map (! A.class_ "fragment") items else listop $ mconcat items @@ -364,7 +365,7 @@ tableOfContents opts sects = do -- | Convert section number to string showSecNum :: [Int] -> String -showSecNum = concat . intersperse "." . map show +showSecNum = intercalate "." . map show -- | Converts an Element to a list item for a table of contents, -- retrieving the appropriate identifier from state. @@ -390,7 +391,7 @@ elementToListItem opts (Sec lev num (id',classes,_) headerText subsecs) let revealSlash = ['/' | slideVariant== RevealJsSlides] return $ Just $ if null id' - then (H.a $ toHtml txt) >> subList + then H.a (toHtml txt) >> subList else (H.a ! A.href (toValue $ "#" ++ revealSlash ++ writerIdentifierPrefix opts ++ id') $ toHtml txt) >> subList @@ -419,7 +420,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 @@ -448,7 +449,8 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen let attr = (id',classes',keyvals) if titleSlide then do - t <- addAttrs opts attr $ secttag $ header' + t <- addAttrs opts attr $ + secttag header' return $ (if slideVariant == RevealJsSlides then H5.section @@ -468,21 +470,19 @@ footnoteSection opts notes = do html5 <- gets stHtml5 slideVariant <- gets stSlideVariant let hrtag = if html5 then H5.hr else H.hr - let container x = if html5 - then H5.section ! A.class_ "footnotes" $ x - else if slideVariant /= NoSlides - then H.div ! A.class_ "footnotes slide" $ x - else H.div ! A.class_ "footnotes" $ x + let container x + | html5 = H5.section ! A.class_ "footnotes" $ x + | slideVariant /= NoSlides = H.div ! A.class_ "footnotes slide" $ x + | otherwise = H.div ! A.class_ "footnotes" $ x return $ if null notes then mempty - else nl opts >> (container - $ nl opts >> hrtag >> nl opts >> + else nl opts >> container (nl opts >> hrtag >> nl opts >> H.ol (mconcat notes >> nl opts) >> nl opts) -- | Parse a mailto link; return Just (name, domain) or Nothing. parseMailto :: String -> Maybe (String, String) -parseMailto s = do +parseMailto s = case break (==':') s of (xs,':':addr) | map toLower xs == "mailto" -> do let (name', rest) = span (/='@') addr @@ -514,8 +514,8 @@ obfuscateLink opts attr (TL.unpack . renderHtml -> txt) s = ReferenceObfuscation -> -- need to use preEscapedString or &'s are escaped to & in URL return $ - preEscapedString $ "" ++ (obfuscateString txt) ++ "" + preEscapedString $ "" ++ obfuscateString txt ++ "" JavascriptObfuscation -> return $ (H.script ! A.type_ "text/javascript" $ @@ -586,7 +586,7 @@ dimensionsToAttrList attr = consolidateStyles $ go Width ++ go Height (ss, rest) -> ("style", intercalate ";" $ map snd ss) : rest isStyle ("style", _) = True isStyle _ = False - go dir = case (dimension dir attr) of + go dir = case dimension dir attr of (Just (Pixel a)) -> [(show dir, show a)] (Just x) -> [("style", show dir ++ ":" ++ show x)] Nothing -> [] @@ -599,9 +599,7 @@ imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf", treatAsImage :: FilePath -> Bool treatAsImage fp = - let path = case uriPath `fmap` parseURIReference fp of - Nothing -> fp - Just up -> up + let path = fromMaybe fp (uriPath `fmap` parseURIReference fp) ext = map toLower $ drop 1 $ takeExtension path in null ext || ext `elem` imageExts @@ -674,13 +672,17 @@ blockToHtml opts (Div attr@(ident, classes, kvs') bs) = do slideVariant <- gets stSlideVariant if speakerNotes then case slideVariant of - RevealJsSlides -> addAttrs opts' attr $ H5.aside $ contents' + RevealJsSlides -> addAttrs opts' attr $ + H5.aside contents' DZSlides -> do - t <- addAttrs opts' attr $ H5.div $ contents' - return $ t ! (H5.customAttribute "role" "note") - NoSlides -> addAttrs opts' attr $ H.div $ contents' + t <- addAttrs opts' attr $ + H5.div contents' + return $ t ! H5.customAttribute "role" "note" + NoSlides -> addAttrs opts' attr $ + H.div contents' _ -> return mempty - else addAttrs opts (ident, classes', kvs) $ divtag $ contents' + else addAttrs opts (ident, classes', kvs) $ + divtag contents' blockToHtml opts (RawBlock f str) = do ishtml <- isRawHtml f if ishtml @@ -692,7 +694,7 @@ blockToHtml opts (RawBlock f str) = do else do report $ BlockNotRendered (RawBlock f str) return mempty -blockToHtml _ (HorizontalRule) = do +blockToHtml _ HorizontalRule = do html5 <- gets stHtml5 return $ if html5 then H5.hr else H.hr blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do @@ -768,12 +770,8 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do let numstyle' = case numstyle of Example -> "decimal" _ -> camelCaseToHyphenated $ show numstyle - let attribs = (if startnum /= 1 - then [A.start $ toValue startnum] - else []) ++ - (if numstyle == Example - then [A.class_ "example"] - else []) ++ + let attribs = ([A.start $ toValue startnum | startnum /= 1]) ++ + ([A.class_ "example" | numstyle == Example]) ++ (if numstyle /= DefaultStyle then if html5 then [A.type_ $ @@ -794,7 +792,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 @@ -848,7 +846,7 @@ tableRowToHtml opts aligns rownum cols' = do 0 -> "header" x | x `rem` 2 == 1 -> "odd" _ -> "even" - cols'' <- sequence $ zipWith + cols'' <- zipWithM (\alignment item -> tableItemToHtml opts mkcell alignment item) aligns cols' return $ (H.tr ! A.class_ rowclass $ nl opts >> mconcat cols'') @@ -877,7 +875,8 @@ tableItemToHtml opts tag' align' item = do let tag'' = if null alignStr then tag' else tag' ! attribs - return $ (tag'' $ contents) >> nl opts + return $ ( + tag'' contents) >> nl opts toListItems :: WriterOptions -> [Html] -> [Html] toListItems opts items = map (toListItem opts) items ++ [nl opts] @@ -887,7 +886,7 @@ toListItem opts item = nl opts >> H.li item blockListToHtml :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m Html blockListToHtml opts lst = - fmap (mconcat . intersperse (nl opts)) $ mapM (blockToHtml opts) lst + (mconcat . intersperse (nl opts)) <$> mapM (blockToHtml opts) lst -- | Convert list of Pandoc inline elements to HTML. inlineListToHtml :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Html @@ -915,12 +914,12 @@ inlineToHtml opts inline = do html5 <- gets stHtml5 case inline of (Str str) -> return $ strToHtml str - (Space) -> return $ strToHtml " " - (SoftBreak) -> return $ case writerWrapText opts of - WrapNone -> preEscapedString " " - WrapAuto -> preEscapedString " " - WrapPreserve -> preEscapedString "\n" - (LineBreak) -> return $ (if html5 then H5.br else H.br) + Space -> return $ strToHtml " " + SoftBreak -> return $ case writerWrapText opts of + WrapNone -> preEscapedString " " + WrapAuto -> preEscapedString " " + WrapPreserve -> preEscapedString "\n" + LineBreak -> return $ (if html5 then H5.br else H.br) <> strToHtml "\n" (Span (id',classes,kvs) ils) -> inlineListToHtml opts ils >>= @@ -931,7 +930,7 @@ inlineToHtml opts inline = do "csl-no-smallcaps"]) classes kvs' = if null styles then kvs - else (("style", concat styles) : kvs) + else ("style", concat styles) : kvs styles = ["font-style:normal;" | "csl-no-emph" `elem` classes] ++ ["font-weight:normal;" @@ -1090,12 +1089,12 @@ inlineToHtml opts inline = do -- note: null title included, as in Markdown.pl (Note contents) -> do notes <- gets stNotes - let number = (length notes) + 1 + let number = length notes + 1 let ref = show number htmlContents <- blockListToNote opts ref contents epubVersion <- gets stEPUBVersion -- push contents onto front of notes - modify $ \st -> st {stNotes = (htmlContents:notes)} + modify $ \st -> st {stNotes = htmlContents:notes} slideVariant <- gets stSlideVariant let revealSlash = ['/' | slideVariant == RevealJsSlides] let link = H.a ! A.href (toValue $ "#" ++ @@ -1134,7 +1133,7 @@ blockListToNote opts ref blocks = _ -> otherBlocks ++ [lastBlock, Plain backlink] in do contents <- blockListToHtml opts blocks' - let noteItem = H.li ! (prefixedId opts ("fn" ++ ref)) $ contents + let noteItem = H.li ! prefixedId opts ("fn" ++ ref) $ contents epubVersion <- gets stEPUBVersion let noteItem' = case epubVersion of Just EPUB3 -> noteItem ! customAttribute "epub:type" "footnote" @@ -1175,7 +1174,7 @@ isMathEnvironment s = "\\begin{" `isPrefixOf` s && allowsMathEnvironments :: HTMLMathMethod -> Bool allowsMathEnvironments (MathJax _) = True -allowsMathEnvironments (MathML) = True +allowsMathEnvironments MathML = True allowsMathEnvironments (WebTeX _) = True allowsMathEnvironments _ = False diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index c964ddf74..caa4b9031 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -76,8 +76,7 @@ pandocToHaddock opts (Pandoc meta blocks) = do (fmap render' . blockListToHaddock opts) (fmap render' . inlineListToHaddock opts) meta - let context = defField "body" main - $ metadata + let context = defField "body" main metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -118,7 +117,7 @@ blockToHaddock opts (Para inlines) = blockToHaddock opts (LineBlock lns) = blockToHaddock opts $ linesToPara lns blockToHaddock _ b@(RawBlock f str) - | f == "haddock" = do + | f == "haddock" = return $ text str <> text "\n" | otherwise = do report $ BlockNotRendered b @@ -150,16 +149,16 @@ blockToHaddock opts (Table caption aligns widths headers rows) = do isPlainBlock _ = False let hasBlocks = not (all isPlainBlock $ concat . concat $ headers:rows) (nst,tbl) <- case True of - _ | isSimple -> fmap (nest 2,) $ + _ | isSimple -> (nest 2,) <$> pandocTable opts (all null headers) aligns widths rawHeaders rawRows - | not hasBlocks -> fmap (nest 2,) $ + | not hasBlocks -> (nest 2,) <$> pandocTable opts (all null headers) aligns widths rawHeaders rawRows - | otherwise -> fmap (id,) $ + | otherwise -> (id,) <$> gridTable opts blockListToHaddock (all null headers) aligns widths headers rows - return $ (prefixed "> " $ nst $ tbl $$ blankline $$ caption'') $$ blankline + return $ prefixed "> " (nst $ tbl $$ blankline $$ caption'') $$ blankline blockToHaddock opts (BulletList items) = do contents <- mapM (bulletListItemToHaddock opts) items return $ cat contents <> blankline @@ -169,7 +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 (\(item, num) -> orderedListItemToHaddock opts item num) $ + contents <- mapM (uncurry (orderedListItemToHaddock opts)) $ zip markers' items return $ cat contents <> blankline blockToHaddock opts (DefinitionList items) = do @@ -194,18 +193,17 @@ pandocTable opts headless aligns widths rawHeaders rawRows = do (floor . (fromIntegral (writerColumns opts) *)) widths let makeRow = hcat . intersperse (lblock 1 (text " ")) . - (zipWith3 alignHeader aligns widthsInChars) + zipWith3 alignHeader aligns widthsInChars let rows' = map makeRow rawRows let head' = makeRow rawHeaders let maxRowHeight = maximum $ map height (head':rows') let underline = cat $ intersperse (text " ") $ map (\width -> text (replicate width '-')) widthsInChars - let border = if maxRowHeight > 1 - then text (replicate (sum widthsInChars + - length widthsInChars - 1) '-') - else if headless - then underline - else empty + let border + | maxRowHeight > 1 = text (replicate (sum widthsInChars + + length widthsInChars - 1) '-') + | headless = underline + | otherwise = empty let head'' = if headless then empty else border <> cr <> head' @@ -304,7 +302,7 @@ inlineToHaddock opts (Quoted DoubleQuote lst) = do return $ "“" <> contents <> "”" inlineToHaddock _ (Code _ str) = return $ "@" <> text (escapeString str) <> "@" -inlineToHaddock _ (Str str) = do +inlineToHaddock _ (Str str) = return $ text $ escapeString str inlineToHaddock opts (Math mt str) = do let adjust x = case mt of diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 650a1c012..4afa23cb9 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -19,6 +19,7 @@ module Text.Pandoc.Writers.ICML (writeICML) where import Control.Monad.Except (catchError) import Control.Monad.State.Strict import Data.List (intersperse, isInfixOf, isPrefixOf, stripPrefix) +import Data.Maybe (fromMaybe) import qualified Data.Set as Set import Data.Text as Text (breakOnAll, pack) import Data.Text (Text) @@ -145,8 +146,7 @@ writeICML opts (Pandoc meta blocks) = do context = defField "body" main $ defField "charStyles" (render' $ charStylesToDoc st) $ defField "parStyles" (render' $ parStylesToDoc st) - $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st) - $ metadata + $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st) metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -154,9 +154,7 @@ writeICML opts (Pandoc meta blocks) = do -- | Auxilary functions for parStylesToDoc and charStylesToDoc. contains :: String -> (String, (String, String)) -> [(String, String)] contains s rule = - if isInfixOf (fst rule) s - then [snd rule] - else [] + [snd rule | isInfixOf (fst rule) s] -- | The monospaced font to use as default. monospacedFont :: Doc @@ -180,7 +178,7 @@ parStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ blockStyles st where makeStyle s = let countSubStrs sub str = length $ Text.breakOnAll (Text.pack sub) (Text.pack str) - attrs = concat $ map (contains s) $ [ + attrs = concatMap (contains s) [ (defListTermName, ("BulletsAndNumberingListType", "BulletList")) , (defListTermName, ("FontStyle", "Bold")) , (tableHeaderName, ("FontStyle", "Bold")) @@ -206,9 +204,9 @@ parStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ blockStyles st where numbering | isOrderedList = [("NumberingExpression", "^#.^t"), ("NumberingLevel", show nOrds)] | otherwise = [] - listType | isOrderedList && (not $ isInfixOf subListParName s) + listType | isOrderedList && not (isInfixOf subListParName s) = [("BulletsAndNumberingListType", "NumberedList")] - | isBulletList && (not $ isInfixOf subListParName s) + | isBulletList && not (isInfixOf subListParName s) = [("BulletsAndNumberingListType", "BulletList")] | otherwise = [] indent = [("LeftIndent", show indt)] @@ -216,9 +214,9 @@ parStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ blockStyles st nBlockQuotes = countSubStrs blockQuoteName s nDefLists = countSubStrs defListDefName s indt = max 0 $ defaultListIndent*(nBuls + nOrds - 1) + defaultIndent*(nBlockQuotes + nDefLists) - props = inTags True "Properties" [] $ (basedOn $$ tabList $$ numbForm) + props = inTags True "Properties" [] (basedOn $$ tabList $$ numbForm) where - font = if isInfixOf codeBlockName s + font = if codeBlockName `isInfixOf` s then monospacedFont else empty basedOn = inTags False "BasedOn" [("type", "object")] (text "$ID/NormalParagraphStyle") $$ font @@ -245,7 +243,7 @@ charStylesToDoc :: WriterState -> Doc charStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ inlineStyles st where makeStyle s = - let attrs = concat $ map (contains s) [ + let attrs = concatMap (contains s) [ (strikeoutName, ("StrikeThru", "true")) , (superscriptName, ("Position", "Superscript")) , (subscriptName, ("Position", "Subscript")) @@ -259,7 +257,7 @@ charStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ inlineStyles st inTags False "BasedOn" [("type", "object")] (text "$ID/NormalCharacterStyle") $$ font where font = - if isInfixOf codeName s + if codeName `isInfixOf` s then monospacedFont else empty in inTags True "CharacterStyle" ([("Self", "CharacterStyle/"++s), ("Name", s)] ++ attrs') props @@ -279,13 +277,12 @@ hyperlinksToDoc (x:xs) = hyp x $$ hyperlinksToDoc xs hyp (ident, url) = hdest $$ hlink where hdest = selfClosingTag "HyperlinkURLDestination" - [("Self", "HyperlinkURLDestination/"++(escapeColons url)), ("Name","link"), ("DestinationURL",url), ("DestinationUniqueKey","1")] -- HyperlinkURLDestination with more than one colon crashes CS6 + [("Self", "HyperlinkURLDestination/"++escapeColons url), ("Name","link"), ("DestinationURL",url), ("DestinationUniqueKey","1")] -- HyperlinkURLDestination with more than one colon crashes CS6 hlink = inTags True "Hyperlink" [("Self","uf-"++show ident), ("Name",url), ("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. @@ -305,7 +302,7 @@ blockToICML opts style (Para img@[Image _ txt (_,'f':'i':'g':':':_)]) = do blockToICML opts style (Para lst) = parStyle opts (paragraphName:style) lst blockToICML opts style (LineBlock lns) = blockToICML opts style $ linesToPara lns -blockToICML opts style (CodeBlock _ str) = parStyle opts (codeBlockName:style) $ [Str str] +blockToICML opts style (CodeBlock _ str) = parStyle opts (codeBlockName:style) [Str str] blockToICML _ _ b@(RawBlock f str) | f == Format "icml" = return $ text str | otherwise = do @@ -351,11 +348,10 @@ blockToICML opts style (Table caption aligns widths headers rows) = then rows else headers:rows cells <- rowsToICML tabl (0::Int) - let colWidths w = if w > 0 - then [("SingleColumnWidth",show $ 500 * w)] - else [] - let tupToDoc tup = selfClosingTag "Column" $ [("Name",show $ fst tup)] ++ (colWidths $ snd tup) - let colDescs = vcat $ map tupToDoc $ zip [0..nrCols-1] widths + let colWidths w = + [("SingleColumnWidth",show $ 500 * w) | w > 0] + let tupToDoc tup = selfClosingTag "Column" $ ("Name",show $ fst tup) : (colWidths $ snd tup) + let colDescs = vcat $ zipWith (curry tupToDoc) [0..nrCols-1] widths let tableDoc = return $ inTags True "Table" [ ("AppliedTableStyle","TableStyle/Table") , ("HeaderRowCount", nrHeaders) @@ -391,9 +387,8 @@ listItemToICML opts style isFirst attribs item = doN LowerAlpha = [lowerAlphaName] doN UpperAlpha = [upperAlphaName] doN _ = [] - bw = if beginsWith > 1 - then [beginsWithName ++ show beginsWith] - else [] + bw = + [beginsWithName ++ show beginsWith | beginsWith > 1] in doN numbStl ++ bw makeNumbStart Nothing = [] stl = if isFirst @@ -402,7 +397,7 @@ listItemToICML opts style isFirst attribs item = stl' = makeNumbStart attribs ++ stl in if length item > 1 then do - let insertTab (Para lst) = blockToICML opts (subListParName:style) $ Para $ (Str "\t"):lst + let insertTab (Para lst) = blockToICML opts (subListParName:style) $ Para $ Str "\t":lst insertTab block = blockToICML opts style block f <- blockToICML opts stl' $ head item r <- mapM insertTab $ tail item @@ -413,7 +408,7 @@ definitionListItemToICML :: PandocMonad m => WriterOptions -> Style -> ([Inline] definitionListItemToICML opts style (term,defs) = do term' <- parStyle opts (defListTermName:style) term defs' <- mapM (blocksToICML opts (defListDefName:style)) defs - return $ intersperseBrs $ (term' : defs') + return $ intersperseBrs (term' : defs') -- | Convert a list of inline elements to ICML. @@ -453,8 +448,8 @@ inlineToICML opts style (Link _ lst (url, title)) = do state $ \st -> let ident = if null $ links st then 1::Int - else 1 + (fst $ head $ links st) - newst = st{ links = (ident, url):(links st) } + else 1 + fst (head $ links st) + newst = st{ links = (ident, url):links st } cont = inTags True "HyperlinkTextSource" [("Self","htss-"++show ident), ("Name",title), ("Hidden","false")] content in (cont, newst) @@ -465,7 +460,7 @@ inlineToICML opts style (Span _ lst) = inlinesToICML opts style lst -- | Convert a list of block elements to an ICML footnote. footnoteToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m Doc footnoteToICML opts style lst = - let insertTab (Para ls) = blockToICML opts (footnoteName:style) $ Para $ (Str "\t"):ls + let insertTab (Para ls) = blockToICML opts (footnoteName:style) $ Para $ Str "\t":ls insertTab block = blockToICML opts (footnoteName:style) block in do contents <- mapM insertTab lst @@ -477,11 +472,11 @@ footnoteToICML opts style lst = -- | Auxiliary function to merge Space elements into the adjacent Strs. mergeSpaces :: [Inline] -> [Inline] -mergeSpaces ((Str s):(x:((Str s'):xs))) | isSp x = +mergeSpaces (Str s:(x:(Str s':xs))) | isSp x = mergeSpaces $ Str(s++" "++s') : xs -mergeSpaces (x:((Str s):xs)) | isSp x = mergeSpaces $ Str (" "++s) : xs -mergeSpaces ((Str s):(x:xs)) | isSp x = mergeSpaces $ Str (s++" ") : xs -mergeSpaces (x:xs) = x : (mergeSpaces xs) +mergeSpaces (x:(Str s:xs)) | isSp x = mergeSpaces $ Str (" "++s) : xs +mergeSpaces (Str s:(x:xs)) | isSp x = mergeSpaces $ Str (s++" ") : xs +mergeSpaces (x:xs) = x : mergeSpaces xs mergeSpaces [] = [] isSp :: Inline -> Bool @@ -509,7 +504,7 @@ parStyle opts style lst = begins = filter (isPrefixOf beginsWithName) style in if null begins then ats - else let i = maybe "" id $ stripPrefix beginsWithName $ head begins + else let i = fromMaybe "" $ stripPrefix beginsWithName $ head begins in ("NumberingStartAt", i) : ats else [attrs] in do @@ -522,12 +517,12 @@ charStyle :: PandocMonad m => Style -> Doc -> WS m Doc charStyle style content = let (stlStr, attrs) = styleToStrAttr style doc = inTags True "CharacterStyleRange" attrs $ inTagsSimple "Content" $ flush content - in do + in state $ \st -> - let styles = if null stlStr - then st - else st{ inlineStyles = Set.insert stlStr $ inlineStyles st } - in (doc, styles) + let styles = if null stlStr + then st + else st{ inlineStyles = Set.insert stlStr $ inlineStyles st } + in (doc, styles) -- | Transform a Style to a tuple of String (eliminating duplicates and ordered) and corresponding attribute. styleToStrAttr :: Style -> (String, [(String, String)]) @@ -580,6 +575,5 @@ imageICML opts style attr (src, _) = do ] doc = inTags True "CharacterStyleRange" attrs $ inTags True "Rectangle" [("Self","uec"), ("StrokeWeight", "0"), - ("ItemTransform", scale++" "++hw++" -"++hh)] - $ (props $$ image) + ("ItemTransform", scale++" "++hw++" -"++hh)] (props $$ image) state $ \st -> (doc, st{ inlineStyles = Set.insert stlStr $ inlineStyles st } ) diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index 4efd00ee5..a62286fa3 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternGuards #-} + {- Copyright (C) 2006-2017 John MacFarlane @@ -34,7 +34,7 @@ module Text.Pandoc.Writers.JATS ( writeJATS ) where import Control.Monad.Reader import Data.Char (toLower) import Data.Generics (everywhere, mkT) -import Data.List (intercalate, isSuffixOf, partition) +import Data.List (isSuffixOf, partition) import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Text.Pandoc.Builder as B @@ -78,7 +78,7 @@ authorToJATS opts name' = do (firstname, lastname) = case lengthname of 0 -> ("","") 1 -> ("", name) - n -> (intercalate " " (take (n-1) namewords), last namewords) + n -> (unwords (take (n-1) namewords), last namewords) in inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$ inTagsSimple "surname" (text $ escapeStringForXML lastname) @@ -99,9 +99,9 @@ docToJATS opts (Pandoc meta blocks) = do else Nothing let render' :: Doc -> Text render' = render colwidth - let opts' = if (maybe False (("/book>" `isSuffixOf`) . trimr) + let opts' = if maybe False (("/book>" `isSuffixOf`) . trimr) (writerTemplate opts) && - TopLevelDefault == writerTopLevelDivision opts) + TopLevelDefault == writerTopLevelDivision opts then opts{ writerTopLevelDivision = TopLevelChapter } else opts -- The numbering here follows LaTeX's internal numbering @@ -114,20 +114,19 @@ docToJATS opts (Pandoc meta blocks) = do let meta' = B.setMeta "author" auths' meta metadata <- metaToJSON opts (fmap (render' . vcat) . - (mapM (elementToJATS opts' startLvl) . - hierarchicalize)) + mapM (elementToJATS opts' startLvl) . + hierarchicalize) (fmap render' . inlinesToJATS opts') meta' main <- (render' . vcat) <$> - (mapM (elementToJATS opts' startLvl) elements) + mapM (elementToJATS opts' startLvl) elements back <- (render' . vcat) <$> - (mapM (elementToJATS opts' startLvl) backElements) + mapM (elementToJATS opts' startLvl) backElements let context = defField "body" main $ defField "back" back $ defField "mathml" (case writerHTMLMathMethod opts of MathML -> True - _ -> False) - $ metadata + _ -> False) metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -158,7 +157,7 @@ plainToPara x = x deflistItemsToJATS :: PandocMonad m => WriterOptions -> [([Inline],[[Block]])] -> DB m Doc deflistItemsToJATS opts items = - vcat <$> mapM (\(term, defs) -> deflistItemToJATS opts term defs) items + vcat <$> mapM (uncurry (deflistItemToJATS opts)) items -- | Convert a term and a list of blocks into a JATS varlistentry. deflistItemToJATS :: PandocMonad m @@ -172,7 +171,7 @@ deflistItemToJATS opts term defs = do -- | Convert a list of lists of blocks to a list of JATS list items. listItemsToJATS :: PandocMonad m - => WriterOptions -> (Maybe [String]) -> [[Block]] -> DB m Doc + => WriterOptions -> Maybe [String] -> [[Block]] -> DB m Doc listItemsToJATS opts markers items = case markers of Nothing -> vcat <$> mapM (listItemToJATS opts Nothing) items @@ -180,7 +179,7 @@ listItemsToJATS opts markers items = -- | Convert a list of blocks into a JATS list item. listItemToJATS :: PandocMonad m - => WriterOptions -> (Maybe String) -> [Block] -> DB m Doc + => WriterOptions -> Maybe String -> [Block] -> DB m Doc listItemToJATS opts mbmarker item = do contents <- blocksToJATS opts item return $ inTagsIndented "list-item" $ @@ -203,7 +202,7 @@ blockToJATS opts (Div (ident,_,kvs) bs) = do [(k,v) | (k,v) <- kvs, k `elem` ["specific-use", "content-type", "orientation", "position"]] return $ inTags True "boxed-text" attr contents -blockToJATS _ h@(Header _ _ _) = do +blockToJATS _ h@(Header{}) = do -- should not occur after hierarchicalize, except inside lists/blockquotes report $ BlockNotRendered h return empty @@ -256,9 +255,9 @@ blockToJATS _ (CodeBlock (ident,classes,kvs) str) = return $ else languagesByExtension . map toLower $ s langs = concatMap langsFrom classes blockToJATS _ (BulletList []) = return empty -blockToJATS opts (BulletList lst) = do +blockToJATS opts (BulletList lst) = inTags True "list" [("list-type", "bullet")] <$> - listItemsToJATS opts Nothing lst + listItemsToJATS opts Nothing lst blockToJATS _ (OrderedList _ []) = return empty blockToJATS opts (OrderedList (start, numstyle, delimstyle) items) = do let listType = case numstyle of @@ -277,7 +276,7 @@ blockToJATS opts (OrderedList (start, numstyle, delimstyle) items) = do orderedListMarkers (start, numstyle, delimstyle) inTags True "list" [("list-type", listType)] <$> listItemsToJATS opts markers items -blockToJATS opts (DefinitionList lst) = do +blockToJATS opts (DefinitionList lst) = inTags True "def-list" [] <$> deflistItemsToJATS opts lst blockToJATS _ b@(RawBlock f str) | f == "jats" = return $ text str -- raw XML block @@ -400,7 +399,7 @@ inlineToJATS _ (Math t str) = do case res of Right r -> inTagsSimple "alternatives" $ cr <> rawtex $$ - (text $ Xml.ppcElement conf $ fixNS r) + text (Xml.ppcElement conf $ fixNS r) Left _ -> rawtex inlineToJATS _ (Link _attr [Str t] ('m':'a':'i':'l':'t':'o':':':email, _)) | escapeURI t == email = diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 1a36f987b..e667984ef 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) +import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe) import Data.Text (Text) import qualified Data.Text as T import Network.URI (unEscapeString) @@ -102,10 +102,10 @@ startingState options = WriterState { , stUrl = False , stGraphics = False , stLHS = False - , stBook = (case writerTopLevelDivision options of - TopLevelPart -> True - TopLevelChapter -> True - _ -> False) + , stBook = case writerTopLevelDivision options of + TopLevelPart -> True + TopLevelChapter -> True + _ -> False , stCsquotes = False , stHighlighting = False , stIncremental = writerIncremental options @@ -134,14 +134,14 @@ pandocToLaTeX options (Pandoc meta blocks) = do let method = writerCiteMethod options let blocks' = if method == Biblatex || method == Natbib then case reverse blocks of - (Div (_,["references"],_) _):xs -> reverse xs + Div (_,["references"],_) _:xs -> reverse xs _ -> blocks else blocks -- see if there are internal links let isInternalLink (Link _ _ ('#':xs,_)) = [xs] isInternalLink _ = [] modify $ \s -> s{ stInternalLinks = query isInternalLink blocks' } - let template = maybe "" id $ writerTemplate options + let template = fromMaybe "" $ writerTemplate options -- set stBook depending on documentclass let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options @@ -190,8 +190,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do docLangs <- catMaybes <$> mapM (toLang . Just) (ordNub (query (extract "lang") blocks)) let hasStringValue x = isJust (getField x metadata :: Maybe String) - let geometryFromMargins = intercalate [','] $ catMaybes $ - map (\(x,y) -> + let geometryFromMargins = intercalate [','] $ mapMaybe (\(x,y) -> ((x ++ "=") ++) <$> getField y metadata) [("lmargin","margin-left") ,("rmargin","margin-right") @@ -256,7 +255,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do (case getField "papersize" metadata of Just ("A4" :: String) -> resetField "papersize" ("a4" :: String) - _ -> id) $ + _ -> id) metadata let context' = -- note: lang is used in some conditionals in the template, @@ -287,9 +286,9 @@ pandocToLaTeX options (Pandoc meta blocks) = do ) $ maybe id (defField "polyglossia-lang" . toPolyObj) mblang $ defField "polyglossia-otherlangs" (map toPolyObj docLangs) - $ defField "latex-dir-rtl" - (getField "dir" context == Just ("rtl" :: String)) - $ context + $ + defField "latex-dir-rtl" + (getField "dir" context == Just ("rtl" :: String)) context case writerTemplate options of Nothing -> return main Just tpl -> renderTemplate' tpl context' @@ -357,7 +356,7 @@ toLabel z = go `fmap` stringToLaTeX URLString z where go [] = "" go (x:xs) | (isLetter x || isDigit x) && isAscii x = x:go xs - | elem x ("_-+=:;." :: String) = x:go xs + | x `elem` ("_-+=:;." :: String) = x:go xs | otherwise = "ux" ++ printf "%x" (ord x) ++ go xs -- | Puts contents into LaTeX command. @@ -369,7 +368,7 @@ toSlides bs = do opts <- gets stOptions let slideLevel = fromMaybe (getSlideLevel bs) $ writerSlideLevel opts let bs' = prepSlides slideLevel bs - concat `fmap` (mapM (elementToBeamer slideLevel) $ hierarchicalize bs') + concat `fmap` mapM (elementToBeamer slideLevel) (hierarchicalize bs') elementToBeamer :: PandocMonad m => Int -> Element -> LW m [Block] elementToBeamer _slideLevel (Blk b) = return [b] @@ -381,7 +380,7 @@ elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts) : bs ++ [RawBlock "latex" "\\end{block}"] | lvl < slideLevel = do bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts - return $ (Header lvl (ident,classes,kvs) tit) : bs + return $ Header lvl (ident,classes,kvs) tit : bs | otherwise = do -- lvl == slideLevel -- note: [fragile] is required or verbatim breaks let hasCodeBlock (CodeBlock _ _) = [True] @@ -480,8 +479,8 @@ blockToLaTeX (Div (identifier,classes,kvs) bs) = do wrapNotes txt = if beamer && "notes" `elem` classes then "\\note" <> braces txt -- speaker notes else linkAnchor $$ txt - fmap (wrapColumns . wrapColumn . wrapDir . wrapLang . wrapNotes) - $ blockListToLaTeX bs + (wrapColumns . wrapColumn . wrapDir . wrapLang . wrapNotes) + <$> blockListToLaTeX bs blockToLaTeX (Plain lst) = inlineListToLaTeX $ dropWhile isLineBreakOrSpace lst -- title beginning with fig: indicates that the image is a figure @@ -517,7 +516,7 @@ blockToLaTeX (Para [Str ".",Space,Str ".",Space,Str "."]) = do else inlineListToLaTeX [Str ".",Space,Str ".",Space,Str "."] blockToLaTeX (Para lst) = inlineListToLaTeX $ dropWhile isLineBreakOrSpace lst -blockToLaTeX (LineBlock lns) = do +blockToLaTeX (LineBlock lns) = blockToLaTeX $ linesToPara lns blockToLaTeX (BlockQuote lst) = do beamer <- gets stBeamer @@ -645,12 +644,11 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do Example -> "1" DefaultStyle -> "1" let enum = text $ "enum" ++ map toLower (toRomanNumeral oldlevel) - let stylecommand = if numstyle == DefaultStyle && numdelim == DefaultDelim - then empty - else if beamer - then brackets (todelim exemplar) - else "\\def" <> "\\label" <> enum <> - braces (todelim $ tostyle enum) + let stylecommand + | numstyle == DefaultStyle && numdelim == DefaultDelim = empty + | beamer = brackets (todelim exemplar) + | otherwise = "\\def" <> "\\label" <> enum <> + braces (todelim $ tostyle enum) let resetcounter = if start == 1 || oldlevel > 4 then empty else "\\setcounter" <> braces enum <> @@ -674,7 +672,8 @@ blockToLaTeX (DefinitionList lst) = do else empty return $ text ("\\begin{description}" ++ inc) $$ spacing $$ vcat items $$ "\\end{description}" -blockToLaTeX HorizontalRule = return $ +blockToLaTeX HorizontalRule = + return "\\begin{center}\\rule{0.5\\linewidth}{\\linethickness}\\end{center}" blockToLaTeX (Header level (id',classes,_) lst) = do modify $ \s -> s{stInHeading = True} @@ -682,7 +681,7 @@ blockToLaTeX (Header level (id',classes,_) lst) = do modify $ \s -> s{stInHeading = False} return hdr blockToLaTeX (Table caption aligns widths heads rows) = do - let toHeaders hs = do contents <- (tableRowToLaTeX True aligns widths) hs + let toHeaders hs = do contents <- tableRowToLaTeX True aligns widths hs return ("\\toprule" $$ contents $$ "\\midrule") let removeNote (Note _) = Span ("", [], []) [] removeNote x = x @@ -702,7 +701,7 @@ blockToLaTeX (Table caption aligns widths heads rows) = do else text "\\caption" <> braces captionText <> "\\tabularnewline" rows' <- mapM (tableRowToLaTeX False aligns widths) rows - let colDescriptors = text $ concat $ map toColDescriptor aligns + let colDescriptors = text $ concatMap toColDescriptor aligns modify $ \s -> s{ stTable = True } return $ "\\begin{longtable}[]" <> braces ("@{}" <> colDescriptors <> "@{}") @@ -812,10 +811,10 @@ 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 = - blockListToLaTeX lst >>= return . (text "\\item ~" $$) . (nest 2) + | (Header _ _ _ :_) <- lst = + blockListToLaTeX lst >>= return . (text "\\item ~" $$) . nest 2 | otherwise = blockListToLaTeX lst >>= return . (text "\\item" $$) . - (nest 2) + nest 2 defListItemToLaTeX :: PandocMonad m => ([Inline], [[Block]]) -> LW m Doc defListItemToLaTeX (term, defs) = do @@ -832,7 +831,7 @@ defListItemToLaTeX (term, defs) = do else term' def' <- liftM vsep $ mapM blockListToLaTeX defs return $ case defs of - (((Header _ _ _) : _) : _) -> + ((Header _ _ _ : _) : _) -> "\\item" <> brackets term'' <> " ~ " $$ def' _ -> "\\item" <> brackets term'' $$ def' @@ -849,16 +848,16 @@ 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 -- footnotes in sections don't work (except for starred variants) -- unless you specify an optional argument: -- \section[mysec]{mysec\footnote{blah}} - optional <- if unnumbered || lstNoNotes == lst || lstNoNotes == [] + optional <- if unnumbered || lstNoNotes == lst || null lstNoNotes then return empty - else do + else return $ brackets txtNoNotes let contents = if render Nothing txt == plain then braces txt @@ -983,7 +982,7 @@ inlineToLaTeX (Strikeout lst) = do return $ inCmd "sout" contents inlineToLaTeX (Superscript lst) = inlineListToLaTeX lst >>= return . inCmd "textsuperscript" -inlineToLaTeX (Subscript lst) = do +inlineToLaTeX (Subscript lst) = inlineListToLaTeX lst >>= return . inCmd "textsubscript" inlineToLaTeX (SmallCaps lst) = inlineListToLaTeX lst >>= return . inCmd "textsc" @@ -1018,7 +1017,7 @@ inlineToLaTeX (Code (_,classes,_) str) = do $ stringToLaTeX CodeString str where escapeSpaces = concatMap (\c -> if c == ' ' then "\\ " else [c]) - let highlightCode = do + let highlightCode = case highlight (writerSyntaxMap opts) formatLaTeXInline ("",classes,[]) str of Left msg -> do @@ -1038,10 +1037,10 @@ inlineToLaTeX (Quoted qt lst) = do if csquotes then return $ "\\enquote" <> braces contents else do - let s1 = if (not (null lst)) && (isQuoted (head lst)) + let s1 = if not (null lst) && isQuoted (head lst) then "\\," else empty - let s2 = if (not (null lst)) && (isQuoted (last lst)) + let s2 = if not (null lst) && isQuoted (last lst) then "\\," else empty let inner = s1 <> contents <> s2 @@ -1071,7 +1070,7 @@ inlineToLaTeX il@(RawInline f str) | otherwise = do report $ InlineNotRendered il return empty -inlineToLaTeX (LineBreak) = do +inlineToLaTeX LineBreak = do emptyLine <- gets stEmptyLine setEmptyLine True return $ (if emptyLine then "~" else "") <> "\\\\" <> cr @@ -1111,7 +1110,7 @@ inlineToLaTeX (Image attr _ (source, _)) = do modify $ \s -> s{ stGraphics = True } opts <- gets stOptions let showDim dir = let d = text (show dir) <> "=" - in case (dimension dir attr) of + in case dimension dir attr of Just (Pixel a) -> [d <> text (showInInch opts (Pixel a)) <> "in"] Just (Percent a) -> @@ -1165,7 +1164,8 @@ setEmptyLine :: PandocMonad m => Bool -> LW m () setEmptyLine b = modify $ \st -> st{ stEmptyLine = b } citationsToNatbib :: PandocMonad m => [Citation] -> LW m Doc -citationsToNatbib (one:[]) +citationsToNatbib + [one] = citeCommand c p s k where Citation { citationId = k @@ -1185,9 +1185,11 @@ citationsToNatbib cits where noPrefix = all (null . citationPrefix) noSuffix = all (null . citationSuffix) - ismode m = all (((==) m) . citationMode) - p = citationPrefix $ head $ cits - s = citationSuffix $ last $ cits + ismode m = all ((==) m . citationMode) + p = citationPrefix $ + head cits + s = citationSuffix $ + last cits ks = intercalate ", " $ map citationId cits citationsToNatbib (c:cs) | citationMode c == AuthorInText = do @@ -1221,7 +1223,8 @@ citeArguments :: PandocMonad m => [Inline] -> [Inline] -> String -> LW m Doc citeArguments p s k = do let s' = case s of - (Str (x:[]) : r) | isPunctuation x -> dropWhile (== Space) r + (Str + [x] : r) | isPunctuation x -> dropWhile (== Space) r (Str (x:xs) : r) | isPunctuation x -> Str xs : r _ -> s pdoc <- inlineListToLaTeX p @@ -1233,7 +1236,8 @@ citeArguments p s k = do return $ optargs <> braces (text k) citationsToBiblatex :: PandocMonad m => [Citation] -> LW m Doc -citationsToBiblatex (one:[]) +citationsToBiblatex + [one] = citeCommand cmd p s k where Citation { citationId = k @@ -1264,8 +1268,8 @@ citationsToBiblatex _ = return empty -- Determine listings language from list of class attributes. getListingsLanguage :: [String] -> Maybe String -getListingsLanguage [] = Nothing -getListingsLanguage (x:xs) = toListingsLanguage x <|> getListingsLanguage xs +getListingsLanguage xs + = foldr ((<|>) . toListingsLanguage) Nothing xs mbBraced :: String -> String mbBraced x = if not (all isAlphaNum x) diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 40c0dd815..cd7a98d43 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -104,8 +104,7 @@ pandocToMan opts (Pandoc meta blocks) = do $ setFieldsFromTitle $ defField "has-tables" hasTables $ defField "hyphenate" True - $ defField "pandoc-version" pandocVersion - $ metadata + $ defField "pandoc-version" pandocVersion metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -115,7 +114,7 @@ notesToMan :: PandocMonad m => WriterOptions -> [[Block]] -> StateT WriterState notesToMan opts notes = if null notes then return empty - else mapM (\(num, note) -> noteToMan opts num note) (zip [1..] notes) >>= + else mapM (uncurry (noteToMan opts)) (zip [1..] notes) >>= return . (text ".SH NOTES" $$) . vcat -- | Return man representation of a note. @@ -141,7 +140,7 @@ escapeString = escapeStringUsing manEscapes -- | Escape a literal (code) section for Man. escapeCode :: String -> String -escapeCode = concat . intersperse "\n" . map escapeLine . lines where +escapeCode = intercalate "\n" . map escapeLine . lines where escapeLine codeline = case escapeStringUsing (manEscapes ++ backslashEscapes "\t ") codeline of a@('.':_) -> "\\&" ++ a @@ -157,7 +156,7 @@ breakSentence [] = ([],[]) breakSentence xs = let isSentenceEndInline (Str ys@(_:_)) | last ys == '.' = True isSentenceEndInline (Str ys@(_:_)) | last ys == '?' = True - isSentenceEndInline (LineBreak) = True + isSentenceEndInline LineBreak = True isSentenceEndInline _ = False (as, bs) = break isSentenceEndInline xs in case bs of @@ -226,12 +225,12 @@ blockToMan opts (Table caption alignments widths headers rows) = then repeat "" else map (printf "w(%0.1fn)" . (70 *)) widths -- 78n default width - 8n indent = 70n - let coldescriptions = text $ intercalate " " + let coldescriptions = text $ unwords (zipWith (\align width -> aligncode align ++ width) alignments iwidths) ++ "." colheadings <- mapM (blockListToMan opts) headers let makeRow cols = text "T{" $$ - (vcat $ intersperse (text "T}@T{") cols) $$ + vcat (intersperse (text "T}@T{") cols) $$ text "T}" let colheadings' = if all null headers then empty @@ -248,7 +247,8 @@ blockToMan opts (BulletList items) = do return (vcat contents) blockToMan opts (OrderedList attribs items) = do let markers = take (length items) $ orderedListMarkers attribs - let indent = 1 + (maximum $ map length markers) + let indent = 1 + + maximum (map length markers) contents <- mapM (\(num, item) -> orderedListItemToMan opts num indent item) $ zip markers items return (vcat contents) @@ -259,9 +259,9 @@ blockToMan opts (DefinitionList items) = do -- | Convert bullet list item (list of blocks) to man. bulletListItemToMan :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m Doc bulletListItemToMan _ [] = return empty -bulletListItemToMan opts ((Para first):rest) = - bulletListItemToMan opts ((Plain first):rest) -bulletListItemToMan opts ((Plain first):rest) = do +bulletListItemToMan opts (Para first:rest) = + bulletListItemToMan opts (Plain first:rest) +bulletListItemToMan opts (Plain first:rest) = do first' <- blockToMan opts (Plain first) rest' <- blockListToMan opts rest let first'' = text ".IP \\[bu] 2" $$ first' @@ -282,8 +282,8 @@ orderedListItemToMan :: PandocMonad m -> [Block] -- ^ list item (list of blocks) -> StateT WriterState m Doc orderedListItemToMan _ _ _ [] = return empty -orderedListItemToMan opts num indent ((Para first):rest) = - orderedListItemToMan opts num indent ((Plain first):rest) +orderedListItemToMan opts num indent (Para first:rest) = + orderedListItemToMan opts num indent (Plain first:rest) orderedListItemToMan opts num indent (first:rest) = do first' <- blockToMan opts first rest' <- blockListToMan opts rest @@ -332,9 +332,9 @@ inlineListToMan opts lst = mapM (inlineToMan opts) lst >>= (return . hcat) -- | Convert Pandoc inline element to man. inlineToMan :: PandocMonad m => WriterOptions -> Inline -> StateT WriterState m Doc inlineToMan opts (Span _ ils) = inlineListToMan opts ils -inlineToMan opts (Emph lst) = do +inlineToMan opts (Emph lst) = withFontFeature 'I' (inlineListToMan opts lst) -inlineToMan opts (Strong lst) = do +inlineToMan opts (Strong lst) = withFontFeature 'B' (inlineListToMan opts lst) inlineToMan opts (Strikeout lst) = do contents <- inlineListToMan opts lst @@ -382,7 +382,7 @@ inlineToMan opts (Link _ txt (src, _)) = do char '<' <> text srcSuffix <> char '>' _ -> linktext <> text " (" <> text src <> char ')' inlineToMan opts (Image attr alternate (source, tit)) = do - let txt = if (null alternate) || (alternate == [Str ""]) || + let txt = if null alternate || (alternate == [Str ""]) || (alternate == [Str source]) -- to prevent autolinks then [Str "image"] else alternate @@ -392,7 +392,7 @@ inlineToMan _ (Note contents) = do -- add to notes in state modify $ \st -> st{ stNotes = contents : stNotes st } notes <- gets stNotes - let ref = show $ (length notes) + let ref = show (length notes) return $ char '[' <> text ref <> char ']' fontChange :: PandocMonad m => StateT WriterState m Doc diff --git a/src/Text/Pandoc/Writers/Math.hs b/src/Text/Pandoc/Writers/Math.hs index 61358378b..477f5a0b1 100644 --- a/src/Text/Pandoc/Writers/Math.hs +++ b/src/Text/Pandoc/Writers/Math.hs @@ -22,7 +22,7 @@ texMathToInlines mt inp = do res <- convertMath writePandoc mt inp case res of Right (Just ils) -> return ils - Right (Nothing) -> do + Right Nothing -> do report $ CouldNotConvertTeXMath inp "" return [mkFallback mt inp] Left il -> return [il] @@ -39,7 +39,7 @@ mkFallback mt str = Str (delim ++ str ++ delim) convertMath :: PandocMonad m => (DisplayType -> [Exp] -> a) -> MathType -> String -> m (Either Inline a) -convertMath writer mt str = do +convertMath writer mt str = case writer dt <$> readTeX str of Right r -> return (Right r) Left e -> do diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs index 68c0d6096..9e3036753 100644 --- a/src/Text/Pandoc/Writers/Ms.hs +++ b/src/Text/Pandoc/Writers/Ms.hs @@ -121,15 +121,14 @@ pandocToMs opts (Pandoc meta blocks) = do $ defField "toc" (writerTableOfContents opts) $ defField "title-meta" titleMeta $ defField "author-meta" (intercalate "; " authorsMeta) - $ defField "highlighting-macros" highlightingMacros - $ metadata + $ defField "highlighting-macros" highlightingMacros metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context -- | Association list of characters to escape. msEscapes :: Map.Map Char String -msEscapes = Map.fromList $ +msEscapes = Map.fromList [ ('\160', "\\~") , ('\'', "\\[aq]") , ('`', "\\`") @@ -146,9 +145,7 @@ msEscapes = Map.fromList $ ] escapeChar :: Char -> String -escapeChar c = case Map.lookup c msEscapes of - Just s -> s - Nothing -> [c] +escapeChar c = fromMaybe [c] (Map.lookup c msEscapes) -- | Escape | character, used to mark inline math, inside math. escapeBar :: String -> String @@ -175,7 +172,7 @@ toSmallCaps (c:cs) -- | Escape a literal (code) section for Ms. escapeCode :: String -> String -escapeCode = concat . intersperse "\n" . map escapeLine . lines +escapeCode = intercalate "\n" . map escapeLine . lines where escapeCodeChar ' ' = "\\ " escapeCodeChar '\t' = "\\\t" escapeCodeChar c = escapeChar c @@ -194,7 +191,7 @@ breakSentence [] = ([],[]) breakSentence xs = let isSentenceEndInline (Str ys@(_:_)) | last ys == '.' = True isSentenceEndInline (Str ys@(_:_)) | last ys == '?' = True - isSentenceEndInline (LineBreak) = True + isSentenceEndInline LineBreak = True isSentenceEndInline _ = False (as, bs) = break isSentenceEndInline xs in case bs of @@ -283,11 +280,11 @@ blockToMs opts (Header level (ident,classes,_) inlines) = do level <= writerTOCDepth opts then text ".XS" $$ backlink <> doubleQuotes ( - nowrap ((text (replicate level '\t') <> + nowrap (text (replicate level '\t') <> (if null secnum then empty else text secnum <> text "\\~\\~") - <> contents))) + <> contents)) $$ text ".XE" else empty modify $ \st -> st{ stFirstPara = True } @@ -325,12 +322,12 @@ blockToMs opts (Table caption alignments widths headers rows) = then repeat "" else map (printf "w(%0.1fn)" . (70 *)) widths -- 78n default width - 8n indent = 70n - let coldescriptions = text $ intercalate " " + let coldescriptions = text $ unwords (zipWith (\align width -> aligncode align ++ width) alignments iwidths) ++ "." colheadings <- mapM (blockListToMs opts) headers let makeRow cols = text "T{" $$ - (vcat $ intersperse (text "T}\tT{") cols) $$ + vcat (intersperse (text "T}\tT{") cols) $$ text "T}" let colheadings' = if all null headers then empty @@ -349,7 +346,8 @@ blockToMs opts (BulletList items) = do return (vcat contents) blockToMs opts (OrderedList attribs items) = do let markers = take (length items) $ orderedListMarkers attribs - let indent = 2 + (maximum $ map length markers) + let indent = 2 + + maximum (map length markers) contents <- mapM (\(num, item) -> orderedListItemToMs opts num indent item) $ zip markers items setFirstPara @@ -362,9 +360,9 @@ blockToMs opts (DefinitionList items) = do -- | Convert bullet list item (list of blocks) to ms. bulletListItemToMs :: PandocMonad m => WriterOptions -> [Block] -> MS m Doc bulletListItemToMs _ [] = return empty -bulletListItemToMs opts ((Para first):rest) = - bulletListItemToMs opts ((Plain first):rest) -bulletListItemToMs opts ((Plain first):rest) = do +bulletListItemToMs opts (Para first:rest) = + bulletListItemToMs opts (Plain first:rest) +bulletListItemToMs opts (Plain first:rest) = do first' <- blockToMs opts (Plain first) rest' <- blockListToMs opts rest let first'' = text ".IP \\[bu] 3" $$ first' @@ -385,8 +383,8 @@ orderedListItemToMs :: PandocMonad m -> [Block] -- ^ list item (list of blocks) -> MS m Doc orderedListItemToMs _ _ _ [] = return empty -orderedListItemToMs opts num indent ((Para first):rest) = - orderedListItemToMs opts num indent ((Plain first):rest) +orderedListItemToMs opts num indent (Para first:rest) = + orderedListItemToMs opts num indent (Plain first:rest) orderedListItemToMs opts num indent (first:rest) = do first' <- blockToMs opts first rest' <- blockListToMs opts rest @@ -409,7 +407,7 @@ definitionListItemToMs opts (label, defs) = do then return empty else liftM vcat $ forM defs $ \blocks -> do let (first, rest) = case blocks of - ((Para x):y) -> (Plain x,y) + (Para x:y) -> (Plain x,y) (x:y) -> (x,y) [] -> (Plain [], []) -- should not happen @@ -503,7 +501,7 @@ inlineToMs _ il@(RawInline f str) | otherwise = do report $ InlineNotRendered il return empty -inlineToMs _ (LineBreak) = return $ cr <> text ".br" <> cr +inlineToMs _ LineBreak = return $ cr <> text ".br" <> cr inlineToMs opts SoftBreak = handleNotes opts $ case writerWrapText opts of @@ -539,8 +537,7 @@ handleNotes opts fallback = do then return fallback else do modify $ \st -> st{ stNotes = [] } - res <- vcat <$> mapM (handleNote opts) notes - return res + vcat <$> mapM (handleNote opts) notes handleNote :: PandocMonad m => WriterOptions -> Note -> MS m Doc handleNote opts bs = do @@ -589,7 +586,7 @@ styleToMs sty = vcat $ colordefs ++ map (toMacro sty) alltoktypes allcolors = catMaybes $ ordNub $ [defaultColor sty, backgroundColor sty, lineNumberColor sty, lineNumberBackgroundColor sty] ++ - concatMap colorsForToken (map snd (tokenStyles sty)) + concatMap (colorsForToken. snd) (tokenStyles sty) colorsForToken ts = [tokenColor ts, tokenBackground ts] hexColor :: Color -> String diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs index c934fe4d9..1fb685985 100644 --- a/src/Text/Pandoc/Writers/Native.hs +++ b/src/Text/Pandoc/Writers/Native.hs @@ -39,7 +39,8 @@ import Text.Pandoc.Pretty prettyList :: [Doc] -> Doc prettyList ds = - "[" <> (cat $ intersperse (cr <> ",") $ map (nest 1) ds) <> "]" + "[" <> + cat (intersperse (cr <> ",") $ map (nest 1) ds) <> "]" -- | Prettyprint Pandoc block element. prettyBlock :: Block -> Doc @@ -49,12 +50,12 @@ prettyBlock (BlockQuote blocks) = "BlockQuote" $$ prettyList (map prettyBlock blocks) prettyBlock (OrderedList attribs blockLists) = "OrderedList" <> space <> text (show attribs) $$ - (prettyList $ map (prettyList . map prettyBlock) blockLists) + prettyList (map (prettyList . map prettyBlock) blockLists) prettyBlock (BulletList blockLists) = "BulletList" $$ - (prettyList $ map (prettyList . map prettyBlock) blockLists) + prettyList (map (prettyList . map prettyBlock) blockLists) prettyBlock (DefinitionList items) = "DefinitionList" $$ - (prettyList $ map deflistitem items) + prettyList (map deflistitem items) where deflistitem (term, defs) = "(" <> text (show term) <> "," <> cr <> nest 1 (prettyList $ map (prettyList . map prettyBlock) defs) <> ")" prettyBlock (Table caption aligns widths header rows) = diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 32fcb0292..fcd551227 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -89,7 +89,7 @@ pandocToODT opts doc@(Pandoc meta _) = do -- picEntriesRef <- P.newIORef ([] :: [Entry]) doc' <- walkM (transformPicMath opts) $ walk fixDisplayMath doc newContents <- lift $ writeOpenDocument opts{writerWrapText = WrapNone} doc' - epochtime <- floor `fmap` (lift P.getPOSIXTime) + epochtime <- floor `fmap` lift P.getPOSIXTime let contentEntry = toEntry "content.xml" epochtime $ fromTextLazy $ TL.fromStrict newContents picEntries <- gets stEntries @@ -111,10 +111,9 @@ pandocToODT opts doc@(Pandoc meta _) = do $ fromStringLazy $ render Nothing $ text "" $$ - ( inTags True "manifest:manifest" + (inTags True "manifest:manifest" [("xmlns:manifest","urn:oasis:names:tc:opendocument:xmlns:manifest:1.0") - ,("manifest:version","1.2")] - $ ( selfClosingTag "manifest:file-entry" + ,("manifest:version","1.2")] ( selfClosingTag "manifest:file-entry" [("manifest:media-type","application/vnd.oasis.opendocument.text") ,("manifest:full-path","/")] $$ vcat ( map toFileEntry $ files ) @@ -126,15 +125,14 @@ pandocToODT opts doc@(Pandoc meta _) = do $ fromStringLazy $ render Nothing $ text "" $$ - ( inTags True "office:document-meta" + (inTags True "office:document-meta" [("xmlns:office","urn:oasis:names:tc:opendocument:xmlns:office:1.0") ,("xmlns:xlink","http://www.w3.org/1999/xlink") ,("xmlns:dc","http://purl.org/dc/elements/1.1/") ,("xmlns:meta","urn:oasis:names:tc:opendocument:xmlns:meta:1.0") ,("xmlns:ooo","http://openoffice.org/2004/office") ,("xmlns:grddl","http://www.w3.org/2003/g/data-view#") - ,("office:version","1.2")] - $ ( inTagsSimple "office:meta" $ + ,("office:version","1.2")] ( inTagsSimple "office:meta" $ ( inTagsSimple "dc:title" (text $ escapeStringForXML (stringify title)) $$ @@ -156,7 +154,7 @@ pandocToODT opts doc@(Pandoc meta _) = do updateStyleWithLang :: PandocMonad m => Maybe Lang -> Archive -> O m Archive updateStyleWithLang Nothing arch = return arch updateStyleWithLang (Just lang) arch = do - epochtime <- floor `fmap` (lift P.getPOSIXTime) + epochtime <- floor `fmap` lift P.getPOSIXTime return arch{ zEntries = [if eRelativePath e == "styles.xml" then case parseXMLDoc (toStringLazy (fromEntry e)) of @@ -196,7 +194,7 @@ transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = catchError _ -> [("width", show ptX ++ "pt"), ("height", show ptY ++ "pt")] where ratio = ptX / ptY - getDim dir = case (dimension dir attr) of + getDim dir = case dimension dir attr of Just (Percent i) -> Just $ Percent i Just dim -> Just $ Inch $ inInch opts dim Nothing -> Nothing @@ -206,7 +204,7 @@ transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = catchError (mbMimeType >>= extensionFromMimeType) let newsrc = "Pictures/" ++ show (length entries) <.> extension let toLazy = B.fromChunks . (:[]) - epochtime <- floor `fmap` (lift P.getPOSIXTime) + epochtime <- floor `fmap` lift P.getPOSIXTime let entry = toEntry newsrc epochtime $ toLazy img modify $ \st -> st{ stEntries = entry : entries } return $ Image newattr lab (newsrc, t)) @@ -222,7 +220,7 @@ transformPicMath _ (Math t math) = do Right r -> do let conf = useShortEmptyTags (const False) defaultConfigPP let mathml = ppcTopElement conf r - epochtime <- floor `fmap` (lift $ P.getPOSIXTime) + epochtime <- floor `fmap` (lift P.getPOSIXTime) let dirname = "Formula-" ++ show (length entries) ++ "/" let fname = dirname ++ "content.xml" let entry = toEntry fname epochtime (fromStringLazy mathml) diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs index 52577ac17..3a2467c65 100644 --- a/src/Text/Pandoc/Writers/OPML.hs +++ b/src/Text/Pandoc/Writers/OPML.hs @@ -56,9 +56,9 @@ writeOPML opts (Pandoc meta blocks) = do meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta metadata <- metaToJSON opts (writeMarkdown def . Pandoc nullMeta) - (\ils -> T.stripEnd <$> (writeMarkdown def $ Pandoc nullMeta [Plain ils])) + (\ils -> T.stripEnd <$> writeMarkdown def (Pandoc nullMeta [Plain ils])) meta' - main <- (render colwidth . vcat) <$> (mapM (elementToOPML opts) elements) + main <- (render colwidth . vcat) <$> mapM (elementToOPML opts) elements let context = defField "body" main metadata case writerTemplate opts of Nothing -> return main @@ -67,7 +67,7 @@ writeOPML opts (Pandoc meta blocks) = do writeHtmlInlines :: PandocMonad m => [Inline] -> m Text writeHtmlInlines ils = - T.strip <$> (writeHtml5String def $ Pandoc nullMeta [Plain ils]) + T.strip <$> writeHtml5String def (Pandoc nullMeta [Plain ils]) -- date format: RFC 822: Thu, 14 Jul 2005 23:41:05 GMT showDateTimeRFC822 :: UTCTime -> String @@ -80,7 +80,7 @@ convertDate ils = maybe "" showDateTimeRFC822 $ #else parseTime #endif - defaultTimeLocale "%F" =<< (normalizeDate $ stringify ils) + defaultTimeLocale "%F" =<< normalizeDate (stringify ils) -- | Convert an Element to OPML. elementToOPML :: PandocMonad m => WriterOptions -> Element -> m Doc @@ -100,7 +100,7 @@ elementToOPML opts (Sec _ _num _ title elements) = do then return mempty else do blks <- mapM fromBlk blocks writeMarkdown def $ Pandoc nullMeta blks - let attrs = [("text", unpack htmlIls)] ++ + let attrs = ("text", unpack htmlIls) : [("_note", unpack md) | not (null blocks)] o <- mapM (elementToOPML opts) rest return $ inTags True "outline" attrs $ vcat o diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 04cae0b4b..ac4a85670 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -117,7 +117,7 @@ increaseIndent :: PandocMonad m => OD m () increaseIndent = modify $ \s -> s { stIndentPara = 1 + stIndentPara s } resetIndent :: PandocMonad m => OD m () -resetIndent = modify $ \s -> s { stIndentPara = (stIndentPara s) - 1 } +resetIndent = modify $ \s -> s { stIndentPara = stIndentPara s - 1 } inTightList :: PandocMonad m => OD m a -> OD m a inTightList f = modify (\s -> s { stTight = True }) >> f >>= \r -> @@ -135,7 +135,7 @@ inParagraphTags d = do b <- gets stFirstPara a <- if b then do modify $ \st -> st { stFirstPara = False } - return $ [("text:style-name", "First_20_paragraph")] + return [("text:style-name", "First_20_paragraph")] else return [("text:style-name", "Text_20_body")] return $ inTags False "text:p" a d @@ -213,16 +213,15 @@ writeOpenDocument opts (Pandoc meta blocks) = do b <- render' `fmap` blocksToOpenDocument opts blocks return (b, m) let styles = stTableStyles s ++ stParaStyles s ++ - map snd (reverse $ sortBy (comparing fst) $ - Map.elems (stTextStyles s)) + map snd (sortBy (flip (comparing fst)) ( + Map.elems (stTextStyles s))) listStyle (n,l) = inTags True "text:list-style" [("style:name", "L" ++ show n)] (vcat l) let listStyles = map listStyle (stListStyles s) let automaticStyles = vcat $ reverse $ styles ++ listStyles let context = defField "body" body $ defField "toc" (writerTableOfContents opts) - $ defField "automatic-styles" (render' automaticStyles) - $ metadata + $defField "automatic-styles" (render' automaticStyles) metadata case writerTemplate opts of Nothing -> return body Just tpl -> renderTemplate' tpl context @@ -297,7 +296,7 @@ deflistItemToOpenDocument o (t,d) = do ds = if isTightList d then "Definition_20_Definition_20_Tight" else "Definition_20_Definition" t' <- withParagraphStyle o ts [Para t] - d' <- liftM vcat $ mapM (withParagraphStyle o ds . (map plainToPara)) d + d' <- liftM vcat $ mapM (withParagraphStyle o ds . map plainToPara) d return $ t' $$ d' inBlockQuote :: PandocMonad m @@ -307,8 +306,8 @@ inBlockQuote o i (b:bs) ni <- paraStyle [("style:parent-style-name","Quotations")] go =<< inBlockQuote o ni (map plainToPara l) - | Para l <- b = do go =<< inParagraphTagsWithStyle ("P" ++ show i) <$> inlinesToOpenDocument o l - | otherwise = do go =<< blockToOpenDocument o b + | Para l <- b = go =<< inParagraphTagsWithStyle ("P" ++ show i) <$> inlinesToOpenDocument o l + | otherwise = go =<< blockToOpenDocument o b where go block = ($$) block <$> inBlockQuote o i bs inBlockQuote _ _ [] = resetIndent >> return empty @@ -446,7 +445,7 @@ inlineToOpenDocument o ils SoftBreak | writerWrapText o == WrapPreserve -> return $ preformatted "\n" - | otherwise -> return $ space + | otherwise ->return space Span attr xs -> withLangFromAttr attr (inlinesToOpenDocument o xs) LineBreak -> return $ selfClosingTag "text:line-break" [] Str s -> return $ handleSpaces $ escapeStringForXML s @@ -556,7 +555,7 @@ tableStyle num wcs = [ ("style:name" , tableId ++ "." ++ [c]) , ("style:family", "table-column" )] $ selfClosingTag "style:table-column-properties" - [("style:rel-column-width", printf "%d*" $ (floor $ w * 65535 :: Integer))] + [("style:rel-column-width", printf "%d*" (floor $ w * 65535 :: Integer))] cellStyle = inTags True "style:style" [ ("style:name" , tableId ++ ".A1") , ("style:family", "table-cell" )] $ @@ -584,8 +583,10 @@ paraStyle attrs = do , ("style:auto-text-indent" , "false" )] else [] attributes = indent ++ tight - paraProps = when (not $ null attributes) $ - selfClosingTag "style:paragraph-properties" attributes + paraProps = if null attributes + then mempty + else selfClosingTag + "style:paragraph-properties" attributes addParaStyle $ inTags True "style:style" (styleAttr ++ attrs) paraProps return pn @@ -643,7 +644,7 @@ withLangFromAttr :: PandocMonad m => Attr -> OD m a -> OD m a withLangFromAttr (_,_,kvs) action = case lookup "lang" kvs of Nothing -> action - Just l -> do + Just l -> case parseBCP47 l of Right lang -> withTextStyle (Language lang) action Left _ -> do diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index cfbacdaed..6c6010880 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -97,15 +97,14 @@ pandocToRST (Pandoc meta blocks) = do pics <- gets (reverse . stImages) >>= pictRefsToRST hasMath <- gets stHasMath rawTeX <- gets stHasRawTeX - let main = render' $ foldl ($+$) empty $ [body, notes, refs, pics] + let main = render' $ foldl ($+$) empty [body, notes, refs, pics] let context = defField "body" main $ defField "toc" (writerTableOfContents opts) $ defField "toc-depth" (show $ writerTOCDepth opts) $ defField "math" hasMath $ defField "title" (render Nothing title :: String) $ defField "math" hasMath - $ defField "rawtex" rawTeX - $ metadata + $ defField "rawtex" rawTeX metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -126,7 +125,7 @@ refsToRST refs = mapM keyToRST refs >>= return . vcat keyToRST :: PandocMonad m => ([Inline], (String, String)) -> RST m Doc keyToRST (label, (src, _)) = do label' <- inlineListToRST label - let label'' = if ':' `elem` ((render Nothing label') :: String) + let label'' = if ':' `elem` (render Nothing label' :: String) then char '`' <> label' <> char '`' else label' return $ nowrap $ ".. _" <> label'' <> ": " <> text src @@ -134,7 +133,7 @@ keyToRST (label, (src, _)) = do -- | Return RST representation of notes. notesToRST :: PandocMonad m => [[Block]] -> RST m Doc notesToRST notes = - mapM (\(num, note) -> noteToRST num note) (zip [1..] notes) >>= + mapM (uncurry noteToRST) (zip [1..] notes) >>= return . vsep -- | Return RST representation of a note. @@ -226,7 +225,7 @@ blockToRST (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do else ":figclass: " <> text (unwords cls) return $ hang 3 ".. " (fig $$ alt $$ classes $$ dims $+$ capt) $$ blankline blockToRST (Para inlines) - | LineBreak `elem` inlines = do -- use line block if LineBreaks + | LineBreak `elem` inlines = linesToLineBlock $ splitBy (==LineBreak) inlines | otherwise = do contents <- inlineListToRST inlines @@ -237,7 +236,7 @@ blockToRST (RawBlock f@(Format f') str) | f == "rst" = return $ text str | otherwise = return $ blankline <> ".. raw:: " <> text (map toLower f') $+$ - (nest 3 $ text str) $$ blankline + nest 3 (text str) $$ blankline blockToRST HorizontalRule = return $ blankline $$ "--------------" $$ blankline blockToRST (Header level (name,classes,_) inlines) = do @@ -279,7 +278,7 @@ blockToRST (CodeBlock (_,classes,kvs) str) = do blockToRST (BlockQuote blocks) = do tabstop <- gets $ writerTabStop . stOptions contents <- blockListToRST blocks - return $ (nest tabstop contents) <> blankline + return $ nest tabstop contents <> blankline blockToRST (Table caption aligns widths headers rows) = do caption' <- inlineListToRST caption let blocksToDoc opts bs = do @@ -302,13 +301,13 @@ blockToRST (BulletList items) = do return $ blankline $$ chomp (vcat contents) $$ blankline blockToRST (OrderedList (start, style', delim) items) = do let markers = if start == 1 && style' == DefaultStyle && delim == DefaultDelim - then take (length items) $ repeat "#." + then replicate (length items) "#." else take (length items) $ orderedListMarkers (start, style', delim) let maxMarkerLength = maximum $ map length markers let markers' = map (\m -> let s = maxMarkerLength - length m in m ++ replicate s ' ') markers - contents <- mapM (\(item, num) -> orderedListItemToRST item num) $ + contents <- mapM (uncurry orderedListItemToRST) $ zip markers' items -- ensure that sublists have preceding blank line return $ blankline $$ chomp (vcat contents) $$ blankline @@ -345,7 +344,8 @@ definitionListItemToRST (label, defs) = do linesToLineBlock :: PandocMonad m => [[Inline]] -> RST m Doc linesToLineBlock inlineLines = do lns <- mapM inlineListToRST inlineLines - return $ (vcat $ map (hang 2 (text "| ")) lns) <> blankline + return $ + vcat (map (hang 2 (text "| ")) lns) <> blankline -- | Convert list of Pandoc block elements to RST. blockListToRST' :: PandocMonad m @@ -397,7 +397,7 @@ inlineListToRST lst = removeSpaceAfterDisplayMath [] = [] insertBS :: [Inline] -> [Inline] -- insert '\ ' where needed insertBS (x:y:z:zs) - | isComplex y && (surroundComplex x z) = + | isComplex y && surroundComplex x z = x : y : insertBS (z : zs) insertBS (x:y:zs) | isComplex x && not (okAfterComplex y) = @@ -437,8 +437,8 @@ inlineListToRST lst = isComplex (Strikeout _) = True isComplex (Superscript _) = True isComplex (Subscript _) = True - isComplex (Link _ _ _) = True - isComplex (Image _ _ _) = True + isComplex (Link{}) = True + isComplex (Image{}) = True isComplex (Code _ _) = True isComplex (Math _ _) = True isComplex (Cite _ (x:_)) = isComplex x @@ -512,7 +512,7 @@ inlineToRST il@(RawInline f x) modify $ \st -> st{ stHasRawTeX = True } return $ ":raw-latex:`" <> text x <> "`" | otherwise = empty <$ report (InlineNotRendered il) -inlineToRST (LineBreak) = return cr -- there's no line break in RST (see Para) +inlineToRST LineBreak = return cr -- there's no line break in RST (see Para) inlineToRST Space = return space inlineToRST SoftBreak = do wrapText <- gets $ writerWrapText . stOptions @@ -540,7 +540,7 @@ inlineToRST (Link _ txt (src, tit)) = do Just (src',tit') -> if src == src' && tit == tit' then return $ "`" <> linktext <> "`_" - else do -- duplicate label, use non-reference link + else return $ "`" <> linktext <> " <" <> text src <> ">`__" Nothing -> do modify $ \st -> st { stLinks = (txt,(src,tit)):refs } @@ -553,7 +553,7 @@ inlineToRST (Note contents) = do -- add to notes in state notes <- gets stNotes modify $ \st -> st { stNotes = contents:notes } - let ref = show $ (length notes) + 1 + let ref = show $ length notes + 1 return $ " [" <> text ref <> "]_" registerImage :: PandocMonad m => Attr -> [Inline] -> Target -> Maybe String -> RST m Doc @@ -578,7 +578,7 @@ imageDimsToRST attr = do then empty else ":name: " <> text ident showDim dir = let cols d = ":" <> text (show dir) <> ": " <> text (show d) - in case (dimension dir attr) of + in case dimension dir attr of Just (Percent a) -> case dir of Height -> empty diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 2b05f2f7e..917fef3eb 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -113,7 +113,7 @@ writeRTF options doc = do $ metamap metadata <- metaToJSON options (fmap concat . mapM (blockToRTF 0 AlignDefault)) - (inlinesToRTF) + inlinesToRTF meta' body <- blocksToRTF 0 AlignDefault blocks let isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options @@ -121,14 +121,13 @@ writeRTF options doc = do toc <- tableOfContents $ filter isTOCHeader blocks let context = defField "body" body $ defField "spacer" spacer - $ (if writerTableOfContents options - then defField "table-of-contents" toc - -- for backwards compatibility, - -- we populate toc with the contents - -- of the toc rather than a boolean: - . defField "toc" toc - else id) - $ metadata + $(if writerTableOfContents options + then defField "table-of-contents" toc + -- for backwards compatibility, + -- we populate toc with the contents + -- of the toc rather than a boolean: + . defField "toc" toc + else id) metadata T.pack <$> case writerTemplate options of Just tpl -> renderTemplate' tpl context @@ -141,12 +140,12 @@ writeRTF options doc = do tableOfContents :: PandocMonad m => [Block] -> m String tableOfContents headers = do let contents = map elementToListItem $ hierarchicalize headers - blocksToRTF 0 AlignDefault $ + blocksToRTF 0 AlignDefault [Header 1 nullAttr [Str "Contents"], BulletList contents] elementToListItem :: Element -> [Block] elementToListItem (Blk _) = [] -elementToListItem (Sec _ _ _ sectext subsecs) = [Plain sectext] ++ +elementToListItem (Sec _ _ _ sectext subsecs) = Plain sectext : if null subsecs then [] else [BulletList (map elementToListItem subsecs)] @@ -163,11 +162,11 @@ handleUnicode (c:cs) = lower = r + 0xDC00 in enc (chr upper) ++ enc (chr lower) ++ handleUnicode cs else enc c ++ handleUnicode cs - else c:(handleUnicode cs) + else c:handleUnicode cs where surrogate x = not ( (0x0000 <= ord x && ord x <= 0xd7ff) || (0xe000 <= ord x && ord x <= 0xffff) ) - enc x = '\\':'u':(show (ord x)) ++ "?" + enc x = '\\':'u':show (ord x) ++ "?" -- | Escape special characters. escapeSpecial :: String -> String @@ -203,8 +202,8 @@ rtfParSpaced spaceAfter indent firstLineIndent alignment content = AlignCenter -> "\\qc " AlignDefault -> "\\ql " in "{\\pard " ++ alignString ++ - "\\f0 \\sa" ++ (show spaceAfter) ++ " \\li" ++ (show indent) ++ - " \\fi" ++ (show firstLineIndent) ++ " " ++ content ++ "\\par}\n" + "\\f0 \\sa" ++ show spaceAfter ++ " \\li" ++ show indent ++ + " \\fi" ++ show firstLineIndent ++ " " ++ content ++ "\\par}\n" -- | Default paragraph. rtfPar :: Int -- ^ block indent (in twips) @@ -269,7 +268,7 @@ blockToRTF indent alignment (LineBlock lns) = blockToRTF indent alignment (BlockQuote lst) = blocksToRTF (indent + indentIncrement) alignment lst blockToRTF indent _ (CodeBlock _ str) = - return $ rtfPar indent 0 AlignLeft ("\\f1 " ++ (codeStringToRTF str)) + return $ rtfPar indent 0 AlignLeft ("\\f1 " ++ codeStringToRTF str) blockToRTF _ _ b@(RawBlock f str) | f == Format "rtf" = return str | otherwise = do @@ -279,7 +278,7 @@ blockToRTF indent alignment (BulletList lst) = (spaceAtEnd . concat) <$> mapM (listItemToRTF alignment indent (bulletMarker indent)) lst blockToRTF indent alignment (OrderedList attribs lst) = (spaceAtEnd . concat) <$> - mapM (\(x,y) -> listItemToRTF alignment indent x y) + mapM (uncurry (listItemToRTF alignment indent)) (zip (orderedMarkers indent attribs) lst) blockToRTF indent alignment (DefinitionList lst) = (spaceAtEnd . concat) <$> mapM (definitionListItemToRTF alignment indent) lst @@ -288,7 +287,7 @@ blockToRTF indent _ HorizontalRule = return $ blockToRTF indent alignment (Header level _ lst) = do contents <- inlinesToRTF lst return $ rtfPar indent 0 alignment $ - "\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ contents + "\\b \\fs" ++ show (40 - (level * 4)) ++ " " ++ contents blockToRTF indent alignment (Table caption aligns sizes headers rows) = do caption' <- inlinesToRTF caption header' <- if all null headers @@ -302,9 +301,9 @@ tableRowToRTF :: PandocMonad m tableRowToRTF header indent aligns sizes' cols = do let totalTwips = 6 * 1440 -- 6 inches let sizes = if all (== 0) sizes' - then take (length cols) $ repeat (1.0 / fromIntegral (length cols)) + then replicate (length cols) (1.0 / fromIntegral (length cols)) else sizes' - columns <- concat <$> mapM (\(x,y) -> tableItemToRTF indent x y) + columns <- concat <$> mapM (uncurry (tableItemToRTF indent)) (zip aligns cols) let rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips)) (0 :: Integer) sizes @@ -326,8 +325,8 @@ tableItemToRTF indent alignment item = do -- lists as after regular lists. spaceAtEnd :: String -> String spaceAtEnd str = - if isSuffixOf "\\par}\n" str - then (take ((length str) - 6) str) ++ "\\sa180\\par}\n" + if "\\par}\n" `isSuffixOf` str + then take ((length str) - 6) str ++ "\\sa180\\par}\n" else str -- | Convert list item (list of blocks) to RTF. @@ -338,11 +337,11 @@ listItemToRTF :: PandocMonad m -> [Block] -- ^ list item (list of blocks) -> m String listItemToRTF alignment indent marker [] = return $ - rtfCompact (indent + listIncrement) (0 - listIncrement) alignment - (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ") + rtfCompact (indent + listIncrement) (negate listIncrement) alignment + (marker ++ "\\tx" ++ show listIncrement ++ "\\tab ") listItemToRTF alignment indent marker list = do (first:rest) <- mapM (blockToRTF (indent + listIncrement) alignment) list - let listMarker = "\\fi" ++ show (0 - listIncrement) ++ " " ++ marker ++ + let listMarker = "\\fi" ++ show (negate listIncrement) ++ " " ++ marker ++ "\\tx" ++ show listIncrement ++ "\\tab" let insertListMarker ('\\':'f':'i':'-':d:xs) | isDigit d = listMarker ++ dropWhile isDigit xs @@ -400,7 +399,7 @@ inlineToRTF (Quoted SingleQuote lst) = do inlineToRTF (Quoted DoubleQuote lst) = do contents <- inlinesToRTF lst return $ "\\u8220\"" ++ contents ++ "\\u8221\"" -inlineToRTF (Code _ str) = return $ "{\\f1 " ++ (codeStringToRTF str) ++ "}" +inlineToRTF (Code _ str) = return $ "{\\f1 " ++ codeStringToRTF str ++ "}" inlineToRTF (Str str) = return $ stringToRTF str inlineToRTF (Math t str) = texMathToInlines t str >>= inlinesToRTF inlineToRTF (Cite _ lst) = inlinesToRTF lst @@ -409,12 +408,12 @@ inlineToRTF il@(RawInline f str) | otherwise = do return $ InlineNotRendered il return "" -inlineToRTF (LineBreak) = return "\\line " +inlineToRTF LineBreak = return "\\line " inlineToRTF SoftBreak = return " " inlineToRTF Space = return " " inlineToRTF (Link _ text (src, _)) = do contents <- inlinesToRTF text - return $ "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++ + return $ "{\\field{\\*\\fldinst{HYPERLINK \"" ++ codeStringToRTF src ++ "\"}}{\\fldrslt{\\ul\n" ++ contents ++ "\n}}}\n" inlineToRTF (Image _ _ (source, _)) = return $ "{\\cf1 [image: " ++ source ++ "]\\cf0}" diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 8f1a06688..0b951b0c9 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -268,19 +268,19 @@ gridTable opts blocksToDoc headless aligns widths headers rows = do else handleGivenWidths widths let hpipeBlocks blocks = hcat [beg, middle, end] where h = maximum (1 : map height blocks) - sep' = lblock 3 $ vcat (map text $ replicate h " | ") - beg = lblock 2 $ vcat (map text $ replicate h "| ") - end = lblock 2 $ vcat (map text $ replicate h " |") + sep' = lblock 3 $ vcat (replicate h (text " | ")) + beg = lblock 2 $ vcat (replicate h (text "| ")) + end = lblock 2 $ vcat (replicate h (text " |")) middle = chomp $ hcat $ intersperse sep' blocks let makeRow = hpipeBlocks . zipWith lblock widthsInChars let head' = makeRow rawHeaders let rows' = map (makeRow . map chomp) rawRows let borderpart ch align widthInChars = - (if (align == AlignLeft || align == AlignCenter) + (if align == AlignLeft || align == AlignCenter then char ':' else char ch) <> text (replicate widthInChars ch) <> - (if (align == AlignRight || align == AlignCenter) + (if align == AlignRight || align == AlignCenter then char ':' else char ch) let border ch aligns' widthsInChars' = diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs index dfdb443a2..aa87c55e1 100644 --- a/src/Text/Pandoc/Writers/TEI.hs +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -79,10 +79,10 @@ writeTEI opts (Pandoc meta blocks) = do meta' main <- (render' . vcat) <$> mapM (elementToTEI opts startLvl) elements let context = defField "body" main - $ defField "mathml" (case writerHTMLMathMethod opts of - MathML -> True - _ -> False) - $ metadata + $ + defField "mathml" (case writerHTMLMathMethod opts of + MathML -> True + _ -> False) metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -121,7 +121,7 @@ plainToPara x = x deflistItemsToTEI :: PandocMonad m => WriterOptions -> [([Inline],[[Block]])] -> m Doc deflistItemsToTEI opts items = - vcat <$> mapM (\(term, defs) -> deflistItemToTEI opts term defs) items + vcat <$> mapM (uncurry (deflistItemToTEI opts)) items -- | Convert a term and a list of blocks into a TEI varlistentry. deflistItemToTEI :: PandocMonad m @@ -146,7 +146,7 @@ imageToTEI _ attr src = return $ selfClosingTag "graphic" $ ("url", src) : idAndRole attr ++ dims where dims = go Width "width" ++ go Height "depth" - go dir dstr = case (dimension dir attr) of + go dir dstr = case dimension dir attr of Just a -> [(dstr, show a)] Nothing -> [] @@ -159,7 +159,7 @@ blockToTEI opts (Div (ident,_,_) [Para lst]) = do let attribs = [("id", ident) | not (null ident)] inTags False "p" attribs <$> inlinesToTEI opts lst blockToTEI opts (Div _ bs) = blocksToTEI opts $ map plainToPara bs -blockToTEI _ h@(Header _ _ _) = do +blockToTEI _ h@(Header{}) = do -- should not occur after hierarchicalize, except inside lists/blockquotes report $ BlockNotRendered h return empty @@ -214,7 +214,7 @@ blockToTEI opts (OrderedList (start, numstyle, _) (first:rest)) = do else do fi <- blocksToTEI opts $ map plainToPara first re <- listItemsToTEI opts rest - return $ (inTags True "item" [("n",show start)] fi) $$ re + return $ inTags True "item" [("n",show start)] fi $$ re return $ inTags True "list" attribs items blockToTEI opts (DefinitionList lst) = do let attribs = [("type", "definition")] @@ -295,28 +295,31 @@ inlineToTEI _ (Code _ str) = return $ inlineToTEI _ (Math t str) = return $ case t of InlineMath -> inTags False "formula" [("notation","TeX")] $ - text (str) + text str DisplayMath -> inTags True "figure" [("type","math")] $ - inTags False "formula" [("notation","TeX")] $ text (str) + inTags False "formula" [("notation","TeX")] $ text str inlineToTEI _ il@(RawInline f x) | f == "tei" = return $ text x | otherwise = empty <$ report (InlineNotRendered il) inlineToTEI _ LineBreak = return $ selfClosingTag "lb" [] -inlineToTEI _ Space = return $ space +inlineToTEI _ Space = + return space -- because we use \n for LineBreak, we can't do soft breaks: -inlineToTEI _ SoftBreak = return $ space +inlineToTEI _ SoftBreak = + return space inlineToTEI opts (Link attr txt (src, _)) | Just email <- stripPrefix "mailto:" src = do let emailLink = text $ - escapeStringForXML $ email + escapeStringForXML email case txt of - [Str s] | escapeURI s == email -> return $ emailLink + [Str s] | escapeURI s == email -> + return emailLink _ -> do linktext <- inlinesToTEI opts txt return $ linktext <+> char '(' <> emailLink <> char ')' | otherwise = - (if isPrefixOf "#" src + (if "#" `isPrefixOf` src then inTags False "ref" $ ("target", drop 1 src) : idAndRole attr else inTags False "ref" $ ("target", src) : idAndRole attr ) <$> inlinesToTEI opts txt diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 549d4f3d9..2d0c7a86d 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -71,7 +71,7 @@ type TI m = StateT WriterState m -- | Convert Pandoc to Texinfo. writeTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeTexinfo options document = - evalStateT (pandocToTexinfo options $ wrapTop document) $ + evalStateT (pandocToTexinfo options $ wrapTop document) WriterState { stStrikeout = False, stSuperscript = False, stEscapeComma = False, stSubscript = False, stIdentifiers = Set.empty, stOptions = options} @@ -102,8 +102,8 @@ pandocToTexinfo options (Pandoc meta blocks) = do $ defField "titlepage" titlePage $ defField "subscript" (stSubscript st) $ defField "superscript" (stSuperscript st) - $ defField "strikeout" (stStrikeout st) - $ metadata + $ + defField "strikeout" (stStrikeout st) metadata case writerTemplate options of Nothing -> return body Just tpl -> renderTemplate' tpl context @@ -166,11 +166,11 @@ blockToTexinfo (BlockQuote lst) = do contents $$ text "@end quotation" -blockToTexinfo (CodeBlock _ str) = do +blockToTexinfo (CodeBlock _ str) = return $ blankline $$ - text "@verbatim" $$ - flush (text str) $$ - text "@end verbatim" <> blankline + text "@verbatim" $$ + flush (text str) $$ + text "@end verbatim" <> blankline blockToTexinfo b@(RawBlock f str) | f == "texinfo" = return $ text str @@ -218,7 +218,7 @@ blockToTexinfo HorizontalRule = text "@bigskip@hrule@bigskip" $$ text "@end iftex" $$ text "@ifnottex" $$ - text (take 72 $ repeat '-') $$ + text (replicate 72 '-') $$ text "@end ifnottex" blockToTexinfo (Header 0 _ lst) = do @@ -339,7 +339,7 @@ blockListToTexinfo (x:xs) = do Para _ -> do xs' <- blockListToTexinfo xs case xs of - ((CodeBlock _ _):_) -> return $ x' $$ xs' + (CodeBlock _ _:_) -> return $ x' $$ xs' _ -> return $ x' $+$ xs' _ -> do xs' <- blockListToTexinfo xs @@ -437,7 +437,7 @@ inlineToTexinfo (Subscript lst) = do inlineToTexinfo (SmallCaps lst) = inlineListToTexinfo lst >>= return . inCmd "sc" -inlineToTexinfo (Code _ str) = do +inlineToTexinfo (Code _ str) = return $ text $ "@code{" ++ stringToTexinfo str ++ "}" inlineToTexinfo (Quoted SingleQuote lst) = do @@ -459,7 +459,7 @@ inlineToTexinfo il@(RawInline f str) | otherwise = do report $ InlineNotRendered il return empty -inlineToTexinfo (LineBreak) = return $ text "@*" <> cr +inlineToTexinfo LineBreak = return $ text "@*" <> cr inlineToTexinfo SoftBreak = do wrapText <- gets (writerWrapText . stOptions) case wrapText of @@ -472,7 +472,7 @@ inlineToTexinfo (Link _ txt (src@('#':_), _)) = do contents <- escapeCommas $ inlineListToTexinfo txt return $ text "@ref" <> braces (text (stringToTexinfo src) <> text "," <> contents) -inlineToTexinfo (Link _ txt (src, _)) = do +inlineToTexinfo (Link _ txt (src, _)) = case txt of [Str x] | escapeURI x == src -> -- autolink do return $ text $ "@url{" ++ x ++ "}" @@ -484,7 +484,7 @@ inlineToTexinfo (Link _ txt (src, _)) = do inlineToTexinfo (Image attr alternate (source, _)) = do content <- escapeCommas $ inlineListToTexinfo alternate opts <- gets stOptions - let showDim dim = case (dimension dim attr) of + let showDim dim = case dimension dim attr of (Just (Pixel a)) -> showInInch opts (Pixel a) ++ "in" (Just (Percent _)) -> "" (Just d) -> show d diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 5ee9d3250..11fb2ae12 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -297,7 +297,7 @@ definitionListItemToTextile opts (label, items) = do labelText <- inlineListToTextile opts label contents <- mapM (blockListToTextile opts) items return $ "
" ++ labelText ++ "
\n" ++ - (intercalate "\n" $ map (\d -> "
" ++ d ++ "
") contents) + intercalate "\n" (map (\d -> "
" ++ d ++ "
") contents) -- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed. isSimpleList :: Block -> Bool @@ -350,7 +350,7 @@ tableRowToTextile opts alignStrings rownum cols' = do 0 -> "header" x | x `rem` 2 == 1 -> "odd" _ -> "even" - cols'' <- sequence $ zipWith + cols'' <- zipWithM (\alignment item -> tableItemToTextile opts celltype alignment item) alignStrings cols' return $ "\n" ++ unlines cols'' ++ "" @@ -483,7 +483,7 @@ inlineToTextile opts (Image attr@(_, cls, _) alt (source, tit)) = do then "" else "(" ++ unwords cls ++ ")" showDim dir = let toCss str = Just $ show dir ++ ":" ++ str ++ ";" - in case (dimension dir attr) of + in case dimension dir attr of Just (Percent a) -> toCss $ show (Percent a) Just dim -> toCss $ showInPixel opts dim ++ "px" Nothing -> Nothing diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs index 67dcd72d1..60029c0d4 100644 --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -36,6 +36,7 @@ import Control.Monad (zipWithM) import Control.Monad.State.Strict (StateT, evalStateT, gets, modify) import Data.Default (Default (..)) import Data.List (intercalate, isInfixOf, isPrefixOf, transpose) +import Data.Maybe (fromMaybe) import qualified Data.Map as Map import Data.Text (Text, breakOnAll, pack) import Text.Pandoc.Class (PandocMonad, report) @@ -75,8 +76,7 @@ pandocToZimWiki opts (Pandoc meta blocks) = do --let header = "Content-Type: text/x-zim-wiki\nWiki-Format: zim 0.4\n" let main = body let context = defField "body" main - $ defField "toc" (writerTableOfContents opts) - $ metadata + $ defField "toc" (writerTableOfContents opts) metadata case writerTemplate opts of Just tpl -> renderTemplate' tpl context Nothing -> return main @@ -118,12 +118,12 @@ blockToZimWiki opts (Para inlines) = do contents <- inlineListToZimWiki opts inlines return $ contents ++ if null indent then "\n" else "" -blockToZimWiki opts (LineBlock lns) = do +blockToZimWiki opts (LineBlock lns) = blockToZimWiki opts $ linesToPara lns blockToZimWiki opts b@(RawBlock f str) | f == Format "zimwiki" = return str - | f == Format "html" = do cont <- indentFromHTML opts str; return cont + | f == Format "html" = indentFromHTML opts str | otherwise = do report $ BlockNotRendered b return "" @@ -142,9 +142,7 @@ blockToZimWiki _ (CodeBlock (_,classes,_) str) = do return $ case classes of [] -> "'''\n" ++ cleanupCode str ++ "\n'''\n" -- turn no lang block into a quote block (x:_) -> "{{{code: lang=\"" ++ - (case Map.lookup x langmap of - Nothing -> x - Just y -> y) ++ "\" linenumbers=\"True\"\n" ++ str ++ "\n}}}\n" -- for zim's code plugin, go verbatim on the lang spec + (fromMaybe x (Map.lookup x langmap)) ++ "\" linenumbers=\"True\"\n" ++ str ++ "\n}}}\n" -- for zim's code plugin, go verbatim on the lang spec blockToZimWiki opts (BlockQuote blocks) = do contents <- blockListToZimWiki opts blocks @@ -157,12 +155,12 @@ blockToZimWiki opts (Table capt aligns _ headers rows) = do c <- inlineListToZimWiki opts capt return $ "" ++ c ++ "\n" headers' <- if all null headers - then zipWithM (tableItemToZimWiki opts) aligns (rows !! 0) - else mapM (inlineListToZimWiki opts) (map removeFormatting headers) -- emphasis, links etc. are not allowed in table headers + then zipWithM (tableItemToZimWiki opts) aligns (head rows) + else mapM ((inlineListToZimWiki opts) . removeFormatting)headers -- emphasis, links etc. are not allowed in table headers rows' <- mapM (zipWithM (tableItemToZimWiki opts) aligns) rows let widths = map (maximum . map length) $ transpose (headers':rows') let padTo (width, al) s = - case (width - length s) of + case width - length s of x | x > 0 -> if al == AlignLeft || al == AlignDefault then s ++ replicate x ' ' @@ -171,14 +169,11 @@ blockToZimWiki opts (Table capt aligns _ headers rows) = do else replicate (x `div` 2) ' ' ++ s ++ replicate (x - x `div` 2) ' ' | otherwise -> s - let borderCell (width, al) _ = - if al == AlignLeft - then ":"++ replicate (width-1) '-' - else if al == AlignDefault - then replicate width '-' - else if al == AlignRight - then replicate (width-1) '-' ++ ":" - else ":" ++ replicate (width-2) '-' ++ ":" + let borderCell (width, al) _ + | al == AlignLeft = ":"++ replicate (width-1) '-' + | al == AlignDefault = replicate width '-' + | al == AlignRight = replicate (width-1) '-' ++ ":" + | otherwise = ":" ++ replicate (width-2) '-' ++ ":" let underheader = "|" ++ intercalate "|" (zipWith borderCell (zip widths aligns) headers') ++ "|" let renderRow cells = "|" ++ intercalate "|" (zipWith padTo (zip widths aligns) cells) ++ "|" return $ captionDoc ++ @@ -188,19 +183,19 @@ blockToZimWiki opts (Table capt aligns _ headers rows) = do blockToZimWiki opts (BulletList items) = do indent <- gets stIndent modify $ \s -> s { stIndent = stIndent s ++ "\t" } - contents <- (mapM (listItemToZimWiki opts) items) + contents <- mapM (listItemToZimWiki opts) items modify $ \s -> s{ stIndent = indent } -- drop 1 (stIndent s) } return $ vcat contents ++ if null indent then "\n" else "" blockToZimWiki opts (OrderedList _ items) = do indent <- gets stIndent modify $ \s -> s { stIndent = stIndent s ++ "\t", stItemNum = 1 } - contents <- (mapM (orderedListItemToZimWiki opts) items) + contents <- mapM (orderedListItemToZimWiki opts) items modify $ \s -> s{ stIndent = indent } -- drop 1 (stIndent s) } return $ vcat contents ++ if null indent then "\n" else "" blockToZimWiki opts (DefinitionList items) = do - contents <- (mapM (definitionListItemToZimWiki opts) items) + contents <- mapM (definitionListItemToZimWiki opts) items return $ vcat contents definitionListItemToZimWiki :: PandocMonad m @@ -218,19 +213,19 @@ indentFromHTML :: PandocMonad m => WriterOptions -> String -> ZW m String indentFromHTML _ str = do indent <- gets stIndent itemnum <- gets stItemNum - if isInfixOf "
  • " str then return $ indent ++ show itemnum ++ "." - else if isInfixOf "
    • " str then return "\n" - else if isInfixOf "
  • " `isInfixOf` str then return $ indent ++ show itemnum ++ "." + else if "
    • " `isInfixOf` str then return "\n" + else if "
  • " str then do + else if "
      " `isInfixOf` str then do let olcount=countSubStrs "
        " str modify $ \s -> s { stIndent = stIndent s ++ replicate olcount '\t', stItemNum = 1 } return "" - else if isInfixOf "
      " str then do + else if "
    " `isInfixOf` str then do let olcount=countSubStrs "/
      " str modify $ \s -> s{ stIndent = drop olcount (stIndent s) } return "" @@ -286,7 +281,7 @@ blockListToZimWiki opts blocks = vcat <$> mapM (blockToZimWiki opts) blocks -- | Convert list of Pandoc inline elements to ZimWiki. inlineListToZimWiki :: PandocMonad m => WriterOptions -> [Inline] -> ZW m String -inlineListToZimWiki opts lst = concat <$> (mapM (inlineToZimWiki opts) lst) +inlineListToZimWiki opts lst = concat <$> mapM (inlineToZimWiki opts) lst -- | Convert Pandoc inline element to ZimWiki. inlineToZimWiki :: PandocMonad m @@ -335,7 +330,7 @@ inlineToZimWiki _ (Str str) = do then return $ substitute "|" "\\|" . escapeString $ str else if inLink - then return $ str + then return str else return $ escapeString str inlineToZimWiki _ (Math mathType str) = return $ delim ++ str ++ delim -- note: str should NOT be escaped @@ -346,7 +341,7 @@ inlineToZimWiki _ (Math mathType str) = return $ delim ++ str ++ delim -- note -- | f == Format "html" = return $ "" ++ str ++ "" inlineToZimWiki opts il@(RawInline f str) | f == Format "zimwiki" = return str - | f == Format "html" = do cont <- indentFromHTML opts str; return cont + | f == Format "html" = indentFromHTML opts str | otherwise = do report $ InlineNotRendered il return "" -- cgit v1.2.3