diff options
43 files changed, 178 insertions, 186 deletions
diff --git a/.hlint.yaml b/.hlint.yaml index def675e77..cc4ee4fea 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -55,18 +55,31 @@ # - ignore: {name: "Use list comprehension"} # - ignore: {name: "Redundant if"} - ignore: {name: "Avoid lambda"} -- ignore: {name: "Use String"} -- ignore: {name: "Use isDigit"} - ignore: {name: "Eta reduce"} -- ignore: {name: "Use fmap"} # specific for GHC 7.8 compat -- ignore: {name: "Parse error"} # we trust the compiler over HLint -- ignore: {name: "Use =="} # Creates infinite loops in `EQ` using expressions - ignore: {name: "Evaluate"} +- ignore: {name: "Monad law, left identity", module: "Text.Pandoc.App.OutputSettings"} +- ignore: {name: "Parse error"} # we trust the compiler over HLint +- ignore: {name: "Reduce duplication", module: "Text.Pandoc.Readers.Markdown"} - ignore: {name: "Use &&&"} -# - ignore: {name: "Redundant compare"} +- ignore: {name: "Use =="} # Creates infinite loops in `EQ` using expressions +- ignore: {name: "Use String"} +- ignore: {name: "Use fmap"} # specific for GHC 7.8 compat +- ignore: {name: "Use forM_", module: "Text.Pandoc.Readers.DocBook"} +- ignore: {name: "Use isDigit"} +- ignore: {name: "Use tuple-section", module: "Text.Pandoc.Readers.EPUB"} +- ignore: {name: "Use uncurry", module: "Text.Pandoc.Readers.Docx.Combine"} +- ignore: + name: "Use <$>" + within: + - Text.Pandoc.Readers.LaTeX + - Text.Pandoc.Readers.Markdown +- ignore: + name: "Use camelCase" + within: + - Text.Pandoc.Extensions + - Text.Pandoc.Lua.Marshalling.Version + - Text.Pandoc.Readers.Odt.ContentReader + - Text.Pandoc.Readers.Odt.Namespaces # Define some custom infix operators # - fixity: infixr 3 ~^#^~ - - - diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index 67315ad09..cce2543e4 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -84,7 +84,7 @@ convertWithOpts opts = do let needsCiteproc = isJust (lookupMeta "bibliography" (optMetadata opts)) && optCiteMethod opts `notElem` [Natbib, Biblatex] && - all (not . isPandocCiteproc) filters + not (any isPandocCiteproc filters) let filters' = filters ++ [ JSONFilter "pandoc-citeproc" | needsCiteproc ] let sources = case optInputFiles opts of diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs index e407d8854..18d15843e 100644 --- a/src/Text/Pandoc/App/CommandLineOptions.hs +++ b/src/Text/Pandoc/App/CommandLineOptions.hs @@ -37,6 +37,7 @@ import Data.List (isPrefixOf) #endif #endif import Data.Maybe (fromMaybe, isJust) +import Data.Text (Text) import Safe (tailDef) import Skylighting (Style, Syntax (..), defaultSyntaxMap, parseTheme) import System.Console.GetOpt @@ -44,7 +45,7 @@ import System.Environment (getArgs, getProgName) import System.Exit (exitSuccess) import System.FilePath import System.IO (stdout) -import Text.DocTemplates (Val(..)) +import Text.DocTemplates (Context (..), ToContext (toVal), Val (..)) import Text.Pandoc import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), IpynbOutput (..), addMeta) import Text.Pandoc.Filter (Filter (..)) @@ -64,10 +65,8 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as B import qualified Data.Map as M import qualified Data.Text as T -import Data.Text (Text) -import Text.DocTemplates (ToContext(toVal), Context(..)) -import qualified Text.Pandoc.UTF8 as UTF8 import qualified Data.YAML as Y +import qualified Text.Pandoc.UTF8 as UTF8 parseOptions :: [OptDescr (Opt -> IO Opt)] -> Opt -> IO Opt parseOptions options' defaults = do @@ -648,7 +647,7 @@ options = "all" -> return opt{ optIpynbOutput = IpynbOutputAll } "best" -> return opt{ optIpynbOutput = IpynbOutputBest } "none" -> return opt{ optIpynbOutput = IpynbOutputNone } - _ -> E.throwIO $ PandocOptionError $ + _ -> E.throwIO $ PandocOptionError "ipynb-output must be all, none, or best") "all|none|best") "" -- "Starting number for sections, subsections, etc." diff --git a/src/Text/Pandoc/BCP47.hs b/src/Text/Pandoc/BCP47.hs index c9f144aa4..fb63ec780 100644 --- a/src/Text/Pandoc/BCP47.hs +++ b/src/Text/Pandoc/BCP47.hs @@ -75,7 +75,7 @@ parseBCP47 lang = cs <- P.many1 asciiLetter let lcs = length cs guard $ lcs == 2 || lcs == 3 - return $ T.toLower $ T.pack $ cs + return $ T.toLower $ T.pack cs pScript = P.try $ do P.char '-' x <- P.satisfy (\c -> isAscii c && isLetter c && isUpper c) diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs index 5abb5fdd8..436238139 100644 --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -2,7 +2,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} diff --git a/src/Text/Pandoc/Emoji.hs b/src/Text/Pandoc/Emoji.hs index fe56dd356..64ef022de 100644 --- a/src/Text/Pandoc/Emoji.hs +++ b/src/Text/Pandoc/Emoji.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | diff --git a/src/Text/Pandoc/Lua/Marshaling/Context.hs b/src/Text/Pandoc/Lua/Marshaling/Context.hs index e209fbd61..db3f2bc75 100644 --- a/src/Text/Pandoc/Lua/Marshaling/Context.hs +++ b/src/Text/Pandoc/Lua/Marshaling/Context.hs @@ -1,7 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {- | Module : Text.Pandoc.Lua.Marshaling.Context diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index 36d6f4009..cd0e5ff9a 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -68,7 +68,7 @@ readDoc content formatSpecOrNil = do case rdr of TextReader r -> r def{ readerExtensions = es } content - _ -> throwError $ PandocSomeError $ + _ -> throwError $ PandocSomeError "Only textual formats are supported" case res of Right pd -> (1 :: NumResults) <$ Lua.push pd -- success, push Pandoc diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index 0fe80be4e..736daac82 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -40,15 +40,14 @@ import Data.Maybe (fromMaybe) import Data.Data (Data) import Data.Default import Data.Text (Text) -import Text.DocTemplates (Context(..)) import qualified Data.Set as Set import Data.Typeable (Typeable) import GHC.Generics (Generic) import Skylighting (SyntaxMap, defaultSyntaxMap) +import Text.DocTemplates (Context(..), Template) import Text.Pandoc.Extensions import Text.Pandoc.Highlighting (Style, pygments) import Text.Pandoc.Shared (camelCaseStrToHyphenated) -import Text.DocTemplates (Template) import Data.Aeson.TH (deriveJSON, defaultOptions, Options(..), SumEncoding(..)) import Data.YAML diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs index 5ef2bd80c..e0d1263f0 100644 --- a/src/Text/Pandoc/PDF.hs +++ b/src/Text/Pandoc/PDF.hs @@ -414,7 +414,7 @@ html2pdf :: Verbosity -- ^ Verbosity level -> [String] -- ^ Args to program -> Text -- ^ HTML5 source -> IO (Either ByteString ByteString) -html2pdf verbosity program args source = do +html2pdf verbosity program args source = -- write HTML to temp file so we don't have to rewrite -- all links in `a`, `img`, `style`, `script`, etc. tags, -- and piping to weasyprint didn't work on Windows either. @@ -502,7 +502,7 @@ showVerboseInfo mbTmpDir program programArgs env source = do putStrLn "[makePDF] Environment:" mapM_ print env putStr "\n" - putStrLn $ "[makePDF] Source:" + putStrLn "[makePDF] Source:" UTF8.putStrLn source handlePDFProgramNotFound :: String -> IE.IOError -> IO a diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 17f6a7562..9c79816f4 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -6,7 +6,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE OverloadedStrings #-} {- | @@ -895,9 +894,7 @@ orderedListMarker style delim = do -- | Parses a character reference and returns a Str element. charRef :: Stream s m Char => ParserT s st m Inline -charRef = do - c <- characterReference - return $ Str $ T.singleton c +charRef = Str . T.singleton <$> characterReference lineBlockLine :: Monad m => ParserT Text st m Text lineBlockLine = try $ do diff --git a/src/Text/Pandoc/Readers/CSV.hs b/src/Text/Pandoc/Readers/CSV.hs index 103e211e7..62c94b3a0 100644 --- a/src/Text/Pandoc/Readers/CSV.hs +++ b/src/Text/Pandoc/Readers/CSV.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} {- | Module : Text.Pandoc.Readers.RST Copyright : Copyright (C) 2006-2019 John MacFarlane @@ -31,7 +30,7 @@ readCSV :: PandocMonad m => ReaderOptions -- ^ Reader options -> Text -- ^ Text to parse (assuming @'\n'@ line endings) -> m Pandoc -readCSV _opts s = do +readCSV _opts s = case parseCSV defaultCSVOptions (crFilter s) of Right (r:rs) -> return $ B.doc $ B.table capt (zip aligns widths) hdrs rows where capt = mempty diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index fbd9d595d..535ade658 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -741,7 +741,7 @@ parseBlock (Elem e) = "refsect2" -> sect 2 "refsect3" -> sect 3 "refsection" -> gets dbSectionLevel >>= sect . (+1) - l@_ | l `elem` admonitionTags -> parseAdmonition $ T.pack l + l | l `elem` admonitionTags -> parseAdmonition $ T.pack l "area" -> skip "areaset" -> skip "areaspec" -> skip @@ -920,7 +920,7 @@ parseBlock (Elem e) = -- include the label and leave it to styling. title <- case filterChild (named "title") e of Just t -> divWith ("", ["title"], []) . plain <$> getInlines t - Nothing -> return $ mempty + Nothing -> return mempty -- this will ignore the title element if it is present b <- getBlocks e -- we also attach the label as a class, so it can be styled properly diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs index 82791d669..cf7b6051d 100644 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -1,7 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternGuards #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Readers.Docx.Combine diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs index bcff7e4b8..f7a7de896 100644 --- a/src/Text/Pandoc/Readers/EPUB.hs +++ b/src/Text/Pandoc/Readers/EPUB.hs @@ -71,7 +71,7 @@ archiveToEPUB os archive = do spine <- parseSpine items content let escapedSpine = map (escapeURI . T.pack . takeFileName . fst) spine Pandoc _ bs <- - foldM' (\a b -> ((a <>) . walk (prependHash $ escapedSpine)) + foldM' (\a b -> ((a <>) . walk (prependHash escapedSpine)) `liftM` parseSpineElem root b) mempty spine let ast = coverDoc <> Pandoc meta bs fetchImages (M.elems items) root archive ast @@ -170,7 +170,7 @@ parseMeta content = do let coverId = findAttr (emptyName "content") =<< filterChild findCover meta return (coverId, r) where - findCover e = maybe False (== "cover") (findAttr (emptyName "name") e) + findCover e = (== Just "cover") (findAttr (emptyName "name") e) -- http://www.idpf.org/epub/30/spec/epub30-publications.html#sec-metadata-elem parseMetaItem :: Element -> Meta -> Meta @@ -294,4 +294,4 @@ findElementE :: PandocMonad m => QName -> Element -> m Element findElementE e x = mkE ("Unable to find element: " ++ show e) $ findElement e x mkE :: PandocMonad m => String -> Maybe a -> m a -mkE s = maybe (throwError . PandocParseError $ T.pack $ s) return +mkE s = maybe (throwError . PandocParseError $ T.pack s) return diff --git a/src/Text/Pandoc/Readers/Ipynb.hs b/src/Text/Pandoc/Readers/Ipynb.hs index 8efc230cc..09d98f667 100644 --- a/src/Text/Pandoc/Readers/Ipynb.hs +++ b/src/Text/Pandoc/Readers/Ipynb.hs @@ -1,10 +1,8 @@ {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Readers.Ipynb Copyright : Copyright (C) 2019 John MacFarlane @@ -130,9 +128,9 @@ addAttachment (fname, mimeBundle) = do outputToBlock :: PandocMonad m => Output a -> m B.Blocks outputToBlock Stream{ streamName = sName, - streamText = Source text } = do + streamText = Source text } = return $ B.divWith ("",["output","stream",sName],[]) - $ B.codeBlock $ T.concat $ text + $ B.codeBlock $ T.concat text outputToBlock DisplayData{ displayData = data', displayMetadata = metadata' } = B.divWith ("",["output", "display_data"],[]) <$> @@ -144,11 +142,11 @@ outputToBlock ExecuteResult{ executeCount = ec, <$> handleData metadata' data' outputToBlock Err{ errName = ename, errValue = evalue, - errTraceback = traceback } = do + errTraceback = traceback } = return $ B.divWith ("",["output","error"], [("ename",ename), ("evalue",evalue)]) - $ B.codeBlock $ T.unlines $ traceback + $ B.codeBlock $ T.unlines traceback -- We want to display the richest output possible given -- the output format. @@ -166,7 +164,7 @@ handleData metadata (MimeBundle mb) = -- normally metadata maps from mime types to key-value map; -- but not always... let meta = case M.lookup mt metadata of - Just v@(Object{}) -> + Just v@Object{} -> case fromJSON v of Success m' -> m' Error _ -> mempty @@ -183,13 +181,13 @@ handleData metadata (MimeBundle mb) = | otherwise = return mempty dataBlock ("text/html", TextualData t) - = return $ B.rawBlock "html" $ t + = return $ B.rawBlock "html" t dataBlock ("text/latex", TextualData t) - = return $ B.rawBlock "latex" $ t + = return $ B.rawBlock "latex" t dataBlock ("text/plain", TextualData t) = - return $ B.codeBlock $ t + return $ B.codeBlock t dataBlock (_, JsonData v) = return $ B.codeBlockWith ("",["json"],[]) $ T.pack $ toStringLazy $ encode v @@ -200,11 +198,11 @@ jsonMetaToMeta :: JSONMeta -> M.Map Text MetaValue jsonMetaToMeta = M.map valueToMetaValue where valueToMetaValue :: Value -> MetaValue - valueToMetaValue x@(Object{}) = + valueToMetaValue x@Object{} = case fromJSON x of Error s -> MetaString $ T.pack s Success jm' -> MetaMap $ jsonMetaToMeta jm' - valueToMetaValue x@(Array{}) = + valueToMetaValue x@Array{} = case fromJSON x of Error s -> MetaString $ T.pack s Success xs -> MetaList $ map valueToMetaValue xs diff --git a/src/Text/Pandoc/Readers/JATS.hs b/src/Text/Pandoc/Readers/JATS.hs index 4b8eb9098..1ccbd5a41 100644 --- a/src/Text/Pandoc/Readers/JATS.hs +++ b/src/Text/Pandoc/Readers/JATS.hs @@ -226,7 +226,7 @@ parseBlock (Elem e) = terms' <- mapM getInlines terms items' <- mapM getBlocks items return (mconcat $ intersperse (str "; ") terms', items') - parseFigure = do + parseFigure = -- if a simple caption and single graphic, we emit a standard -- implicit figure. otherwise, we emit a div with the contents case filterChildren (named "graphic") e of @@ -238,7 +238,7 @@ parseBlock (Elem e) = (filterChildren (const True) t) Nothing -> return mempty img <- getGraphic (Just (caption, attrValue "id" e)) g - return $ para $ img + return $ para img _ -> divWith (attrValue "id" e, ["fig"], []) <$> getBlocks e parseTable = do let isCaption x = named "title" x || named "caption" x diff --git a/src/Text/Pandoc/Readers/Jira.hs b/src/Text/Pandoc/Readers/Jira.hs index 362693af9..46077a4a9 100644 --- a/src/Text/Pandoc/Readers/Jira.hs +++ b/src/Text/Pandoc/Readers/Jira.hs @@ -106,8 +106,8 @@ rowToBlocksList (Jira.Row cells) = splitIntoHeaderAndBody :: [Jira.Row] -> (Jira.Row, [Jira.Row]) splitIntoHeaderAndBody [] = (Jira.Row [], []) splitIntoHeaderAndBody rows@(first@(Jira.Row cells) : rest) = - let isHeaderCell (Jira.HeaderCell{}) = True - isHeaderCell (Jira.BodyCell{}) = False + let isHeaderCell Jira.HeaderCell{} = True + isHeaderCell Jira.BodyCell{} = False in if all isHeaderCell cells then (first, rest) else (Jira.Row [], rows) diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 69aec212f..0bafa0d19 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -1508,7 +1508,7 @@ include name = do _ | name == "usepackage" -> addExtension f ".sty" | otherwise -> addExtension f ".tex" dirs <- (map T.unpack . splitTextBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS" - mapM_ (insertIncluded dirs) (map addExt fs) + mapM_ (insertIncluded dirs . addExt) fs return mempty insertIncluded :: PandocMonad m @@ -1559,7 +1559,7 @@ macroDef constructor = do mbenv <- newenvironment case mbenv of Nothing -> return () - Just (name, macro1, macro2) -> do + Just (name, macro1, macro2) -> guardDisabled Ext_latex_macros <|> do updateState $ \s -> s{ sMacros = M.insert name macro1 (sMacros s) } @@ -1669,7 +1669,7 @@ newenvironment = do | mtype == "newenvironment" -> do report $ MacroAlreadyDefined name pos return Nothing - | mtype == "provideenvironment" -> do + | mtype == "provideenvironment" -> return Nothing _ -> return $ Just (name, Macro ExpandWhenUsed argspecs optarg startcontents, diff --git a/src/Text/Pandoc/Readers/LaTeX/Parsing.hs b/src/Text/Pandoc/Readers/LaTeX/Parsing.hs index 5630ed868..a6836c3c1 100644 --- a/src/Text/Pandoc/Readers/LaTeX/Parsing.hs +++ b/src/Text/Pandoc/Readers/LaTeX/Parsing.hs @@ -391,7 +391,7 @@ doMacros = do updateState $ \st -> st{ sExpanded = True } doMacros' :: PandocMonad m => Int -> [Tok] -> LP m [Tok] -doMacros' n inp = do +doMacros' n inp = case inp of Tok spos (CtrlSeq "begin") _ : Tok _ Symbol "{" : Tok _ Word name : Tok _ Symbol "}" : ts @@ -456,7 +456,7 @@ doMacros' n inp = do args <- case optarg of Nothing -> getargs M.empty argspecs Just o -> do - x <- option o $ bracketedToks + x <- option o bracketedToks getargs (M.singleton 1 x) $ drop 1 argspecs rest <- getInput return (args, rest) diff --git a/src/Text/Pandoc/Readers/Man.hs b/src/Text/Pandoc/Readers/Man.hs index 314643621..3955c6069 100644 --- a/src/Text/Pandoc/Readers/Man.hs +++ b/src/Text/Pandoc/Readers/Man.hs @@ -91,8 +91,8 @@ parseBlock = choice [ parseList parseTable :: PandocMonad m => ManParser m Blocks parseTable = do modifyState $ \st -> st { tableCellsPlain = True } - let isTbl (Tbl{}) = True - isTbl _ = False + let isTbl Tbl{} = True + isTbl _ = False Tbl _opts rows pos <- msatisfy isTbl case rows of ((as,_):_) -> try (do @@ -287,7 +287,7 @@ parseInline = try $ do handleInlineMacro :: PandocMonad m => T.Text -> [Arg] -> SourcePos -> ManParser m Inlines -handleInlineMacro mname args _pos = do +handleInlineMacro mname args _pos = case mname of "UR" -> parseLink args "MT" -> parseEmailLink args @@ -366,7 +366,7 @@ parseCodeBlock = try $ do tok <- mtoken case tok of ControlLine "PP" _ _ -> return $ Just "" -- .PP sometimes used for blank line - ControlLine mname args pos -> do + ControlLine mname args pos -> (Just . query getText <$> handleInlineMacro mname args pos) <|> do report $ SkippedContent ("." <> mname) pos return Nothing diff --git a/src/Text/Pandoc/Readers/Metadata.hs b/src/Text/Pandoc/Readers/Metadata.hs index 76f30e957..701e65980 100644 --- a/src/Text/Pandoc/Readers/Metadata.hs +++ b/src/Text/Pandoc/Readers/Metadata.hs @@ -1,9 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RelaxedPolyRec #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} {- | Module : Text.Pandoc.Readers.Metadata Copyright : Copyright (C) 2006-2019 John MacFarlane @@ -83,9 +81,7 @@ toMetaValue pBlocks x = [Plain ils] -> MetaInlines ils [Para ils] -> MetaInlines ils xs -> MetaBlocks xs - asBlocks p = do - p' <- p - return $ MetaBlocks (B.toList p') + asBlocks p = MetaBlocks . B.toList <$> p checkBoolean :: Text -> Maybe Bool checkBoolean t = diff --git a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs index 6949da9d8..ea4e09403 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs @@ -1,9 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE Arrows #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternGuards #-} -{-# LANGUAGE RecordWildCards #-} {- | Module : Text.Pandoc.Readers.Odt.Generic.XMLConverter Copyright : Copyright (C) 2015 Martin Linnemann diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index 8aceebc07..6ad50c5bc 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -626,7 +626,7 @@ orgToPandocTable :: OrgTable -> Inlines -> Blocks orgToPandocTable (OrgTable colProps heads lns) caption = - let totalWidth = if any isJust (map columnRelWidth colProps) + let totalWidth = if any (isJust . columnRelWidth) colProps then Just . sum $ map (fromMaybe 1 . columnRelWidth) colProps else Nothing in B.table caption (map (convertColProp totalWidth) colProps) heads lns diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index 5e7aaf910..71dee53bc 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -83,8 +83,7 @@ parseTextile = do let reversedNotes = stateNotes st' updateState $ \s -> s { stateNotes = reverse reversedNotes } -- now parse it for real... - blocks <- parseBlocks - return $ Pandoc nullMeta (B.toList blocks) -- FIXME + Pandoc nullMeta . B.toList <$> parseBlocks -- FIXME noteMarker :: PandocMonad m => ParserT Text ParserState m Text noteMarker = skipMany spaceChar >> string "fn" >> T.pack <$> manyTill digit (char '.') diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 933798534..c03a99cdb 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -1,12 +1,10 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {- | diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs index e189336b2..815750a4e 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -158,7 +158,7 @@ blockToNodes opts (DefinitionList items) ns = Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs dlToBullet (term, xs) = Para term : concat xs -blockToNodes opts t@(Table capt aligns _widths headers rows) ns = do +blockToNodes opts t@(Table capt aligns _widths headers rows) ns = if isEnabled Ext_pipe_tables opts && onlySimpleTableCells (headers:rows) then do -- We construct a table manually as a CUSTOM_BLOCK, for @@ -319,7 +319,7 @@ inlineToNodes opts (Math mt str) = (node (HTML_INLINE ("\\(" <> str <> "\\)")) [] :) DisplayMath -> (node (HTML_INLINE ("\\[" <> str <> "\\]")) [] :) -inlineToNodes opts (Span ("",["emoji"],kvs) [Str s]) = do +inlineToNodes opts (Span ("",["emoji"],kvs) [Str s]) = case lookup "data-emoji" kvs of Just emojiname | isEnabled Ext_emoji opts -> (node (TEXT (":" <> emojiname <> ":")) [] :) diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index a72d121e1..c7009b891 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -91,7 +91,7 @@ writeDocbook opts (Pandoc meta blocks) = do auths' <- mapM (authorToDocbook opts) $ docAuthors meta let meta' = B.setMeta "author" auths' meta metadata <- metaToContext opts - (fromBlocks) + fromBlocks (inlinesToDocbook opts) meta' main <- fromBlocks blocks diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 7934e27c3..7605d3a4b 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -731,7 +731,7 @@ pandocToEPUB version opts doc = do => (Int -> [Inline] -> TS.Text -> [Element] -> Element) -> Block -> StateT Int m [Element] navPointNode formatter (Div (ident,_,_) - (Header lvl (_,_,kvs) ils : children)) = do + (Header lvl (_,_,kvs) ils : children)) = if lvl > tocLevel then return [] else do @@ -941,10 +941,15 @@ metadataElement version md currentTime = (("id",id') : maybe [] (\x -> [("opf:scheme", x)]) scheme) $ txt] | otherwise = [dcNode "identifier" ! [("id",id')] $ txt] ++ - maybe [] (\x -> [unode "meta" ! - [("refines",'#':id'),("property","identifier-type"), - ("scheme","onix:codelist5")] $ x]) - (schemeToOnix `fmap` scheme) + maybe [] ((\x -> [unode "meta" ! + [ ("refines",'#':id') + , ("property","identifier-type") + , ("scheme","onix:codelist5") + ] + $ x + ]) + . schemeToOnix) + scheme toCreatorNode s id' creator | version == EPUB2 = [dcNode s ! (("id",id') : @@ -1060,7 +1065,7 @@ transformInline :: PandocMonad m transformInline _opts (Image attr lab (src,tit)) = do newsrc <- modifyMediaRef $ TS.unpack src return $ Image attr lab ("../" <> newsrc, tit) -transformInline opts (x@(Math t m)) +transformInline opts x@(Math t m) | WebTeX url <- writerHTMLMathMethod opts = do newsrc <- modifyMediaRef (TS.unpack url <> urlEncode (TS.unpack m)) let mathclass = if t == DisplayMath then "display" else "inline" diff --git a/src/Text/Pandoc/Writers/Ipynb.hs b/src/Text/Pandoc/Writers/Ipynb.hs index 75d3d8f9b..e5c99c93d 100644 --- a/src/Text/Pandoc/Writers/Ipynb.hs +++ b/src/Text/Pandoc/Writers/Ipynb.hs @@ -1,5 +1,4 @@ {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {- | @@ -75,7 +74,7 @@ pandocToNotebook opts (Pandoc meta blocks) = do Nothing -> (4, 5) _ -> (4, 5) -- write as v4.5 metadata' <- toJSON <$> metaToContext' blockWriter inlineWriter - (B.deleteMeta "nbformat" $ + (B.deleteMeta "nbformat" . B.deleteMeta "nbformat_minor" $ jupyterMeta) -- convert from a Value (JSON object) to a M.Map Text Value: @@ -171,7 +170,7 @@ extractCells opts (b:bs) = do let isCodeOrDiv (CodeBlock (_,cl,_) _) = "code" `elem` cl isCodeOrDiv (Div (_,cl,_) _) = "cell" `elem` cl isCodeOrDiv _ = False - let (mds, rest) = break (isCodeOrDiv) bs + let (mds, rest) = break isCodeOrDiv bs extractCells opts (Div ("",["cell","markdown"],[]) (b:mds) : rest) blockToOutput :: PandocMonad m => Block -> m (Maybe (Output a)) diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index 14df21ea8..3b9c95a3a 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -92,11 +92,11 @@ docToJATS opts (Pandoc meta blocks) = do Nothing -> NullVal Just day -> let (y,m,d) = toGregorian day - in MapVal $ Context - $ M.insert ("year" :: Text) (SimpleVal $ text $ show y) - $ M.insert "month" (SimpleVal $ text $ show m) - $ M.insert "day" (SimpleVal $ text $ show d) - $ M.insert "iso-8601" + in MapVal . Context + . M.insert ("year" :: Text) (SimpleVal $ text $ show y) + . M.insert "month" (SimpleVal $ text $ show m) + . M.insert "day" (SimpleVal $ text $ show d) + . M.insert "iso-8601" (SimpleVal $ text $ formatTime defaultTimeLocale "%F" day) $ mempty @@ -219,7 +219,7 @@ blockToJATS opts (Div (id',"section":_,kvs) (Header _lvl _ ils : xs)) = do return $ inTags True "sec" attribs $ inTagsSimple "title" title' $$ contents -- Bibliography reference: -blockToJATS opts (Div (T.stripPrefix "ref-" -> Just _,_,_) [Para lst]) = +blockToJATS opts (Div (T.stripPrefix "ref-" -> Just _,_,_) [Para lst]) = inlinesToJATS opts lst blockToJATS opts (Div ("refs",_,_) xs) = do contents <- blocksToJATS opts xs @@ -365,10 +365,10 @@ inlinesToJATS opts lst = hcat <$> mapM (inlineToJATS opts) (fixCitations lst) where needsFixing (RawInline (Format "jats") z) = "<pub-id pub-id-type=" `T.isPrefixOf` z - needsFixing _ = False - isRawInline (RawInline{}) = True - isRawInline _ = False - (ys,zs) = break isRawInline xs + needsFixing _ = False + isRawInline RawInline{} = True + isRawInline _ = False + (ys,zs) = break isRawInline xs fixCitations (x:xs) = x : fixCitations xs -- | Convert an inline element to JATS. diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 438b04bc7..bc91c7405 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -749,7 +749,7 @@ blockToLaTeX (DefinitionList lst) = do beamer <- gets stBeamer let inc = if beamer && incremental then "[<+->]" else "" items <- mapM defListItemToLaTeX lst - let spacing = if all isTightList (map snd lst) + let spacing = if all (isTightList . snd) lst then text "\\tightlist" else empty return $ text ("\\begin{description}" <> inc) $$ spacing $$ vcat items $$ @@ -896,10 +896,10 @@ tableCellToLaTeX header (width, align, blocks) = do AlignRight -> "\\raggedleft" AlignCenter -> "\\centering" AlignDefault -> "\\raggedright" - return $ ("\\begin{minipage}" <> valign <> - braces (text (printf "%.2f\\columnwidth" width)) <> - (halign <> cr <> cellContents <> "\\strut" <> cr) <> - "\\end{minipage}") + return $ "\\begin{minipage}" <> valign <> + braces (text (printf "%.2f\\columnwidth" width)) <> + halign <> cr <> cellContents <> "\\strut" <> cr <> + "\\end{minipage}" notesToLaTeX :: [Doc Text] -> Doc Text notesToLaTeX [] = empty @@ -1686,4 +1686,3 @@ commonFromBcp47 (Lang l _ _ _) = fromIso l fromIso "ur" = "urdu" fromIso "vi" = "vietnamese" fromIso _ = "" - diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index d9eeb3bfa..8dc1271fe 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -252,8 +252,8 @@ definitionListItemToMan opts (label, defs) = do makeCodeBold :: [Inline] -> [Inline] makeCodeBold = walk go - where go x@(Code{}) = Strong [x] - go x = x + where go x@Code{} = Strong [x] + go x = x -- | Convert list of Pandoc block elements to man. blockListToMan :: PandocMonad m diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 87e41b766..74662083a 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -490,7 +490,7 @@ blockToMarkdown' opts b@(RawBlock f str) = do | isEnabled Ext_raw_attribute opts -> rawAttribBlock | otherwise -> renderEmpty | otherwise -> renderEmpty -blockToMarkdown' opts HorizontalRule = do +blockToMarkdown' opts HorizontalRule = return $ blankline <> literal (T.replicate (writerColumns opts) "-") <> blankline blockToMarkdown' opts (Header level attr inlines) = do -- first, if we're putting references at the end of a section, we @@ -632,7 +632,7 @@ blockToMarkdown' opts t@(Table caption aligns widths headers rows) = do | isEnabled Ext_raw_html opts -> fmap (id,) $ literal <$> (writeHtml5String opts{ writerTemplate = Nothing } $ Pandoc nullMeta [t]) - | otherwise -> return $ (id, literal "[TABLE]") + | otherwise -> return (id, literal "[TABLE]") return $ nst (tbl $$ caption'') $$ blankline blockToMarkdown' opts (BulletList items) = do contents <- inList $ mapM (bulletListItemToMarkdown opts) items @@ -767,7 +767,7 @@ bulletListItemToMarkdown opts bs = do let contents' = if itemEndsWithTightList bs then chomp contents <> cr else contents - return $ hang (writerTabStop opts) start $ contents' + return $ hang (writerTabStop opts) start contents' -- | Convert ordered list item (a list of blocks) to markdown. orderedListItemToMarkdown :: PandocMonad m @@ -789,7 +789,7 @@ orderedListItemToMarkdown opts marker bs = do let contents' = if itemEndsWithTightList bs then chomp contents <> cr else contents - return $ hang ind start $ contents' + return $ hang ind start contents' -- | Convert definition list item (label, list of blocks) to markdown. definitionListItemToMarkdown :: PandocMonad m @@ -821,7 +821,7 @@ definitionListItemToMarkdown opts (label, defs) = do defs' return $ blankline <> nowrap labelText $$ (if isTight then empty else blankline) <> contents <> blankline - else do + else return $ nowrap (chomp labelText <> literal " " <> cr) <> vsep (map vsep defs') <> blankline @@ -914,7 +914,7 @@ getReference attr label target = do (stKeys s) }) return lab' - Just km -> do -- we have refs with this label + Just km -> -- we have refs with this label case M.lookup (target, attr) km of Just i -> do let lab' = render Nothing $ @@ -1012,7 +1012,7 @@ isRight (Left _) = False -- | Convert Pandoc inline element to markdown. inlineToMarkdown :: PandocMonad m => WriterOptions -> Inline -> MD m (Doc Text) -inlineToMarkdown opts (Span ("",["emoji"],kvs) [Str s]) = do +inlineToMarkdown opts (Span ("",["emoji"],kvs) [Str s]) = case lookup "data-emoji" kvs of Just emojiname | isEnabled Ext_emoji opts -> return $ ":" <> literal emojiname <> ":" @@ -1187,7 +1187,7 @@ inlineToMarkdown opts il@(RawInline f str) = do | isEnabled Ext_raw_attribute opts -> rawAttribInline | otherwise -> renderEmpty | otherwise -> renderEmpty -inlineToMarkdown opts (LineBreak) = do +inlineToMarkdown opts LineBreak = do plain <- asks envPlain if plain || isEnabled Ext_hard_line_breaks opts then return cr diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index a5ea4b641..5fafaa38d 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -136,7 +136,7 @@ pandocToODT opts doc@(Pandoc meta _) = do ,("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")] ( inTags True "office:meta" [] $ + ,("office:version","1.2")] ( inTags True "office:meta" [] ( metaTag "meta:generator" ("Pandoc/" <> pandocVersion) $$ metaTag "dc:title" (stringify title) diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 58d4698a8..7b03f96e2 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -241,8 +241,8 @@ writeOpenDocument opts (Pandoc meta blocks) = do let listStyles = map listStyle (stListStyles s) let automaticStyles = vcat $ reverse $ styles ++ listStyles let context = defField "body" body - $ defField "toc" (writerTableOfContents opts) - $ defField "automatic-styles" automaticStyles + . defField "toc" (writerTableOfContents opts) + . defField "automatic-styles" automaticStyles $ metadata return $ render colwidth $ case writerTemplate opts of diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 2774a98bd..c5a5386d6 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -84,7 +84,7 @@ noteToOrg num note = do -- | Escape special characters for Org. escapeString :: Text -> Text -escapeString = escapeStringUsing $ +escapeString = escapeStringUsing [ ('\x2014',"---") , ('\x2013',"--") , ('\x2019',"'") diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs index 856dbfcd0..52b05b511 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs @@ -314,7 +314,7 @@ presentationToArchive opts pres = do presSize <- case getPresentationSize refArchive distArchive of Just sz -> return sz Nothing -> throwError $ - PandocSomeError $ + PandocSomeError "Could not determine presentation size" let env = def { envRefArchive = refArchive @@ -338,7 +338,8 @@ presentationToArchive opts pres = do -- Check to see if the presentation has speaker notes. This will -- influence whether we import the notesMaster template. presHasSpeakerNotes :: Presentation -> Bool -presHasSpeakerNotes (Presentation _ slides) = not $ all (mempty ==) $ map slideSpeakerNotes slides +presHasSpeakerNotes (Presentation _ slides) = + not $ all ((mempty ==) . slideSpeakerNotes) slides curSlideHasSpeakerNotes :: PandocMonad m => P m Bool curSlideHasSpeakerNotes = @@ -374,11 +375,9 @@ getContentShape ns spTreeElem NormalContent | (sp : _) <- contentShapes -> return sp TwoColumnLeftContent | (sp : _) <- contentShapes -> return sp TwoColumnRightContent | (_ : sp : _) <- contentShapes -> return sp - _ -> throwError $ - PandocSomeError $ + _ -> throwError $ PandocSomeError "Could not find shape for Powerpoint content" -getContentShape _ _ = throwError $ - PandocSomeError $ +getContentShape _ _ = throwError $ PandocSomeError "Attempted to find content on non shapeTree" getShapeDimensions :: NameSpaces @@ -398,7 +397,8 @@ getShapeDimensions ns element (y, _) <- listToMaybe $ reads yS (cx, _) <- listToMaybe $ reads cxS (cy, _) <- listToMaybe $ reads cyS - return $ ((x `div` 12700, y `div` 12700), (cx `div` 12700, cy `div` 12700)) + return ((x `div` 12700, y `div` 12700), + (cx `div` 12700, cy `div` 12700)) | otherwise = Nothing @@ -431,11 +431,9 @@ getContentShapeSize ns layout master flip getMasterShapeDimensionsById master case mbSz of Just sz' -> return sz' - Nothing -> throwError $ - PandocSomeError $ + Nothing -> throwError $ PandocSomeError "Couldn't find necessary content shape size" -getContentShapeSize _ _ _ = throwError $ - PandocSomeError $ +getContentShapeSize _ _ _ = throwError $ PandocSomeError "Attempted to find content shape size in non-layout" buildSpTree :: NameSpaces -> Element -> [Element] -> Element @@ -461,7 +459,7 @@ replaceNamedChildren ns prefix name newKids element = fun _ [] = [] fun switch ((Elem e) : conts) | isElem ns prefix name e = if switch - then (map Elem $ newKids) : fun False conts + then map Elem newKids : fun False conts else fun False conts fun switch (cont : conts) = [cont] : fun switch conts @@ -682,8 +680,8 @@ makePicElements layout picProps mInfo alt = do let hasCaption = mInfoCaption mInfo (imgBytes, _) <- P.fetchItem (T.pack $ mInfoFilePath mInfo) let (pxX, pxY) = case imageSize opts imgBytes of - Right sz -> sizeInPixels $ sz - Left _ -> sizeInPixels $ def + Right sz -> sizeInPixels sz + Left _ -> sizeInPixels def master <- getMaster let ns = elemToNameSpaces layout ((x, y), (cx, cytmp)) <- getContentShapeSize ns layout master @@ -802,7 +800,7 @@ paraElemToElements (Run rpr s) = do then [mknode "a:latin" [("typeface", T.unpack codeFont)] ()] else [] let propContents = linkProps <> colorContents <> codeContents - return [mknode "a:r" [] [ mknode "a:rPr" attrs $ propContents + return [mknode "a:r" [] [ mknode "a:rPr" attrs propContents , mknode "a:t" [] $ T.unpack s ]] paraElemToElements (MathElem mathType texStr) = do @@ -886,11 +884,11 @@ shapeToElement layout (TextBox paras) let txBody = mknode "p:txBody" [] $ [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] <> elements emptySpPr = mknode "p:spPr" [] () - return $ - surroundWithMathAlternate $ - replaceNamedChildren ns "p" "txBody" [txBody] $ - replaceNamedChildren ns "p" "spPr" [emptySpPr] $ - sp + return + . surroundWithMathAlternate + . replaceNamedChildren ns "p" "txBody" [txBody] + . replaceNamedChildren ns "p" "spPr" [emptySpPr] + $ sp -- GraphicFrame and Pic should never reach this. shapeToElement _ _ = return $ mknode "p:sp" [] () @@ -898,7 +896,7 @@ shapeToElements :: PandocMonad m => Element -> Shape -> P m [Element] shapeToElements layout (Pic picProps fp alt) = do mInfo <- registerMedia fp alt case mInfoExt mInfo of - Just _ -> do + Just _ -> makePicElements layout picProps mInfo alt Nothing -> shapeToElements layout $ TextBox [Paragraph def alt] shapeToElements layout (GraphicFrame tbls cptn) = @@ -909,7 +907,7 @@ shapeToElements layout shp = do return [element] shapesToElements :: PandocMonad m => Element -> [Shape] -> P m [Element] -shapesToElements layout shps = do +shapesToElements layout shps = concat <$> mapM (shapeToElements layout) shps graphicFrameToElements :: PandocMonad m => Element -> [Graphic] -> [ParaElem] -> P m [Element] @@ -927,14 +925,14 @@ graphicFrameToElements layout tbls caption = do elements <- mapM (graphicToElement cx) tbls let graphicFrameElts = mknode "p:graphicFrame" [] $ - [ mknode "p:nvGraphicFramePr" [] $ + [ mknode "p:nvGraphicFramePr" [] [ mknode "p:cNvPr" [("id", "6"), ("name", "Content Placeholder 5")] () - , mknode "p:cNvGraphicFramePr" [] $ + , mknode "p:cNvGraphicFramePr" [] [mknode "a:graphicFrameLocks" [("noGrp", "1")] ()] - , mknode "p:nvPr" [] $ + , mknode "p:nvPr" [] [mknode "p:ph" [("idx", "1")] ()] ] - , mknode "p:xfrm" [] $ + , mknode "p:xfrm" [] [ mknode "a:off" [("x", show $ 12700 * x), ("y", show $ 12700 * y)] () , mknode "a:ext" [("cx", show $ 12700 * cx), ("cy", show $ 12700 * cy)] () ] @@ -957,25 +955,26 @@ graphicToElement tableWidth (Tbl tblPr hdrCells rows) = do let colWidths = if null hdrCells then case rows of r : _ | not (null r) -> replicate (length r) $ - (tableWidth `div` (toInteger $ length r)) + tableWidth `div` toInteger (length r) -- satisfy the compiler. This is the same as -- saying that rows is empty, but the compiler -- won't understand that `[]` exhausts the -- alternatives. _ -> [] else replicate (length hdrCells) $ - (tableWidth `div` (toInteger $ length hdrCells)) + tableWidth `div` toInteger (length hdrCells) let cellToOpenXML paras = do elements <- mapM paragraphToElement paras let elements' = if null elements then [mknode "a:p" [] [mknode "a:endParaRPr" [] ()]] else elements - return $ + + return [mknode "a:txBody" [] $ - ([ mknode "a:bodyPr" [] () - , mknode "a:lstStyle" [] ()] - <> elements')] + [ mknode "a:bodyPr" [] () + , mknode "a:lstStyle" [] ()] + <> elements'] headers' <- mapM cellToOpenXML hdrCells rows' <- mapM (mapM cellToOpenXML) rows let borderProps = mknode "a:tcPr" [] () @@ -998,8 +997,8 @@ graphicToElement tableWidth (Tbl tblPr hdrCells rows) = do Nothing -> [] Just sty -> [mknode "a:tableStyleId" [] $ T.unpack sty]) - return $ mknode "a:graphic" [] $ - [mknode "a:graphicData" [("uri", "http://schemas.openxmlformats.org/drawingml/2006/table")] $ + return $ mknode "a:graphic" [] + [mknode "a:graphicData" [("uri", "http://schemas.openxmlformats.org/drawingml/2006/table")] [mknode "a:tbl" [] $ [ tblPrElt , mknode "a:tblGrid" [] (if all (==0) colWidths @@ -1203,23 +1202,23 @@ getSlideNumberFieldId notesMaster , Just fldId <- findAttrText (QName "id" Nothing Nothing) fld = return fldId | otherwise = throwError $ - PandocSomeError $ + PandocSomeError "No field id for slide numbers in notesMaster.xml" speakerNotesSlideImage :: Element speakerNotesSlideImage = - mknode "p:sp" [] $ - [ mknode "p:nvSpPr" [] $ + mknode "p:sp" [] + [ mknode "p:nvSpPr" [] [ mknode "p:cNvPr" [ ("id", "2") , ("name", "Slide Image Placeholder 1") ] () - , mknode "p:cNvSpPr" [] $ + , mknode "p:cNvSpPr" [] [ mknode "a:spLocks" [ ("noGrp", "1") , ("noRot", "1") , ("noChangeAspect", "1") ] () ] - , mknode "p:nvPr" [] $ + , mknode "p:nvPr" [] [ mknode "p:ph" [("type", "sldImg")] ()] ] , mknode "p:spPr" [] () @@ -1243,14 +1242,14 @@ speakerNotesBody paras = do let txBody = mknode "p:txBody" [] $ [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] <> elements return $ - mknode "p:sp" [] $ - [ mknode "p:nvSpPr" [] $ + mknode "p:sp" [] + [ mknode "p:nvSpPr" [] [ mknode "p:cNvPr" [ ("id", "3") , ("name", "Notes Placeholder 2") ] () - , mknode "p:cNvSpPr" [] $ + , mknode "p:cNvSpPr" [] [ mknode "a:spLocks" [("noGrp", "1")] ()] - , mknode "p:nvPr" [] $ + , mknode "p:nvPr" [] [ mknode "p:ph" [("type", "body"), ("idx", "1")] ()] ] , mknode "p:spPr" [] () @@ -1259,14 +1258,14 @@ speakerNotesBody paras = do speakerNotesSlideNumber :: Int -> T.Text -> Element speakerNotesSlideNumber pgNum fieldId = - mknode "p:sp" [] $ - [ mknode "p:nvSpPr" [] $ + mknode "p:sp" [] + [ mknode "p:nvSpPr" [] [ mknode "p:cNvPr" [ ("id", "4") , ("name", "Slide Number Placeholder 3") ] () - , mknode "p:cNvSpPr" [] $ + , mknode "p:cNvSpPr" [] [ mknode "a:spLocks" [("noGrp", "1")] ()] - , mknode "p:nvPr" [] $ + , mknode "p:nvPr" [] [ mknode "p:ph" [ ("type", "sldNum") , ("sz", "quarter") , ("idx", "10") @@ -1274,10 +1273,10 @@ speakerNotesSlideNumber pgNum fieldId = ] ] , mknode "p:spPr" [] () - , mknode "p:txBody" [] $ + , mknode "p:txBody" [] [ mknode "a:bodyPr" [] () , mknode "a:lstStyle" [] () - , mknode "a:p" [] $ + , mknode "a:p" [] [ mknode "a:fld" [ ("id", T.unpack fieldId) , ("type", "slidenum") ] @@ -1340,12 +1339,12 @@ slideNum :: PandocMonad m => Slide -> P m Int slideNum slide = getSlideIdNum $ slideId slide idNumToFilePath :: Int -> FilePath -idNumToFilePath idNum = "slide" <> (show $ idNum) <> ".xml" +idNumToFilePath idNum = "slide" <> show idNum <> ".xml" slideToFilePath :: PandocMonad m => Slide -> P m FilePath slideToFilePath slide = do idNum <- slideNum slide - return $ "slide" <> (show $ idNum) <> ".xml" + return $ "slide" <> show idNum <> ".xml" slideToRelId :: PandocMonad m => Slide -> P m T.Text slideToRelId slide = do @@ -1547,7 +1546,7 @@ linkRelElement (rIdNum, InternalTarget targetId) = do , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide") , ("Target", "slide" <> show targetIdNum <> ".xml") ] () -linkRelElement (rIdNum, ExternalTarget (url, _)) = do +linkRelElement (rIdNum, ExternalTarget (url, _)) = return $ mknode "Relationship" [ ("Id", "rId" <> show rIdNum) , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink") @@ -1830,8 +1829,8 @@ presentationToContentTypes p@(Presentation _ slides) = do , DefaultContentType "rels" "application/vnd.openxmlformats-package.relationships+xml" ] mediaDefaults = nub $ - (mapMaybe mediaContentType $ mediaInfos) <> - (mapMaybe mediaFileContentType $ mediaFps) + mapMaybe mediaContentType mediaInfos <> + mapMaybe mediaFileContentType mediaFps inheritedOverrides = mapMaybe pathToOverride filePaths createdOverrides = mapMaybe pathToOverride [ "docProps/core.xml" @@ -1860,8 +1859,8 @@ getContentType fp | fp == "ppt/presProps.xml" = Just $ presML <> ".presProps+xml" | fp == "ppt/viewProps.xml" = Just $ presML <> ".viewProps+xml" | fp == "ppt/tableStyles.xml" = Just $ presML <> ".tableStyles+xml" - | fp == "docProps/core.xml" = Just $ "application/vnd.openxmlformats-package.core-properties+xml" - | fp == "docProps/custom.xml" = Just $ "application/vnd.openxmlformats-officedocument.custom-properties+xml" + | fp == "docProps/core.xml" = Just "application/vnd.openxmlformats-package.core-properties+xml" + | fp == "docProps/custom.xml" = Just "application/vnd.openxmlformats-officedocument.custom-properties+xml" | fp == "docProps/app.xml" = Just $ noPresML <> ".extended-properties+xml" | "ppt" : "slideMasters" : f : [] <- splitDirectories fp , (_, ".xml") <- splitExtension f = diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index d36c92fa3..affe62d31 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -946,8 +946,8 @@ metaToDocProps meta = ss -> Just $ T.intercalate "_x000d_\n" ss customProperties' = case [(k, lookupMetaString k meta) | k <- M.keys (unMeta meta) - , k `notElem` (["title", "author", "keywords", "description" - , "subject","lang","category"])] of + , k `notElem` ["title", "author", "keywords", "description" + , "subject","lang","category"]] of [] -> Nothing ss -> Just ss in diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index d8c559214..c3996a97e 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -607,7 +607,7 @@ inlineToRST (Quoted DoubleQuote lst) = do else return $ "“" <> contents <> "”" inlineToRST (Cite _ lst) = writeInlines lst -inlineToRST (Code (_,["interpreted-text"],[("role",role)]) str) = do +inlineToRST (Code (_,["interpreted-text"],[("role",role)]) str) = return $ ":" <> literal role <> ":`" <> literal str <> "`" inlineToRST (Code _ str) = do opts <- gets stOptions diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 6018b4294..7f8e68651 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -426,5 +426,5 @@ sectionToListItem _ _ = [] endsWithPlain :: [Block] -> Bool endsWithPlain xs = case lastMay xs of - Just (Plain{}) -> True - _ -> False + Just Plain{} -> True + _ -> False diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 387858fd3..eab0d1662 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -70,7 +70,7 @@ pandocToTexinfo options (Pandoc meta blocks) = do then Just $ writerColumns options else Nothing metadata <- metaToContext options - (blockListToTexinfo) + blockListToTexinfo (fmap chomp .inlineListToTexinfo) meta body <- blockListToTexinfo blocks diff --git a/src/Text/Pandoc/Writers/XWiki.hs b/src/Text/Pandoc/Writers/XWiki.hs index 4f9494933..08fad7680 100644 --- a/src/Text/Pandoc/Writers/XWiki.hs +++ b/src/Text/Pandoc/Writers/XWiki.hs @@ -114,9 +114,9 @@ blockToXWiki (BlockQuote blocks) = do let prefixed = map (">" <>) quoteLines return $ vcat prefixed -blockToXWiki (BulletList contents) = blockToXWikiList "*" $ contents +blockToXWiki (BulletList contents) = blockToXWikiList "*" contents -blockToXWiki (OrderedList _ contents) = blockToXWikiList "1" $ contents +blockToXWiki (OrderedList _ contents) = blockToXWikiList "1" contents blockToXWiki (DefinitionList items) = do lev <- asks listLevel @@ -180,9 +180,8 @@ inlineToXWiki (Subscript lst) = do return $ ",," <> contents <> ",," -- TODO: Not supported. Maybe escape to HTML? -inlineToXWiki (SmallCaps lst) = do - contents <- inlineListToXWiki lst - return contents +inlineToXWiki (SmallCaps lst) = + inlineListToXWiki lst inlineToXWiki (Quoted SingleQuote lst) = do contents <- inlineListToXWiki lst @@ -201,7 +200,7 @@ inlineToXWiki (Code (_,classes,_) contents) = do inlineToXWiki (Cite _ lst) = inlineListToXWiki lst --- FIXME: optionally support this (plugin?) +-- FIXME: optionally support this (plugin?) inlineToXWiki (Math _ str) = return $ "{{formula}}" <> str <> "{{/formula}}" inlineToXWiki il@(RawInline frmt str) @@ -232,14 +231,14 @@ inlineToXWiki (Note contents) = do inlineToXWiki (Span (id', _, _) contents) = do contents' <- inlineListToXWiki contents return $ (genAnchor id') <> contents' - + -- Utility method since (for now) all lists are handled the same way blockToXWikiList :: PandocMonad m => Text -> [[Block]] -> XWikiReader m Text blockToXWikiList marker contents = do lev <- asks listLevel contents' <- local (\s -> s { listLevel = listLevel s <> marker } ) $ mapM listItemToXWiki contents return $ vcat contents' <> if Text.null lev then "\n" else "" - + listItemToXWiki :: PandocMonad m => [Block] -> XWikiReader m Text listItemToXWiki contents = do @@ -262,4 +261,3 @@ definitionListItemToMediaWiki (label, items) = do -- Escape the escape character, as well as formatting pairs escapeXWikiString :: Text -> Text escapeXWikiString s = foldr (uncurry replace) s $ zip ["--", "**", "//", "^^", ",,", "~"] ["~-~-", "~*~*", "~/~/", "~^~^", "~,~,", "~~"] - |