Protect partial uses of maximum with NonEmpty.

This commit is contained in:
John MacFarlane
2021-03-19 11:55:59 -07:00
parent 8d5116381b
commit 4002c35a91
21 changed files with 108 additions and 86 deletions
+3 -3
View File
@@ -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
+2 -1
View File
@@ -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
+2 -1
View File
@@ -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
+2 -1
View File
@@ -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 ->
+2 -2
View File
@@ -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
+13 -9
View File
@@ -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
+2 -1
View File
@@ -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 $
+4 -2
View File
@@ -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"
+3 -1
View File
@@ -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 ->
+2 -2
View File
@@ -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)
+20 -17
View File
@@ -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 =
+3 -6
View File
@@ -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 $
+2 -2
View File
@@ -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
+6 -3
View File
@@ -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
+3 -2
View File
@@ -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
+21 -21
View File
@@ -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))
@@ -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}}) $
+3 -3
View File
@@ -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)
+3 -3
View File
@@ -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
+7 -2
View File
@@ -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 $$
+3 -1
View File
@@ -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 ->