From 4f3434586743afb69f00ca91fe6ec9b68b39ae7e Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 8 Jan 2021 18:38:20 +0100 Subject: Update copyright notices for 2021 (#7012) --- src/Text/Pandoc/Readers/Docx/Combine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Readers/Docx/Combine.hs') diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs index 46112af19..bcf26c4a3 100644 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -2,7 +2,7 @@ {- | Module : Text.Pandoc.Readers.Docx.Combine Copyright : © 2014-2020 Jesse Rosenthal , - 2014-2020 John MacFarlane , + 2014-2021 John MacFarlane , 2020 Nikolay Yakimov License : GNU GPL, version 2 or above -- cgit v1.2.3 From 24191a2a278c0dec30bacd66b78cbb8cc8d91324 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Mon, 15 Mar 2021 10:37:35 -0700 Subject: Use foldl' instead of foldl everywhere. --- src/Text/Pandoc/App/CommandLineOptions.hs | 4 ++-- src/Text/Pandoc/Citeproc/Locator.hs | 3 ++- src/Text/Pandoc/Class/PandocMonad.hs | 3 ++- src/Text/Pandoc/Extensions.hs | 3 ++- src/Text/Pandoc/Lua/Filter.hs | 3 ++- src/Text/Pandoc/Readers/Docx/Combine.hs | 4 ++-- src/Text/Pandoc/Readers/HTML/TagCategories.hs | 1 + src/Text/Pandoc/Readers/Markdown.hs | 6 +++--- src/Text/Pandoc/Readers/Odt/Arrows/State.hs | 4 ++-- src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs | 4 ++-- src/Text/Pandoc/Readers/Odt/StyleReader.hs | 4 ++-- src/Text/Pandoc/Readers/Textile.hs | 4 ++-- src/Text/Pandoc/Shared.hs | 4 ++-- src/Text/Pandoc/Writers/HTML.hs | 8 ++++---- src/Text/Pandoc/Writers/RST.hs | 4 ++-- src/Text/Pandoc/Writers/Texinfo.hs | 4 ++-- 16 files changed, 34 insertions(+), 29 deletions(-) (limited to 'src/Text/Pandoc/Readers/Docx/Combine.hs') diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs index b4483f756..a6df12715 100644 --- a/src/Text/Pandoc/App/CommandLineOptions.hs +++ b/src/Text/Pandoc/App/CommandLineOptions.hs @@ -31,7 +31,7 @@ import Data.Aeson.Encode.Pretty (encodePretty', Config(..), keyOrder, defConfig, Indent(..), NumberFormat(..)) import Data.Bifunctor (second) import Data.Char (toLower) -import Data.List (intercalate, sort) +import Data.List (intercalate, sort, foldl') #ifdef _WINDOWS #if MIN_VERSION_base(4,12,0) import Data.List (isPrefixOf) @@ -93,7 +93,7 @@ parseOptionsFromArgs options' defaults prg rawArgs = do ("Try " ++ prg ++ " --help for more information.") -- thread option data structure through all supplied option actions - opts <- foldl (>>=) (return defaults) actions + opts <- foldl' (>>=) (return defaults) actions let mbArgs = case args of [] -> Nothing xs -> Just xs diff --git a/src/Text/Pandoc/Citeproc/Locator.hs b/src/Text/Pandoc/Citeproc/Locator.hs index dba762c02..44416ca12 100644 --- a/src/Text/Pandoc/Citeproc/Locator.hs +++ b/src/Text/Pandoc/Citeproc/Locator.hs @@ -7,6 +7,7 @@ where import Citeproc.Types import Data.Text (Text) import qualified Data.Text as T +import Data.List (foldl') import Text.Parsec import Text.Pandoc.Definition import Text.Pandoc.Parsing (romanNumeral) @@ -139,7 +140,7 @@ pBalancedBraces braces p = try $ do where except = notFollowedBy pBraces >> p -- outer and inner - surround = foldl (\a (open, close) -> sur open close except <|> a) + surround = foldl' (\a (open, close) -> sur open close except <|> a) except braces diff --git a/src/Text/Pandoc/Class/PandocMonad.hs b/src/Text/Pandoc/Class/PandocMonad.hs index 86c8de79e..293a822a0 100644 --- a/src/Text/Pandoc/Class/PandocMonad.hs +++ b/src/Text/Pandoc/Class/PandocMonad.hs @@ -59,6 +59,7 @@ import Control.Monad.Except (MonadError (catchError, throwError), MonadTrans, lift, when) import Data.Digest.Pure.SHA (sha1, showDigest) import Data.Maybe (fromMaybe) +import Data.List (foldl') import Data.Time (UTCTime) import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds, posixSecondsToUTCTime) @@ -612,7 +613,7 @@ checkExistence fn = do -- | Canonicalizes a file path by removing redundant @.@ and @..@. makeCanonical :: FilePath -> FilePath makeCanonical = Posix.joinPath . transformPathParts . splitDirectories - where transformPathParts = reverse . foldl go [] + where transformPathParts = reverse . foldl' go [] go as "." = as go (_:as) ".." = as go as x = x : as diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs index 3b96f9e04..266a09e3c 100644 --- a/src/Text/Pandoc/Extensions.hs +++ b/src/Text/Pandoc/Extensions.hs @@ -34,6 +34,7 @@ module Text.Pandoc.Extensions ( Extension(..) where import Data.Bits (clearBit, setBit, testBit, (.|.)) import Data.Data (Data) +import Data.List (foldl') import qualified Data.Text as T import Data.Typeable (Typeable) import GHC.Generics (Generic) @@ -593,7 +594,7 @@ parseFormatSpec :: T.Text parseFormatSpec = parse formatSpec "" where formatSpec = do name <- formatName - (extsToEnable, extsToDisable) <- foldl (flip ($)) ([],[]) <$> + (extsToEnable, extsToDisable) <- foldl' (flip ($)) ([],[]) <$> many extMod return (T.pack name, reverse extsToEnable, reverse extsToDisable) formatName = many1 $ noneOf "-+" diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs index bffe01a34..90967f295 100644 --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -22,6 +22,7 @@ import Control.Monad.Catch (finally, try) import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf, showConstr, toConstr, tyconUQname) import Data.Foldable (foldrM) +import Data.List (foldl') import Data.Map (Map) import Data.Maybe (fromMaybe) import Foreign.Lua (Lua, Peekable, Pushable, StackIndex) @@ -204,7 +205,7 @@ walkMeta lf (Pandoc m bs) = do walkPandoc :: LuaFilter -> Pandoc -> Lua Pandoc walkPandoc (LuaFilter fnMap) = - case foldl mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of + case foldl' mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of Just fn -> \x -> runFilterFunction fn x *> singleElement x Nothing -> return diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs index bcf26c4a3..7c6d01769 100644 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -182,7 +182,7 @@ isAttrModifier _ = False smushInlines :: [Inlines] -> Inlines smushInlines xs = combineInlines xs' mempty - where xs' = foldl combineInlines mempty xs + where xs' = foldl' combineInlines mempty xs smushBlocks :: [Blocks] -> Blocks -smushBlocks xs = foldl combineBlocks mempty xs +smushBlocks xs = foldl' combineBlocks mempty xs diff --git a/src/Text/Pandoc/Readers/HTML/TagCategories.hs b/src/Text/Pandoc/Readers/HTML/TagCategories.hs index b7bd40fee..67aba1cb1 100644 --- a/src/Text/Pandoc/Readers/HTML/TagCategories.hs +++ b/src/Text/Pandoc/Readers/HTML/TagCategories.hs @@ -23,6 +23,7 @@ where import Data.Set (Set, fromList, unions) import Data.Text (Text) +import Data.List (foldl') eitherBlockOrInline :: Set Text eitherBlockOrInline = fromList diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 34edbcc17..dc94fc2d6 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -21,7 +21,7 @@ module Text.Pandoc.Readers.Markdown ( import Control.Monad import Control.Monad.Except (throwError) import Data.Char (isAlphaNum, isPunctuation, isSpace) -import Data.List (transpose, elemIndex, sortOn) +import Data.List (transpose, elemIndex, sortOn, foldl') import qualified Data.Map as M import Data.Maybe import qualified Data.Set as Set @@ -357,7 +357,7 @@ referenceKey = try $ do addKvs <- option [] $ guardEnabled Ext_mmd_link_attributes >> many (try $ spnl >> keyValAttr) blanklines - let attr' = extractIdClass $ foldl (\x f -> f x) attr addKvs + let attr' = extractIdClass $ foldl' (\x f -> f x) attr addKvs target = (escapeURI $ trimr src, tit) st <- getState let oldkeys = stateKeys st @@ -613,7 +613,7 @@ attributes = try $ do spnl attrs <- many (attribute <* spnl) char '}' - return $ foldl (\x f -> f x) nullAttr attrs + return $ foldl' (\x f -> f x) nullAttr attrs attribute :: PandocMonad m => MarkdownParser m (Attr -> Attr) attribute = identifierAttr <|> classAttr <|> keyValAttr <|> specialAttr diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs index 93c6b5e79..96515bf56 100644 --- a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs @@ -22,7 +22,7 @@ module Text.Pandoc.Readers.Odt.Arrows.State where import Control.Arrow import qualified Control.Category as Cat import Control.Monad - +import Data.List (foldl') import Text.Pandoc.Readers.Odt.Arrows.Utils import Text.Pandoc.Readers.Odt.Generic.Fallible @@ -122,7 +122,7 @@ iterateS a = ArrowState $ \(s,f) -> foldr a' (s,mzero) f iterateSL :: (Foldable f, MonadPlus m) => ArrowState s x y -> ArrowState s (f x) (m y) -iterateSL a = ArrowState $ \(s,f) -> foldl a' (s,mzero) f +iterateSL a = ArrowState $ \(s,f) -> foldl' a' (s,mzero) f where a' (s',m) x = second (mplus m.return) $ runArrowState a (s',x) diff --git a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs index 0d921e23b..341903046 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs @@ -64,12 +64,12 @@ import qualified Data.Map as M import Data.Text (Text) import Data.Default import Data.Maybe +import Data.List (foldl') import qualified Text.Pandoc.XML.Light as XML import Text.Pandoc.Readers.Odt.Arrows.State import Text.Pandoc.Readers.Odt.Arrows.Utils - import Text.Pandoc.Readers.Odt.Generic.Namespaces import Text.Pandoc.Readers.Odt.Generic.Utils import Text.Pandoc.Readers.Odt.Generic.Fallible @@ -293,7 +293,7 @@ readNSattributes = fromState $ \state -> maybe (state, failEmpty ) => XMLConverterState nsID extraState -> Maybe (XMLConverterState nsID extraState) extractNSAttrs startState - = foldl (\state d -> state >>= addNS d) + = foldl' (\state d -> state >>= addNS d) (Just startState) nsAttribs where nsAttribs = mapMaybe readNSattr (XML.elAttribs element) diff --git a/src/Text/Pandoc/Readers/Odt/StyleReader.hs b/src/Text/Pandoc/Readers/Odt/StyleReader.hs index 5e10f896c..b722aa07d 100644 --- a/src/Text/Pandoc/Readers/Odt/StyleReader.hs +++ b/src/Text/Pandoc/Readers/Odt/StyleReader.hs @@ -44,7 +44,7 @@ import Control.Arrow import Data.Default import qualified Data.Foldable as F -import Data.List (unfoldr) +import Data.List (unfoldr, foldl') import qualified Data.Map as M import Data.Maybe import Data.Text (Text) @@ -120,7 +120,7 @@ fontPitchReader = executeInSub NsOffice "font-face-decls" ( &&& lookupDefaultingAttr NsStyle "font-pitch" )) - >>?^ ( M.fromList . foldl accumLegalPitches [] ) + >>?^ ( M.fromList . foldl' accumLegalPitches [] ) ) `ifFailedDo` returnV (Right M.empty) where accumLegalPitches ls (Nothing,_) = ls accumLegalPitches ls (Just n,p) = (n,p):ls diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index 860da2dc3..99238c7f0 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -38,7 +38,7 @@ module Text.Pandoc.Readers.Textile ( readTextile) where import Control.Monad (guard, liftM) import Control.Monad.Except (throwError) import Data.Char (digitToInt, isUpper) -import Data.List (intersperse, transpose) +import Data.List (intersperse, transpose, foldl') import Data.Text (Text) import qualified Data.Text as T import Text.HTML.TagSoup (Tag (..), fromAttrib) @@ -627,7 +627,7 @@ code2 = do -- | Html / CSS attributes attributes :: PandocMonad m => ParserT Text ParserState m Attr -attributes = foldl (flip ($)) ("",[],[]) <$> +attributes = foldl' (flip ($)) ("",[],[]) <$> try (do special <- option id specialAttribute attrs <- many attribute return (special : attrs)) diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index d11ad13f5..0ce9396b3 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -109,7 +109,7 @@ import qualified Data.Bifunctor as Bifunctor import Data.Char (isAlpha, isLower, isSpace, isUpper, toLower, isAlphaNum, generalCategory, GeneralCategory(NonSpacingMark, SpacingCombiningMark, EnclosingMark, ConnectorPunctuation)) -import Data.List (find, intercalate, intersperse, sortOn) +import Data.List (find, intercalate, intersperse, sortOn, foldl') import qualified Data.Map as M import Data.Maybe (mapMaybe, fromMaybe) import Data.Monoid (Any (..)) @@ -840,7 +840,7 @@ mapLeft = Bifunctor.first -- > collapseFilePath "parent/foo/.." == "parent" -- > collapseFilePath "/parent/foo/../../bar" == "/bar" collapseFilePath :: FilePath -> FilePath -collapseFilePath = Posix.joinPath . reverse . foldl go [] . splitDirectories +collapseFilePath = Posix.joinPath . reverse . foldl' go [] . splitDirectories where go rs "." = rs go r@(p:rs) ".." = case p of diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 2f33cd467..332de1545 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -30,7 +30,7 @@ module Text.Pandoc.Writers.HTML ( ) where import Control.Monad.State.Strict import Data.Char (ord) -import Data.List (intercalate, intersperse, partition, delete, (\\)) +import Data.List (intercalate, intersperse, partition, delete, (\\), foldl') import Data.List.NonEmpty (NonEmpty((:|))) import Data.Maybe (fromMaybe, isJust, isNothing) import qualified Data.Set as Set @@ -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 @@ -1407,7 +1407,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 diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index d01e13db4..54d042332 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -16,7 +16,7 @@ reStructuredText: module Text.Pandoc.Writers.RST ( writeRST, flatten ) where import Control.Monad.State.Strict import Data.Char (isSpace) -import Data.List (transpose, intersperse) +import Data.List (transpose, intersperse, foldl') import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Text (Text) @@ -509,7 +509,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 = diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 53da70f84..9d695563f 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -15,7 +15,7 @@ module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where import Control.Monad.Except (throwError) import Control.Monad.State.Strict import Data.Char (chr, ord) -import Data.List (maximumBy, transpose) +import Data.List (maximumBy, transpose, foldl') import Data.Ord (comparing) import qualified Data.Set as Set import Data.Text (Text) @@ -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 -- cgit v1.2.3 From 105a50569be6d2c1b37cc290abcbfbae1cd0fd1e Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 25 May 2021 17:49:48 +0200 Subject: Allow compilation with base 4.15 --- src/Text/Pandoc/Options.hs | 34 +++++----- src/Text/Pandoc/Readers/Docx/Combine.hs | 6 +- src/Text/Pandoc/Readers/Odt/ContentReader.hs | 11 ++-- src/Text/Pandoc/Writers/OpenDocument.hs | 98 +++++++++++++--------------- 4 files changed, 72 insertions(+), 77 deletions(-) (limited to 'src/Text/Pandoc/Readers/Docx/Combine.hs') diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index 92bda36b2..85d9aa103 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -315,6 +315,23 @@ defaultMathJaxURL = "https://cdn.jsdelivr.net/npm/mathjax@3/es5/tex-chtml-full.j defaultKaTeXURL :: Text defaultKaTeXURL = "https://cdnjs.cloudflare.com/ajax/libs/KaTeX/0.11.1/" +-- Update documentation in doc/filters.md if this is changed. +$(deriveJSON defaultOptions{ constructorTagModifier = + camelCaseStrToHyphenated + } ''TrackChanges) + +$(deriveJSON defaultOptions{ constructorTagModifier = + camelCaseStrToHyphenated + } ''WrapOption) + +$(deriveJSON defaultOptions{ constructorTagModifier = + camelCaseStrToHyphenated . drop 8 + } ''TopLevelDivision) + +$(deriveJSON defaultOptions{ constructorTagModifier = + camelCaseStrToHyphenated + } ''ReferenceLocation) + -- Update documentation in doc/filters.md if this is changed. $(deriveJSON defaultOptions ''ReaderOptions) @@ -338,20 +355,3 @@ $(deriveJSON defaultOptions{ constructorTagModifier = } ''ObfuscationMethod) $(deriveJSON defaultOptions ''HTMLSlideVariant) - --- Update documentation in doc/filters.md if this is changed. -$(deriveJSON defaultOptions{ constructorTagModifier = - camelCaseStrToHyphenated - } ''TrackChanges) - -$(deriveJSON defaultOptions{ constructorTagModifier = - camelCaseStrToHyphenated - } ''WrapOption) - -$(deriveJSON defaultOptions{ constructorTagModifier = - camelCaseStrToHyphenated . drop 8 - } ''TopLevelDivision) - -$(deriveJSON defaultOptions{ constructorTagModifier = - camelCaseStrToHyphenated - } ''ReferenceLocation) diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs index 7c6d01769..6e4faa639 100644 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -61,7 +61,7 @@ import Data.List import Data.Bifunctor import Data.Sequence ( ViewL (..), ViewR (..), viewl, viewr, spanr, spanl , (><), (|>) ) -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B data Modifier a = Modifier (a -> a) | AttrModifier (Attr -> a -> a) Attr @@ -116,12 +116,12 @@ ilModifierAndInnards ils = case viewl $ unMany ils of inlinesL :: Inlines -> (Inlines, Inlines) inlinesL ils = case viewl $ unMany ils of - (s :< sq) -> (singleton s, Many sq) + (s :< sq) -> (B.singleton s, Many sq) _ -> (mempty, ils) inlinesR :: Inlines -> (Inlines, Inlines) inlinesR ils = case viewr $ unMany ils of - (sq :> s) -> (Many sq, singleton s) + (sq :> s) -> (Many sq, B.singleton s) _ -> (ils, mempty) combineInlines :: Inlines -> Inlines -> Inlines diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index c4220b0db..5520d039f 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs +++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Arrows #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PatternGuards #-} @@ -33,7 +34,7 @@ import Data.List (find) import qualified Data.Map as M import qualified Data.Text as T import Data.Maybe -import Data.Semigroup (First(..), Option(..)) +import Data.Monoid (Alt (..)) import Text.TeXMath (readMathML, writeTeX) import qualified Text.Pandoc.XML.Light as XML @@ -505,13 +506,11 @@ type InlineMatcher = ElementMatcher Inlines type BlockMatcher = ElementMatcher Blocks - -newtype FirstMatch a = FirstMatch (Option (First a)) - deriving (Foldable, Monoid, Semigroup) +newtype FirstMatch a = FirstMatch (Alt Maybe a) + deriving (Foldable, Monoid, Semigroup) firstMatch :: a -> FirstMatch a -firstMatch = FirstMatch . Option . Just . First - +firstMatch = FirstMatch . Alt . Just -- matchingElement :: (Monoid e) diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 34a3a4aa5..5f3224c2f 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ViewPatterns #-} @@ -372,36 +373,32 @@ blocksToOpenDocument o b = vcat <$> mapM (blockToOpenDocument o) b -- | Convert a Pandoc block element to OpenDocument. blockToOpenDocument :: PandocMonad m => WriterOptions -> Block -> OD m (Doc Text) -blockToOpenDocument o bs - | Plain b <- bs = if null b - then return empty - else inParagraphTags =<< inlinesToOpenDocument o b - | Para [Image attr c (s,T.stripPrefix "fig:" -> Just t)] <- bs - = figure attr c s t - | Para b <- bs = if null b && - not (isEnabled Ext_empty_paragraphs o) - then return empty - else inParagraphTags =<< inlinesToOpenDocument o b - | LineBlock b <- bs = blockToOpenDocument o $ linesToPara b - | Div attr xs <- bs = mkDiv attr xs - | Header i (ident,_,_) b - <- bs = setFirstPara >> (inHeaderTags i ident - =<< inlinesToOpenDocument o b) - | BlockQuote b <- bs = setFirstPara >> mkBlockQuote b - | DefinitionList b <- bs = setFirstPara >> defList b - | BulletList b <- bs = setFirstPara >> bulletListToOpenDocument o b - | OrderedList a b <- bs = setFirstPara >> orderedList a b - | CodeBlock _ s <- bs = setFirstPara >> preformatted s - | Table a bc s th tb tf <- bs = setFirstPara >> table (Ann.toTable a bc s th tb tf) - | HorizontalRule <- bs = setFirstPara >> return (selfClosingTag "text:p" - [ ("text:style-name", "Horizontal_20_Line") ]) - | RawBlock f s <- bs = if f == Format "opendocument" - then return $ text $ T.unpack s - else do - report $ BlockNotRendered bs - return empty - | Null <- bs = return empty - | otherwise = return empty +blockToOpenDocument o = \case + Plain b -> if null b + then return empty + else inParagraphTags =<< inlinesToOpenDocument o b + Para [Image attr c (s,T.stripPrefix "fig:" -> Just t)] -> figure attr c s t + Para b -> if null b && + not (isEnabled Ext_empty_paragraphs o) + then return empty + else inParagraphTags =<< inlinesToOpenDocument o b + LineBlock b -> blockToOpenDocument o $ linesToPara b + Div attr xs -> mkDiv attr xs + Header i (ident,_,_) b -> do + setFirstPara + inHeaderTags i ident =<< inlinesToOpenDocument o b + BlockQuote b -> setFirstPara >> mkBlockQuote b + DefinitionList b -> setFirstPara >> defList b + BulletList b -> setFirstPara >> bulletListToOpenDocument o b + OrderedList a b -> setFirstPara >> orderedList a b + CodeBlock _ s -> setFirstPara >> preformatted s + Table a bc s th tb tf -> setFirstPara >> table (Ann.toTable a bc s th tb tf) + HorizontalRule -> setFirstPara >> return (selfClosingTag "text:p" + [ ("text:style-name", "Horizontal_20_Line") ]) + b@(RawBlock f s) -> if f == Format "opendocument" + then return $ text $ T.unpack s + else empty <$ report (BlockNotRendered b) + Null -> return empty where defList b = do setInDefinitionList True r <- vcat <$> mapM (deflistItemToOpenDocument o) b @@ -874,27 +871,26 @@ data TextStyle = Italic textStyleAttr :: Map.Map Text Text -> TextStyle -> Map.Map Text Text -textStyleAttr m s - | Italic <- s = Map.insert "fo:font-style" "italic" . - Map.insert "style:font-style-asian" "italic" . - Map.insert "style:font-style-complex" "italic" $ m - | Bold <- s = Map.insert "fo:font-weight" "bold" . - Map.insert "style:font-weight-asian" "bold" . - Map.insert "style:font-weight-complex" "bold" $ m - | Under <- s = Map.insert "style:text-underline-style" "solid" . - Map.insert "style:text-underline-width" "auto" . - Map.insert "style:text-underline-color" "font-color" $ m - | Strike <- s = Map.insert "style:text-line-through-style" "solid" m - | Sub <- s = Map.insert "style:text-position" "sub 58%" m - | Sup <- s = Map.insert "style:text-position" "super 58%" m - | SmallC <- s = Map.insert "fo:font-variant" "small-caps" m - | Pre <- s = Map.insert "style:font-name" "Courier New" . - Map.insert "style:font-name-asian" "Courier New" . - Map.insert "style:font-name-complex" "Courier New" $ m - | Language lang <- s - = Map.insert "fo:language" (langLanguage lang) . - maybe id (Map.insert "fo:country") (langRegion lang) $ m - | otherwise = m +textStyleAttr m = \case + Italic -> Map.insert "fo:font-style" "italic" . + Map.insert "style:font-style-asian" "italic" . + Map.insert "style:font-style-complex" "italic" $ m + Bold -> Map.insert "fo:font-weight" "bold" . + Map.insert "style:font-weight-asian" "bold" . + Map.insert "style:font-weight-complex" "bold" $ m + Under -> Map.insert "style:text-underline-style" "solid" . + Map.insert "style:text-underline-width" "auto" . + Map.insert "style:text-underline-color" "font-color" $ m + Strike -> Map.insert "style:text-line-through-style" "solid" m + Sub -> Map.insert "style:text-position" "sub 58%" m + Sup -> Map.insert "style:text-position" "super 58%" m + SmallC -> Map.insert "fo:font-variant" "small-caps" m + Pre -> Map.insert "style:font-name" "Courier New" . + Map.insert "style:font-name-asian" "Courier New" . + Map.insert "style:font-name-complex" "Courier New" $ m + Language lang -> + Map.insert "fo:language" (langLanguage lang) . + maybe id (Map.insert "fo:country") (langRegion lang) $ m withLangFromAttr :: PandocMonad m => Attr -> OD m a -> OD m a withLangFromAttr (_,_,kvs) action = -- cgit v1.2.3