From 4002c35a9184ecc1c9a6553e9ee28e283cb1fd0a Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 19 Mar 2021 11:55:59 -0700 Subject: Protect partial uses of maximum with NonEmpty. --- src/Text/Pandoc/Readers/DocBook.hs | 6 ++-- src/Text/Pandoc/Readers/HTML/Table.hs | 3 +- src/Text/Pandoc/Readers/Haddock.hs | 3 +- src/Text/Pandoc/Readers/Markdown.hs | 3 +- src/Text/Pandoc/Readers/Textile.hs | 4 +-- src/Text/Pandoc/Readers/Txt2Tags.hs | 22 +++++++----- src/Text/Pandoc/Writers/AsciiDoc.hs | 3 +- src/Text/Pandoc/Writers/ConTeXt.hs | 6 ++-- src/Text/Pandoc/Writers/DokuWiki.hs | 4 ++- src/Text/Pandoc/Writers/Man.hs | 4 +-- src/Text/Pandoc/Writers/Markdown.hs | 37 ++++++++++--------- src/Text/Pandoc/Writers/Markdown/Inline.hs | 9 ++--- src/Text/Pandoc/Writers/Ms.hs | 4 +-- src/Text/Pandoc/Writers/Muse.hs | 9 +++-- src/Text/Pandoc/Writers/Org.hs | 5 +-- src/Text/Pandoc/Writers/Powerpoint/Output.hs | 42 +++++++++++----------- src/Text/Pandoc/Writers/Powerpoint/Presentation.hs | 5 ++- src/Text/Pandoc/Writers/RST.hs | 6 ++-- src/Text/Pandoc/Writers/Shared.hs | 6 ++-- src/Text/Pandoc/Writers/Texinfo.hs | 9 +++-- src/Text/Pandoc/Writers/ZimWiki.hs | 4 ++- 21 files changed, 108 insertions(+), 86 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index d38b07864..6f5bb0ad4 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -18,6 +18,7 @@ import Data.Either (rights) import Data.Foldable (asum) import Data.Generics import Data.List (intersperse,elemIndex) +import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe,mapMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -949,9 +950,8 @@ parseBlock (Elem e) = (x >= '0' && x <= '9') || x == '.') w if n > 0 then Just n else Nothing - let numrows = case bodyrows of - [] -> 0 - xs -> maximum $ map length xs + let numrows = maybe 0 maximum $ nonEmpty + $ map length bodyrows let aligns = case colspecs of [] -> replicate numrows AlignDefault cs -> map toAlignment cs diff --git a/src/Text/Pandoc/Readers/HTML/Table.hs b/src/Text/Pandoc/Readers/HTML/Table.hs index 6179ea8e7..ad0b51253 100644 --- a/src/Text/Pandoc/Readers/HTML/Table.hs +++ b/src/Text/Pandoc/Readers/HTML/Table.hs @@ -17,6 +17,7 @@ module Text.Pandoc.Readers.HTML.Table (pTable) where import Control.Applicative ((<|>)) import Data.Maybe (fromMaybe) +import Data.List.NonEmpty (nonEmpty) import Data.Text (Text) import Text.HTML.TagSoup import Text.Pandoc.Builder (Blocks) @@ -216,7 +217,7 @@ normalize widths head' bodies foot = do let rows = headRows head' <> concatMap bodyRows bodies <> footRows foot let cellWidth (Cell _ _ _ (ColSpan cs) _) = cs let rowLength = foldr (\cell acc -> cellWidth cell + acc) 0 . rowCells - let ncols = maximum (map rowLength rows) + let ncols = maybe 0 maximum $ nonEmpty $ map rowLength rows let tblType = tableType (map rowCells rows) -- fail on empty table if null rows diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs index 25d69f040..48454e353 100644 --- a/src/Text/Pandoc/Readers/Haddock.hs +++ b/src/Text/Pandoc/Readers/Haddock.hs @@ -17,6 +17,7 @@ module Text.Pandoc.Readers.Haddock import Control.Monad.Except (throwError) import Data.List (intersperse) +import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe) import Data.Text (Text, unpack) import qualified Data.Text as T @@ -92,7 +93,7 @@ docHToBlocks d' = then ([], map toCells bodyRows) else (toCells (head headerRows), map toCells (tail headerRows ++ bodyRows)) - colspecs = replicate (maximum (map length body)) + colspecs = replicate (maybe 0 maximum (nonEmpty (map length body))) (AlignDefault, ColWidthDefault) in B.table B.emptyCaption colspecs diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index c836a896b..a86286b3a 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -22,6 +22,7 @@ import Control.Monad import Control.Monad.Except (throwError) import Data.Char (isAlphaNum, isPunctuation, isSpace) import Data.List (transpose, elemIndex, sortOn, foldl') +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map as M import Data.Maybe import qualified Data.Set as Set @@ -1364,7 +1365,7 @@ pipeTable = try $ do lines' <- many pipeTableRow let lines'' = map (take (length aligns) <$>) lines' let maxlength = maximum $ - map (\x -> T.length . stringify $ runF x def) (heads' : lines'') + fmap (\x -> T.length . stringify $ runF x def) (heads' :| lines'') numColumns <- getOption readerColumns let widths = if maxlength > numColumns then map (\len -> diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index e26b902f1..8d7900de4 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -39,6 +39,7 @@ import Control.Monad (guard, liftM) import Control.Monad.Except (throwError) import Data.Char (digitToInt, isUpper) import Data.List (intersperse, transpose, foldl') +import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import Data.Text (Text) import qualified Data.Text as T import Text.HTML.TagSoup (Tag (..), fromAttrib) @@ -53,7 +54,6 @@ import Text.Pandoc.Parsing import Text.Pandoc.Readers.HTML (htmlTag, isBlockTag, isInlineTag) import Text.Pandoc.Readers.LaTeX (rawLaTeXBlock, rawLaTeXInline) import Text.Pandoc.Shared (crFilter, trim, tshow) -import Data.List.NonEmpty (nonEmpty) -- | Parse a Textile text and return a Pandoc document. readTextile :: PandocMonad m @@ -376,7 +376,7 @@ table = try $ do (toprow:rest) | any (fst . fst) toprow -> (toprow, rest) _ -> (mempty, rawrows) - let nbOfCols = maximum $ map length (headers:rows) + let nbOfCols = maximum $ fmap length (headers :| rows) let aligns = map (maybe AlignDefault minimum . nonEmpty) $ transpose $ map (map (snd . fst)) (headers:rows) let toRow = Row nullAttr . map B.simpleCell diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index 0ce8e286f..f27a3fc2c 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} {- | Module : Text.Pandoc.Readers.Txt2Tags Copyright : Copyright (C) 2014 Matthew Pickering @@ -19,6 +20,7 @@ import Control.Monad.Except (catchError, throwError) import Control.Monad.Reader (Reader, asks, runReader) import Data.Default import Data.List (intercalate, transpose) +import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -53,14 +55,16 @@ getT2TMeta = do inps <- P.getInputFiles outp <- fromMaybe "" <$> P.getOutputFile curDate <- formatTime defaultTimeLocale "%F" <$> P.getZonedTime - let getModTime = fmap (formatTime defaultTimeLocale "%T") . - P.getModificationTime - curMtime <- case inps of - [] -> formatTime defaultTimeLocale "%T" <$> P.getZonedTime - _ -> catchError - (maximum <$> mapM getModTime inps) - (const (return "")) - return $ T2TMeta (T.pack curDate) (T.pack curMtime) (intercalate ", " inps) outp + curMtime <- catchError + ((nonEmpty <$> mapM P.getModificationTime inps) >>= + \case + Nothing -> + formatTime defaultTimeLocale "%T" <$> P.getZonedTime + Just ts -> return $ + formatTime defaultTimeLocale "%T" $ maximum ts) + (const (return "")) + return $ T2TMeta (T.pack curDate) (T.pack curMtime) + (intercalate ", " inps) outp -- | Read Txt2Tags from an input string returning a Pandoc document readTxt2Tags :: PandocMonad m @@ -263,7 +267,7 @@ table = try $ do let ncolumns = length columns let aligns = map (fromMaybe AlignDefault . foldr findAlign Nothing) columns let rows' = map (map snd) rows - let size = maximum (map length rows') + let size = maybe 0 maximum $ nonEmpty $ map length rows' let rowsPadded = map (pad size) rows' let headerPadded = if null tableHeader then mempty else pad size tableHeader let toRow = Row nullAttr . map B.simpleCell diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index b4ef7c8b9..69e608ef9 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -22,6 +22,7 @@ module Text.Pandoc.Writers.AsciiDoc (writeAsciiDoc, writeAsciiDoctor) where import Control.Monad.State.Strict import Data.Char (isPunctuation, isSpace) import Data.List (intercalate, intersperse) +import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (fromMaybe, isJust) import qualified Data.Set as Set import qualified Data.Text as T @@ -274,7 +275,7 @@ blockToAsciiDoc opts block@(Table _ blkCapt specs thead tbody tfoot) = do let colwidth = if writerWrapText opts == WrapAuto then writerColumns opts else 100000 - let maxwidth = maximum $ map offset (head':rows') + let maxwidth = maximum $ fmap offset (head' :| rows') let body = if maxwidth > colwidth then vsep rows' else vcat rows' let border = separator <> text "===" return $ diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 4d44842e2..1c56388ed 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -16,6 +16,7 @@ module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where import Control.Monad.State.Strict import Data.Char (ord, isDigit) import Data.List (intersperse) +import Data.List.NonEmpty (nonEmpty) import Data.Maybe (mapMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -228,8 +229,9 @@ blockToConTeXt (OrderedList (start, style', delim) lst) = do Period -> "stopper=." OneParen -> "stopper=)" TwoParens -> "left=(,stopper=)" - let width = maximum $ map T.length $ take (length contents) - (orderedListMarkers (start, style', delim)) + let width = maybe 0 maximum $ nonEmpty $ map T.length $ + take (length contents) + (orderedListMarkers (start, style', delim)) let width' = (toEnum width + 1) / 2 let width'' = if width' > (1.5 :: Double) then "width=" <> tshow width' <> "em" diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index 7df47c912..602c70ebe 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -27,6 +27,7 @@ import Control.Monad.Reader (ReaderT, asks, local, runReaderT) import Control.Monad.State.Strict (StateT, evalStateT) import Data.Default (Default (..)) import Data.List (transpose) +import Data.List.NonEmpty (nonEmpty) import Data.Text (Text) import qualified Data.Text as T import Text.Pandoc.Class.PandocMonad (PandocMonad, report) @@ -172,7 +173,8 @@ blockToDokuWiki opts (Table _ blkCapt specs thead tbody tfoot) = do then return [] else zipWithM (tableItemToDokuWiki opts) aligns headers rows' <- mapM (zipWithM (tableItemToDokuWiki opts) aligns) rows - let widths = map (maximum . map T.length) $ transpose (headers':rows') + let widths = map (maybe 0 maximum . nonEmpty . map T.length) + $ transpose (headers':rows') let padTo (width, al) s = case width - T.length s of x | x > 0 -> diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index edb70f53e..87b2d8d21 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -16,6 +16,7 @@ Conversion of 'Pandoc' documents to roff man page format. module Text.Pandoc.Writers.Man ( writeMan ) where import Control.Monad.State.Strict import Data.List (intersperse) +import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -175,8 +176,7 @@ 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 T.length markers) + let indent = 1 + maybe 0 maximum (nonEmpty (map T.length markers)) contents <- mapM (\(num, item) -> orderedListItemToMan opts num indent item) $ zip markers items return (vcat contents) diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 533bcc071..4d9f3d5b0 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -24,6 +24,7 @@ import Control.Monad.Reader import Control.Monad.State.Strict import Data.Default import Data.List (intersperse, sortOn, transpose) +import Data.List.NonEmpty (nonEmpty, NonEmpty(..)) import qualified Data.Map as M import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Set as Set @@ -492,19 +493,20 @@ blockToMarkdown' opts (CodeBlock attribs str) = do | isEnabled Ext_fenced_code_blocks opts -> tildes <> attrs <> cr <> literal str <> cr <> tildes <> blankline _ -> nest (writerTabStop opts) (literal str) <> blankline - where endline c = literal $ case [T.length ln - | ln <- map trim (T.lines str) - , T.pack [c,c,c] `T.isPrefixOf` ln - , T.all (== c) ln] of - [] -> T.replicate 3 $ T.singleton c - xs -> T.replicate (maximum xs + 1) $ T.singleton c - backticks = endline '`' - tildes = endline '~' - attrs = if isEnabled Ext_fenced_code_attributes opts - then nowrap $ " " <> attrsToMarkdown attribs - else case attribs of - (_,cls:_,_) -> " " <> literal cls - _ -> empty + where + endlineLen c = maybe 3 ((+1) . maximum) $ nonEmpty $ + [T.length ln + | ln <- map trim (T.lines str) + , T.pack [c,c,c] `T.isPrefixOf` ln + , T.all (== c) ln] + endline c = literal $ T.replicate (endlineLen c) $ T.singleton c + backticks = endline '`' + tildes = endline '~' + attrs = if isEnabled Ext_fenced_code_attributes opts + then nowrap $ " " <> attrsToMarkdown attribs + else case attribs of + (_,cls:_,_) -> " " <> literal cls + _ -> empty blockToMarkdown' opts (BlockQuote blocks) = do variant <- asks envVariant -- if we're writing literate haskell, put a space before the bird tracks @@ -517,7 +519,7 @@ blockToMarkdown' opts (BlockQuote blocks) = do return $ prefixed leader contents <> blankline blockToMarkdown' opts t@(Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot - let numcols = maximum (length aligns : length widths : + let numcols = maximum (length aligns :| length widths : map length (headers:rows)) caption' <- inlineListToMarkdown opts caption let caption'' @@ -619,7 +621,8 @@ pipeTable headless aligns rawHeaders rawRows = do blockFor AlignCenter x y = cblock (x + 2) (sp <> y <> sp) <> lblock 0 empty blockFor AlignRight x y = rblock (x + 2) (y <> sp) <> lblock 0 empty blockFor _ x y = lblock (x + 2) (sp <> y) <> lblock 0 empty - let widths = map (max 3 . maximum . map offset) $ transpose (rawHeaders : rawRows) + let widths = map (max 3 . maybe 3 maximum . nonEmpty . map offset) $ + transpose (rawHeaders : rawRows) let torow cs = nowrap $ literal "|" <> hcat (intersperse (literal "|") $ zipWith3 blockFor aligns widths (map chomp cs)) @@ -653,11 +656,11 @@ pandocTable opts multiline headless aligns widths rawHeaders rawRows = do -- Number of characters per column necessary to output every cell -- without requiring a line break. -- The @+2@ is needed for specifying the alignment. - let numChars = (+ 2) . maximum . map offset + let numChars = (+ 2) . maybe 0 maximum . nonEmpty . map offset -- Number of characters per column necessary to output every cell -- without requiring a line break *inside a word*. -- The @+2@ is needed for specifying the alignment. - let minNumChars = (+ 2) . maximum . map minOffset + let minNumChars = (+ 2) . maybe 0 maximum . nonEmpty . map minOffset let columns = transpose (rawHeaders : rawRows) -- minimal column width without wrapping a single word let relWidth w col = diff --git a/src/Text/Pandoc/Writers/Markdown/Inline.hs b/src/Text/Pandoc/Writers/Markdown/Inline.hs index 19157701e..e35e1a0b9 100644 --- a/src/Text/Pandoc/Writers/Markdown/Inline.hs +++ b/src/Text/Pandoc/Writers/Markdown/Inline.hs @@ -17,6 +17,7 @@ import Control.Monad.Reader import Control.Monad.State.Strict import Data.Char (isAlphaNum, isDigit) import Data.List (find, intersperse) +import Data.List.NonEmpty (nonEmpty) import qualified Data.Map as M import Data.Maybe (fromMaybe) import Data.Text (Text) @@ -383,9 +384,7 @@ inlineToMarkdown opts (Quoted DoubleQuote lst) = do else "“" <> contents <> "”" inlineToMarkdown opts (Code attr str) = do let tickGroups = filter (T.any (== '`')) $ T.group str - let longest = if null tickGroups - then 0 - else maximum $ map T.length tickGroups + let longest = maybe 0 maximum $ nonEmpty $ map T.length tickGroups let marker = T.replicate (longest + 1) "`" let spacer = if longest == 0 then "" else " " let attrs = if isEnabled Ext_inline_code_attributes opts && attr /= nullAttr @@ -438,9 +437,7 @@ inlineToMarkdown opts (Math DisplayMath str) = (texMathToInlines DisplayMath str >>= inlineListToMarkdown opts) inlineToMarkdown opts il@(RawInline f str) = do let tickGroups = filter (T.any (== '`')) $ T.group str - let numticks = if null tickGroups - then 1 - else 1 + maximum (map T.length tickGroups) + let numticks = 1 + maybe 0 maximum (nonEmpty (map T.length tickGroups)) variant <- asks envVariant let Format fmt = f let rawAttribInline = return $ diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs index 48395c420..0ed7a8a64 100644 --- a/src/Text/Pandoc/Writers/Ms.hs +++ b/src/Text/Pandoc/Writers/Ms.hs @@ -23,6 +23,7 @@ module Text.Pandoc.Writers.Ms ( writeMs ) where import Control.Monad.State.Strict import Data.Char (isLower, isUpper, ord) import Data.List (intercalate, intersperse) +import Data.List.NonEmpty (nonEmpty) import qualified Data.Map as Map import Data.Maybe (catMaybes) import Data.Text (Text) @@ -274,8 +275,7 @@ 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 T.length markers) + let indent = 2 + maybe 0 maximum (nonEmpty (map T.length markers)) contents <- mapM (\(num, item) -> orderedListItemToMs opts num indent item) $ zip markers items setFirstPara diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index bf3265107..d5100f43f 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -31,6 +31,7 @@ import Control.Monad.State.Strict import Data.Char (isAlphaNum, isAsciiLower, isAsciiUpper, isDigit, isSpace) import Data.Default import Data.List (intersperse, transpose) +import Data.List.NonEmpty (nonEmpty, NonEmpty(..)) import qualified Data.Set as Set import qualified Data.Text as T import Data.Text (Text) @@ -158,7 +159,8 @@ simpleTable caption headers rows = do caption' <- inlineListToMuse caption headers' <- mapM blockListToMuse headers rows' <- mapM (mapM blockListToMuse) rows - let widthsInChars = maximum . map offset <$> transpose (headers' : rows') + let widthsInChars = maybe 0 maximum . nonEmpty . map offset <$> + transpose (headers' : rows') let hpipeBlocks sep blocks = hcat $ intersperse sep' blocks where sep' = lblock (T.length sep) $ literal sep let makeRow sep = hpipeBlocks sep . zipWith lblock widthsInChars @@ -238,7 +240,7 @@ blockToMuse (DefinitionList items) = do label' <- local (\env -> env { envOneLine = True, envAfterSpace = True }) $ inlineListToMuse' label let ind = offset' label' -- using Text.DocLayout.offset results in round trip failures hang ind (nowrap label') . vcat <$> mapM descriptionToMuse defs - where offset' d = maximum (0: map T.length + where offset' d = maximum (0 :| map T.length (T.lines $ render Nothing d)) descriptionToMuse :: PandocMonad m => [Block] @@ -269,7 +271,8 @@ blockToMuse (Table _ blkCapt specs thead tbody tfoot) = (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot blocksToDoc opts blocks = local (\env -> env { envOptions = opts }) $ blockListToMuse blocks - numcols = maximum (length aligns : length widths : map length (headers:rows)) + numcols = maximum + (length aligns :| length widths : map length (headers:rows)) isSimple = onlySimpleTableCells (headers : rows) && all (== 0) widths blockToMuse (Div _ bs) = flatBlockListToMuse bs blockToMuse Null = return empty diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 29d58a161..bb645eaf9 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -19,6 +19,7 @@ module Text.Pandoc.Writers.Org (writeOrg) where import Control.Monad.State.Strict import Data.Char (isAlphaNum, isDigit) import Data.List (intersect, intersperse, partition, transpose) +import Data.List.NonEmpty (nonEmpty) import Data.Text (Text) import qualified Data.Text as T import Text.Pandoc.Class.PandocMonad (PandocMonad, report) @@ -163,7 +164,7 @@ blockToOrg (Table _ blkCapt specs thead tbody tfoot) = do else "#+caption: " <> caption'' headers' <- mapM blockListToOrg headers rawRows <- mapM (mapM blockListToOrg) rows - let numChars = maximum . map offset + let numChars = maybe 0 maximum . nonEmpty . map offset -- FIXME: width is not being used. let widthsInChars = map numChars $ transpose (headers' : rawRows) @@ -198,7 +199,7 @@ blockToOrg (OrderedList (start, _, delim) items) = do x -> x let markers = take (length items) $ orderedListMarkers (start, Decimal, delim') - let maxMarkerLength = maximum $ map T.length markers + let maxMarkerLength = maybe 0 maximum . nonEmpty $ map T.length markers let markers' = map (\m -> let s = maxMarkerLength - T.length m in m <> T.replicate s " ") markers contents <- zipWithM orderedListItemToOrg markers' items diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs index 4dbf32c4e..0e515b3c2 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs @@ -475,15 +475,16 @@ registerLink link = do linkReg <- gets stLinkIds mediaReg <- gets stMediaIds hasSpeakerNotes <- curSlideHasSpeakerNotes - let maxLinkId = case M.lookup curSlideId linkReg of - Just mp -> case M.keys mp of - [] -> if hasSpeakerNotes then 2 else 1 - ks -> maximum ks - Nothing -> if hasSpeakerNotes then 2 else 1 - maxMediaId = case M.lookup curSlideId mediaReg of - Just [] -> if hasSpeakerNotes then 2 else 1 - Just mInfos -> maximum $ map mInfoLocalId mInfos - Nothing -> if hasSpeakerNotes then 2 else 1 + let maxLinkId = case M.lookup curSlideId linkReg >>= nonEmpty . M.keys of + Just xs -> maximum xs + Nothing + | hasSpeakerNotes -> 2 + | otherwise -> 1 + maxMediaId = case M.lookup curSlideId mediaReg >>= nonEmpty of + Just mInfos -> maximum $ fmap mInfoLocalId mInfos + Nothing + | hasSpeakerNotes -> 2 + | otherwise -> 1 maxId = max maxLinkId maxMediaId slideLinks = case M.lookup curSlideId linkReg of Just mp -> M.insert (maxId + 1) link mp @@ -498,20 +499,19 @@ registerMedia fp caption = do mediaReg <- gets stMediaIds globalIds <- gets stMediaGlobalIds hasSpeakerNotes <- curSlideHasSpeakerNotes - let maxLinkId = case M.lookup curSlideId linkReg of - Just mp -> case M.keys mp of - [] -> if hasSpeakerNotes then 2 else 1 - ks -> maximum ks - Nothing -> if hasSpeakerNotes then 2 else 1 - maxMediaId = case M.lookup curSlideId mediaReg of - Just [] -> if hasSpeakerNotes then 2 else 1 - Just mInfos -> maximum $ map mInfoLocalId mInfos - Nothing -> if hasSpeakerNotes then 2 else 1 + let maxLinkId = case M.lookup curSlideId linkReg >>= nonEmpty . M.keys of + Just ks -> maximum ks + Nothing + | hasSpeakerNotes -> 2 + | otherwise -> 1 + maxMediaId = case M.lookup curSlideId mediaReg >>= nonEmpty of + Just mInfos -> maximum $ fmap mInfoLocalId mInfos + Nothing + | hasSpeakerNotes -> 2 + | otherwise -> 1 maxLocalId = max maxLinkId maxMediaId - maxGlobalId = case M.elems globalIds of - [] -> 0 - ids -> maximum ids + maxGlobalId = maybe 0 maximum $ nonEmpty $ M.elems globalIds (imgBytes, mbMt) <- P.fetchItem $ T.pack fp let imgExt = (mbMt >>= extensionFromMimeType >>= (\x -> return $ "." <> x)) diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index affec38aa..9246a93e9 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -45,6 +45,7 @@ module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation import Control.Monad.Reader import Control.Monad.State import Data.List (intercalate) +import Data.List.NonEmpty (nonEmpty) import Data.Default import Text.Pandoc.Definition import Text.Pandoc.ImageSize @@ -363,9 +364,7 @@ inlineToParElems (Note blks) = do then return [] else do notes <- gets stNoteIds - let maxNoteId = case M.keys notes of - [] -> 0 - lst -> maximum lst + let maxNoteId = maybe 0 maximum $ nonEmpty $ M.keys notes curNoteId = maxNoteId + 1 modify $ \st -> st { stNoteIds = M.insert curNoteId blks notes } local (\env -> env{envRunProps = (envRunProps env){rLink = Just $ InternalTarget endNotesSlideId}}) $ diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 54d042332..0b9fc8331 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -17,6 +17,7 @@ module Text.Pandoc.Writers.RST ( writeRST, flatten ) where import Control.Monad.State.Strict import Data.Char (isSpace) import Data.List (transpose, intersperse, foldl') +import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Text (Text) @@ -335,7 +336,7 @@ blockToRST (OrderedList (start, style', delim) items) = do then replicate (length items) "#." else take (length items) $ orderedListMarkers (start, style', delim) - let maxMarkerLength = maximum $ map T.length markers + let maxMarkerLength = maybe 0 maximum $ nonEmpty $ map T.length markers let markers' = map (\m -> let s = maxMarkerLength - T.length m in m <> T.replicate s " ") markers contents <- zipWithM orderedListItemToRST markers' items @@ -761,8 +762,7 @@ simpleTable opts blocksToDoc headers rows = do then return [] else fixEmpties <$> mapM (blocksToDoc opts) headers rowDocs <- mapM (fmap fixEmpties . mapM (blocksToDoc opts)) rows - let numChars [] = 0 - numChars xs = maximum . map offset $ xs + let numChars = maybe 0 maximum . nonEmpty . map offset let colWidths = map numChars $ transpose (headerDocs : rowDocs) let toRow = mconcat . intersperse (lblock 1 " ") . zipWith lblock colWidths let hline = nowrap $ hsep (map (\n -> literal (T.replicate n "=")) colWidths) diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index fc3f8ff3a..91ecb310b 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -44,6 +44,7 @@ import Control.Monad (zipWithM) import Data.Aeson (ToJSON (..), encode) import Data.Char (chr, ord, isSpace) import Data.List (groupBy, intersperse, transpose, foldl') +import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import Data.Text.Conversions (FromText(..)) import qualified Data.Map as M import qualified Data.Text as T @@ -224,7 +225,7 @@ gridTable :: (Monad m, HasChars a) -> m (Doc a) gridTable opts blocksToDoc headless aligns widths headers rows = do -- the number of columns will be used in case of even widths - let numcols = maximum (length aligns : length widths : + let numcols = maximum (length aligns :| length widths : map length (headers:rows)) let officialWidthsInChars widths' = map ( (\x -> if x < 1 then 1 else x) . @@ -253,8 +254,7 @@ gridTable opts blocksToDoc headless aligns widths headers rows = do let handleFullWidths widths' = do rawHeaders' <- mapM (blocksToDoc opts) headers rawRows' <- mapM (mapM (blocksToDoc opts)) rows - let numChars [] = 0 - numChars xs = maximum . map offset $ xs + let numChars = maybe 0 maximum . nonEmpty . map offset let minWidthsInChars = map numChars $ transpose (rawHeaders' : rawRows') let widthsInChars' = zipWith max diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 9d695563f..0146fdfd8 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -16,6 +16,7 @@ import Control.Monad.Except (throwError) import Control.Monad.State.Strict import Data.Char (chr, ord) import Data.List (maximumBy, transpose, foldl') +import Data.List.NonEmpty (nonEmpty) import Data.Ord (comparing) import qualified Data.Set as Set import Data.Text (Text) @@ -238,9 +239,13 @@ blockToTexinfo (Table _ blkCapt specs thead tbody tfoot) = do colDescriptors <- if all (== 0) widths then do -- use longest entry instead of column widths - cols <- mapM (mapM (liftM (T.unpack . render Nothing . hcat) . mapM blockToTexinfo)) $ + cols <- mapM (mapM (fmap (T.unpack . render Nothing . hcat) . + mapM blockToTexinfo)) $ transpose $ heads : rows - return $ concatMap ((\x -> "{"++x++"} ") . maximumBy (comparing length)) cols + return $ concatMap + ((\x -> "{"++x++"} ") . + maybe "" (maximumBy (comparing length)) . nonEmpty) + cols else return $ "@columnfractions " ++ concatMap (printf "%.2f ") widths let tableBody = text ("@multitable " ++ colDescriptors) $$ headers $$ diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs index 9e45f0417..fcf9e000d 100644 --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -20,6 +20,7 @@ import Control.Monad (zipWithM) import Control.Monad.State.Strict (StateT, evalStateT, gets, modify) import Data.Default (Default (..)) import Data.List (transpose) +import Data.List.NonEmpty (nonEmpty) import qualified Data.Map as Map import Text.DocLayout (render, literal) import Data.Maybe (fromMaybe) @@ -143,7 +144,8 @@ blockToZimWiki opts (Table _ blkCapt specs thead tbody tfoot) = do 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 T.length) $ transpose (headers':rows') + let widths = map (maybe 0 maximum . nonEmpty . map T.length) $ + transpose (headers':rows') let padTo (width, al) s = case width - T.length s of x | x > 0 -> -- cgit v1.2.3