diff options
| author | John MacFarlane <[email protected]> | 2021-03-11 15:49:27 -0800 |
|---|---|---|
| committer | John MacFarlane <[email protected]> | 2021-03-13 15:05:37 -0800 |
| commit | 8be95ad8e5150d5cab66c4abdf59baaf4670c6c8 (patch) | |
| tree | 9655036efbaabda6a2a7802dc971c7fba5a987ca /src/Text/Pandoc/Writers | |
| parent | 35b66a76718205c303f416bf0afc01c098e8a171 (diff) | |
Use custom Prelude based on relude.relude
The Prelude now longer exports partial functions, so
a large number of uses of these functions in the
code base have been rewritten.
A .ghci file has been added; this is necessary for
ghci to work properly with the custom Prelude.
Currently there are lots of compiler warnings.
We should either fix these or go to using a custom
Prelude that changes less than relude.
Diffstat (limited to 'src/Text/Pandoc/Writers')
35 files changed, 192 insertions, 167 deletions
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index b4ef7c8b9..12a5ba6dc 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -274,7 +274,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 = maximum1 $ 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..a0c7326ae 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -228,8 +228,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 = fromMaybe 0 $ viaNonEmpty maximum1 + $ 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" @@ -239,7 +240,8 @@ blockToConTeXt (OrderedList (start, style', delim) lst) = do then "" else "[" <> T.intercalate "," specs2Items <> "]" let style'' = '[': (case style' of - DefaultStyle -> orderedListStyles !! level + DefaultStyle -> fromMaybe 'n' $ + orderedListStyles !!? level Decimal -> 'n' Example -> 'n' LowerRoman -> 'r' @@ -280,20 +282,20 @@ tableToConTeXt Xtb heads rows = (if isEmpty heads then empty else "\\startxtablehead[head]" $$ heads $$ "\\stopxtablehead") $$ - (if null rows - then empty - else "\\startxtablebody[body]" $$ vcat (init rows) $$ "\\stopxtablebody" $$ - "\\startxtablefoot[foot]" $$ last rows $$ "\\stopxtablefoot") $$ + fromMaybe empty + (flip viaNonEmpty rows $ \rs -> + "\\startxtablebody[body]" $$ vcat (init rs) $$ "\\stopxtablebody" $$ + "\\startxtablefoot[foot]" $$ last rs $$ "\\stopxtablefoot") $$ "\\stopxtable" tableToConTeXt Ntb heads rows = return $ "\\startTABLE" $$ (if isEmpty heads then empty else "\\startTABLEhead" $$ heads $$ "\\stopTABLEhead") $$ - (if null rows - then empty - else "\\startTABLEbody" $$ vcat (init rows) $$ "\\stopTABLEbody" $$ - "\\startTABLEfoot" $$ last rows $$ "\\stopTABLEfoot") $$ + fromMaybe empty + (flip viaNonEmpty rows $ \rs -> + "\\startTABLEbody" $$ vcat (init rs) $$ "\\stopTABLEbody" $$ + "\\startTABLEfoot" $$ last rs $$ "\\stopTABLEfoot") $$ "\\stopTABLE" tableRowToConTeXt :: PandocMonad m => Tabl -> [Alignment] -> [Double] -> [[Block]] -> WM m (Doc Text) @@ -456,9 +458,9 @@ inlineToConTeXt (Image attr@(_,cls,_) _ (src, _)) = do dims = if null dimList then empty else brackets $ mconcat (intersperse "," dimList) - clas = if null cls - then empty - else brackets $ literal $ toLabel $ head cls + clas = case cls of + [] -> empty + (x:_) -> brackets $ literal $ toLabel x -- Use / for path separators on Windows; see #4918 fixPathSeparators = T.map $ \c -> case c of '\\' -> '/' diff --git a/src/Text/Pandoc/Writers/CslJson.hs b/src/Text/Pandoc/Writers/CslJson.hs index a10def95e..4f1c73349 100644 --- a/src/Text/Pandoc/Writers/CslJson.hs +++ b/src/Text/Pandoc/Writers/CslJson.hs @@ -24,7 +24,6 @@ import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Error import Text.Pandoc.Class import Control.Monad.Except (throwError) -import Data.ByteString.Lazy (toStrict) import Data.ByteString (ByteString) import Text.Pandoc.Definition import Text.Pandoc.Builder as B diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 58c4bb5be..78a327cb1 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Writers.Custom Copyright : Copyright (C) 2012-2021 John MacFarlane @@ -63,7 +64,7 @@ instance Pushable (Stringify Citation) where addField "citationId" $ citationId cit addField "citationPrefix" . Stringify $ citationPrefix cit addField "citationSuffix" . Stringify $ citationSuffix cit - addField "citationMode" $ show (citationMode cit) + addField "citationMode" $ show @String (citationMode cit) addField "citationNoteNum" $ citationNoteNum cit addField "citationHash" $ citationHash cit @@ -142,7 +143,7 @@ blockToCustom (BlockQuote blocks) = blockToCustom (Table _ blkCapt specs thead tbody tfoot) = let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot - aligns' = map show aligns + aligns' = map (show @String) aligns capt' = Stringify capt headers' = map Stringify headers rows' = map (map Stringify) rows @@ -152,7 +153,8 @@ blockToCustom (BulletList items) = Lua.callFunc "BulletList" (map Stringify items) blockToCustom (OrderedList (num,sty,delim) items) = - Lua.callFunc "OrderedList" (map Stringify items) num (show sty) (show delim) + Lua.callFunc "OrderedList" (map Stringify items) + num (show @String sty) (show @String delim) blockToCustom (DefinitionList items) = Lua.callFunc "DefinitionList" diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index a6776608d..256426767 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -81,7 +81,8 @@ authorToDocbook opts name' = do (firstname, lastname) = case lengthname of 0 -> ("","") 1 -> ("", name) - n -> (T.unwords (take (n-1) namewords), last namewords) + n -> (T.unwords (take (n-1) namewords), + fromMaybe mempty (viaNonEmpty last namewords)) in inTagsSimple "firstname" (literal $ escapeStringForXML firstname) $$ inTagsSimple "surname" (literal $ escapeStringForXML lastname) @@ -253,10 +254,9 @@ blockToDocbook opts (BlockQuote blocks) = blockToDocbook _ (CodeBlock (_,classes,_) str) = return $ literal ("<programlisting" <> lang <> ">") <> cr <> flush (literal (escapeStringForXML str) <> cr <> literal "</programlisting>") - where lang = if null langs - then "" - else " language=\"" <> escapeStringForXML (head langs) <> - "\"" + where lang = case langs of + [] -> "" + (l:_) -> " language=\"" <> escapeStringForXML l <> "\"" isLang l = T.toLower l `elem` map T.toLower languages langsFrom s = if isLang s then [s] diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index 7df47c912..525391f74 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -172,7 +172,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 (fromMaybe 0 . viaNonEmpty maximum1 . 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/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 3f10cb437..37aeb504d 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -35,7 +35,7 @@ import qualified Data.Text.Lazy as TL import Network.HTTP (urlEncode) import System.FilePath (takeExtension, takeFileName, makeRelative) import Text.HTML.TagSoup (Tag (TagOpen), fromAttrib, parseTags) -import Text.Pandoc.Builder (fromList, setMeta) +import Text.Pandoc.Builder as B import Text.Pandoc.Class.PandocMonad (PandocMonad, report) import qualified Text.Pandoc.Class.PandocPure as P import qualified Text.Pandoc.Class.PandocMonad as P @@ -644,8 +644,8 @@ pandocToEPUB version opts doc = do (Div (_,"section":_,kvs) (Header _ _ xs : _) : _) -> -- remove notes or we get doubled footnotes - (Pandoc (setMeta "title" - (walk removeNote $ fromList xs) nullMeta) bs, + (Pandoc (B.setMeta "title" + (walk removeNote $ B.fromList xs) nullMeta) bs, case lookup "epub:type" kvs of Nothing -> "bodymatter" Just x @@ -903,8 +903,8 @@ pandocToEPUB version opts doc = do ,("body-type", toVal' "frontmatter") ]) <> cssvars False <> vars } - (Pandoc (setMeta "title" - (walk removeNote $ fromList $ docTitle' meta) nullMeta) + (Pandoc (B.setMeta "title" + (walk removeNote $ B.fromList $ docTitle' meta) nullMeta) (navBlocks ++ landmarks)) navEntry <- mkEntry "nav.xhtml" navData diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 3b5d04427..04d676307 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -42,6 +42,7 @@ import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers, makeSections, tshow, stringify) import Text.Pandoc.Writers.Shared (lookupMetaString, toLegacyTable) import Data.Generics (everywhere, mkT) +import qualified GHC.Show -- | Data to be written at the end of the document: -- (foot)notes, URLs, references, images. @@ -61,7 +62,7 @@ newFB = FbRenderState { footnotes = [], imagesToFetch = [] , writerOptions = def } data ImageMode = NormalImage | InlineImage deriving (Eq) -instance Show ImageMode where +instance GHC.Show.Show ImageMode where show NormalImage = "imageType" show InlineImage = "inlineImageType" @@ -143,8 +144,11 @@ author ss = [fname, lname] -> [ el "first-name" fname , el "last-name" lname ] (fname:rest) -> [ el "first-name" fname - , el "middle-name" (T.concat . init $ rest) - , el "last-name" (last rest) ] + , el "middle-name" + (maybe mempty T.concat + (viaNonEmpty init rest)) + , el "last-name" + (fromMaybe mempty (viaNonEmpty last rest)) ] [] -> [] in list $ el "author" (names ++ email) diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 2f33cd467..7ec3001f4 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -375,12 +375,12 @@ prefixedId opts s = "" -> mempty _ -> A.id $ toValue $ writerIdentifierPrefix opts <> s -toList :: PandocMonad m - => (Html -> Html) - -> WriterOptions - -> [Html] - -> StateT WriterState m Html -toList listop opts items = do +toList' :: PandocMonad m + => (Html -> Html) + -> WriterOptions + -> [Html] + -> StateT WriterState m Html +toList' listop opts items = do slideVariant <- gets stSlideVariant return $ if writerIncremental opts @@ -391,15 +391,15 @@ toList listop opts items = do unordList :: PandocMonad m => WriterOptions -> [Html] -> StateT WriterState m Html -unordList opts = toList H.ul opts . toListItems opts +unordList opts = toList' H.ul opts . toListItems opts ordList :: PandocMonad m => WriterOptions -> [Html] -> StateT WriterState m Html -ordList opts = toList H.ol opts . toListItems opts +ordList opts = toList' H.ol opts . toListItems opts defList :: PandocMonad m => WriterOptions -> [Html] -> StateT WriterState m Html -defList opts items = toList H.dl opts (items ++ [nl opts]) +defList opts items = toList' H.dl opts (items ++ [nl opts]) isTaskListItem :: [Block] -> Bool isTaskListItem (Plain (Str "☐":Space:_):_) = True @@ -544,7 +544,7 @@ tagWithAttributes opts html5 selfClosing tagname attr = addAttrs :: PandocMonad m => WriterOptions -> Attr -> Html -> StateT WriterState m Html -addAttrs opts attr h = foldl (!) h <$> attrsToHtml opts attr +addAttrs opts attr h = foldl' (!) h <$> attrsToHtml opts attr toAttrs :: PandocMonad m => [(Text, Text)] -> StateT WriterState m [Attribute] @@ -926,7 +926,7 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do numstyle'] else []) l <- ordList opts contents - return $ foldl (!) l attribs + return $ foldl' (!) l attribs blockToHtml opts (DefinitionList lst) = do contents <- mapM (\(term, defs) -> do term' <- liftM H.dt $ inlineListToHtml opts term @@ -1075,7 +1075,8 @@ colSpecListToHtml opts colspecs = do let hasDefaultWidth (_, ColWidthDefault) = True hasDefaultWidth _ = False - let percent w = show (truncate (100*w) :: Integer) <> "%" + let percent :: Double -> Text + percent w = show (truncate (100*w) :: Integer) <> "%" let col :: ColWidth -> Html col cw = do @@ -1238,7 +1239,7 @@ inlineToHtml opts inline = do in case spanLikeTag of Just tag -> do h <- inlineListToHtml opts ils - addAttrs opts (id',tail classes',kvs') $ tag h + addAttrs opts (id',drop 1 classes',kvs') $ tag h Nothing -> do h <- inlineListToHtml opts ils addAttrs opts (id',classes',kvs') (H.span h) @@ -1407,7 +1408,7 @@ inlineToHtml opts inline = do Just "audio" -> mediaTag H5.audio "Audio" Just _ -> (H5.embed, []) _ -> imageTag - return $ foldl (!) tag $ attributes ++ specAttrs + return $ foldl' (!) tag $ attributes ++ specAttrs -- note: null title included, as in Markdown.pl (Note contents) -> do notes <- gets stNotes @@ -1455,10 +1456,9 @@ blockListToNote opts ref blocks = do let kvs = [("role","doc-backlink") | html5] let backlink = [Link ("",["footnote-back"],kvs) [Str "↩"] ("#" <> "fnref" <> ref,"")] - let blocks' = if null blocks - then [] - else let lastBlock = last blocks - otherBlocks = init blocks + let blocks' = fromMaybe [] $ flip viaNonEmpty blocks $ \bs -> + let lastBlock = last bs + otherBlocks = init bs in case lastBlock of Para [Image _ _ (_,tit)] | "fig:" `T.isPrefixOf` tit diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index c254fbc58..284628de9 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -342,9 +342,9 @@ blockToICML opts style (Table _ blkCapt specs thead tbody tfoot) = then "0" else "1" nrRows = length rows - nrCols = if null rows - then 0 - else length $ head rows + nrCols = case rows of + [] -> 0 + (r:_) -> length r rowsToICML [] _ = return empty rowsToICML (col:rest) rowNr = liftM2 ($$) (colsToICML col aligns rowNr (0::Int)) $ rowsToICML rest (rowNr+1) @@ -416,14 +416,15 @@ listItemToICML opts style isFirst attribs item = then firstListItemName:style else style stl' = makeNumbStart attribs ++ stl - in if length item > 1 - then do - let insertTab (Para lst) = blockToICML opts (subListParName:style) $ Para $ Str "\t":lst + in case item of + (x:xs@(_:_)) -> do + let insertTab (Para lst) = blockToICML opts (subListParName:style) + $ Para $ Str "\t":lst insertTab block = blockToICML opts style block - f <- blockToICML opts stl' $ head item - r <- mapM insertTab $ tail item + f <- blockToICML opts stl' x + r <- mapM insertTab xs return $ intersperseBrs (f : r) - else blocksToICML opts stl' item + _ -> blocksToICML opts stl' item definitionListItemToICML :: PandocMonad m => WriterOptions -> Style -> ([Inline],[[Block]]) -> WS m (Doc Text) definitionListItemToICML opts style (term,defs) = do @@ -470,9 +471,9 @@ inlineToICML _ _ _ il@(RawInline f str) inlineToICML opts style ident (Link _ lst (url, title)) = do content <- inlinesToICML opts (linkName:style) ident lst state $ \st -> - let link_id = if null $ links st - then 1::Int - else 1 + fst (head $ links st) + let link_id = case links st of + [] -> 1 :: Int + (l:_) -> 1 + fst l newst = st{ links = (link_id, url):links st } cont = inTags True "HyperlinkTextSource" [("Self","htss-"<>tshow link_id), ("Name",title), ("Hidden","false")] content @@ -531,11 +532,11 @@ parStyle opts style ident lst = attrs' = if firstListItemName `elem` style then let ats = attrs : [("NumberingContinue", "false")] begins = filter (Text.isPrefixOf beginsWithName) style - in if null begins - then ats - else let i = fromMaybe "" $ Text.stripPrefix beginsWithName - $ head begins - in ("NumberingStartAt", i) : ats + in case begins of + [] -> ats + (b:_) -> let i = fromMaybe "" $ + Text.stripPrefix beginsWithName b + in ("NumberingStartAt", i) : ats else [attrs] in do content <- inlinesToICML opts [] ident lst diff --git a/src/Text/Pandoc/Writers/Ipynb.hs b/src/Text/Pandoc/Writers/Ipynb.hs index 2613851c5..76e2e2e09 100644 --- a/src/Text/Pandoc/Writers/Ipynb.hs +++ b/src/Text/Pandoc/Writers/Ipynb.hs @@ -14,9 +14,9 @@ Ipynb (Jupyter notebook JSON format) writer for pandoc. -} module Text.Pandoc.Writers.Ipynb ( writeIpynb ) where -import Control.Monad.State import qualified Data.Map as M import Data.Maybe (catMaybes, fromMaybe) +import Control.Monad (foldM) import Text.Pandoc.Options import Text.Pandoc.Definition import Data.Ipynb as Ipynb diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index a9369db7a..b2095329e 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -20,8 +20,6 @@ module Text.Pandoc.Writers.JATS , writeJatsPublishing , writeJatsArticleAuthoring ) where -import Control.Monad.Reader -import Control.Monad.State import Data.Generics (everywhere, mkT) import Data.List (partition) import qualified Data.Map as M @@ -50,6 +48,7 @@ import Text.Pandoc.XML import Text.TeXMath import qualified Text.Pandoc.Writers.AnnotatedTable as Ann import qualified Text.XML.Light as Xml +import Control.Monad (msum) -- | Convert a @'Pandoc'@ document to JATS (Archiving and Interchange -- Tag Set.) diff --git a/src/Text/Pandoc/Writers/JATS/Types.hs b/src/Text/Pandoc/Writers/JATS/Types.hs index 6fdddc0b5..33f6be930 100644 --- a/src/Text/Pandoc/Writers/JATS/Types.hs +++ b/src/Text/Pandoc/Writers/JATS/Types.hs @@ -18,9 +18,6 @@ module Text.Pandoc.Writers.JATS.Types where import Citeproc.Types (Reference) -import Control.Monad.Reader (ReaderT) -import Control.Monad.State (StateT) -import Data.Text (Text) import Text.DocLayout (Doc) import Text.Pandoc.Builder (Block, Inline, Inlines) import Text.Pandoc.Options (WriterOptions) diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 180aaa44d..4e2266fa6 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -107,11 +107,12 @@ pandocToLaTeX options (Pandoc meta blocks) = do Nothing -> return () Just "false" -> return () Just _ -> modify $ \s -> s{stCsquotes = True} - let (blocks'', lastHeader) = if writerCiteMethod options == Citeproc then - (blocks', []) - else case reverse blocks' of - Header 1 _ il : _ -> (init blocks', il) - _ -> (blocks', []) + let (blocks'', lastHeader) = + if writerCiteMethod options == Citeproc + then (blocks', []) + else case viaNonEmpty (\bs -> (last bs, init bs)) blocks' of + Just (Header 1 _ il, bsInit) -> (bsInit, il) + _ -> (blocks', []) blocks''' <- if beamer then toSlides blocks'' else return $ makeSections False Nothing blocks'' @@ -851,12 +852,12 @@ inlineToLaTeX (Quoted qt lst) = do DoubleQuote -> "\\enquote" <> braces contents SingleQuote -> "\\enquote*" <> braces contents else do - let s1 = if not (null lst) && isQuoted (head lst) - then "\\," - else empty - let s2 = if not (null lst) && isQuoted (last lst) - then "\\," - else empty + let s1 = case lst of + (x:_) | isQuoted x -> "\\," + _ -> empty + let s2 = case viaNonEmpty last lst of + Just x | isQuoted x -> "\\," + _ -> empty let inner = s1 <> contents <> s2 return $ case qt of DoubleQuote -> diff --git a/src/Text/Pandoc/Writers/LaTeX/Citation.hs b/src/Text/Pandoc/Writers/LaTeX/Citation.hs index f48a43d7a..3844f9b17 100644 --- a/src/Text/Pandoc/Writers/LaTeX/Citation.hs +++ b/src/Text/Pandoc/Writers/LaTeX/Citation.hs @@ -43,16 +43,19 @@ citationsToNatbib inlineListToLaTeX [one] NormalCitation -> "citep" citationsToNatbib inlineListToLaTeX cits - | noPrefix (tail cits) && noSuffix (init cits) && ismode NormalCitation cits - = citeCommand inlineListToLaTeX "citep" p s ks + | Just citsTail <- viaNonEmpty tail cits + , Just citsInit <- viaNonEmpty init cits + , Just citsHead <- viaNonEmpty head cits + , Just citsLast <- viaNonEmpty last cits + , noPrefix citsTail + , noSuffix citsInit + , ismode NormalCitation cits + = citeCommand inlineListToLaTeX "citep" + (citationPrefix citsHead) (citationSuffix citsLast) ks where noPrefix = all (null . citationPrefix) noSuffix = all (null . citationSuffix) ismode m = all ((==) m . citationMode) - p = citationPrefix $ - head cits - s = citationSuffix $ - last cits ks = T.intercalate ", " $ map citationId cits citationsToNatbib inlineListToLaTeX (c:cs) diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index edb70f53e..e81545380 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -175,8 +175,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 + fromMaybe 0 (viaNonEmpty maximum1 (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..05d22f754 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -23,7 +23,7 @@ module Text.Pandoc.Writers.Markdown ( import Control.Monad.Reader import Control.Monad.State.Strict import Data.Default -import Data.List (intersperse, sortOn, transpose) +import Data.List (intersperse, sortOn, transpose, zipWith3) import qualified Data.Map as M import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Set as Set @@ -497,7 +497,10 @@ blockToMarkdown' opts (CodeBlock attribs str) = do , 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 + xs -> T.replicate + (fromMaybe 0 + (viaNonEmpty maximum1 xs) + 1) + (T.singleton c) backticks = endline '`' tildes = endline '~' attrs = if isEnabled Ext_fenced_code_attributes opts @@ -517,8 +520,8 @@ 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 : - map length (headers:rows)) + let numcols = maximum1 + (length aligns :| length widths : map length (headers:rows)) caption' <- inlineListToMarkdown opts caption let caption'' | null caption = blankline @@ -619,7 +622,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 . fromMaybe 0 . viaNonEmpty maximum1 . map offset) + $ transpose (rawHeaders : rawRows) let torow cs = nowrap $ literal "|" <> hcat (intersperse (literal "|") $ zipWith3 blockFor aligns widths (map chomp cs)) @@ -653,11 +657,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) . fromMaybe 0 . viaNonEmpty maximum1 . 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) . fromMaybe 0 . viaNonEmpty maximum1 . 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..5592340f5 100644 --- a/src/Text/Pandoc/Writers/Markdown/Inline.hs +++ b/src/Text/Pandoc/Writers/Markdown/Inline.hs @@ -383,9 +383,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 = fromMaybe 0 $ viaNonEmpty maximum1 $ 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 @@ -440,7 +438,8 @@ 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) + else maybe 1 (1 +) $ + viaNonEmpty maximum1 (map T.length tickGroups) variant <- asks envVariant let Format fmt = f let rawAttribInline = return $ diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 5029be69f..f4203e097 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -245,7 +245,10 @@ definitionListItemToMediaWiki (label, items) = do else do marker <- asks listLevel return $ T.pack marker <> " " <> labelText <> "\n" <> - T.intercalate "\n" (map (\d -> T.pack (init marker) <> ": " <> d) contents) + T.intercalate "\n" + (map (\d -> + maybe mempty T.pack (viaNonEmpty init marker) <> + ": " <> d) contents) -- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed. isSimpleList :: Block -> Bool diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs index 48395c420..791189469 100644 --- a/src/Text/Pandoc/Writers/Ms.hs +++ b/src/Text/Pandoc/Writers/Ms.hs @@ -274,8 +274,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 + fromMaybe 0 (viaNonEmpty maximum1 (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..242769f73 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -158,7 +158,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 = fromMaybe 0 . viaNonEmpty maximum1 . 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,8 +239,8 @@ 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 - (T.lines $ render Nothing d)) + where offset' d = maximum1 + (0 :| map T.length (T.lines $ render Nothing d)) descriptionToMuse :: PandocMonad m => [Block] -> Muse m (Doc Text) @@ -269,7 +270,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 = maximum1 + (length aligns :| length widths : map length (headers:rows)) isSimple = onlySimpleTableCells (headers : rows) && all (== 0) widths blockToMuse (Div _ bs) = flatBlockListToMuse bs blockToMuse Null = return empty @@ -711,7 +713,11 @@ inlineToMuse (Span (anchor,names,kvs) inlines) = do then mempty else literal ("#" <> anchor) <> space modify $ \st -> st { stUseTags = False } - return $ anchorDoc <> (if null inlines && not (T.null anchor) - then mempty - else (if null names then (if hasDir then contents' else "<class>" <> contents' <> "</class>") - else "<class name=\"" <> literal (head names) <> "\">" <> contents' <> "</class>")) + return $ anchorDoc <> + (if null inlines && not (T.null anchor) + then mempty + else case names of + [] | hasDir -> contents' + | otherwise -> "<class>" <> contents' <> "</class>" + (n:_) -> "<class name=\"" <> literal n <> + "\">" <> contents' <> "</class>") diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs index 9c2ce805d..493e0a1b9 100644 --- a/src/Text/Pandoc/Writers/Native.hs +++ b/src/Text/Pandoc/Writers/Native.hs @@ -18,6 +18,7 @@ import Text.Pandoc.Class.PandocMonad (PandocMonad) import Text.Pandoc.Definition import Text.Pandoc.Options (WrapOption (..), WriterOptions (..)) import Text.DocLayout +import Text.Show hiding (show) prettyList :: [Doc Text] -> Doc Text prettyList ds = diff --git a/src/Text/Pandoc/Writers/OOXML.hs b/src/Text/Pandoc/Writers/OOXML.hs index 0533d6c12..792ce05fa 100644 --- a/src/Text/Pandoc/Writers/OOXML.hs +++ b/src/Text/Pandoc/Writers/OOXML.hs @@ -50,9 +50,6 @@ nodename s = QName{ qName = name, qURI = Nothing, qPrefix = prefix } Nothing -> (xs, Nothing) Just (_,zs) -> (zs, Just xs) -toLazy :: B.ByteString -> BL.ByteString -toLazy = BL.fromChunks . (:[]) - renderXml :: Element -> BL.ByteString renderXml elt = BL.fromStrict (UTF8.fromText (showTopElement elt)) diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index cf42f2228..b9d8de756 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -15,7 +15,7 @@ Conversion of 'Pandoc' documents to OpenDocument XML. -} module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where import Control.Arrow ((***), (>>>)) -import Control.Monad.State.Strict hiding (when) +import Control.Monad.State.Strict import Data.Char (chr) import Data.Foldable (find) import Data.List (sortOn, sortBy, foldl') @@ -97,9 +97,6 @@ defaultWriterState = , stIdentTypes = [] } -when :: Bool -> Doc Text -> Doc Text -when p a = if p then a else empty - addTableStyle :: PandocMonad m => Doc Text -> OD m () addTableStyle i = modify $ \s -> s { stTableStyles = i : stTableStyles s } @@ -226,7 +223,9 @@ handleSpaces s = case T.uncons s of _ -> rm s where genTag = T.span (==' ') >>> tag . T.length *** rm >>> uncurry (<>) - tag n = when (n /= 0) $ selfClosingTag "text:s" [("text:c", tshow n)] + tag n = if n /= 0 + then selfClosingTag "text:s" [("text:c", tshow n)] + else mempty rm t = case T.uncons t of Just ( ' ',xs) -> char ' ' <> genTag xs Just ('\t',xs) -> selfClosingTag "text:tab" [] <> genTag xs @@ -309,9 +308,11 @@ orderedItemToOpenDocument o n bs = vcat <$> mapM go bs go b = blockToOpenDocument o b newLevel a l = do nn <- length <$> gets stParaStyles - ls <- head <$> gets stListStyles - modify $ \s -> s { stListStyles = orderedListLevelStyle a ls : - drop 1 (stListStyles s) } + listStyles <- gets stListStyles + case listStyles of + [] -> return () + (lst:rest) -> modify $ \s -> s { stListStyles = + orderedListLevelStyle a lst : rest } inTagsIndented "text:list" <$> orderedListToOpenDocument o nn l isTightList :: [[Block]] -> Bool @@ -720,7 +721,8 @@ bulletListStyle l = do [ ("text:level" , tshow (i + 1)) , ("text:style-name" , "Bullet_20_Symbols" ) , ("style:num-suffix", "." ) - , ("text:bullet-char", T.singleton (bulletList !! i)) + , ("text:bullet-char", maybe mempty T.singleton + (bulletList !!? i)) ] (listLevelStyle (1 + i)) bulletList = map chr $ cycle [8226,9702,9642] listElStyle = map doStyles [0..9] diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 29d58a161..345f1cfd0 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -163,7 +163,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 = fromMaybe 0 . viaNonEmpty maximum1 . map offset -- FIXME: width is not being used. let widthsInChars = map numChars $ transpose (headers' : rawRows) @@ -198,7 +198,8 @@ 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 = + fromMaybe 0 $ viaNonEmpty maximum1 $ 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 5caeb0753..a9fb4e46a 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs @@ -17,9 +17,8 @@ module Text.Pandoc.Writers.Powerpoint.Output ( presentationToArchive ) where import Control.Monad.Except (throwError, catchError) -import Control.Monad.Reader -import Control.Monad.State import Codec.Archive.Zip +import Control.Monad (foldM) import Data.List (intercalate, stripPrefix, nub, union, isPrefixOf, intersperse) import Data.Default import Data.Text (Text) @@ -477,11 +476,12 @@ registerLink link = do let maxLinkId = case M.lookup curSlideId linkReg of Just mp -> case M.keys mp of [] -> if hasSpeakerNotes then 2 else 1 - ks -> maximum ks + ks -> fromMaybe 0 $ viaNonEmpty maximum1 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 + Just mInfos -> fromMaybe 0 $ viaNonEmpty maximum1 + $ map mInfoLocalId mInfos Nothing -> if hasSpeakerNotes then 2 else 1 maxId = max maxLinkId maxMediaId slideLinks = case M.lookup curSlideId linkReg of @@ -500,17 +500,18 @@ registerMedia fp caption = do let maxLinkId = case M.lookup curSlideId linkReg of Just mp -> case M.keys mp of [] -> if hasSpeakerNotes then 2 else 1 - ks -> maximum ks + ks -> fromMaybe 0 $ viaNonEmpty maximum1 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 + Just mInfos -> fromMaybe 0 $ viaNonEmpty maximum1 + $ map mInfoLocalId mInfos Nothing -> if hasSpeakerNotes then 2 else 1 maxLocalId = max maxLinkId maxMediaId maxGlobalId = case M.elems globalIds of [] -> 0 - ids -> maximum ids + ids -> fromMaybe 0 $ viaNonEmpty maximum1 ids (imgBytes, mbMt) <- P.fetchItem $ T.pack fp let imgExt = (mbMt >>= extensionFromMimeType >>= (\x -> return $ "." <> x)) @@ -1431,7 +1432,7 @@ presentationToRels pres@(Presentation _ slides) = do [] -> 0 -- doesn't matter in this case, since -- there will be nothing to map the -- function over - l -> minimum l + l -> fromMaybe 0 $ viaNonEmpty minimum1 l modifyRelNum :: Int -> Int modifyRelNum 1 = 1 diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index affec38aa..a5d2dfac1 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -42,8 +42,7 @@ module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation ) where -import Control.Monad.Reader -import Control.Monad.State +import Control.Monad.State (liftM) import Data.List (intercalate) import Data.Default import Text.Pandoc.Definition @@ -363,9 +362,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 = fromMaybe 0 $ viaNonEmpty maximum1 $ 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 d01e13db4..ae1913a60 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -266,7 +266,7 @@ blockToRST (Header level (name,classes,_) inlines) = do isTopLevel <- gets stTopLevel if isTopLevel then do - let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1) + let headerChar = fromMaybe ' ' $ "=-~^'" !!? (level - 1) let border = literal $ T.replicate (offset contents) $ T.singleton headerChar let anchor | T.null name || name == autoId = empty | otherwise = ".. _" <> literal name <> ":" $$ blankline @@ -335,7 +335,8 @@ 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 = + fromMaybe 0 $ viaNonEmpty maximum1 $ 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 @@ -509,7 +510,7 @@ flatten outer | null contents = [outer] | otherwise = combineAll contents where contents = dropInlineParent outer - combineAll = foldl combine [] + combineAll = foldl' combine [] combine :: [Inline] -> Inline -> [Inline] combine f i = @@ -539,9 +540,12 @@ flatten outer appendToLast :: [Inline] -> [Inline] -> [Inline] appendToLast [] toAppend = [setInlineChildren outer toAppend] appendToLast flattened toAppend - | isOuter lastFlat = init flattened <> [appendTo lastFlat toAppend] + | Just lastFlat <- mblastFlat + , isOuter lastFlat = + fromMaybe [] (viaNonEmpty init flattened) + <> [appendTo lastFlat toAppend] | otherwise = flattened <> [setInlineChildren outer toAppend] - where lastFlat = last flattened + where mblastFlat = viaNonEmpty last flattened appendTo o i = mapNested (<> i) o isOuter i = emptyParent i == emptyParent outer emptyParent i = setInlineChildren i [] @@ -761,8 +765,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 = fromMaybe 0 . viaNonEmpty maximum1 . 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/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index cf27011c2..6df1ffb25 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -272,8 +272,9 @@ tableRowToRTF header indent aligns sizes' cols = do else sizes' columns <- T.concat <$> zipWithM (tableItemToRTF indent) aligns cols - let rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips)) - (0 :: Integer) sizes + let rightEdges = + fromMaybe [] $ viaNonEmpty tail $ scanl + (\sofar new -> sofar + floor (new * totalTwips)) (0 :: Integer) sizes let cellDefs = map (\edge -> (if header then "\\clbrdrb\\brdrs" else "") <> "\\cellx" <> tshow edge) diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index fc3f8ff3a..68e8fcd47 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -224,8 +224,8 @@ 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 : - map length (headers:rows)) + let numcols = fromMaybe 0 $ viaNonEmpty maximum1 + (length aligns : length widths : map length (headers:rows)) let officialWidthsInChars widths' = map ( (\x -> if x < 1 then 1 else x) . (\x -> x - 3) . floor . @@ -253,8 +253,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 = fromMaybe 0 . viaNonEmpty maximum1 . map offset let minWidthsInChars = map numChars $ transpose (rawHeaders' : rawRows') let widthsInChars' = zipWith max diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs index b926c48a1..7d9f9d1f9 100644 --- a/src/Text/Pandoc/Writers/TEI.hs +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -149,9 +149,9 @@ blockToTEI opts (BlockQuote blocks) = blockToTEI _ (CodeBlock (_,classes,_) str) = return $ literal ("<ab type='codeblock " <> lang <> "'>") <> cr <> flush (literal (escapeStringForXML str) <> cr <> text "</ab>") - where lang = if null langs - then "" - else escapeStringForXML (head langs) + where lang = case langs of + [] -> "" + (l:_) -> escapeStringForXML l isLang l = T.toLower l `elem` map T.toLower languages langsFrom s = if isLang s then [s] diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 53da70f84..9c1b44fb7 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -271,7 +271,7 @@ tableAnyRowToTexinfo :: PandocMonad m -> [[Block]] -> TI m (Doc Text) tableAnyRowToTexinfo itemtype aligns cols = - (literal itemtype $$) . foldl (\row item -> row $$ + (literal itemtype $$) . foldl' (\row item -> row $$ (if isEmpty row then empty else text " @tab ") <> item) empty <$> zipWithM alignedBlock aligns cols alignedBlock :: PandocMonad m diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 03d030477..eb5ebdee3 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -218,7 +218,8 @@ blockToTextile opts x@(BulletList items) = do modify $ \s -> s { stListLevel = stListLevel s <> "*" } level <- gets $ length . stListLevel contents <- mapM (listItemToTextile opts) items - modify $ \s -> s { stListLevel = init (stListLevel s) } + modify $ \s -> s { stListLevel = + fromMaybe [] $ viaNonEmpty init (stListLevel s) } return $ vcat contents <> (if level > 1 then "" else "\n") blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do @@ -236,7 +237,8 @@ blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do else Nothing } level <- gets $ length . stListLevel contents <- mapM (listItemToTextile opts) items - modify $ \s -> s { stListLevel = init (stListLevel s), + modify $ \s -> s { stListLevel = + fromMaybe [] $ viaNonEmpty init (stListLevel s), stStartNum = Nothing } return $ vcat contents <> (if level > 1 then "" else "\n") diff --git a/src/Text/Pandoc/Writers/XWiki.hs b/src/Text/Pandoc/Writers/XWiki.hs index c35235650..a49989bb3 100644 --- a/src/Text/Pandoc/Writers/XWiki.hs +++ b/src/Text/Pandoc/Writers/XWiki.hs @@ -36,7 +36,7 @@ module Text.Pandoc.Writers.XWiki ( writeXWiki ) where import Control.Monad.Reader (ReaderT, asks, local, runReaderT) import qualified Data.Set as Set import qualified Data.Text as Text -import Data.Text (Text, intercalate, replace, split) +import Data.Text (Text, replace, split) import Text.Pandoc.Class.PandocMonad (PandocMonad, report) import Text.Pandoc.Definition import Text.Pandoc.Logging @@ -59,7 +59,7 @@ writeXWiki _ (Pandoc _ blocks) = -- | Concatenates strings with line breaks between them. vcat :: [Text] -> Text -vcat = intercalate "\n" +vcat = Text.intercalate "\n" -- If an id is provided, we can generate an anchor using the id macro -- https://extensions.xwiki.org/xwiki/bin/view/Extension/Id%20Macro @@ -139,7 +139,7 @@ tableCellXWiki :: PandocMonad m => Bool -> [Block] -> XWikiReader m Text tableCellXWiki isHeader cell = do contents <- blockListToXWiki cell let isMultiline = (length . split (== '\n')) contents > 1 - let contents' = intercalate contents $ if isMultiline then ["(((", ")))"] else [mempty, mempty] + let contents' = Text.intercalate contents $ if isMultiline then ["(((", ")))"] else [mempty, mempty] let cellBorder = if isHeader then "|=" else "|" return $ cellBorder <> contents' @@ -260,7 +260,7 @@ definitionListItemToMediaWiki (label, items) = do contents <- mapM blockListToXWiki items marker <- asks listLevel return $ marker <> " " <> labelText <> "\n" <> - intercalate "\n" (map (\d -> Text.init marker <> ": " <> d) contents) + Text.intercalate "\n" (map (\d -> Text.init marker <> ": " <> d) contents) -- Escape the escape character, as well as formatting pairs escapeXWikiString :: Text -> Text diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs index 9e45f0417..c5f9c6762 100644 --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -140,10 +140,12 @@ blockToZimWiki opts (Table _ blkCapt specs thead tbody tfoot) = do c <- inlineListToZimWiki opts capt return $ "" <> c <> "\n" headers' <- if all null headers - then zipWithM (tableItemToZimWiki opts) aligns (head rows) + then fromMaybe (return []) $ viaNonEmpty + (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 (fromMaybe 0 . viaNonEmpty maximum1 . map T.length) + $ transpose (headers':rows') let padTo (width, al) s = case width - T.length s of x | x > 0 -> |