diff options
Diffstat (limited to 'src')
54 files changed, 943 insertions, 953 deletions
diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index 9fa5f098d..0da2a925c 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -65,11 +65,7 @@ module Text.Pandoc -- * Logging , module Text.Pandoc.Logging -- * Typeclass - , PandocMonad - , runIO - , runPure - , runIOorExplode - , setVerbosity + , module Text.Pandoc.Class -- * Error handling , module Text.Pandoc.Error -- * Readers: converting /to/ Pandoc format diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index a80c6ac44..e82ccf3f0 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -77,11 +77,6 @@ import System.IO.Error (isDoesNotExistError) import Text.Pandoc import Text.Pandoc.BCP47 (Lang (..), parseBCP47) import Text.Pandoc.Builder (setMeta) -import Text.Pandoc.Class (PandocIO, extractMedia, fillMediaBag, getLog, openURL, - readDataFile, readDefaultDataFile, readFileStrict, - report, setInputFiles, setOutputFile, - setRequestHeader, setResourcePath, setTrace, - setTranslations, setUserDataDir) import Text.Pandoc.Highlighting (highlightingStyles) import Text.Pandoc.Lua (LuaException (..), runLuaFilter) import Text.Pandoc.PDF (makePDF) @@ -493,7 +488,7 @@ convertWithOpts opts = do report $ Deprecated "markdown_github" "Use gfm instead." setResourcePath (optResourcePath opts) - mapM_ (\(n,v) -> setRequestHeader n v) (optRequestHeaders opts) + mapM_ (uncurry setRequestHeader) (optRequestHeaders opts) doc <- sourceToDoc sources >>= ( (if isJust (optExtractMedia opts) @@ -540,7 +535,7 @@ convertWithOpts opts = do type Transform = Pandoc -> Pandoc isTextFormat :: String -> Bool -isTextFormat s = s `notElem` ["odt","docx","epub","epub3"] +isTextFormat s = s `notElem` ["odt","docx","epub2","epub3","epub"] externalFilter :: MonadIO m => ReaderOptions -> FilePath -> [String] -> Pandoc -> m Pandoc diff --git a/src/Text/Pandoc/BCP47.hs b/src/Text/Pandoc/BCP47.hs index 0f1421555..a9fb5c7a7 100644 --- a/src/Text/Pandoc/BCP47.hs +++ b/src/Text/Pandoc/BCP47.hs @@ -79,7 +79,7 @@ parseBCP47 lang = region <- P.option "" pRegion variants <- P.many (pVariant P.<|> pExtension P.<|> pPrivateUse) P.eof - return $ Lang{ langLanguage = language + return Lang{ langLanguage = language , langScript = script , langRegion = region , langVariants = variants } diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs index 7c518e84b..19897e53f 100644 --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -2,6 +2,7 @@ {-# LANGUAGE PatternGuards #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleContexts #-} @@ -92,7 +93,6 @@ module Text.Pandoc.Class ( PandocMonad(..) , setTranslations , translateTerm , Translations - , Term(..) ) where import Prelude hiding (readFile) diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index 27d5c6a9c..5f491e08b 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -79,6 +79,7 @@ instance Show Direction where data Dimension = Pixel Integer | Centimeter Double + | Millimeter Double | Inch Double | Percent Double | Em Double @@ -86,6 +87,7 @@ data Dimension = Pixel Integer instance Show Dimension where show (Pixel a) = show a ++ "px" show (Centimeter a) = showFl a ++ "cm" + show (Millimeter a) = showFl a ++ "mm" show (Inch a) = showFl a ++ "in" show (Percent a) = show a ++ "%" show (Em a) = showFl a ++ "em" @@ -184,6 +186,7 @@ inInch opts dim = case dim of (Pixel a) -> fromIntegral a / fromIntegral (writerDpi opts) (Centimeter a) -> a * 0.3937007874 + (Millimeter a) -> a * 0.03937007874 (Inch a) -> a (Percent _) -> 0 (Em a) -> a * (11/64) @@ -193,6 +196,7 @@ inPixel opts dim = case dim of (Pixel a) -> a (Centimeter a) -> floor $ dpi * a * 0.3937007874 :: Integer + (Millimeter a) -> floor $ dpi * a * 0.03937007874 :: Integer (Inch a) -> floor $ dpi * a :: Integer (Percent _) -> 0 (Em a) -> floor $ dpi * a * (11/64) :: Integer @@ -225,6 +229,7 @@ scaleDimension factor dim = case dim of Pixel x -> Pixel (round $ factor * fromIntegral x) Centimeter x -> Centimeter (factor * x) + Millimeter x -> Millimeter (factor * x) Inch x -> Inch (factor * x) Percent x -> Percent (factor * x) Em x -> Em (factor * x) @@ -243,7 +248,7 @@ lengthToDim :: String -> Maybe Dimension lengthToDim s = numUnit s >>= uncurry toDim where toDim a "cm" = Just $ Centimeter a - toDim a "mm" = Just $ Centimeter (a / 10) + toDim a "mm" = Just $ Millimeter a toDim a "in" = Just $ Inch a toDim a "inch" = Just $ Inch a toDim a "%" = Just $ Percent a diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs index a156f017c..4723c1119 100644 --- a/src/Text/Pandoc/Logging.hs +++ b/src/Text/Pandoc/Logging.hs @@ -45,8 +45,8 @@ import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty', keyOrder) import qualified Data.ByteString.Lazy as BL import Data.Data (Data, toConstr) -import Data.Typeable (Typeable) import qualified Data.Text as Text +import Data.Typeable (Typeable) import GHC.Generics (Generic) import Text.Pandoc.Definition import Text.Parsec.Pos diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 73498788d..a02034de4 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -1,11 +1,10 @@ -{-# LANGUAGE - FlexibleContexts -, GeneralizedNewtypeDeriving -, TypeSynonymInstances -, MultiParamTypeClasses -, FlexibleInstances -, IncoherentInstances #-} - +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE IncoherentInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeSynonymInstances #-} {- Copyright (C) 2006-2017 John MacFarlane <jgm@berkeley.edu> @@ -187,34 +186,34 @@ module Text.Pandoc.Parsing ( takeWhileP, ) where +import Control.Monad.Identity +import Control.Monad.Reader +import Data.Char (chr, isAlphaNum, isAscii, isHexDigit, isPunctuation, isSpace, + ord, toLower, toUpper) +import Data.Default +import Data.List (intercalate, isSuffixOf, transpose) +import qualified Data.Map as M +import Data.Maybe (catMaybes) +import Data.Monoid ((<>)) +import qualified Data.Set as Set import Data.Text (Text) +import Text.HTML.TagSoup.Entity (lookupEntity) +import Text.Pandoc.Asciify (toAsciiChar) +import Text.Pandoc.Builder (Blocks, HasMeta (..), Inlines, trimInlines) +import qualified Text.Pandoc.Builder as B +import Text.Pandoc.Class (PandocMonad, readFileFromDirs, report) import Text.Pandoc.Definition +import Text.Pandoc.Logging import Text.Pandoc.Options -import Text.Pandoc.Builder (Blocks, Inlines, HasMeta(..), trimInlines) -import qualified Text.Pandoc.Builder as B -import Text.Pandoc.XML (fromEntities) +import Text.Pandoc.Readers.LaTeX.Types (Macro) +import Text.Pandoc.Shared import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn) +import Text.Pandoc.XML (fromEntities) import Text.Parsec hiding (token) -import Text.Parsec.Pos (newPos, initialPos, updatePosString) -import Data.Char ( toLower, toUpper, ord, chr, isAscii, isAlphaNum, - isHexDigit, isSpace, isPunctuation ) -import Data.List ( intercalate, transpose, isSuffixOf ) -import Text.Pandoc.Shared -import qualified Data.Map as M -import Text.Pandoc.Readers.LaTeX.Types (Macro) -import Text.HTML.TagSoup.Entity ( lookupEntity ) -import Text.Pandoc.Asciify (toAsciiChar) -import Data.Monoid ((<>)) -import Text.Pandoc.Class (PandocMonad, readFileFromDirs, report) -import Text.Pandoc.Logging -import Data.Default -import qualified Data.Set as Set -import Control.Monad.Reader -import Control.Monad.Identity -import Data.Maybe (catMaybes) +import Text.Parsec.Pos (initialPos, newPos, updatePosString) -import Text.Pandoc.Error import Control.Monad.Except +import Text.Pandoc.Error type Parser t s = Parsec t s @@ -670,9 +669,9 @@ withRaw parser = do let (l2,c2) = (sourceLine pos2, sourceColumn pos2) let inplines = take ((l2 - l1) + 1) $ lines inp let raw = case inplines of - [] -> "" - [l] -> take (c2 - c1) l - ls -> unlines (init ls) ++ take (c2 - 1) (last ls) + [] -> "" + [l] -> take (c2 - c1) l + ls -> unlines (init ls) ++ take (c2 - 1) (last ls) return (result, raw) -- | Parses backslash, then applies character parser. @@ -688,11 +687,11 @@ characterReference = try $ do ent <- many1Till nonspaceChar (char ';') let ent' = case ent of '#':'X':xs -> '#':'x':xs -- workaround tagsoup bug - '#':_ -> ent - _ -> ent ++ ";" + '#':_ -> ent + _ -> ent ++ ";" case lookupEntity ent' of - Just (c : _) -> return c - _ -> fail "entity not found" + Just (c : _) -> return c + _ -> fail "entity not found" -- | Parses an uppercase roman numeral and returns (UpperRoman, number). upperRoman :: Stream s m Char => ParserT s st m (ListNumberStyle, Int) @@ -1006,7 +1005,7 @@ removeOneLeadingSpace xs = if all startsWithSpace xs then map (drop 1) xs else xs - where startsWithSpace "" = True + where startsWithSpace "" = True startsWithSpace (y:_) = y == ' ' -- | Parse footer for a grid table. @@ -1042,36 +1041,36 @@ testStringWith parser str = UTF8.putStrLn $ show $ -- | Parsing options. data ParserState = ParserState - { stateOptions :: ReaderOptions, -- ^ User options - stateParserContext :: ParserContext, -- ^ Inside list? - stateQuoteContext :: QuoteContext, -- ^ Inside quoted environment? - stateAllowLinks :: Bool, -- ^ Allow parsing of links - stateMaxNestingLevel :: Int, -- ^ Max # of nested Strong/Emph - stateLastStrPos :: Maybe SourcePos, -- ^ Position after last str parsed - stateKeys :: KeyTable, -- ^ List of reference keys - stateHeaderKeys :: KeyTable, -- ^ List of implicit header ref keys - stateSubstitutions :: SubstTable, -- ^ List of substitution references - stateNotes :: NoteTable, -- ^ List of notes (raw bodies) - stateNotes' :: NoteTable', -- ^ List of notes (parsed bodies) - stateNoteRefs :: Set.Set String, -- ^ List of note references used - stateMeta :: Meta, -- ^ Document metadata - stateMeta' :: F Meta, -- ^ Document metadata - stateCitations :: M.Map String String, -- ^ RST-style citations - stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used - stateHeaders :: M.Map Inlines String, -- ^ List of headers and ids (used for implicit ref links) - stateIdentifiers :: Set.Set String, -- ^ Header identifiers used - stateNextExample :: Int, -- ^ Number of next example - stateExamples :: M.Map String Int, -- ^ Map from example labels to numbers - stateMacros :: M.Map Text Macro, -- ^ Table of macros defined so far - stateRstDefaultRole :: String, -- ^ Current rST default interpreted text role - stateRstCustomRoles :: M.Map String (String, Maybe String, Attr), -- ^ Current rST custom text roles + { stateOptions :: ReaderOptions, -- ^ User options + stateParserContext :: ParserContext, -- ^ Inside list? + stateQuoteContext :: QuoteContext, -- ^ Inside quoted environment? + stateAllowLinks :: Bool, -- ^ Allow parsing of links + stateMaxNestingLevel :: Int, -- ^ Max # of nested Strong/Emph + stateLastStrPos :: Maybe SourcePos, -- ^ Position after last str parsed + stateKeys :: KeyTable, -- ^ List of reference keys + stateHeaderKeys :: KeyTable, -- ^ List of implicit header ref keys + stateSubstitutions :: SubstTable, -- ^ List of substitution references + stateNotes :: NoteTable, -- ^ List of notes (raw bodies) + stateNotes' :: NoteTable', -- ^ List of notes (parsed bodies) + stateNoteRefs :: Set.Set String, -- ^ List of note references used + stateMeta :: Meta, -- ^ Document metadata + stateMeta' :: F Meta, -- ^ Document metadata + stateCitations :: M.Map String String, -- ^ RST-style citations + stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used + stateHeaders :: M.Map Inlines String, -- ^ List of headers and ids (used for implicit ref links) + stateIdentifiers :: Set.Set String, -- ^ Header identifiers used + stateNextExample :: Int, -- ^ Number of next example + stateExamples :: M.Map String Int, -- ^ Map from example labels to numbers + stateMacros :: M.Map Text Macro, -- ^ Table of macros defined so far + stateRstDefaultRole :: String, -- ^ Current rST default interpreted text role + stateRstCustomRoles :: M.Map String (String, Maybe String, Attr), -- ^ Current rST custom text roles -- Triple represents: 1) Base role, 2) Optional format (only for :raw: -- roles), 3) Additional classes (rest of Attr is unused)). - stateCaption :: Maybe Inlines, -- ^ Caption in current environment - stateInHtmlBlock :: Maybe String, -- ^ Tag type of HTML block being parsed - stateFencedDivLevel :: Int, -- ^ Depth of fenced div - stateContainers :: [String], -- ^ parent include files - stateLogMessages :: [LogMessage], -- ^ log messages + stateCaption :: Maybe Inlines, -- ^ Caption in current environment + stateInHtmlBlock :: Maybe String, -- ^ Tag type of HTML block being parsed + stateFencedDivLevel :: Int, -- ^ Depth of fenced div + stateContainers :: [String], -- ^ parent include files + stateLogMessages :: [LogMessage], -- ^ log messages stateMarkdownAttribute :: Bool -- ^ True if in markdown=1 context } diff --git a/src/Text/Pandoc/Readers/Creole.hs b/src/Text/Pandoc/Readers/Creole.hs index 4da259c0e..b4eb6eaef 100644 --- a/src/Text/Pandoc/Readers/Creole.hs +++ b/src/Text/Pandoc/Readers/Creole.hs @@ -27,7 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA License : GNU GPL, version 2 or above Maintainer : Sascha Wilde <wilde@sha-bang.de> - Stability : WIP + Stability : alpha Portability : portable Conversion of creole text to 'Pandoc' document. @@ -64,7 +64,7 @@ readCreole opts s = do type CRLParser = ParserT [Char] ParserState -- --- Utility funcitons +-- Utility functions -- (<+>) :: (Monad m, Monoid a) => m a -> m a -> m a @@ -111,7 +111,8 @@ block = do return res nowiki :: PandocMonad m => CRLParser m B.Blocks -nowiki = try $ fmap (B.codeBlock . mconcat) (nowikiStart >> manyTill content nowikiEnd) +nowiki = try $ fmap (B.codeBlock . mconcat) (nowikiStart + >> manyTill content nowikiEnd) where content = brackets <|> line brackets = try $ option "" ((:[]) <$> newline) @@ -154,7 +155,8 @@ listItem :: PandocMonad m => Char -> Int -> CRLParser m B.Blocks listItem c n = fmap (B.plain . B.trimInlines .mconcat) (listStart >> many1Till inline itemEnd) where - listStart = try $ optional newline >> skipSpaces >> count n (char c) + listStart = try $ skipSpaces >> optional newline >> skipSpaces + >> count n (char c) >> lookAhead (noneOf [c]) >> skipSpaces itemEnd = endOfParaElement <|> nextItem n <|> if n < 3 then nextItem (n+1) @@ -193,7 +195,7 @@ endOfParaElement = lookAhead $ endOfInput <|> endOfPara startOf :: PandocMonad m => CRLParser m a -> CRLParser m () startOf p = try $ blankline >> p >> return mempty startOfList = startOf $ anyList 1 - startOfTable =startOf table + startOfTable = startOf table startOfHeader = startOf header startOfNowiki = startOf nowiki hr = startOf horizontalRule diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index 0f3f6f6e3..728f77a05 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -1,22 +1,22 @@ +{-# LANGUAGE ExplicitForAll #-} module Text.Pandoc.Readers.DocBook ( readDocBook ) where -import Data.Char (toUpper, isSpace) -import Text.Pandoc.Shared (safeRead, crFilter) -import Text.Pandoc.Options -import Text.Pandoc.Definition -import Text.Pandoc.Builder -import Text.XML.Light -import Text.HTML.TagSoup.Entity (lookupEntity) +import Control.Monad.State.Strict +import Data.Char (isSpace, toUpper) +import Data.Default import Data.Either (rights) +import Data.Foldable (asum) import Data.Generics -import Control.Monad.State.Strict import Data.List (intersperse) import Data.Maybe (fromMaybe) -import Text.TeXMath (readMathML, writeTeX) -import Data.Default -import Data.Foldable (asum) -import Text.Pandoc.Class (PandocMonad) import Data.Text (Text) import qualified Data.Text as T +import Text.HTML.TagSoup.Entity (lookupEntity) +import Text.Pandoc.Builder +import Text.Pandoc.Class (PandocMonad) +import Text.Pandoc.Options +import Text.Pandoc.Shared (crFilter, safeRead) +import Text.TeXMath (readMathML, writeTeX) +import Text.XML.Light {- @@ -538,12 +538,12 @@ handleInstructions ('<':'?':'a':'s':'c':'i':'i':'d':'o':'c':'-':'b':'r':'?':'>': handleInstructions xs = case break (=='<') xs of (ys, []) -> ys ([], '<':zs) -> '<' : handleInstructions zs - (ys, zs) -> ys ++ handleInstructions zs + (ys, zs) -> ys ++ handleInstructions zs getFigure :: PandocMonad m => Element -> DB m Blocks getFigure e = do tit <- case filterChild (named "title") e of - Just t -> getInlines t + Just t -> getInlines t Nothing -> return mempty modify $ \st -> st{ dbFigureTitle = tit } res <- getBlocks e @@ -797,8 +797,8 @@ parseBlock (Elem e) = return $ p <> b <> x codeBlockWithLang = do let classes' = case attrValue "language" e of - "" -> [] - x -> [x] + "" -> [] + x -> [x] return $ codeBlockWith (attrValue "id" e, classes', []) $ trimNl $ strContentRecursive e parseBlockquote = do @@ -871,11 +871,11 @@ parseBlock (Elem e) = || x == '.') w Nothing -> 0 :: Double let numrows = case bodyrows of - [] -> 0 - xs -> maximum $ map length xs + [] -> 0 + xs -> maximum $ map length xs let aligns = case colspecs of - [] -> replicate numrows AlignDefault - cs -> map toAlignment cs + [] -> replicate numrows AlignDefault + cs -> map toAlignment cs let widths = case colspecs of [] -> replicate numrows 0 cs -> let ws = map toWidth cs @@ -895,7 +895,7 @@ parseBlock (Elem e) = headerText <- case filterChild (named "title") e `mplus` (filterChild (named "info") e >>= filterChild (named "title")) of - Just t -> getInlines t + Just t -> getInlines t Nothing -> return mempty modify $ \st -> st{ dbSectionLevel = n } b <- getBlocks e @@ -989,10 +989,10 @@ parseInline (Elem e) = return $ linkWith attr href "" ils' "foreignphrase" -> emph <$> innerInlines "emphasis" -> case attrValue "role" e of - "bold" -> strong <$> innerInlines - "strong" -> strong <$> innerInlines + "bold" -> strong <$> innerInlines + "strong" -> strong <$> innerInlines "strikethrough" -> strikeout <$> innerInlines - _ -> emph <$> innerInlines + _ -> emph <$> innerInlines "footnote" -> (note . mconcat) <$> mapM parseBlock (elContent e) "title" -> return mempty diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 1874a011a..295b79195 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -214,14 +214,14 @@ codeDivs :: [String] codeDivs = ["SourceCode"] runElemToInlines :: RunElem -> Inlines -runElemToInlines (TextRun s) = text s +runElemToInlines (TextRun s) = text s runElemToInlines LnBrk = linebreak runElemToInlines Tab = space runElemToInlines SoftHyphen = text "\xad" runElemToInlines NoBreakHyphen = text "\x2011" runElemToString :: RunElem -> String -runElemToString (TextRun s) = s +runElemToString (TextRun s) = s runElemToString LnBrk = ['\n'] runElemToString Tab = ['\t'] runElemToString SoftHyphen = ['\xad'] diff --git a/src/Text/Pandoc/Readers/Docx/Lists.hs b/src/Text/Pandoc/Readers/Docx/Lists.hs index 53840c609..70eccd7d6 100644 --- a/src/Text/Pandoc/Readers/Docx/Lists.hs +++ b/src/Text/Pandoc/Readers/Docx/Lists.hs @@ -157,7 +157,7 @@ flatToBullets elems = flatToBullets' (-1) elems singleItemHeaderToHeader :: Block -> Block singleItemHeaderToHeader (OrderedList _ [[h@Header{}]]) = h -singleItemHeaderToHeader blk = blk +singleItemHeaderToHeader blk = blk blocksToBullets :: [Block] -> [Block] diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index fea595027..99e6f99e6 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -106,7 +106,7 @@ eitherToD (Right b) = return b eitherToD (Left _) = throwError DocxError concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b] -concatMapM f xs = fmap concat (mapM f xs) +concatMapM f xs = liftM concat (mapM f xs) -- This is similar to `mapMaybe`: it maps a function returning the D diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs index c1eb6ca59..3b13bbe13 100644 --- a/src/Text/Pandoc/Readers/EPUB.hs +++ b/src/Text/Pandoc/Readers/EPUB.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} module Text.Pandoc.Readers.EPUB (readEPUB) diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 277405b09..915fa852f 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -1,5 +1,8 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, -ViewPatterns, OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} {- Copyright (C) 2006-2017 John MacFarlane <jgm@berkeley.edu> @@ -39,43 +42,42 @@ module Text.Pandoc.Readers.HTML ( readHtml , isCommentTag ) where +import Control.Applicative ((<|>)) +import Control.Arrow ((***)) +import Control.Monad (guard, mplus, msum, mzero, unless, void) +import Control.Monad.Except (throwError) +import Control.Monad.Reader (ReaderT, ask, asks, lift, local, runReaderT) +import Data.Char (isAlphaNum, isDigit, isLetter) +import Data.Default (Default (..), def) +import Data.Foldable (for_) +import Data.List (intercalate, isPrefixOf) +import Data.List.Split (wordsBy) +import qualified Data.Map as M +import Data.Maybe (fromMaybe, isJust, isNothing) +import Data.Monoid (First (..)) +import Data.Monoid ((<>)) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as T +import Network.URI (URI, nonStrictRelativeTo, parseURIReference) import Text.HTML.TagSoup import Text.HTML.TagSoup.Match -import Text.Pandoc.Definition +import Text.Pandoc.Builder (Blocks, HasMeta (..), Inlines, trimInlines) import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Builder (Blocks, Inlines, trimInlines, HasMeta(..)) -import Text.Pandoc.Shared ( extractSpaces, addMetaField - , escapeURI, safeRead, crFilter, underlineSpan ) -import Text.Pandoc.Options ( - ReaderOptions(readerExtensions,readerStripComments), extensionEnabled, - Extension (Ext_epub_html_exts, - Ext_raw_html, Ext_native_divs, Ext_native_spans)) +import Text.Pandoc.Class (PandocMonad (..)) +import Text.Pandoc.CSS (foldOrElse, pickStyleAttrProps) +import Text.Pandoc.Definition +import Text.Pandoc.Error import Text.Pandoc.Logging +import Text.Pandoc.Options (Extension (Ext_epub_html_exts, Ext_native_divs, Ext_native_spans, Ext_raw_html), + ReaderOptions (readerExtensions, readerStripComments), + extensionEnabled) import Text.Pandoc.Parsing hiding ((<|>)) +import Text.Pandoc.Shared (addMetaField, crFilter, escapeURI, extractSpaces, + safeRead, underlineSpan) import Text.Pandoc.Walk -import qualified Data.Map as M -import Data.Foldable ( for_ ) -import Data.Maybe ( fromMaybe, isJust, isNothing ) -import Data.List.Split ( wordsBy ) -import Data.List ( intercalate, isPrefixOf ) -import Data.Char ( isDigit, isLetter, isAlphaNum ) -import Control.Monad ( guard, mzero, void, unless, mplus, msum ) -import Control.Arrow ((***)) -import Control.Applicative ( (<|>) ) -import Data.Monoid (First (..)) -import Data.Text (Text) -import qualified Data.Text as T -import Text.TeXMath (readMathML, writeTeX) -import Data.Default (Default (..), def) -import Control.Monad.Reader (ask, asks, local, ReaderT, runReaderT, lift) -import Network.URI (URI, parseURIReference, nonStrictRelativeTo) -import Text.Pandoc.CSS (foldOrElse, pickStyleAttrProps) -import Data.Monoid ((<>)) import Text.Parsec.Error -import qualified Data.Set as Set -import Text.Pandoc.Error -import Text.Pandoc.Class (PandocMonad(..)) -import Control.Monad.Except (throwError) +import Text.TeXMath (readMathML, writeTeX) -- | Convert HTML-formatted string to 'Pandoc' document. readHtml :: PandocMonad m @@ -123,8 +125,8 @@ data HTMLState = } data HTMLLocal = HTMLLocal { quoteContext :: QuoteContext - , inChapter :: Bool -- ^ Set if in chapter section - , inPlain :: Bool -- ^ Set if in pPlain + , inChapter :: Bool -- ^ Set if in chapter section + , inPlain :: Bool -- ^ Set if in pPlain } setInChapter :: PandocMonad m => HTMLParser m s a -> HTMLParser m s a @@ -354,16 +356,16 @@ fixPlains :: Bool -> Blocks -> Blocks fixPlains inList bs = if any isParaish bs' then B.fromList $ map plainToPara bs' else bs - where isParaish (Para _) = True - isParaish (CodeBlock _ _) = True - isParaish (Header _ _ _) = True - isParaish (BlockQuote _) = True - isParaish (BulletList _) = not inList - isParaish (OrderedList _ _) = not inList + where isParaish (Para _) = True + isParaish (CodeBlock _ _) = True + isParaish (Header _ _ _) = True + isParaish (BlockQuote _) = True + isParaish (BulletList _) = not inList + isParaish (OrderedList _ _) = not inList isParaish (DefinitionList _) = not inList - isParaish _ = False + isParaish _ = False plainToPara (Plain xs) = Para xs - plainToPara x = x + plainToPara x = x bs' = B.toList bs pRawTag :: PandocMonad m => TagParser m Text @@ -377,10 +379,10 @@ pRawTag = do pDiv :: PandocMonad m => TagParser m Blocks pDiv = try $ do guardEnabled Ext_native_divs - let isDivLike "div" = True + let isDivLike "div" = True isDivLike "section" = True - isDivLike "main" = True - isDivLike _ = False + isDivLike "main" = True + isDivLike _ = False TagOpen tag attr' <- lookAhead $ pSatisfy $ tagOpen isDivLike (const True) let attr = toStringAttr attr' contents <- pInTags tag block @@ -545,9 +547,9 @@ pCell celltype = try $ do skipMany pBlank tag <- lookAhead $ pSatisfy (\t -> t ~== TagOpen celltype [] && noColOrRowSpans t) - let extractAlign' [] = "" + let extractAlign' [] = "" extractAlign' ("text-align":x:_) = x - extractAlign' (_:xs) = extractAlign' xs + extractAlign' (_:xs) = extractAlign' xs let extractAlign = extractAlign' . wordsBy (`elem` [' ','\t',';',':']) let align = case maybeFromAttrib "align" tag `mplus` (extractAlign <$> maybeFromAttrib "style" tag) of @@ -603,18 +605,18 @@ pCodeBlock = try $ do let rawText = concatMap tagToString contents -- drop leading newline if any let result' = case rawText of - '\n':xs -> xs - _ -> rawText + '\n':xs -> xs + _ -> rawText -- drop trailing newline if any let result = case reverse result' of - '\n':_ -> init result' - _ -> result' + '\n':_ -> init result' + _ -> result' return $ B.codeBlockWith (mkAttr attr) result tagToString :: Tag Text -> String -tagToString (TagText s) = T.unpack s +tagToString (TagText s) = T.unpack s tagToString (TagOpen "br" _) = "\n" -tagToString _ = "" +tagToString _ = "" inline :: PandocMonad m => TagParser m Inlines inline = choice @@ -893,16 +895,16 @@ pStr = do return $ B.str result isSpecial :: Char -> Bool -isSpecial '"' = True -isSpecial '\'' = True -isSpecial '.' = True -isSpecial '-' = True -isSpecial '$' = True +isSpecial '"' = True +isSpecial '\'' = True +isSpecial '.' = True +isSpecial '-' = True +isSpecial '$' = True isSpecial '\8216' = True isSpecial '\8217' = True isSpecial '\8220' = True isSpecial '\8221' = True -isSpecial _ = False +isSpecial _ = False pSymbol :: PandocMonad m => InlinesParser m Inlines pSymbol = satisfy isSpecial >>= return . B.str . (:[]) @@ -1123,7 +1125,7 @@ htmlInBalanced' tagname ts = fromMaybe [] $ go 0 ts hasTagWarning :: [Tag a] -> Bool hasTagWarning (TagWarning _:_) = True -hasTagWarning _ = False +hasTagWarning _ = False -- | Matches a tag meeting a certain condition. htmlTag :: (HasReaderOptions st, Monad m) @@ -1148,7 +1150,7 @@ htmlTag f = try $ do -- in XML elemnet names let isNameChar c = isAlphaNum c || c == ':' || c == '-' || c == '_' let isName s = case s of - [] -> False + [] -> False (c:cs) -> isLetter c && all isNameChar cs let endAngle = try $ do char '>' @@ -1170,8 +1172,9 @@ htmlTag f = try $ do case next of TagComment s | "<!--" `isPrefixOf` inp -> do - char '<' - manyTill anyChar endAngle + string "<!--" + count (length s) anyChar + string "-->" stripComments <- getOption readerStripComments if stripComments then return (next, "") diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index c91e8bd79..9bac3d3a7 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -430,7 +430,7 @@ doMacros n = do Nothing -> return () Just (Macro expansionPoint numargs optarg newtoks) -> do setInput ts - let getarg = spaces >> braced + let getarg = try $ spaces >> bracedOrToken args <- case optarg of Nothing -> count numargs getarg Just o -> @@ -438,7 +438,14 @@ doMacros n = do <*> count (numargs - 1) getarg let addTok (Tok _ (Arg i) _) acc | i > 0 , i <= numargs = - map (setpos spos) (args !! (i - 1)) ++ acc + foldr addTok acc (args !! (i - 1)) + -- add space if needed after control sequence + -- see #4007 + addTok (Tok _ (CtrlSeq x) txt) + acc@(Tok _ Word _ : _) + | not (T.null txt) && + (isLetter (T.last txt)) = + Tok spos (CtrlSeq x) (txt <> " ") : acc addTok t acc = setpos spos t : acc ts' <- getInput setInput $ foldr addTok ts' newtoks @@ -665,7 +672,7 @@ removeDoubleQuotes t = Data.Maybe.fromMaybe t $ T.stripPrefix "\"" t >>= T.stripSuffix "\"" doubleQuote :: PandocMonad m => LP m Inlines -doubleQuote = +doubleQuote = quoted' doubleQuoted (try $ count 2 $ symbol '`') (void $ try $ count 2 $ symbol '\'') <|> quoted' doubleQuoted ((:[]) <$> symbol '“') (void $ symbol '”') @@ -674,7 +681,7 @@ doubleQuote = (void $ try $ sequence [symbol '"', symbol '\'']) singleQuote :: PandocMonad m => LP m Inlines -singleQuote = +singleQuote = quoted' singleQuoted ((:[]) <$> symbol '`') (try $ symbol '\'' >> notFollowedBy (satisfyTok startsWithLetter)) @@ -1125,7 +1132,7 @@ inlineCommand' = try $ do lookupListDefault raw names inlineCommands tok :: PandocMonad m => LP m Inlines -tok = grouped inline <|> inlineCommand' <|> singleChar' +tok = try $ spaces >> grouped inline <|> inlineCommand' <|> singleChar' where singleChar' = do Tok _ _ t <- singleChar return (str (T.unpack t)) @@ -1824,7 +1831,7 @@ letmacro = do Tok _ (CtrlSeq name) _ <- anyControlSeq optional $ symbol '=' spaces - contents <- braced <|> ((:[]) <$> (anyControlSeq <|> singleChar)) + contents <- bracedOrToken return (name, Macro ExpandWhenDefined 0 Nothing contents) defmacro :: PandocMonad m => LP m (Text, Macro) @@ -1832,7 +1839,9 @@ defmacro = try $ do controlSeq "def" Tok _ (CtrlSeq name) _ <- anyControlSeq numargs <- option 0 $ argSeq 1 - contents <- withVerbatimMode braced + -- we use withVerbatimMode, because macros are to be expanded + -- at point of use, not point of definition + contents <- withVerbatimMode bracedOrToken return (name, Macro ExpandWhenUsed numargs Nothing contents) -- Note: we don't yet support fancy things like #1.#2 @@ -1846,6 +1855,9 @@ isArgTok :: Tok -> Bool isArgTok (Tok _ (Arg _) _) = True isArgTok _ = False +bracedOrToken :: PandocMonad m => LP m [Tok] +bracedOrToken = braced <|> ((:[]) <$> (anyControlSeq <|> singleChar)) + newcommand :: PandocMonad m => LP m (Text, Macro) newcommand = do pos <- getPosition @@ -1861,9 +1873,7 @@ newcommand = do spaces optarg <- option Nothing $ Just <$> try bracketedToks spaces - contents <- withVerbatimMode braced - -- we use withVerbatimMode, because macros are to be expanded - -- at point of use, not point of definition + contents <- withVerbatimMode bracedOrToken when (mtype == "newcommand") $ do macros <- sMacros <$> getState case M.lookup name macros of @@ -1885,9 +1895,9 @@ newenvironment = do spaces optarg <- option Nothing $ Just <$> try bracketedToks spaces - startcontents <- withVerbatimMode braced + startcontents <- withVerbatimMode bracedOrToken spaces - endcontents <- withVerbatimMode braced + endcontents <- withVerbatimMode bracedOrToken when (mtype == "newenvironment") $ do macros <- sMacros <$> getState case M.lookup name macros of diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 69e70f9f5..98552e65d 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -241,7 +241,7 @@ yamlMetaBlock = try $ do case Yaml.decodeEither' $ UTF8.fromString rawYaml of Right (Yaml.Object hashmap) -> do let alist = H.toList hashmap - mapM_ (\(k, v) -> + mapM_ (\(k, v) -> if ignorable k then return () else do @@ -320,7 +320,7 @@ yamlToMeta (Yaml.Array xs) = do return $ B.toMetaValue xs'' yamlToMeta (Yaml.Object o) = do let alist = H.toList o - foldM (\m (k,v) -> + foldM (\m (k,v) -> if ignorable k then return m else do @@ -846,6 +846,7 @@ listLine continuationIndent = try $ do skipMany spaceChar listStart) notFollowedByHtmlCloser + notFollowedByDivCloser optional (() <$ gobbleSpaces continuationIndent) listLineCommon @@ -883,16 +884,24 @@ listContinuation continuationIndent = try $ do x <- try $ do notFollowedBy blankline notFollowedByHtmlCloser + notFollowedByDivCloser gobbleSpaces continuationIndent anyLineNewline xs <- many $ try $ do notFollowedBy blankline notFollowedByHtmlCloser + notFollowedByDivCloser gobbleSpaces continuationIndent <|> notFollowedBy' listStart anyLineNewline blanks <- many blankline return $ concat (x:xs) ++ blanks +notFollowedByDivCloser :: PandocMonad m => MarkdownParser m () +notFollowedByDivCloser = do + guardDisabled Ext_fenced_divs <|> + do divLevel <- stateFencedDivLevel <$> getState + guard (divLevel < 1) <|> notFollowedBy divFenceEnd + notFollowedByHtmlCloser :: PandocMonad m => MarkdownParser m () notFollowedByHtmlCloser = do inHtmlBlock <- stateInHtmlBlock <$> getState @@ -965,6 +974,7 @@ defRawBlock compact = try $ do let dline = try ( do notFollowedBy blankline notFollowedByHtmlCloser + notFollowedByDivCloser if compact -- laziness not compatible with compact then () <$ indentSpaces else (() <$ indentSpaces) @@ -1688,10 +1698,8 @@ endline = try $ do guardEnabled Ext_blank_before_header <|> (notFollowedBy . char =<< atxChar) -- atx header guardDisabled Ext_backtick_code_blocks <|> notFollowedBy (() <$ (lookAhead (char '`') >> codeBlockFenced)) - guardDisabled Ext_fenced_divs <|> - do divLevel <- stateFencedDivLevel <$> getState - guard (divLevel < 1) <|> notFollowedBy divFenceEnd notFollowedByHtmlCloser + notFollowedByDivCloser (eof >> return mempty) <|> (guardEnabled Ext_hard_line_breaks >> return (return B.linebreak)) <|> (guardEnabled Ext_ignore_line_breaks >> return mempty) diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 6cc505e3b..6f4244ac3 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts #-} {- Copyright (C) 2017 Alexander Krotov <ilabdsf@gmail.com> @@ -42,23 +42,23 @@ module Text.Pandoc.Readers.Muse (readMuse) where import Control.Monad import Control.Monad.Except (throwError) -import qualified Data.Map as M import Data.Char (isLetter) -import Data.Text (Text, unpack) import Data.List (stripPrefix) +import qualified Data.Map as M import Data.Maybe (fromMaybe) +import Data.Text (Text, unpack) +import System.FilePath (takeExtension) import Text.HTML.TagSoup import Text.Pandoc.Builder (Blocks, Inlines) import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Class (PandocMonad(..)) +import Text.Pandoc.Class (PandocMonad (..)) import Text.Pandoc.Definition import Text.Pandoc.Logging import Text.Pandoc.Options -import Text.Pandoc.Shared (crFilter) import Text.Pandoc.Parsing hiding (nested) import Text.Pandoc.Readers.HTML (htmlTag) +import Text.Pandoc.Shared (crFilter) import Text.Pandoc.XML (fromEntities) -import System.FilePath (takeExtension) -- | Read Muse from an input string and return a Pandoc document. readMuse :: PandocMonad m @@ -233,14 +233,14 @@ exampleTag = do return $ return $ B.codeBlockWith attr $ chop contents where lchop s = case s of '\n':ss -> ss - _ -> s + _ -> s rchop = reverse . lchop . reverse -- Trim up to one newline from the beginning and the end, -- in case opening and/or closing tags are on separate lines. chop = lchop . rchop literal :: PandocMonad m => MuseParser m (F Blocks) -literal = fmap (return . rawBlock) $ htmlElement "literal" +literal = (return . rawBlock) <$> htmlElement "literal" where format (_, _, kvs) = fromMaybe "html" $ lookup "format" kvs rawBlock (attrs, content) = B.rawBlock (format attrs) content @@ -315,7 +315,7 @@ noteBlock = try $ do content <- mconcat <$> blocksTillNote oldnotes <- stateNotes' <$> getState case M.lookup ref oldnotes of - Just _ -> logMessage $ DuplicateNoteReference ref pos + Just _ -> logMessage $ DuplicateNoteReference ref pos Nothing -> return () updateState $ \s -> s{ stateNotes' = M.insert ref (pos, content) oldnotes } return mempty @@ -445,7 +445,7 @@ definitionList = do data MuseTable = MuseTable { museTableCaption :: Inlines , museTableHeaders :: [[Blocks]] - , museTableRows :: [[Blocks]] + , museTableRows :: [[Blocks]] , museTableFooters :: [[Blocks]] } @@ -658,7 +658,7 @@ str :: PandocMonad m => MuseParser m (F Inlines) str = fmap (return . B.str) (many1 alphaNum <|> count 1 characterReference) symbol :: PandocMonad m => MuseParser m (F Inlines) -symbol = fmap (return . B.str) $ count 1 nonspaceChar +symbol = (return . B.str) <$> count 1 nonspaceChar link :: PandocMonad m => MuseParser m (F Inlines) link = try $ do diff --git a/src/Text/Pandoc/Readers/OPML.hs b/src/Text/Pandoc/Readers/OPML.hs index e3ef67bc1..1a1375b16 100644 --- a/src/Text/Pandoc/Readers/OPML.hs +++ b/src/Text/Pandoc/Readers/OPML.hs @@ -58,7 +58,7 @@ normalizeTree = everywhere (mkT go) go xs = xs convertEntity :: String -> String -convertEntity e = maybe (map toUpper e) id (lookupEntity e) +convertEntity e = Data.Maybe.fromMaybe (map toUpper e) (lookupEntity e) -- convenience function to get an attribute value, defaulting to "" attrValue :: String -> Element -> String diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index 69eececc8..44bd89278 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs +++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs @@ -49,7 +49,6 @@ import Data.Maybe import qualified Text.XML.Light as XML -import Text.Pandoc.Definition import Text.Pandoc.Builder import Text.Pandoc.MediaBag (MediaBag, insertMedia) import Text.Pandoc.Shared diff --git a/src/Text/Pandoc/Readers/Odt/StyleReader.hs b/src/Text/Pandoc/Readers/Odt/StyleReader.hs index abb131983..1384072d1 100644 --- a/src/Text/Pandoc/Readers/Odt/StyleReader.hs +++ b/src/Text/Pandoc/Readers/Odt/StyleReader.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Arrows #-} -{-# LANGUAGE PatternGuards #-} + {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index dae9fe40a..de488adfe 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -31,11 +31,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion from reStructuredText to 'Pandoc' document. -} module Text.Pandoc.Readers.RST ( readRST ) where +import Control.Arrow (second) import Control.Monad (forM_, guard, liftM, mplus, mzero, when) import Control.Monad.Except (throwError) import Control.Monad.Identity (Identity (..)) import Data.Char (isHexDigit, isSpace, toLower, toUpper) -import Data.List (deleteFirstsBy, findIndex, intercalate, isInfixOf, isSuffixOf, +import Data.List (deleteFirstsBy, elemIndex, intercalate, isInfixOf, isSuffixOf, nub, sort, transpose, union) import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust) @@ -43,8 +44,7 @@ import Data.Monoid ((<>)) import Data.Sequence (ViewR (..), viewr) import Data.Text (Text) import qualified Data.Text as T -import Text.Pandoc.Builder (fromList, setMeta) -import Text.Pandoc.Builder (Blocks, Inlines, trimInlines) +import Text.Pandoc.Builder (Blocks, Inlines, fromList, setMeta, trimInlines) import qualified Text.Pandoc.Builder as B import Text.Pandoc.Class (PandocMonad, fetchItem, readFileFromDirs) import Text.Pandoc.CSV (CSVOptions (..), defaultCSVOptions, parseCSV) @@ -67,7 +67,7 @@ readRST :: PandocMonad m -> Text -- ^ String to parse (assuming @'\n'@ line endings) -> m Pandoc readRST opts s = do - parsed <- (readWithM parseRST) def{ stateOptions = opts } + parsed <- readWithM parseRST def{ stateOptions = opts } (T.unpack (crFilter s) ++ "\n\n") case parsed of Right result -> return result @@ -100,9 +100,9 @@ isHeader _ _ = False -- | Promote all headers in a list of blocks. (Part of -- title transformation for RST.) promoteHeaders :: Int -> [Block] -> [Block] -promoteHeaders num ((Header level attr text):rest) = - (Header (level - num) attr text):(promoteHeaders num rest) -promoteHeaders num (other:rest) = other:(promoteHeaders num rest) +promoteHeaders num (Header level attr text:rest) = + Header (level - num) attr text:promoteHeaders num rest +promoteHeaders num (other:rest) = other:promoteHeaders num rest promoteHeaders _ [] = [] -- | If list of blocks starts with a header (or a header and subheader) @@ -114,11 +114,11 @@ titleTransform :: ([Block], Meta) -- ^ list of blocks, metadata titleTransform (bs, meta) = let (bs', meta') = case bs of - ((Header 1 _ head1):(Header 2 _ head2):rest) + (Header 1 _ head1:Header 2 _ head2:rest) | not (any (isHeader 1) rest || any (isHeader 2) rest) -> -- tit/sub (promoteHeaders 2 rest, setMeta "title" (fromList head1) $ setMeta "subtitle" (fromList head2) meta) - ((Header 1 _ head1):rest) + (Header 1 _ head1:rest) | not (any (isHeader 1) rest) -> -- title only (promoteHeaders 1 rest, setMeta "title" (fromList head1) meta) @@ -137,8 +137,7 @@ metaFromDefList ds meta = adjustAuthors $ foldr f meta ds $ M.mapKeys (\k -> if k == "authors" then "author" - else k) - $ metamap + else k) metamap toPlain (MetaBlocks [Para xs]) = MetaInlines xs toPlain x = x splitAuthors (MetaBlocks [Para xs]) @@ -201,7 +200,7 @@ parseCitation :: PandocMonad m => (String, String) -> RSTParser m (Inlines, [Blocks]) parseCitation (ref, raw) = do contents <- parseFromString' parseBlocks raw - return $ (B.spanWith (ref, ["citation-label"], []) (B.str ref), + return (B.spanWith (ref, ["citation-label"], []) (B.str ref), [contents]) @@ -289,7 +288,7 @@ para = try $ do newline blanklines case viewr (B.unMany result) of - ys :> (Str xs) | "::" `isSuffixOf` xs -> do + ys :> Str xs | "::" `isSuffixOf` xs -> do raw <- option mempty codeBlockBody return $ B.para (B.Many ys <> B.str (take (length xs - 1) xs)) <> raw @@ -313,9 +312,9 @@ doubleHeader = do -- if so, get appropriate level. if not, add to list. state <- getState let headerTable = stateHeaderTable state - let (headerTable',level) = case findIndex (== DoubleHeader c) headerTable of + let (headerTable',level) = case elemIndex (DoubleHeader c) headerTable of Just ind -> (headerTable, ind + 1) - Nothing -> (headerTable ++ [DoubleHeader c], (length headerTable) + 1) + Nothing -> (headerTable ++ [DoubleHeader c], length headerTable + 1) setState (state { stateHeaderTable = headerTable' }) attr <- registerHeader nullAttr txt return $ B.headerWith attr level txt @@ -329,8 +328,8 @@ doubleHeader' = try $ do newline txt <- trimInlines . mconcat <$> many1 (notFollowedBy blankline >> inline) pos <- getPosition - let len = (sourceColumn pos) - 1 - if (len > lenTop) then fail "title longer than border" else return () + let len = sourceColumn pos - 1 + when (len > lenTop) $ fail "title longer than border" blankline -- spaces and newline count lenTop (char c) -- the bottom line blanklines @@ -342,9 +341,9 @@ singleHeader = do (txt, c) <- singleHeader' state <- getState let headerTable = stateHeaderTable state - let (headerTable',level) = case findIndex (== SingleHeader c) headerTable of + let (headerTable',level) = case elemIndex (SingleHeader c) headerTable of Just ind -> (headerTable, ind + 1) - Nothing -> (headerTable ++ [SingleHeader c], (length headerTable) + 1) + Nothing -> (headerTable ++ [SingleHeader c], length headerTable + 1) setState (state { stateHeaderTable = headerTable' }) attr <- registerHeader nullAttr txt return $ B.headerWith attr level txt @@ -355,7 +354,7 @@ singleHeader' = try $ do lookAhead $ anyLine >> oneOf underlineChars txt <- trimInlines . mconcat <$> many1 (do {notFollowedBy newline; inline}) pos <- getPosition - let len = (sourceColumn pos) - 1 + let len = sourceColumn pos - 1 blankline c <- oneOf underlineChars count (len - 1) (char c) @@ -491,8 +490,7 @@ includeDirective top fields body = do Just x | x >= 0 -> x | otherwise -> numLines + x -- negative from end let contentLines' = drop (startLine' - 1) - $ take (endLine' - 1) - $ contentLines + $ take (endLine' - 1) contentLines let contentLines'' = (case trim <$> lookup "end-before" fields of Just patt -> takeWhile (not . (patt `isInfixOf`)) Nothing -> id) . @@ -692,7 +690,7 @@ directive' = do "csv-table" -> csvTableDirective top fields body' "line-block" -> lineBlockDirective body' "raw" -> return $ B.rawBlock (trim top) (stripTrailingNewlines body) - "role" -> addNewRole top $ map (\(k,v) -> (k, trim v)) fields + "role" -> addNewRole top $ map (second trim) fields "container" -> parseFromString' parseBlocks body' "replace" -> B.para <$> -- consumed by substKey parseInlineFromString (trim top) @@ -733,7 +731,7 @@ directive' = do codeblock (words $ fromMaybe [] $ lookup "class" fields) (lookup "number-lines" fields) (trim top) body "aafig" -> do - let attribs = ("", ["aafig"], map (\(k,v) -> (k, trimr v)) fields) + let attribs = ("", ["aafig"], map (second trimr) fields) return $ B.codeBlockWith attribs $ stripTrailingNewlines body "math" -> return $ B.para $ mconcat $ map B.displayMath $ toChunks $ top ++ "\n\n" ++ body @@ -752,8 +750,8 @@ directive' = do $ B.imageWith attr src "" alt Nothing -> B.imageWith attr src "" alt "class" -> do - let attrs = ("", (splitBy isSpace $ trim top), - map (\(k,v) -> (k, trimr v)) fields) + let attrs = ("", splitBy isSpace $ trim top, + map (second trimr) fields) -- directive content or the first immediately following element children <- case body of "" -> block @@ -857,7 +855,7 @@ csvTableDirective top fields rawcsv = do Just h -> h ++ "\n" ++ rawcsv' Nothing -> rawcsv') case res of - Left e -> do + Left e -> throwError $ PandocParsecError "csv table" e Right rawrows -> do let parseCell = parseFromString' (plain <|> return mempty) . T.unpack @@ -909,13 +907,13 @@ addNewRole roleString fields = do in (ident, nub . (role :) . annotate $ classes, keyValues) -- warn about syntax we ignore - flip mapM_ fields $ \(key, _) -> case key of - "language" -> when (baseRole /= "code") $ logMessage $ - SkippedContent ":language: [because parent of role is not :code:]" - pos - "format" -> when (baseRole /= "raw") $ logMessage $ - SkippedContent ":format: [because parent of role is not :raw:]" pos - _ -> logMessage $ SkippedContent (":" ++ key ++ ":") pos + forM_ fields $ \(key, _) -> case key of + "language" -> when (baseRole /= "code") $ logMessage $ + SkippedContent ":language: [because parent of role is not :code:]" + pos + "format" -> when (baseRole /= "raw") $ logMessage $ + SkippedContent ":format: [because parent of role is not :raw:]" pos + _ -> logMessage $ SkippedContent (":" ++ key ++ ":") pos when (parentRole == "raw" && countKeys "format" > 1) $ logMessage $ SkippedContent ":format: [after first in definition of role]" @@ -983,7 +981,7 @@ codeblock classes numberLines lang body = return $ B.codeBlockWith attribs $ stripTrailingNewlines body where attribs = ("", classes', kvs) classes' = "sourceCode" : lang - : maybe [] (\_ -> ["numberLines"]) numberLines + : maybe [] (const ["numberLines"]) numberLines ++ classes kvs = case numberLines of Just "" -> [] @@ -1038,7 +1036,8 @@ noteMarker :: Monad m => RSTParser m [Char] noteMarker = do char '[' res <- many1 digit - <|> (try $ char '#' >> liftM ('#':) simpleReferenceName') + <|> + try (char '#' >> liftM ('#':) simpleReferenceName') <|> count 1 (oneOf "#*") char ']' return res @@ -1050,13 +1049,11 @@ noteMarker = do quotedReferenceName :: PandocMonad m => RSTParser m Inlines quotedReferenceName = try $ do char '`' >> notFollowedBy (char '`') -- `` means inline code! - label' <- trimInlines . mconcat <$> many1Till inline (char '`') - return label' + trimInlines . mconcat <$> many1Till inline (char '`') unquotedReferenceName :: PandocMonad m => RSTParser m Inlines -unquotedReferenceName = try $ do - label' <- trimInlines . mconcat <$> many1Till inline (lookAhead $ char ':') - return label' +unquotedReferenceName = try $ do -- `` means inline code! + trimInlines . mconcat <$> many1Till inline (lookAhead $ char ':') -- Simple reference names are single words consisting of alphanumerics -- plus isolated (no two adjacent) internal hyphens, underscores, @@ -1066,7 +1063,8 @@ simpleReferenceName' :: Monad m => ParserT [Char] st m String simpleReferenceName' = do x <- alphaNum xs <- many $ alphaNum - <|> (try $ oneOf "-_:+." <* lookAhead alphaNum) + <|> + try (oneOf "-_:+." <* lookAhead alphaNum) return (x:xs) simpleReferenceName :: Monad m => ParserT [Char] st m Inlines @@ -1074,7 +1072,7 @@ simpleReferenceName = B.str <$> simpleReferenceName' referenceName :: PandocMonad m => RSTParser m Inlines referenceName = quotedReferenceName <|> - (try $ simpleReferenceName <* lookAhead (char ':')) <|> + try (simpleReferenceName <* lookAhead (char ':')) <|> unquotedReferenceName referenceKey :: PandocMonad m => RSTParser m [Char] @@ -1093,7 +1091,7 @@ targetURI = do contents <- many1 (try (many spaceChar >> newline >> many1 spaceChar >> noneOf " \t\n") <|> noneOf "\n") blanklines - return $ escapeURI $ trim $ contents + return $ escapeURI $ trim contents substKey :: PandocMonad m => RSTParser m () substKey = try $ do @@ -1258,8 +1256,7 @@ simpleTableHeader headless = try $ do let rawHeads = if headless then replicate (length dashes) "" else simpleTableSplitLine indices rawContent - heads <- mapM (parseFromString' (mconcat <$> many plain)) $ - map trim rawHeads + heads <- mapM ( (parseFromString' (mconcat <$> many plain)) . trim) rawHeads return (heads, aligns, indices) -- Parse a simple table. @@ -1450,10 +1447,8 @@ endline = try $ do notFollowedBy blankline -- parse potential list-starts at beginning of line differently in a list: st <- getState - if (stateParserContext st) == ListItemState - then notFollowedBy (anyOrderedListMarker >> spaceChar) >> + when ((stateParserContext st) == ListItemState) $ notFollowedBy (anyOrderedListMarker >> spaceChar) >> notFollowedBy' bulletListStart - else return () return B.softbreak -- diff --git a/src/Text/Pandoc/Readers/Vimwiki.hs b/src/Text/Pandoc/Readers/Vimwiki.hs index 49da5a6c6..fecbb2fb4 100644 --- a/src/Text/Pandoc/Readers/Vimwiki.hs +++ b/src/Text/Pandoc/Readers/Vimwiki.hs @@ -91,12 +91,10 @@ import Text.Pandoc.Parsing (F, ParserState, ParserT, blanklines, emailAddress, registerHeader, runF, spaceChar, stateMeta', stateOptions, uri) import Text.Pandoc.Shared (crFilter, splitBy, stringify, stripFirstAndLast) -import Text.Parsec.Char - (alphaNum, anyChar, char, newline, noneOf, spaces, string, oneOf, - space) -import Text.Parsec.Combinator - (choice, count, eof, many1, manyTill, notFollowedBy, option, - skipMany1, between, lookAhead) +import Text.Parsec.Char (alphaNum, anyChar, char, newline, noneOf, oneOf, space, + spaces, string) +import Text.Parsec.Combinator (between, choice, count, eof, lookAhead, many1, + manyTill, notFollowedBy, option, skipMany1) import Text.Parsec.Prim (getState, many, try, updateState, (<|>)) readVimwiki :: PandocMonad m => ReaderOptions -> Text -> m Pandoc diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 9d4877c24..60c8e1a0c 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -520,7 +520,7 @@ uniqueIdent title' usedIdents -- | True if block is a Header block. isHeaderBlock :: Block -> Bool isHeaderBlock (Header{}) = True -isHeaderBlock _ = False +isHeaderBlock _ = False -- | Shift header levels up or down. headerShift :: Int -> Pandoc -> Pandoc diff --git a/src/Text/Pandoc/Slides.hs b/src/Text/Pandoc/Slides.hs index d83735029..27e7d3d76 100644 --- a/src/Text/Pandoc/Slides.hs +++ b/src/Text/Pandoc/Slides.hs @@ -42,7 +42,7 @@ getSlideLevel = go 6 go least [] = least nonHOrHR Header{} = False nonHOrHR HorizontalRule = False - nonHOrHR _ = True + nonHOrHR _ = True -- | Prepare a block list to be passed to hierarchicalize. prepSlides :: Int -> [Block] -> [Block] diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs index 89d524d96..1ba8d5a05 100644 --- a/src/Text/Pandoc/Templates.hs +++ b/src/Text/Pandoc/Templates.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} {- Copyright (C) 2009-2017 John MacFarlane <jgm@berkeley.edu> diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index 112f8b657..bf58a755f 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -42,7 +42,7 @@ import Data.Aeson (Result (..), Value (String), fromJSON, toJSON) import Data.Char (isPunctuation, isSpace) import Data.List (intercalate, intersperse, stripPrefix) import qualified Data.Map as M -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isJust) import Data.Text (Text) import qualified Data.Text as T import Text.Pandoc.Class (PandocMonad, report) @@ -100,9 +100,8 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do let context = defField "body" main $ defField "toc" (writerTableOfContents opts && - writerTemplate opts /= Nothing) - $ defField "titleblock" titleblock - $ metadata' + isJust (writerTemplate opts)) + $defField "titleblock" titleblock metadata' case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -137,7 +136,7 @@ blockToAsciiDoc _ Null = return empty blockToAsciiDoc opts (Plain inlines) = do contents <- inlineListToAsciiDoc opts inlines return $ contents <> blankline -blockToAsciiDoc opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do +blockToAsciiDoc opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = blockToAsciiDoc opts (Para [Image attr alt (src,tit)]) blockToAsciiDoc opts (Para inlines) = do contents <- inlineListToAsciiDoc opts inlines @@ -165,9 +164,9 @@ blockToAsciiDoc opts (Header level (ident,_,_) inlines) = do let len = offset contents -- ident seem to be empty most of the time and asciidoc will generate them automatically -- so lets make them not show up when null - let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]") + let identifier = if null ident then empty else "[[" <> text ident <> "]]" let setext = writerSetextHeaders opts - return $ + return (if setext then identifier $$ contents $$ @@ -179,7 +178,7 @@ blockToAsciiDoc opts (Header level (ident,_,_) inlines) = do _ -> empty) <> blankline else identifier $$ text (replicate level '=') <> space <> contents <> blankline) -blockToAsciiDoc _ (CodeBlock (_,classes,_) str) = return $ (flush $ +blockToAsciiDoc _ (CodeBlock (_,classes,_) str) = return $ flush ( if null classes then "...." $$ text str $$ "...." else attrs $$ "----" $$ text str $$ "----") @@ -204,7 +203,7 @@ blockToAsciiDoc opts (Table caption aligns widths headers rows) = do let isSimple = all (== 0) widths let relativePercentWidths = if isSimple then widths - else map (/ (sum widths)) widths + else map (/ sum widths) widths let widths'' :: [Integer] widths'' = map (floor . (* 100)) relativePercentWidths -- ensure that the widths sum to 100 @@ -266,14 +265,14 @@ blockToAsciiDoc opts (OrderedList (_start, sty, _delim) items) = do let markers' = map (\m -> if length m < 3 then m ++ replicate (3 - length m) ' ' else m) markers - contents <- mapM (\(item, num) -> orderedListItemToAsciiDoc opts item num) $ + contents <- mapM (uncurry (orderedListItemToAsciiDoc opts)) $ zip markers' items return $ cat contents <> blankline blockToAsciiDoc opts (DefinitionList items) = do contents <- mapM (definitionListItemToAsciiDoc opts) items return $ cat contents <> blankline blockToAsciiDoc opts (Div (ident,_,_) bs) = do - let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]") + let identifier = if null ident then empty else ("[[" <> text ident <> "]]") contents <- blockListToAsciiDoc opts bs return $ identifier $$ contents @@ -460,7 +459,7 @@ inlineToAsciiDoc opts (Image attr alternate (src, tit)) = do let linktitle = if null tit then empty else ",title=\"" <> text tit <> "\"" - showDim dir = case (dimension dir attr) of + showDim dir = case dimension dir attr of Just (Percent a) -> ["scaledwidth=" <> text (show (Percent a))] Just dim -> @@ -480,6 +479,6 @@ inlineToAsciiDoc opts (Note [Plain inlines]) = do -- asciidoc can't handle blank lines in notes inlineToAsciiDoc _ (Note _) = return "[multiblock footnote omitted]" inlineToAsciiDoc opts (Span (ident,_,_) ils) = do - let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]") + let identifier = if null ident then empty else ("[[" <> text ident <> "]]") contents <- inlineListToAsciiDoc opts ils return $ identifier <> contents diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs index 9bd9f25bc..e6d297291 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -60,7 +60,7 @@ writeCommonMark opts (Pandoc meta blocks) = do (blocksToCommonMark opts) (inlinesToCommonMark opts) meta - let context = defField "body" main $ metadata + let context = defField "body" main metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -108,11 +108,11 @@ blockToNodes opts (Plain xs) ns = blockToNodes opts (Para xs) ns = return (node PARAGRAPH (inlinesToNodes opts xs) : ns) blockToNodes opts (LineBlock lns) ns = blockToNodes opts (linesToPara lns) ns -blockToNodes _ (CodeBlock (_,classes,_) xs) ns = return $ +blockToNodes _ (CodeBlock (_,classes,_) xs) ns = return (node (CODE_BLOCK (T.pack (unwords classes)) (T.pack xs)) [] : ns) blockToNodes _ (RawBlock fmt xs) ns | fmt == Format "html" = return (node (HTML_BLOCK (T.pack xs)) [] : ns) - | otherwise = return (node (CUSTOM_BLOCK (T.pack xs) (T.empty)) [] : ns) + | otherwise = return (node (CUSTOM_BLOCK (T.pack xs) T.empty) [] : ns) blockToNodes opts (BlockQuote bs) ns = do nodes <- blocksToNodes opts bs return (node BLOCK_QUOTE nodes : ns) @@ -142,9 +142,9 @@ blockToNodes opts (Div _ bs) ns = do blockToNodes opts (DefinitionList items) ns = blockToNodes opts (BulletList items') ns where items' = map dlToBullet items - dlToBullet (term, ((Para xs : ys) : zs)) = + dlToBullet (term, (Para xs : ys) : zs) = Para (term ++ [LineBreak] ++ xs) : ys ++ concat zs - dlToBullet (term, ((Plain xs : ys) : zs)) = + dlToBullet (term, (Plain xs : ys) : zs) = Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs dlToBullet (term, xs) = Para term : concat xs @@ -264,7 +264,7 @@ inlineToNodes opts (Image _ ils (url,tit)) = (node (IMAGE (T.pack url) (T.pack tit)) (inlinesToNodes opts ils) :) inlineToNodes _ (RawInline fmt xs) | fmt == Format "html" = (node (HTML_INLINE (T.pack xs)) [] :) - | otherwise = (node (CUSTOM_INLINE (T.pack xs) (T.empty)) [] :) + | otherwise = (node (CUSTOM_INLINE (T.pack xs) T.empty) [] :) inlineToNodes opts (Quoted qt ils) = ((node (TEXT start) [] : inlinesToNodes opts ils ++ [node (TEXT end) []]) ++) diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 101be3fc0..63113ac82 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -33,7 +33,7 @@ module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where import Control.Monad.State.Strict import Data.Char (ord) import Data.List (intercalate, intersperse) -import Data.Maybe (catMaybes) +import Data.Maybe (mapMaybe) import Data.Text (Text) import Network.URI (unEscapeString) import Text.Pandoc.BCP47 @@ -82,8 +82,7 @@ pandocToConTeXt options (Pandoc meta blocks) = do meta body <- mapM (elementToConTeXt options) $ hierarchicalize blocks let main = (render' . vcat) body - let layoutFromMargins = intercalate [','] $ catMaybes $ - map (\(x,y) -> + let layoutFromMargins = intercalate [','] $ mapMaybe (\(x,y) -> ((x ++ "=") ++) <$> getField y metadata) [("leftmargin","margin-left") ,("rightmargin","margin-right") @@ -107,8 +106,7 @@ pandocToConTeXt options (Pandoc meta blocks) = do $ (case getField "papersize" metadata of Just ("a4" :: String) -> resetField "papersize" ("A4" :: String) - _ -> id) - $ metadata + _ -> id) metadata let context' = defField "context-dir" (toContextDir $ getField "dir" context) context case writerTemplate options of @@ -150,7 +148,7 @@ stringToConTeXt opts = concatMap (escapeCharForConTeXt opts) toLabel :: String -> String toLabel z = concatMap go z where go x - | elem x ("\\#[]\",{}%()|=" :: String) = "ux" ++ printf "%x" (ord x) + | x `elem` ("\\#[]\",{}%()|=" :: String) = "ux" ++ printf "%x" (ord x) | otherwise = [x] -- | Convert Elements to ConTeXt @@ -206,7 +204,7 @@ blockToConTeXt (Div (ident,_,kvs) bs) = do <> text lng <> "]" $$ txt $$ "\\stop" Nothing -> txt wrapBlank txt = blankline <> txt <> blankline - fmap (wrapBlank . wrapLang . wrapDir . wrapRef) $ blockListToConTeXt bs + (wrapBlank . wrapLang . wrapDir . wrapRef) <$> blockListToConTeXt bs blockToConTeXt (BulletList lst) = do contents <- mapM listItemToConTeXt lst return $ ("\\startitemize" <> if isTightList lst @@ -261,7 +259,7 @@ blockToConTeXt (Table caption aligns widths heads rows) = do if colWidth == 0 then "|" else ("p(" ++ printf "%.2f" colWidth ++ "\\textwidth)|") - let colDescriptors = "|" ++ (concat $ + let colDescriptors = "|" ++ concat ( zipWith colDescriptor widths aligns) headers <- if all null heads then return empty @@ -279,11 +277,11 @@ blockToConTeXt (Table caption aligns widths heads rows) = do tableRowToConTeXt :: PandocMonad m => [[Block]] -> WM m Doc tableRowToConTeXt cols = do cols' <- mapM blockListToConTeXt cols - return $ (vcat (map ("\\NC " <>) cols')) $$ "\\NC\\AR" + return $ vcat (map ("\\NC " <>) cols') $$ "\\NC\\AR" listItemToConTeXt :: PandocMonad m => [Block] -> WM m Doc listItemToConTeXt list = blockListToConTeXt list >>= - return . ("\\item" $$) . (nest 2) + return . ("\\item" $$) . nest 2 defListItemToConTeXt :: PandocMonad m => ([Inline], [[Block]]) -> WM m Doc defListItemToConTeXt (term, defs) = do @@ -358,7 +356,7 @@ inlineToConTeXt (RawInline "tex" str) = return $ text str inlineToConTeXt il@(RawInline _ _) = do report $ InlineNotRendered il return empty -inlineToConTeXt (LineBreak) = return $ text "\\crlf" <> cr +inlineToConTeXt LineBreak = return $ text "\\crlf" <> cr inlineToConTeXt SoftBreak = do wrapText <- gets (writerWrapText . stOptions) return $ case wrapText of @@ -367,7 +365,7 @@ inlineToConTeXt SoftBreak = do WrapPreserve -> cr inlineToConTeXt Space = return space -- Handle HTML-like internal document references to sections -inlineToConTeXt (Link _ txt (('#' : ref), _)) = do +inlineToConTeXt (Link _ txt ('#' : ref, _)) = do opts <- gets stOptions contents <- inlineListToConTeXt txt let ref' = toLabel $ stringToConTeXt opts ref @@ -393,7 +391,7 @@ inlineToConTeXt (Link _ txt (src, _)) = do inlineToConTeXt (Image attr@(_,cls,_) _ (src, _)) = do opts <- gets stOptions let showDim dir = let d = text (show dir) <> "=" - in case (dimension dir attr) of + in case dimension dir attr of Just (Pixel a) -> [d <> text (showInInch opts (Pixel a)) <> "in"] Just (Percent a) -> @@ -432,7 +430,7 @@ inlineToConTeXt (Span (_,_,kvs) ils) = do Just lng -> "\\start\\language[" <> text lng <> "]" <> txt <> "\\stop " Nothing -> txt - fmap (wrapLang . wrapDir) $ inlineListToConTeXt ils + (wrapLang . wrapDir) <$> inlineListToConTeXt ils -- | Craft the section header, inserting the section reference, if supplied. sectionHeader :: PandocMonad m diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 09cf3fac8..87b97dcee 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -235,7 +235,7 @@ inlineToCustom (Math InlineMath str) = inlineToCustom (RawInline format str) = callFunc "RawInline" format str -inlineToCustom (LineBreak) = callFunc "LineBreak" +inlineToCustom LineBreak = callFunc "LineBreak" inlineToCustom (Link attr txt (src,tit)) = callFunc "Link" txt src tit (attrToMap attr) diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index d6b7f7cad..74a1249a4 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -33,7 +33,7 @@ module Text.Pandoc.Writers.Docbook ( writeDocbook4, writeDocbook5 ) where import Control.Monad.Reader import Data.Char (toLower) import Data.Generics (everywhere, mkT) -import Data.List (intercalate, isPrefixOf, isSuffixOf, stripPrefix) +import Data.List (isPrefixOf, isSuffixOf, stripPrefix) import Data.Monoid (Any (..)) import Data.Text (Text) import qualified Text.Pandoc.Builder as B @@ -76,9 +76,9 @@ authorToDocbook opts name' = do let namewords = words name lengthname = length namewords (firstname, lastname) = case lengthname of - 0 -> ("","") - 1 -> ("", name) - n -> (intercalate " " (take (n-1) namewords), last namewords) + 0 -> ("","") + 1 -> ("", name) + n -> (unwords (take (n-1) namewords), last namewords) in inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$ inTagsSimple "surname" (text $ escapeStringForXML lastname) @@ -99,9 +99,9 @@ writeDocbook opts (Pandoc meta blocks) = do else Nothing let render' :: Doc -> Text render' = render colwidth - let opts' = if (maybe False (("/book>" `isSuffixOf`) . trimr) + let opts' = if maybe False (("/book>" `isSuffixOf`) . trimr) (writerTemplate opts) && - TopLevelDefault == writerTopLevelDivision opts) + TopLevelDefault == writerTopLevelDivision opts then opts{ writerTopLevelDivision = TopLevelChapter } else opts -- The numbering here follows LaTeX's internal numbering @@ -114,16 +114,16 @@ writeDocbook opts (Pandoc meta blocks) = do let meta' = B.setMeta "author" auths' meta metadata <- metaToJSON opts (fmap (render' . vcat) . - (mapM (elementToDocbook opts' startLvl) . - hierarchicalize)) + mapM (elementToDocbook opts' startLvl) . + hierarchicalize) (fmap render' . inlinesToDocbook opts') meta' - main <- (render' . vcat) <$> (mapM (elementToDocbook opts' startLvl) elements) + main <- (render' . vcat) <$> mapM (elementToDocbook opts' startLvl) elements let context = defField "body" main - $ defField "mathml" (case writerHTMLMathMethod opts of - MathML -> True - _ -> False) - $ metadata + $ + defField "mathml" (case writerHTMLMathMethod opts of + MathML -> True + _ -> False) metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -170,7 +170,7 @@ plainToPara x = x deflistItemsToDocbook :: PandocMonad m => WriterOptions -> [([Inline],[[Block]])] -> DB m Doc deflistItemsToDocbook opts items = - vcat <$> mapM (\(term, defs) -> deflistItemToDocbook opts term defs) items + vcat <$> mapM (uncurry (deflistItemToDocbook opts)) items -- | Convert a term and a list of blocks into a Docbook varlistentry. deflistItemToDocbook :: PandocMonad m @@ -196,7 +196,7 @@ imageToDocbook _ attr src = selfClosingTag "imagedata" $ ("fileref", src) : idAndRole attr ++ dims where dims = go Width "width" ++ go Height "depth" - go dir dstr = case (dimension dir attr) of + go dir dstr = case dimension dir attr of Just a -> [(dstr, show a)] Nothing -> [] @@ -217,7 +217,7 @@ blockToDocbook opts (Div (ident,_,_) bs) = do (if null ident then mempty else selfClosingTag "anchor" [("id", ident)]) $$ contents -blockToDocbook _ h@(Header _ _ _) = do +blockToDocbook _ h@Header{} = do -- should not occur after hierarchicalize, except inside lists/blockquotes report $ BlockNotRendered h return empty @@ -230,9 +230,9 @@ blockToDocbook opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) = do else inTagsSimple "title" alt return $ inTagsIndented "figure" $ capt $$ - (inTagsIndented "mediaobject" $ - (inTagsIndented "imageobject" - (imageToDocbook opts attr src)) $$ + inTagsIndented "mediaobject" ( + inTagsIndented "imageobject" + (imageToDocbook opts attr src) $$ inTagsSimple "textobject" (inTagsSimple "phrase" alt)) blockToDocbook opts (Para lst) | hasLineBreaks lst = (flush . nowrap . inTagsSimple "literallayout") @@ -275,7 +275,7 @@ blockToDocbook opts (OrderedList (start, numstyle, _) (first:rest)) = do first' <- blocksToDocbook opts (map plainToPara first) rest' <- listItemsToDocbook opts rest return $ - (inTags True "listitem" [("override",show start)] first') $$ + inTags True "listitem" [("override",show start)] first' $$ rest' return $ inTags True "orderedlist" attribs items blockToDocbook opts (DefinitionList lst) = do @@ -308,7 +308,7 @@ blockToDocbook opts (Table caption aligns widths headers rows) = do body' <- (inTagsIndented "tbody" . vcat) <$> mapM (tableRowToDocbook opts) rows return $ inTagsIndented tableType $ captionDoc $$ - (inTags True "tgroup" [("cols", show (length headers))] $ + inTags True "tgroup" [("cols", show (length headers))] ( coltags $$ head' $$ body') hasLineBreaks :: [Inline] -> Bool @@ -406,7 +406,7 @@ inlineToDocbook _ SoftBreak = return space inlineToDocbook opts (Link attr txt (src, _)) | Just email <- stripPrefix "mailto:" src = let emailLink = inTagsSimple "email" $ text $ - escapeStringForXML $ email + escapeStringForXML email in case txt of [Str s] | escapeURI s == email -> return emailLink _ -> do contents <- inlinesToDocbook opts txt @@ -414,7 +414,7 @@ inlineToDocbook opts (Link attr txt (src, _)) char '(' <> emailLink <> char ')' | otherwise = do version <- ask - (if isPrefixOf "#" src + (if "#" `isPrefixOf` src then inTags False "link" $ ("linkend", writerIdentifierPrefix opts ++ drop 1 src) : idAndRole attr else if version == DocBook5 then inTags False "link" $ ("xlink:href", src) : idAndRole attr diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 3ab4548a2..d146ebf84 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveFunctor #-} + {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -177,16 +177,16 @@ renumIdMap :: Int -> [Element] -> M.Map String String renumIdMap _ [] = M.empty renumIdMap n (e:es) | Just oldId <- findAttr (QName "Id" Nothing Nothing) e = - M.insert oldId ("rId" ++ (show n)) (renumIdMap (n+1) es) + M.insert oldId ("rId" ++ show n) (renumIdMap (n+1) es) | otherwise = renumIdMap n es replaceAttr :: (QName -> Bool) -> String -> [XML.Attr] -> [XML.Attr] replaceAttr _ _ [] = [] replaceAttr f val (a:as) | f (attrKey a) = - (XML.Attr (attrKey a) val) : (replaceAttr f val as) - | otherwise = a : (replaceAttr f val as) + XML.Attr (attrKey a) val : replaceAttr f val as + | otherwise = a : replaceAttr f val as -renumId :: (QName -> Bool) -> (M.Map String String) -> Element -> Element +renumId :: (QName -> Bool) -> M.Map String String -> Element -> Element renumId f renumMap e | Just oldId <- findAttrBy f e , Just newId <- M.lookup oldId renumMap = @@ -195,7 +195,7 @@ renumId f renumMap e e { elAttribs = attrs' } | otherwise = e -renumIds :: (QName -> Bool) -> (M.Map String String) -> [Element] -> [Element] +renumIds :: (QName -> Bool) -> M.Map String String -> [Element] -> [Element] renumIds f renumMap = map (renumId f renumMap) -- | Certain characters are invalid in XML even if escaped. @@ -228,7 +228,7 @@ writeDocx :: (PandocMonad m) -> Pandoc -- ^ Document to convert -> m BL.ByteString writeDocx opts doc@(Pandoc meta _) = do - let doc' = walk fixDisplayMath $ doc + let doc' = walk fixDisplayMath doc username <- P.lookupEnv "USERNAME" utctime <- P.getCurrentTime distArchive <- (toArchive . BL.fromStrict) <$> @@ -243,12 +243,12 @@ writeDocx opts doc@(Pandoc meta _) = do let mbsectpr = filterElementName (wname (=="sectPr")) parsedDoc -- Gets the template size - let mbpgsz = mbsectpr >>= (filterElementName (wname (=="pgSz"))) - let mbAttrSzWidth = (elAttribs <$> mbpgsz) >>= (lookupAttrBy ((=="w") . qName)) + let mbpgsz = mbsectpr >>= filterElementName (wname (=="pgSz")) + let mbAttrSzWidth = (elAttribs <$> mbpgsz) >>= lookupAttrBy ((=="w") . qName) - let mbpgmar = mbsectpr >>= (filterElementName (wname (=="pgMar"))) - let mbAttrMarLeft = (elAttribs <$> mbpgmar) >>= (lookupAttrBy ((=="left") . qName)) - let mbAttrMarRight = (elAttribs <$> mbpgmar) >>= (lookupAttrBy ((=="right") . qName)) + let mbpgmar = mbsectpr >>= filterElementName (wname (=="pgMar")) + let mbAttrMarLeft = (elAttribs <$> mbpgmar) >>= lookupAttrBy ((=="left") . qName) + let mbAttrMarRight = (elAttribs <$> mbpgmar) >>= lookupAttrBy ((=="right") . qName) -- Get the avaible area (converting the size and the margins to int and -- doing the difference @@ -303,7 +303,7 @@ writeDocx opts doc@(Pandoc meta _) = do envRTL = isRTLmeta , envChangesAuthor = fromMaybe "unknown" username , envChangesDate = formatTime defaultTimeLocale "%FT%XZ" utctime - , envPrintWidth = (maybe 420 (\x -> quot x 20) pgContentWidth) + , envPrintWidth = maybe 420 (\x -> quot x 20) pgContentWidth } @@ -446,7 +446,7 @@ writeDocx opts doc@(Pandoc meta _) = do (elChildren sectpr') in add_attrs (elAttribs sectpr') $ mknode "w:sectPr" [] cs - Nothing -> (mknode "w:sectPr" [] ()) + Nothing -> mknode "w:sectPr" [] () -- let sectpr = fromMaybe (mknode "w:sectPr" [] ()) mbsectpr' let contents' = contents ++ [sectpr] @@ -489,7 +489,7 @@ writeDocx opts doc@(Pandoc meta _) = do map newTextPropToOpenXml newDynamicTextProps ++ (case writerHighlightStyle opts of Nothing -> [] - Just sty -> (styleToOpenXml styleMaps sty)) + Just sty -> styleToOpenXml styleMaps sty) let styledoc' = styledoc{ elContent = elContent styledoc ++ map Elem newstyles } let styleEntry = toEntry stylepath epochtime $ renderXml styledoc' @@ -641,8 +641,8 @@ styleToOpenXml sm style = , mknode "w:link" [("w:val","VerbatimChar")] () , mknode "w:pPr" [] $ mknode "w:wordWrap" [("w:val","off")] () - : ( maybe [] (\col -> [mknode "w:shd" [("w:val","clear"),("w:fill",drop 1 $ fromColor col)] ()]) - $ backgroundColor style ) + : + maybe [] (\col -> [mknode "w:shd" [("w:val","clear"),("w:fill",drop 1 $ fromColor col)] ()]) (backgroundColor style) ] copyChildren :: (PandocMonad m) => Archive -> Archive -> String -> Integer -> [String] -> m Entry @@ -747,11 +747,11 @@ getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists makeTOC :: (PandocMonad m) => WriterOptions -> WS m [Element] makeTOC opts | writerTableOfContents opts = do - let depth = "1-"++(show (writerTOCDepth opts)) + let depth = "1-"++show (writerTOCDepth opts) let tocCmd = "TOC \\o \""++depth++"\" \\h \\z \\u" tocTitle <- gets stTocTitle title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para tocTitle]) - return $ + return [mknode "w:sdt" [] ([ mknode "w:sdtPr" [] ( mknode "w:docPartObj" [] ( @@ -803,7 +803,7 @@ writeOpenXML opts (Pandoc meta blocks) = do convertSpace (Str x : Str y : xs) = Str (x ++ y) : xs convertSpace xs = xs let blocks' = bottomUp convertSpace blocks - doc' <- (setFirstPara >> blocksToOpenXML opts blocks') + doc' <- setFirstPara >> blocksToOpenXML opts blocks' notes' <- reverse <$> gets stFootnotes comments <- reverse <$> gets stComments let toComment (kvs, ils) = do @@ -1106,7 +1106,7 @@ formattedString str = [w] -> formattedString' w ws -> do sh <- formattedRun [mknode "w:softHyphen" [] ()] - (intercalate sh) <$> mapM formattedString' ws + intercalate sh <$> mapM formattedString' ws formattedString' :: PandocMonad m => String -> WS m [Element] formattedString' str = do @@ -1134,13 +1134,13 @@ inlineToOpenXML' opts SoftBreak = inlineToOpenXML opts (Str " ") inlineToOpenXML' _ (Span (ident,["comment-start"],kvs) ils) = do modify $ \st -> st{ stComments = (("id",ident):kvs, ils) : stComments st } return [ mknode "w:commentRangeStart" [("w:id", ident)] () ] -inlineToOpenXML' _ (Span (ident,["comment-end"],_) _) = do +inlineToOpenXML' _ (Span (ident,["comment-end"],_) _) = return [ mknode "w:commentRangeEnd" [("w:id", ident)] () - , mknode "w:r" [] - [ mknode "w:rPr" [] - [ mknode "w:rStyle" [("w:val", "CommentReference")] () ] - , mknode "w:commentReference" [("w:id", ident)] () ] - ] + , mknode "w:r" [] + [ mknode "w:rPr" [] + [ mknode "w:rStyle" [("w:val", "CommentReference")] () ] + , mknode "w:commentReference" [("w:id", ident)] () ] + ] inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do stylemod <- case lookup dynamicStyleKey kvs of Just sty -> do @@ -1166,13 +1166,13 @@ inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do let author = fromMaybe defaultAuthor (lookup "author" kvs) date = fromMaybe defaultDate (lookup "date" kvs) insId <- gets stInsId - modify $ \s -> s{stInsId = (insId + 1)} + modify $ \s -> s{stInsId = insId + 1} return $ \f -> do x <- f - return $ [ mknode "w:ins" + return [ mknode "w:ins" [("w:id", (show insId)), ("w:author", author), - ("w:date", date)] x] + ("w:date", date)] x ] else return id delmod <- if "insertion" `elem` classes then do @@ -1181,11 +1181,11 @@ inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do let author = fromMaybe defaultAuthor (lookup "author" kvs) date = fromMaybe defaultDate (lookup "date" kvs) insId <- gets stInsId - modify $ \s -> s{stInsId = (insId + 1)} + modify $ \s -> s{stInsId = insId + 1} return $ \f -> do x <- f return [mknode "w:ins" - [("w:id", (show insId)), + [("w:id", show insId), ("w:author", author), ("w:date", date)] x] else return id @@ -1235,7 +1235,7 @@ inlineToOpenXML' opts (Math mathType str) = do inlineToOpenXML' opts (Cite _ lst) = inlinesToOpenXML opts lst inlineToOpenXML' opts (Code attrs str) = do let unhighlighted = intercalate [br] `fmap` - (mapM formattedString $ lines str) + mapM formattedString (lines str) formatOpenXML _fmtOpts = intercalate [br] . map (map toHlTok) toHlTok (toktype,tok) = mknode "w:r" [] [ mknode "w:rPr" [] @@ -1267,7 +1267,7 @@ inlineToOpenXML' opts (Note bs) = do , envTextProperties = [] }) (withParaPropM (pStyleM "Footnote Text") $ blocksToOpenXML opts $ insertNoteRef bs) - let newnote = mknode "w:footnote" [("w:id", notenum)] $ contents + let newnote = mknode "w:footnote" [("w:id", notenum)] contents modify $ \s -> s{ stFootnotes = newnote : notes } return [ mknode "w:r" [] [ mknode "w:rPr" [] footnoteStyle @@ -1283,7 +1283,7 @@ inlineToOpenXML' opts (Link _ txt (src,_)) = do id' <- case M.lookup src extlinks of Just i -> return i Nothing -> do - i <- ("rId"++) `fmap` ((lift . lift) getUniqueId) + i <- ("rId"++) `fmap` (lift . lift) getUniqueId modify $ \st -> st{ stExternalLinks = M.insert src i extlinks } return i @@ -1294,81 +1294,81 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do imgs <- gets stImages case M.lookup src imgs of Just (_,_,_,elt,_) -> return [elt] - Nothing -> do + Nothing -> catchError - (do (img, mt) <- P.fetchItem src - ident <- ("rId"++) `fmap` ((lift . lift) getUniqueId) - let (xpt,ypt) = desiredSizeInPoints opts attr - (either (const def) id (imageSize opts img)) - -- 12700 emu = 1 pt - let (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) - (pageWidth * 12700) - let cNvPicPr = mknode "pic:cNvPicPr" [] $ - mknode "a:picLocks" [("noChangeArrowheads","1") - ,("noChangeAspect","1")] () - let nvPicPr = mknode "pic:nvPicPr" [] - [ mknode "pic:cNvPr" - [("descr",src),("id","0"),("name","Picture")] () - , cNvPicPr ] - let blipFill = mknode "pic:blipFill" [] - [ mknode "a:blip" [("r:embed",ident)] () - , mknode "a:stretch" [] $ - mknode "a:fillRect" [] () ] - let xfrm = mknode "a:xfrm" [] - [ mknode "a:off" [("x","0"),("y","0")] () - , mknode "a:ext" [("cx",show xemu) - ,("cy",show yemu)] () ] - let prstGeom = mknode "a:prstGeom" [("prst","rect")] $ - mknode "a:avLst" [] () - let ln = mknode "a:ln" [("w","9525")] - [ mknode "a:noFill" [] () - , mknode "a:headEnd" [] () - , mknode "a:tailEnd" [] () ] - let spPr = mknode "pic:spPr" [("bwMode","auto")] - [xfrm, prstGeom, mknode "a:noFill" [] (), ln] - let graphic = mknode "a:graphic" [] $ - mknode "a:graphicData" - [("uri","http://schemas.openxmlformats.org/drawingml/2006/picture")] - [ mknode "pic:pic" [] - [ nvPicPr - , blipFill - , spPr ] ] - let imgElt = mknode "w:r" [] $ - mknode "w:drawing" [] $ - mknode "wp:inline" [] - [ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] () - , mknode "wp:effectExtent" - [("b","0"),("l","0"),("r","0"),("t","0")] () - , mknode "wp:docPr" [("descr",stringify alt) - ,("title", title) - ,("id","1") - ,("name","Picture")] () - , graphic ] - let imgext = case mt >>= extensionFromMimeType of - Just x -> '.':x - Nothing -> case imageType img of - Just Png -> ".png" - Just Jpeg -> ".jpeg" - Just Gif -> ".gif" - Just Pdf -> ".pdf" - Just Eps -> ".eps" - Just Svg -> ".svg" - Nothing -> "" - if null imgext - then -- without an extension there is no rule for content type - inlinesToOpenXML opts alt -- return alt to avoid corrupted docx - else do - let imgpath = "media/" ++ ident ++ imgext - let mbMimeType = mt <|> getMimeType imgpath - -- insert mime type to use in constructing [Content_Types].xml - modify $ \st -> st{ stImages = - M.insert src (ident, imgpath, mbMimeType, imgElt, img) - $ stImages st } - return [imgElt]) - (\e -> do - report $ CouldNotFetchResource src (show e) - -- emit alt text - inlinesToOpenXML opts alt) + (do (img, mt) <- P.fetchItem src + ident <- ("rId"++) `fmap` ((lift . lift) getUniqueId) + let (xpt,ypt) = desiredSizeInPoints opts attr + (either (const def) id (imageSize opts img)) + -- 12700 emu = 1 pt + let (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) + (pageWidth * 12700) + let cNvPicPr = mknode "pic:cNvPicPr" [] $ + mknode "a:picLocks" [("noChangeArrowheads","1") + ,("noChangeAspect","1")] () + let nvPicPr = mknode "pic:nvPicPr" [] + [ mknode "pic:cNvPr" + [("descr",src),("id","0"),("name","Picture")] () + , cNvPicPr ] + let blipFill = mknode "pic:blipFill" [] + [ mknode "a:blip" [("r:embed",ident)] () + , mknode "a:stretch" [] $ + mknode "a:fillRect" [] () ] + let xfrm = mknode "a:xfrm" [] + [ mknode "a:off" [("x","0"),("y","0")] () + , mknode "a:ext" [("cx",show xemu) + ,("cy",show yemu)] () ] + let prstGeom = mknode "a:prstGeom" [("prst","rect")] $ + mknode "a:avLst" [] () + let ln = mknode "a:ln" [("w","9525")] + [ mknode "a:noFill" [] () + , mknode "a:headEnd" [] () + , mknode "a:tailEnd" [] () ] + let spPr = mknode "pic:spPr" [("bwMode","auto")] + [xfrm, prstGeom, mknode "a:noFill" [] (), ln] + let graphic = mknode "a:graphic" [] $ + mknode "a:graphicData" + [("uri","http://schemas.openxmlformats.org/drawingml/2006/picture")] + [ mknode "pic:pic" [] + [ nvPicPr + , blipFill + , spPr ] ] + let imgElt = mknode "w:r" [] $ + mknode "w:drawing" [] $ + mknode "wp:inline" [] + [ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] () + , mknode "wp:effectExtent" + [("b","0"),("l","0"),("r","0"),("t","0")] () + , mknode "wp:docPr" [("descr",stringify alt) + ,("title", title) + ,("id","1") + ,("name","Picture")] () + , graphic ] + let imgext = case mt >>= extensionFromMimeType of + Just x -> '.':x + Nothing -> case imageType img of + Just Png -> ".png" + Just Jpeg -> ".jpeg" + Just Gif -> ".gif" + Just Pdf -> ".pdf" + Just Eps -> ".eps" + Just Svg -> ".svg" + Nothing -> "" + if null imgext + then -- without an extension there is no rule for content type + inlinesToOpenXML opts alt -- return alt to avoid corrupted docx + else do + let imgpath = "media/" ++ ident ++ imgext + let mbMimeType = mt <|> getMimeType imgpath + -- insert mime type to use in constructing [Content_Types].xml + modify $ \st -> st{ stImages = + M.insert src (ident, imgpath, mbMimeType, imgElt, img) + $ stImages st } + return [imgElt]) + (\e -> do + report $ CouldNotFetchResource src (show e) + -- emit alt text + inlinesToOpenXML opts alt) br :: Element br = breakElement "textWrapping" @@ -1382,12 +1382,12 @@ breakElement kind = mknode "w:r" [] [mknode "w:br" [("w:type",kind)] () ] -- problems. So we want to make sure we insert them into our document. defaultFootnotes :: [Element] defaultFootnotes = [ mknode "w:footnote" - [("w:type", "separator"), ("w:id", "-1")] $ + [("w:type", "separator"), ("w:id", "-1")] [ mknode "w:p" [] $ [mknode "w:r" [] $ [ mknode "w:separator" [] ()]]] , mknode "w:footnote" - [("w:type", "continuationSeparator"), ("w:id", "0")] $ + [("w:type", "continuationSeparator"), ("w:id", "0")] [ mknode "w:p" [] $ [ mknode "w:r" [] $ [ mknode "w:continuationSeparator" [] ()]]]] @@ -1407,7 +1407,7 @@ fitToPage :: (Double, Double) -> Integer -> (Integer, Integer) fitToPage (x, y) pageWidth -- Fixes width to the page width and scales the height | x > fromIntegral pageWidth = - (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y) + (pageWidth, floor $ (fromIntegral pageWidth / x) * y) | otherwise = (floor x, floor y) withDirection :: PandocMonad m => WS m a -> WS m a @@ -1423,8 +1423,8 @@ withDirection x = do if isRTL -- if we are going right-to-left, we (re?)add the properties. then flip local x $ - \env -> env { envParaProperties = (mknode "w:bidi" [] ()) : paraProps' - , envTextProperties = (mknode "w:rtl" [] ()) : textProps' + \env -> env { envParaProperties = mknode "w:bidi" [] () : paraProps' + , envTextProperties = mknode "w:rtl" [] () : textProps' } else flip local x $ \env -> env { envParaProperties = paraProps' , envTextProperties = textProps' diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index 43e2952de..e52cc75ad 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -41,7 +41,7 @@ DokuWiki: <https://www.dokuwiki.org/dokuwiki> module Text.Pandoc.Writers.DokuWiki ( writeDokuWiki ) where import Control.Monad (zipWithM) import Control.Monad.Reader (ReaderT, ask, local, runReaderT) -import Control.Monad.State.Strict (StateT, evalStateT, gets, modify) +import Control.Monad.State.Strict (StateT, evalStateT) import Data.Default (Default (..)) import Data.List (intercalate, intersect, isPrefixOf, transpose) import Data.Text (Text, pack) @@ -56,7 +56,6 @@ import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Writers.Shared (defField, metaToJSON) data WriterState = WriterState { - stNotes :: Bool -- True if there are notes } data WriterEnvironment = WriterEnvironment { @@ -66,7 +65,7 @@ data WriterEnvironment = WriterEnvironment { } instance Default WriterState where - def = WriterState { stNotes = False } + def = WriterState {} instance Default WriterEnvironment where def = WriterEnvironment { stIndent = "" @@ -92,15 +91,9 @@ pandocToDokuWiki opts (Pandoc meta blocks) = do (inlineListToDokuWiki opts) meta body <- blockListToDokuWiki opts blocks - notesExist <- gets stNotes - let notes = if notesExist - then "" -- TODO Was "\n<references />" Check whether I can really remove this: - -- if it is definitely to do with footnotes, can remove this whole bit - else "" - let main = pack $ body ++ notes + let main = pack body let context = defField "body" main - $ defField "toc" (writerTableOfContents opts) - $ metadata + $ defField "toc" (writerTableOfContents opts) metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -155,7 +148,8 @@ blockToDokuWiki _ b@(RawBlock f str) -- See https://www.dokuwiki.org/wiki:syntax -- use uppercase HTML tag for block-level content: | f == Format "html" = return $ "<HTML>\n" ++ str ++ "\n</HTML>" - | otherwise = "" <$ (report $ BlockNotRendered b) + | otherwise = "" <$ + report (BlockNotRendered b) blockToDokuWiki _ HorizontalRule = return "\n----\n" @@ -199,7 +193,7 @@ blockToDokuWiki opts (Table capt aligns _ headers rows) = do rows' <- mapM (zipWithM (tableItemToDokuWiki opts) aligns) rows let widths = map (maximum . map length) $ transpose (headers':rows') let padTo (width, al) s = - case (width - length s) of + case width - length s of x | x > 0 -> if al == AlignLeft || al == AlignDefault then s ++ replicate x ' ' @@ -294,7 +288,7 @@ listItemToDokuWiki opts items = do _ -> vcat bs indent <- stIndent <$> ask backSlash <- stBackSlashLB <$> ask - let indent' = if backSlash then (drop 2 indent) else indent + let indent' = if backSlash then drop 2 indent else indent return $ indent' ++ "* " ++ contents -- | Convert ordered list item (list of blocks) to DokuWiki. @@ -308,7 +302,7 @@ orderedListItemToDokuWiki opts items = do else do indent <- stIndent <$> ask backSlash <- stBackSlashLB <$> ask - let indent' = if backSlash then (drop 2 indent) else indent + let indent' = if backSlash then drop 2 indent else indent return $ indent' ++ "- " ++ contents -- | Convert definition list item (label, list of blocks) to DokuWiki. @@ -322,11 +316,11 @@ definitionListItemToDokuWiki opts (label, items) = do useTags <- stUseTags <$> ask if useTags then return $ "<HTML><dt></HTML>" ++ labelText ++ "<HTML></dt></HTML>\n" ++ - (intercalate "\n" $ map (\d -> "<HTML><dd></HTML>" ++ d ++ "<HTML></dd></HTML>") contents) + intercalate "\n" (map (\d -> "<HTML><dd></HTML>" ++ d ++ "<HTML></dd></HTML>") contents) else do indent <- stIndent <$> ask backSlash <- stBackSlashLB <$> ask - let indent' = if backSlash then (drop 2 indent) else indent + let indent' = if backSlash then drop 2 indent else indent return $ indent' ++ "* **" ++ labelText ++ "** " ++ concat contents -- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed. @@ -419,7 +413,7 @@ consolidateRawBlocks (x:xs) = x : consolidateRawBlocks xs inlineListToDokuWiki :: PandocMonad m => WriterOptions -> [Inline] -> DokuWiki m String inlineListToDokuWiki opts lst = - concat <$> (mapM (inlineToDokuWiki opts) lst) + concat <$> mapM (inlineToDokuWiki opts) lst -- | Convert Pandoc inline element to DokuWiki. inlineToDokuWiki :: PandocMonad m @@ -518,7 +512,6 @@ inlineToDokuWiki opts (Image attr alt (source, tit)) = do inlineToDokuWiki opts (Note contents) = do contents' <- blockListToDokuWiki opts contents - modify (\s -> s { stNotes = True }) return $ "((" ++ contents' ++ "))" -- note - may not work for notes with multiple blocks diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index d28187bf0..1129ac3f4 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -43,7 +43,7 @@ import qualified Data.ByteString.Lazy.Char8 as B8 import Data.Char (isAlphaNum, isAscii, isDigit, toLower) import Data.List (intercalate, isInfixOf, isPrefixOf) import qualified Data.Map as M -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (fromMaybe, isNothing, mapMaybe, isJust) import qualified Data.Set as Set import qualified Data.Text as TS import qualified Data.Text.Lazy as TL @@ -280,11 +280,10 @@ getCreator s meta = getList s meta handleMetaValue getDate :: String -> Meta -> [Date] getDate s meta = getList s meta handleMetaValue where handleMetaValue (MetaMap m) = - Date{ dateText = maybe "" id $ + Date{ dateText = fromMaybe "" $ M.lookup "text" m >>= normalizeDate' . metaValueToString , dateEvent = metaValueToString <$> M.lookup "event" m } - handleMetaValue mv = Date { dateText = maybe "" - id $ normalizeDate' $ metaValueToString mv + handleMetaValue mv = Date { dateText = fromMaybe "" $ normalizeDate' $ metaValueToString mv , dateEvent = Nothing } simpleList :: String -> Meta -> [String] @@ -334,7 +333,7 @@ metadataFromMeta opts meta = EPUBMetadata{ rights = metaValueToString <$> lookupMeta "rights" meta coverImage = lookup "epub-cover-image" (writerVariables opts) `mplus` (metaValueToString <$> lookupMeta "cover-image" meta) - stylesheets = maybe [] id + stylesheets = fromMaybe [] (metaValueToPaths <$> lookupMeta "stylesheet" meta) ++ [f | ("css",f) <- writerVariables opts] pageDirection = case map toLower . metaValueToString <$> @@ -383,6 +382,10 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do -- sanity check on epubSubdir unless (all (\c -> isAscii c && isAlphaNum c) epubSubdir) $ throwError $ PandocEpubSubdirectoryError epubSubdir + let inSubdir f = if null epubSubdir + then f + else epubSubdir ++ "/" ++ f + let epub3 = version == EPUB3 let writeHtml o = fmap (UTF8.fromTextLazy . TL.fromStrict) . writeHtmlStringForEPUB version o @@ -400,8 +403,15 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do stylesheets [(1 :: Int)..] let vars = ("epub3", if epub3 then "true" else "false") - : map (\e -> ("css", "../" ++ eRelativePath e)) stylesheetEntries - ++ [(x,y) | (x,y) <- writerVariables opts, x /= "css"] + : [(x,y) | (x,y) <- writerVariables opts, x /= "css"] + + let cssvars useprefix = map (\e -> ("css", + (if useprefix && not (null epubSubdir) + then "../" + else "") + ++ eRelativePath e)) + stylesheetEntries + let opts' = opts{ writerEmailObfuscation = NoObfuscation , writerSectionDivs = True , writerVariables = vars @@ -418,7 +428,9 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do Just img -> do let coverImage = "media/" ++ takeFileName img cpContent <- lift $ writeHtml - opts'{ writerVariables = ("coverpage","true"):vars } + opts'{ writerVariables = + ("coverpage","true"): + cssvars False ++ vars } (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"]) imgContent <- lift $ P.readFileLazy img return ( [mkEntry "cover.xhtml" cpContent] @@ -426,15 +438,16 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do -- title page tpContent <- lift $ writeHtml opts'{ - writerVariables = ("titlepage","true"):vars } + writerVariables = ("titlepage","true"): + cssvars True ++ vars } (Pandoc meta []) - let tpEntry = mkEntry "text/title_page.xhtml" tpContent + let tpEntry = mkEntry (inSubdir "title_page.xhtml") tpContent -- handle pictures -- mediaRef <- P.newIORef [] Pandoc _ blocks <- walkM (transformInline opts') doc >>= walkM transformBlock - picEntries <- (catMaybes . map (snd . snd)) <$> (gets stMediaPaths) + picEntries <- (mapMaybe (snd . snd)) <$> gets stMediaPaths -- handle fonts let matchingGlob f = do xs <- lift $ P.glob f @@ -479,7 +492,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do mbnum <- if "unnumbered" `elem` classes then return Nothing else case splitAt (n - 1) nums of - (ks, (m:_)) -> do + (ks, m:_) -> do let nums' = ks ++ [m+1] put nums' return $ Just (ks ++ [m]) @@ -527,23 +540,25 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do chapters' let chapToEntry num (Chapter mbnum bs) = - mkEntry ("text/" ++ showChapter num) <$> - (writeHtml opts'{ writerNumberOffset = fromMaybe [] mbnum } - $ case bs of - (Header _ _ xs : _) -> - -- remove notes or we get doubled footnotes - Pandoc (setMeta "title" (walk removeNote $ fromList xs) - nullMeta) bs - _ -> - Pandoc nullMeta bs) + mkEntry (inSubdir (showChapter num)) <$> + writeHtml opts'{ writerNumberOffset = fromMaybe [] mbnum + , writerVariables = cssvars True ++ vars } + (case bs of + (Header _ _ xs : _) -> + -- remove notes or we get doubled footnotes + Pandoc (setMeta "title" (walk removeNote $ fromList xs) + nullMeta) bs + _ -> Pandoc nullMeta bs) chapterEntries <- lift $ zipWithM chapToEntry [1..] chapters -- incredibly inefficient (TODO): let containsMathML ent = epub3 && - "<math" `isInfixOf` (B8.unpack $ fromEntry ent) + "<math" `isInfixOf` + B8.unpack (fromEntry ent) let containsSVG ent = epub3 && - "<svg" `isInfixOf` (B8.unpack $ fromEntry ent) + "<svg" `isInfixOf` + B8.unpack (fromEntry ent) let props ent = ["mathml" | containsMathML ent] ++ ["svg" | containsSVG ent] -- contents.opf @@ -577,14 +592,16 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do uuid <- case epubIdentifier metadata of (x:_) -> return $ identifierText x -- use first identifier as UUID [] -> throwError $ PandocShouldNeverHappenError "epubIdentifier is null" -- shouldn't happen - currentTime <- lift $ P.getCurrentTime + currentTime <- lift P.getCurrentTime let contentsData = UTF8.fromStringLazy $ ppTopElement $ - unode "package" ! [("version", case version of - EPUB2 -> "2.0" - EPUB3 -> "3.0") - ,("xmlns","http://www.idpf.org/2007/opf") - ,("unique-identifier","epub-id-1") - ,("prefix","ibooks: http://vocabulary.itunes.apple.com/rdf/ibooks/vocabulary-extensions-1.0/")] $ + unode "package" ! + ([("version", case version of + EPUB2 -> "2.0" + EPUB3 -> "3.0") + ,("xmlns","http://www.idpf.org/2007/opf") + ,("unique-identifier","epub-id-1") + ] ++ + [("prefix","ibooks: http://vocabulary.itunes.apple.com/rdf/ibooks/vocabulary-extensions-1.0/") | version == EPUB3]) $ [ metadataElement version metadata currentTime , unode "manifest" $ [ unode "item" ! [("id","ncx"), ("href","toc.ncx") @@ -594,8 +611,8 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do ,("media-type","application/xhtml+xml")] ++ [("properties","nav") | epub3 ]) $ () ] ++ - [ (unode "item" ! [("id","style"), ("href",fp) - ,("media-type","text/css")] $ ()) | + [ unode "item" ! [("id","style"), ("href",fp) + ,("media-type","text/css")] $ () | fp <- map eRelativePath stylesheetEntries ] ++ map chapterNode (cpgEntry ++ (tpEntry : chapterEntries)) ++ (case cpicEntry of @@ -605,7 +622,8 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do (pictureNode x)]) ++ map pictureNode picEntries ++ map fontNode fontEntries - , unode "spine" ! ([("toc","ncx")] ++ progressionDirection) $ + , unode "spine" ! ( + ("toc","ncx") : progressionDirection) $ case epubCoverImage metadata of Nothing -> [] Just _ -> [ unode "itemref" ! @@ -624,7 +642,10 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do ("href","nav.xhtml")] $ () ] ++ [ unode "reference" ! - [("type","cover"),("title","Cover"),("href","cover.xhtml")] $ () | epubCoverImage metadata /= Nothing + [("type","cover") + ,("title","Cover") + ,("href","cover.xhtml")] $ () + | isJust (epubCoverImage metadata) ] ] let contentsEntry = mkEntry "content.opf" contentsData @@ -660,12 +681,13 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do navMapFormatter n tit src subs = unode "navPoint" ! [("id", "navPoint-" ++ show n)] $ [ unode "navLabel" $ unode "text" $ stringify tit - , unode "content" ! [("src", "text/" ++ src)] $ () + , unode "content" ! [("src", inSubdir src)] $ () ] ++ subs let tpNode = unode "navPoint" ! [("id", "navPoint-0")] $ [ unode "navLabel" $ unode "text" (stringify $ docTitle' meta) - , unode "content" ! [("src","text/title_page.xhtml")] $ () ] + , unode "content" ! [("src", inSubdir "title_page.xhtml")] + $ () ] navMap <- lift $ evalStateT (mapM (navPointNode navMapFormatter) secs) 1 let tocData = UTF8.fromStringLazy $ ppTopElement $ @@ -684,7 +706,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do Nothing -> [] Just img -> [unode "meta" ! [("name","cover"), ("content", toId img)] $ ()] - , unode "docTitle" $ unode "text" $ plainTitle + , unode "docTitle" $ unode "text" plainTitle , unode "navMap" $ tpNode : navMap ] @@ -693,8 +715,8 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do let navXhtmlFormatter :: Int -> [Inline] -> String -> [Element] -> Element navXhtmlFormatter n tit src subs = unode "li" ! [("id", "toc-li-" ++ show n)] $ - (unode "a" ! [("href", "text/" ++ - src)] + (unode "a" ! + [("href", inSubdir src)] $ titElements) : case subs of [] -> [] @@ -740,10 +762,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do ] else [] navData <- lift $ writeHtml opts'{ writerVariables = ("navpage","true"): - -- remove the leading ../ from stylesheet paths: - map (\(k,v) -> if k == "css" - then (k, drop 3 v) - else (k, v)) vars } + cssvars False ++ vars } (Pandoc (setMeta "title" (walk removeNote $ fromList $ docTitle' meta) nullMeta) (navBlocks ++ landmarks)) @@ -757,8 +776,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do unode "container" ! [("version","1.0") ,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $ unode "rootfiles" $ - unode "rootfile" ! [("full-path", - epubSubdir ++ ['/' | not (null epubSubdir)] ++ "content.opf") + unode "rootfile" ! [("full-path", inSubdir "content.opf") ,("media-type","application/oebps-package+xml")] $ () let containerEntry = mkEntry "META-INF/container.xml" containerData @@ -770,8 +788,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do let appleEntry = mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple let addEpubSubdir :: Entry -> Entry - addEpubSubdir e = e{ eRelativePath = - epubSubdir ++ ['/' | not (null epubSubdir)] ++ eRelativePath e } + addEpubSubdir e = e{ eRelativePath = inSubdir (eRelativePath e) } -- construct archive let archive = foldr addEntryToArchive emptyArchive $ [mimetypeEntry, containerEntry, appleEntry] ++ @@ -826,7 +843,7 @@ metadataElement version md currentTime = ("content",toId img)] $ ()]) $ epubCoverImage md modifiedNodes = [ unode "meta" ! [("property", "dcterms:modified")] $ - (showDateTimeISO8601 currentTime) | version == EPUB3 ] + showDateTimeISO8601 currentTime | version == EPUB3 ] dcTag n s = unode ("dc:" ++ n) s dcTag' n s = [dcTag n s] toIdentifierNode id' (Identifier txt scheme) @@ -895,7 +912,7 @@ transformTag :: PandocMonad m -> E m (Tag String) transformTag tag@(TagOpen name attr) | name `elem` ["video", "source", "img", "audio"] && - lookup "data-external" attr == Nothing = do + isNothing (lookup "data-external" attr) = do let src = fromAttrib "src" tag let poster = fromAttrib "poster" tag newsrc <- modifyMediaRef src diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index b7dc43685..0a8ae17bb 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -338,13 +338,13 @@ blockToXml (LineBlock lns) = blockToXml (OrderedList a bss) = do state <- get let pmrk = parentListMarker state - let markers = map ((pmrk ++ " ") ++) $ orderedListMarkers a + let markers = map (pmrk ++) $ orderedListMarkers a let mkitem mrk bs = do - modify (\s -> s { parentListMarker = mrk }) - itemtext <- cMapM blockToXml . paraToPlain $ bs + modify (\s -> s { parentListMarker = mrk ++ " "}) + item <- cMapM blockToXml $ plainToPara $ indentBlocks (mrk ++ " ") bs modify (\s -> s { parentListMarker = pmrk }) -- old parent marker - return . el "p" $ [ txt mrk, txt " " ] ++ itemtext - zipWithM mkitem markers bss + return item + concat <$> zipWithM mkitem markers bss blockToXml (BulletList bss) = do state <- get let level = parentBulletLevel state @@ -354,25 +354,17 @@ blockToXml (BulletList bss) = do let mrk = prefix ++ bullets !! (level `mod` length bullets) let mkitem bs = do modify (\s -> s { parentBulletLevel = level+1 }) - itemtext <- cMapM blockToXml . paraToPlain $ bs + item <- cMapM blockToXml $ plainToPara $ indentBlocks (mrk ++ " ") bs modify (\s -> s { parentBulletLevel = level }) -- restore bullet level - return $ el "p" $ txt (mrk ++ " ") : itemtext - mapM mkitem bss + return item + cMapM mkitem bss blockToXml (DefinitionList defs) = cMapM mkdef defs where mkdef (term, bss) = do - def' <- cMapM (cMapM blockToXml . sep . paraToPlain . map indent) bss + items <- cMapM (cMapM blockToXml . plainToPara . indentBlocks (replicate 4 ' ')) bss t <- wrap "strong" term - return [ el "p" t, el "p" def' ] - sep blocks = - if all needsBreak blocks then - blocks ++ [Plain [LineBreak]] - else - blocks - needsBreak (Para _) = False - needsBreak (Plain ins) = LineBreak `notElem` ins - needsBreak _ = True + return (el "p" t : items) blockToXml h@Header{} = do -- should not occur after hierarchicalize, except inside lists/blockquotes report $ BlockNotRendered h @@ -403,24 +395,21 @@ blockToXml (Table caption aligns _ headers rows) = do align_str AlignDefault = "left" blockToXml Null = return [] --- Replace paragraphs with plain text and line break. --- Necessary to simulate multi-paragraph lists in FB2. -paraToPlain :: [Block] -> [Block] -paraToPlain [] = [] -paraToPlain (Para inlines : rest) = - let p = Plain (inlines ++ [LineBreak]) - in p : paraToPlain rest -paraToPlain (p:rest) = p : paraToPlain rest +-- Replace plain text with paragraphs and add line break after paragraphs. +-- It is used to convert plain text from tight list items to paragraphs. +plainToPara :: [Block] -> [Block] +plainToPara [] = [] +plainToPara (Plain inlines : rest) = + Para inlines : plainToPara rest +plainToPara (Para inlines : rest) = + Para inlines : Plain [LineBreak] : plainToPara rest +plainToPara (p:rest) = p : plainToPara rest -- Simulate increased indentation level. Will not really work -- for multi-line paragraphs. -indent :: Block -> Block -indent = indentBlock +indentPrefix :: String -> Block -> Block +indentPrefix spacer = indentBlock where - -- indentation space - spacer :: String - spacer = replicate 4 ' ' - -- indentBlock (Plain ins) = Plain (Str spacer:ins) indentBlock (Para ins) = Para (Str spacer:ins) indentBlock (CodeBlock a s) = @@ -434,6 +423,17 @@ indent = indentBlock indentLines ins = let lns = split isLineBreak ins :: [[Inline]] in intercalate [LineBreak] $ map (Str spacer:) lns +indent :: Block -> Block +indent = indentPrefix spacer + where + -- indentation space + spacer :: String + spacer = replicate 4 ' ' + +indentBlocks :: String -> [Block] -> [Block] +indentBlocks _ [] = [] +indentBlocks prefix (x:xs) = indentPrefix prefix x : map (indentPrefix $ replicate (length prefix) ' ') xs + -- | Convert a Pandoc's Inline element to FictionBook XML representation. toXml :: PandocMonad m => Inline -> FBM m [Content] toXml (Str s) = return [txt s] diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 9cb3aced8..ffcde3ce7 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -215,7 +215,7 @@ writeHtmlString' st opts d = do defField "body" (renderHtml' body) context' writeHtml' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Html -writeHtml' st opts d = do +writeHtml' st opts d = case writerTemplate opts of Just _ -> preEscapedText <$> writeHtmlString' st opts d Nothing -> do @@ -274,7 +274,8 @@ pandocToHtml opts (Pandoc meta blocks) = do (H.script ! A.src (toValue $ url ++ "contrib/auto-render.min.js") $ mempty) <> - (H.script $ + ( + H.script "document.addEventListener(\"DOMContentLoaded\", function() {\n renderMathInElement(document.body);\n});") <> (H.link ! A.rel "stylesheet" ! A.href (toValue $ url ++ "katex.min.css")) @@ -315,7 +316,7 @@ pandocToHtml opts (Pandoc meta blocks) = do defField "slideous-url" ("slideous" :: String) $ defField "revealjs-url" ("reveal.js" :: String) $ defField "s5-url" ("s5/default" :: String) $ - defField "html5" (stHtml5 st) $ + defField "html5" (stHtml5 st) metadata return (thebody, context) @@ -334,9 +335,9 @@ toList :: PandocMonad m toList listop opts items = do slideVariant <- gets stSlideVariant return $ - if (writerIncremental opts) - then if (slideVariant /= RevealJsSlides) - then (listop $ mconcat items) ! A.class_ "incremental" + if writerIncremental opts + then if slideVariant /= RevealJsSlides + then listop (mconcat items) ! A.class_ "incremental" else listop $ mconcat $ map (! A.class_ "fragment") items else listop $ mconcat items @@ -364,7 +365,7 @@ tableOfContents opts sects = do -- | Convert section number to string showSecNum :: [Int] -> String -showSecNum = concat . intersperse "." . map show +showSecNum = intercalate "." . map show -- | Converts an Element to a list item for a table of contents, -- retrieving the appropriate identifier from state. @@ -390,7 +391,7 @@ elementToListItem opts (Sec lev num (id',classes,_) headerText subsecs) let revealSlash = ['/' | slideVariant== RevealJsSlides] return $ Just $ if null id' - then (H.a $ toHtml txt) >> subList + then H.a (toHtml txt) >> subList else (H.a ! A.href (toValue $ "#" ++ revealSlash ++ writerIdentifierPrefix opts ++ id') $ toHtml txt) >> subList @@ -419,8 +420,8 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen modify (\st -> st{ stElement = False}) return res - let isSec (Sec _ _ _ _ _) = True - isSec (Blk _) = False + let isSec (Sec{}) = True + isSec (Blk _) = False let isPause (Blk x) = x == Para [Str ".",Space,Str ".",Space,Str "."] isPause _ = False let fragmentClass = case slideVariant of @@ -448,7 +449,8 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen let attr = (id',classes',keyvals) if titleSlide then do - t <- addAttrs opts attr $ secttag $ header' + t <- addAttrs opts attr $ + secttag header' return $ (if slideVariant == RevealJsSlides then H5.section @@ -468,21 +470,19 @@ footnoteSection opts notes = do html5 <- gets stHtml5 slideVariant <- gets stSlideVariant let hrtag = if html5 then H5.hr else H.hr - let container x = if html5 - then H5.section ! A.class_ "footnotes" $ x - else if slideVariant /= NoSlides - then H.div ! A.class_ "footnotes slide" $ x - else H.div ! A.class_ "footnotes" $ x + let container x + | html5 = H5.section ! A.class_ "footnotes" $ x + | slideVariant /= NoSlides = H.div ! A.class_ "footnotes slide" $ x + | otherwise = H.div ! A.class_ "footnotes" $ x return $ if null notes then mempty - else nl opts >> (container - $ nl opts >> hrtag >> nl opts >> + else nl opts >> container (nl opts >> hrtag >> nl opts >> H.ol (mconcat notes >> nl opts) >> nl opts) -- | Parse a mailto link; return Just (name, domain) or Nothing. parseMailto :: String -> Maybe (String, String) -parseMailto s = do +parseMailto s = case break (==':') s of (xs,':':addr) | map toLower xs == "mailto" -> do let (name', rest) = span (/='@') addr @@ -514,8 +514,8 @@ obfuscateLink opts attr (TL.unpack . renderHtml -> txt) s = ReferenceObfuscation -> -- need to use preEscapedString or &'s are escaped to & in URL return $ - preEscapedString $ "<a href=\"" ++ (obfuscateString s') - ++ "\" class=\"email\">" ++ (obfuscateString txt) ++ "</a>" + preEscapedString $ "<a href=\"" ++ obfuscateString s' + ++ "\" class=\"email\">" ++ obfuscateString txt ++ "</a>" JavascriptObfuscation -> return $ (H.script ! A.type_ "text/javascript" $ @@ -586,7 +586,7 @@ dimensionsToAttrList attr = consolidateStyles $ go Width ++ go Height (ss, rest) -> ("style", intercalate ";" $ map snd ss) : rest isStyle ("style", _) = True isStyle _ = False - go dir = case (dimension dir attr) of + go dir = case dimension dir attr of (Just (Pixel a)) -> [(show dir, show a)] (Just x) -> [("style", show dir ++ ":" ++ show x)] Nothing -> [] @@ -599,9 +599,7 @@ imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf", treatAsImage :: FilePath -> Bool treatAsImage fp = - let path = case uriPath `fmap` parseURIReference fp of - Nothing -> fp - Just up -> up + let path = fromMaybe fp (uriPath `fmap` parseURIReference fp) ext = map toLower $ drop 1 $ takeExtension path in null ext || ext `elem` imageExts @@ -674,13 +672,17 @@ blockToHtml opts (Div attr@(ident, classes, kvs') bs) = do slideVariant <- gets stSlideVariant if speakerNotes then case slideVariant of - RevealJsSlides -> addAttrs opts' attr $ H5.aside $ contents' + RevealJsSlides -> addAttrs opts' attr $ + H5.aside contents' DZSlides -> do - t <- addAttrs opts' attr $ H5.div $ contents' - return $ t ! (H5.customAttribute "role" "note") - NoSlides -> addAttrs opts' attr $ H.div $ contents' + t <- addAttrs opts' attr $ + H5.div contents' + return $ t ! H5.customAttribute "role" "note" + NoSlides -> addAttrs opts' attr $ + H.div contents' _ -> return mempty - else addAttrs opts (ident, classes', kvs) $ divtag $ contents' + else addAttrs opts (ident, classes', kvs) $ + divtag contents' blockToHtml opts (RawBlock f str) = do ishtml <- isRawHtml f if ishtml @@ -692,7 +694,7 @@ blockToHtml opts (RawBlock f str) = do else do report $ BlockNotRendered (RawBlock f str) return mempty -blockToHtml _ (HorizontalRule) = do +blockToHtml _ HorizontalRule = do html5 <- gets stHtml5 return $ if html5 then H5.hr else H.hr blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do @@ -768,12 +770,8 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do let numstyle' = case numstyle of Example -> "decimal" _ -> camelCaseToHyphenated $ show numstyle - let attribs = (if startnum /= 1 - then [A.start $ toValue startnum] - else []) ++ - (if numstyle == Example - then [A.class_ "example"] - else []) ++ + let attribs = ([A.start $ toValue startnum | startnum /= 1]) ++ + ([A.class_ "example" | numstyle == Example]) ++ (if numstyle /= DefaultStyle then if html5 then [A.type_ $ @@ -794,7 +792,7 @@ blockToHtml opts (DefinitionList lst) = do do term' <- if null term then return mempty else liftM H.dt $ inlineListToHtml opts term - defs' <- mapM ((liftM (\x -> H.dd $ (x >> nl opts))) . + defs' <- mapM (liftM (\x -> H.dd $ (x >> nl opts)) . blockListToHtml opts) defs return $ mconcat $ nl opts : term' : nl opts : intersperse (nl opts) defs') lst @@ -848,7 +846,7 @@ tableRowToHtml opts aligns rownum cols' = do 0 -> "header" x | x `rem` 2 == 1 -> "odd" _ -> "even" - cols'' <- sequence $ zipWith + cols'' <- zipWithM (\alignment item -> tableItemToHtml opts mkcell alignment item) aligns cols' return $ (H.tr ! A.class_ rowclass $ nl opts >> mconcat cols'') @@ -877,7 +875,8 @@ tableItemToHtml opts tag' align' item = do let tag'' = if null alignStr then tag' else tag' ! attribs - return $ (tag'' $ contents) >> nl opts + return $ ( + tag'' contents) >> nl opts toListItems :: WriterOptions -> [Html] -> [Html] toListItems opts items = map (toListItem opts) items ++ [nl opts] @@ -887,7 +886,7 @@ toListItem opts item = nl opts >> H.li item blockListToHtml :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m Html blockListToHtml opts lst = - fmap (mconcat . intersperse (nl opts)) $ mapM (blockToHtml opts) lst + (mconcat . intersperse (nl opts)) <$> mapM (blockToHtml opts) lst -- | Convert list of Pandoc inline elements to HTML. inlineListToHtml :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Html @@ -915,12 +914,12 @@ inlineToHtml opts inline = do html5 <- gets stHtml5 case inline of (Str str) -> return $ strToHtml str - (Space) -> return $ strToHtml " " - (SoftBreak) -> return $ case writerWrapText opts of - WrapNone -> preEscapedString " " - WrapAuto -> preEscapedString " " - WrapPreserve -> preEscapedString "\n" - (LineBreak) -> return $ (if html5 then H5.br else H.br) + Space -> return $ strToHtml " " + SoftBreak -> return $ case writerWrapText opts of + WrapNone -> preEscapedString " " + WrapAuto -> preEscapedString " " + WrapPreserve -> preEscapedString "\n" + LineBreak -> return $ (if html5 then H5.br else H.br) <> strToHtml "\n" (Span (id',classes,kvs) ils) -> inlineListToHtml opts ils >>= @@ -931,7 +930,7 @@ inlineToHtml opts inline = do "csl-no-smallcaps"]) classes kvs' = if null styles then kvs - else (("style", concat styles) : kvs) + else ("style", concat styles) : kvs styles = ["font-style:normal;" | "csl-no-emph" `elem` classes] ++ ["font-weight:normal;" @@ -1090,12 +1089,12 @@ inlineToHtml opts inline = do -- note: null title included, as in Markdown.pl (Note contents) -> do notes <- gets stNotes - let number = (length notes) + 1 + let number = length notes + 1 let ref = show number htmlContents <- blockListToNote opts ref contents epubVersion <- gets stEPUBVersion -- push contents onto front of notes - modify $ \st -> st {stNotes = (htmlContents:notes)} + modify $ \st -> st {stNotes = htmlContents:notes} slideVariant <- gets stSlideVariant let revealSlash = ['/' | slideVariant == RevealJsSlides] let link = H.a ! A.href (toValue $ "#" ++ @@ -1134,7 +1133,7 @@ blockListToNote opts ref blocks = _ -> otherBlocks ++ [lastBlock, Plain backlink] in do contents <- blockListToHtml opts blocks' - let noteItem = H.li ! (prefixedId opts ("fn" ++ ref)) $ contents + let noteItem = H.li ! prefixedId opts ("fn" ++ ref) $ contents epubVersion <- gets stEPUBVersion let noteItem' = case epubVersion of Just EPUB3 -> noteItem ! customAttribute "epub:type" "footnote" @@ -1175,7 +1174,7 @@ isMathEnvironment s = "\\begin{" `isPrefixOf` s && allowsMathEnvironments :: HTMLMathMethod -> Bool allowsMathEnvironments (MathJax _) = True -allowsMathEnvironments (MathML) = True +allowsMathEnvironments MathML = True allowsMathEnvironments (WebTeX _) = True allowsMathEnvironments _ = False diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index c964ddf74..caa4b9031 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -76,8 +76,7 @@ pandocToHaddock opts (Pandoc meta blocks) = do (fmap render' . blockListToHaddock opts) (fmap render' . inlineListToHaddock opts) meta - let context = defField "body" main - $ metadata + let context = defField "body" main metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -118,7 +117,7 @@ blockToHaddock opts (Para inlines) = blockToHaddock opts (LineBlock lns) = blockToHaddock opts $ linesToPara lns blockToHaddock _ b@(RawBlock f str) - | f == "haddock" = do + | f == "haddock" = return $ text str <> text "\n" | otherwise = do report $ BlockNotRendered b @@ -150,16 +149,16 @@ blockToHaddock opts (Table caption aligns widths headers rows) = do isPlainBlock _ = False let hasBlocks = not (all isPlainBlock $ concat . concat $ headers:rows) (nst,tbl) <- case True of - _ | isSimple -> fmap (nest 2,) $ + _ | isSimple -> (nest 2,) <$> pandocTable opts (all null headers) aligns widths rawHeaders rawRows - | not hasBlocks -> fmap (nest 2,) $ + | not hasBlocks -> (nest 2,) <$> pandocTable opts (all null headers) aligns widths rawHeaders rawRows - | otherwise -> fmap (id,) $ + | otherwise -> (id,) <$> gridTable opts blockListToHaddock (all null headers) aligns widths headers rows - return $ (prefixed "> " $ nst $ tbl $$ blankline $$ caption'') $$ blankline + return $ prefixed "> " (nst $ tbl $$ blankline $$ caption'') $$ blankline blockToHaddock opts (BulletList items) = do contents <- mapM (bulletListItemToHaddock opts) items return $ cat contents <> blankline @@ -169,7 +168,7 @@ blockToHaddock opts (OrderedList (start,_,delim) items) = do let markers' = map (\m -> if length m < 3 then m ++ replicate (3 - length m) ' ' else m) markers - contents <- mapM (\(item, num) -> orderedListItemToHaddock opts item num) $ + contents <- mapM (uncurry (orderedListItemToHaddock opts)) $ zip markers' items return $ cat contents <> blankline blockToHaddock opts (DefinitionList items) = do @@ -194,18 +193,17 @@ pandocTable opts headless aligns widths rawHeaders rawRows = do (floor . (fromIntegral (writerColumns opts) *)) widths let makeRow = hcat . intersperse (lblock 1 (text " ")) . - (zipWith3 alignHeader aligns widthsInChars) + zipWith3 alignHeader aligns widthsInChars let rows' = map makeRow rawRows let head' = makeRow rawHeaders let maxRowHeight = maximum $ map height (head':rows') let underline = cat $ intersperse (text " ") $ map (\width -> text (replicate width '-')) widthsInChars - let border = if maxRowHeight > 1 - then text (replicate (sum widthsInChars + - length widthsInChars - 1) '-') - else if headless - then underline - else empty + let border + | maxRowHeight > 1 = text (replicate (sum widthsInChars + + length widthsInChars - 1) '-') + | headless = underline + | otherwise = empty let head'' = if headless then empty else border <> cr <> head' @@ -304,7 +302,7 @@ inlineToHaddock opts (Quoted DoubleQuote lst) = do return $ "“" <> contents <> "”" inlineToHaddock _ (Code _ str) = return $ "@" <> text (escapeString str) <> "@" -inlineToHaddock _ (Str str) = do +inlineToHaddock _ (Str str) = return $ text $ escapeString str inlineToHaddock opts (Math mt str) = do let adjust x = case mt of diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 650a1c012..4afa23cb9 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -19,6 +19,7 @@ module Text.Pandoc.Writers.ICML (writeICML) where import Control.Monad.Except (catchError) import Control.Monad.State.Strict import Data.List (intersperse, isInfixOf, isPrefixOf, stripPrefix) +import Data.Maybe (fromMaybe) import qualified Data.Set as Set import Data.Text as Text (breakOnAll, pack) import Data.Text (Text) @@ -145,8 +146,7 @@ writeICML opts (Pandoc meta blocks) = do context = defField "body" main $ defField "charStyles" (render' $ charStylesToDoc st) $ defField "parStyles" (render' $ parStylesToDoc st) - $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st) - $ metadata + $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st) metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -154,9 +154,7 @@ writeICML opts (Pandoc meta blocks) = do -- | Auxilary functions for parStylesToDoc and charStylesToDoc. contains :: String -> (String, (String, String)) -> [(String, String)] contains s rule = - if isInfixOf (fst rule) s - then [snd rule] - else [] + [snd rule | isInfixOf (fst rule) s] -- | The monospaced font to use as default. monospacedFont :: Doc @@ -180,7 +178,7 @@ parStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ blockStyles st where makeStyle s = let countSubStrs sub str = length $ Text.breakOnAll (Text.pack sub) (Text.pack str) - attrs = concat $ map (contains s) $ [ + attrs = concatMap (contains s) [ (defListTermName, ("BulletsAndNumberingListType", "BulletList")) , (defListTermName, ("FontStyle", "Bold")) , (tableHeaderName, ("FontStyle", "Bold")) @@ -206,9 +204,9 @@ parStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ blockStyles st where numbering | isOrderedList = [("NumberingExpression", "^#.^t"), ("NumberingLevel", show nOrds)] | otherwise = [] - listType | isOrderedList && (not $ isInfixOf subListParName s) + listType | isOrderedList && not (isInfixOf subListParName s) = [("BulletsAndNumberingListType", "NumberedList")] - | isBulletList && (not $ isInfixOf subListParName s) + | isBulletList && not (isInfixOf subListParName s) = [("BulletsAndNumberingListType", "BulletList")] | otherwise = [] indent = [("LeftIndent", show indt)] @@ -216,9 +214,9 @@ parStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ blockStyles st nBlockQuotes = countSubStrs blockQuoteName s nDefLists = countSubStrs defListDefName s indt = max 0 $ defaultListIndent*(nBuls + nOrds - 1) + defaultIndent*(nBlockQuotes + nDefLists) - props = inTags True "Properties" [] $ (basedOn $$ tabList $$ numbForm) + props = inTags True "Properties" [] (basedOn $$ tabList $$ numbForm) where - font = if isInfixOf codeBlockName s + font = if codeBlockName `isInfixOf` s then monospacedFont else empty basedOn = inTags False "BasedOn" [("type", "object")] (text "$ID/NormalParagraphStyle") $$ font @@ -245,7 +243,7 @@ charStylesToDoc :: WriterState -> Doc charStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ inlineStyles st where makeStyle s = - let attrs = concat $ map (contains s) [ + let attrs = concatMap (contains s) [ (strikeoutName, ("StrikeThru", "true")) , (superscriptName, ("Position", "Superscript")) , (subscriptName, ("Position", "Subscript")) @@ -259,7 +257,7 @@ charStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ inlineStyles st inTags False "BasedOn" [("type", "object")] (text "$ID/NormalCharacterStyle") $$ font where font = - if isInfixOf codeName s + if codeName `isInfixOf` s then monospacedFont else empty in inTags True "CharacterStyle" ([("Self", "CharacterStyle/"++s), ("Name", s)] ++ attrs') props @@ -279,13 +277,12 @@ hyperlinksToDoc (x:xs) = hyp x $$ hyperlinksToDoc xs hyp (ident, url) = hdest $$ hlink where hdest = selfClosingTag "HyperlinkURLDestination" - [("Self", "HyperlinkURLDestination/"++(escapeColons url)), ("Name","link"), ("DestinationURL",url), ("DestinationUniqueKey","1")] -- HyperlinkURLDestination with more than one colon crashes CS6 + [("Self", "HyperlinkURLDestination/"++escapeColons url), ("Name","link"), ("DestinationURL",url), ("DestinationUniqueKey","1")] -- HyperlinkURLDestination with more than one colon crashes CS6 hlink = inTags True "Hyperlink" [("Self","uf-"++show ident), ("Name",url), ("Source","htss-"++show ident), ("Visible","true"), ("DestinationUniqueKey","1")] $ inTags True "Properties" [] $ inTags False "BorderColor" [("type","enumeration")] (text "Black") - $$ (inTags False "Destination" [("type","object")] - $ text $ "HyperlinkURLDestination/"++(escapeColons (escapeStringForXML url))) -- HyperlinkURLDestination with more than one colon crashes CS6 + $$ inTags False "Destination" [("type","object")] (text $ "HyperlinkURLDestination/"++(escapeColons (escapeStringForXML url))) -- HyperlinkURLDestination with more than one colon crashes CS6 -- | Convert a list of Pandoc blocks to ICML. @@ -305,7 +302,7 @@ blockToICML opts style (Para img@[Image _ txt (_,'f':'i':'g':':':_)]) = do blockToICML opts style (Para lst) = parStyle opts (paragraphName:style) lst blockToICML opts style (LineBlock lns) = blockToICML opts style $ linesToPara lns -blockToICML opts style (CodeBlock _ str) = parStyle opts (codeBlockName:style) $ [Str str] +blockToICML opts style (CodeBlock _ str) = parStyle opts (codeBlockName:style) [Str str] blockToICML _ _ b@(RawBlock f str) | f == Format "icml" = return $ text str | otherwise = do @@ -351,11 +348,10 @@ blockToICML opts style (Table caption aligns widths headers rows) = then rows else headers:rows cells <- rowsToICML tabl (0::Int) - let colWidths w = if w > 0 - then [("SingleColumnWidth",show $ 500 * w)] - else [] - let tupToDoc tup = selfClosingTag "Column" $ [("Name",show $ fst tup)] ++ (colWidths $ snd tup) - let colDescs = vcat $ map tupToDoc $ zip [0..nrCols-1] widths + let colWidths w = + [("SingleColumnWidth",show $ 500 * w) | w > 0] + let tupToDoc tup = selfClosingTag "Column" $ ("Name",show $ fst tup) : (colWidths $ snd tup) + let colDescs = vcat $ zipWith (curry tupToDoc) [0..nrCols-1] widths let tableDoc = return $ inTags True "Table" [ ("AppliedTableStyle","TableStyle/Table") , ("HeaderRowCount", nrHeaders) @@ -391,9 +387,8 @@ listItemToICML opts style isFirst attribs item = doN LowerAlpha = [lowerAlphaName] doN UpperAlpha = [upperAlphaName] doN _ = [] - bw = if beginsWith > 1 - then [beginsWithName ++ show beginsWith] - else [] + bw = + [beginsWithName ++ show beginsWith | beginsWith > 1] in doN numbStl ++ bw makeNumbStart Nothing = [] stl = if isFirst @@ -402,7 +397,7 @@ listItemToICML opts style isFirst attribs item = stl' = makeNumbStart attribs ++ stl in if length item > 1 then do - let insertTab (Para lst) = blockToICML opts (subListParName:style) $ Para $ (Str "\t"):lst + 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 @@ -413,7 +408,7 @@ definitionListItemToICML :: PandocMonad m => WriterOptions -> Style -> ([Inline] definitionListItemToICML opts style (term,defs) = do term' <- parStyle opts (defListTermName:style) term defs' <- mapM (blocksToICML opts (defListDefName:style)) defs - return $ intersperseBrs $ (term' : defs') + return $ intersperseBrs (term' : defs') -- | Convert a list of inline elements to ICML. @@ -453,8 +448,8 @@ inlineToICML opts style (Link _ lst (url, title)) = do state $ \st -> let ident = if null $ links st then 1::Int - else 1 + (fst $ head $ links st) - newst = st{ links = (ident, url):(links st) } + else 1 + fst (head $ links st) + newst = st{ links = (ident, url):links st } cont = inTags True "HyperlinkTextSource" [("Self","htss-"++show ident), ("Name",title), ("Hidden","false")] content in (cont, newst) @@ -465,7 +460,7 @@ inlineToICML opts style (Span _ lst) = inlinesToICML opts style lst -- | Convert a list of block elements to an ICML footnote. footnoteToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m Doc footnoteToICML opts style lst = - let insertTab (Para ls) = blockToICML opts (footnoteName:style) $ Para $ (Str "\t"):ls + let insertTab (Para ls) = blockToICML opts (footnoteName:style) $ Para $ Str "\t":ls insertTab block = blockToICML opts (footnoteName:style) block in do contents <- mapM insertTab lst @@ -477,11 +472,11 @@ footnoteToICML opts style lst = -- | Auxiliary function to merge Space elements into the adjacent Strs. mergeSpaces :: [Inline] -> [Inline] -mergeSpaces ((Str s):(x:((Str s'):xs))) | isSp x = +mergeSpaces (Str s:(x:(Str s':xs))) | isSp x = mergeSpaces $ Str(s++" "++s') : xs -mergeSpaces (x:((Str s):xs)) | isSp x = mergeSpaces $ Str (" "++s) : xs -mergeSpaces ((Str s):(x:xs)) | isSp x = mergeSpaces $ Str (s++" ") : xs -mergeSpaces (x:xs) = x : (mergeSpaces xs) +mergeSpaces (x:(Str s:xs)) | isSp x = mergeSpaces $ Str (" "++s) : xs +mergeSpaces (Str s:(x:xs)) | isSp x = mergeSpaces $ Str (s++" ") : xs +mergeSpaces (x:xs) = x : mergeSpaces xs mergeSpaces [] = [] isSp :: Inline -> Bool @@ -509,7 +504,7 @@ parStyle opts style lst = begins = filter (isPrefixOf beginsWithName) style in if null begins then ats - else let i = maybe "" id $ stripPrefix beginsWithName $ head begins + else let i = fromMaybe "" $ stripPrefix beginsWithName $ head begins in ("NumberingStartAt", i) : ats else [attrs] in do @@ -522,12 +517,12 @@ charStyle :: PandocMonad m => Style -> Doc -> WS m Doc charStyle style content = let (stlStr, attrs) = styleToStrAttr style doc = inTags True "CharacterStyleRange" attrs $ inTagsSimple "Content" $ flush content - in do + in state $ \st -> - let styles = if null stlStr - then st - else st{ inlineStyles = Set.insert stlStr $ inlineStyles st } - in (doc, styles) + let styles = if null stlStr + then st + else st{ inlineStyles = Set.insert stlStr $ inlineStyles st } + in (doc, styles) -- | Transform a Style to a tuple of String (eliminating duplicates and ordered) and corresponding attribute. styleToStrAttr :: Style -> (String, [(String, String)]) @@ -580,6 +575,5 @@ imageICML opts style attr (src, _) = do ] doc = inTags True "CharacterStyleRange" attrs $ inTags True "Rectangle" [("Self","uec"), ("StrokeWeight", "0"), - ("ItemTransform", scale++" "++hw++" -"++hh)] - $ (props $$ image) + ("ItemTransform", scale++" "++hw++" -"++hh)] (props $$ image) state $ \st -> (doc, st{ inlineStyles = Set.insert stlStr $ inlineStyles st } ) diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index 4efd00ee5..0ac37efba 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternGuards #-} + {- Copyright (C) 2006-2017 John MacFarlane <jgm@berkeley.edu> @@ -34,10 +34,9 @@ module Text.Pandoc.Writers.JATS ( writeJATS ) where import Control.Monad.Reader import Data.Char (toLower) import Data.Generics (everywhere, mkT) -import Data.List (intercalate, isSuffixOf, partition) +import Data.List (isSuffixOf, partition) import Data.Maybe (fromMaybe) import Data.Text (Text) -import qualified Text.Pandoc.Builder as B import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Definition import Text.Pandoc.Highlighting (languages, languagesByExtension) @@ -56,38 +55,14 @@ import qualified Text.XML.Light as Xml data JATSVersion = JATS1_1 deriving (Eq, Show) -type DB = ReaderT JATSVersion - --- | Convert list of authors to a docbook <author> section -authorToJATS :: PandocMonad m => WriterOptions -> [Inline] -> DB m B.Inlines -authorToJATS opts name' = do - name <- render Nothing <$> inlinesToJATS opts name' - let colwidth = if writerWrapText opts == WrapAuto - then Just $ writerColumns opts - else Nothing - return $ B.rawInline "docbook" $ render colwidth $ - if ',' `elem` name - then -- last name first - let (lastname, rest) = break (==',') name - firstname = triml rest in - inTagsSimple "firstname" (text $ escapeStringForXML firstname) <> - inTagsSimple "surname" (text $ escapeStringForXML lastname) - else -- last name last - let namewords = words name - lengthname = length namewords - (firstname, lastname) = case lengthname of - 0 -> ("","") - 1 -> ("", name) - n -> (intercalate " " (take (n-1) namewords), last namewords) - in inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$ - inTagsSimple "surname" (text $ escapeStringForXML lastname) +type JATS = ReaderT JATSVersion writeJATS :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeJATS opts d = runReaderT (docToJATS opts d) JATS1_1 -- | Convert Pandoc document to string in JATS format. -docToJATS :: PandocMonad m => WriterOptions -> Pandoc -> DB m Text +docToJATS :: PandocMonad m => WriterOptions -> Pandoc -> JATS m Text docToJATS opts (Pandoc meta blocks) = do let isBackBlock (Div ("refs",_,_) _) = True isBackBlock _ = False @@ -99,9 +74,9 @@ docToJATS opts (Pandoc meta blocks) = do else Nothing let render' :: Doc -> Text render' = render colwidth - let opts' = if (maybe False (("/book>" `isSuffixOf`) . trimr) + let opts' = if maybe False (("/book>" `isSuffixOf`) . trimr) (writerTemplate opts) && - TopLevelDefault == writerTopLevelDivision opts) + TopLevelDefault == writerTopLevelDivision opts then opts{ writerTopLevelDivision = TopLevelChapter } else opts -- The numbering here follows LaTeX's internal numbering @@ -110,30 +85,27 @@ docToJATS opts (Pandoc meta blocks) = do TopLevelChapter -> 0 TopLevelSection -> 1 TopLevelDefault -> 1 - auths' <- mapM (authorToJATS opts) $ docAuthors meta - let meta' = B.setMeta "author" auths' meta metadata <- metaToJSON opts (fmap (render' . vcat) . - (mapM (elementToJATS opts' startLvl) . - hierarchicalize)) + mapM (elementToJATS opts' startLvl) . + hierarchicalize) (fmap render' . inlinesToJATS opts') - meta' + meta main <- (render' . vcat) <$> - (mapM (elementToJATS opts' startLvl) elements) + mapM (elementToJATS opts' startLvl) elements back <- (render' . vcat) <$> - (mapM (elementToJATS opts' startLvl) backElements) + mapM (elementToJATS opts' startLvl) backElements let context = defField "body" main $ defField "back" back $ defField "mathml" (case writerHTMLMathMethod opts of MathML -> True - _ -> False) - $ metadata + _ -> False) metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context -- | Convert an Element to JATS. -elementToJATS :: PandocMonad m => WriterOptions -> Int -> Element -> DB m Doc +elementToJATS :: PandocMonad m => WriterOptions -> Int -> Element -> JATS m Doc elementToJATS opts _ (Blk block) = blockToJATS opts block elementToJATS opts lvl (Sec _ _num (id',_,kvs) title elements) = do let idAttr = [("id", writerIdentifierPrefix opts ++ id') | not (null id')] @@ -145,7 +117,7 @@ elementToJATS opts lvl (Sec _ _num (id',_,kvs) title elements) = do inTagsSimple "title" title' $$ vcat contents -- | Convert a list of Pandoc blocks to JATS. -blocksToJATS :: PandocMonad m => WriterOptions -> [Block] -> DB m Doc +blocksToJATS :: PandocMonad m => WriterOptions -> [Block] -> JATS m Doc blocksToJATS opts = fmap vcat . mapM (blockToJATS opts) -- | Auxiliary function to convert Plain block to Para. @@ -156,13 +128,13 @@ plainToPara x = x -- | Convert a list of pairs of terms and definitions into a list of -- JATS varlistentrys. deflistItemsToJATS :: PandocMonad m - => WriterOptions -> [([Inline],[[Block]])] -> DB m Doc + => WriterOptions -> [([Inline],[[Block]])] -> JATS m Doc deflistItemsToJATS opts items = - vcat <$> mapM (\(term, defs) -> deflistItemToJATS opts term defs) items + vcat <$> mapM (uncurry (deflistItemToJATS opts)) items -- | Convert a term and a list of blocks into a JATS varlistentry. deflistItemToJATS :: PandocMonad m - => WriterOptions -> [Inline] -> [[Block]] -> DB m Doc + => WriterOptions -> [Inline] -> [[Block]] -> JATS m Doc deflistItemToJATS opts term defs = do term' <- inlinesToJATS opts term def' <- blocksToJATS opts $ concatMap (map plainToPara) defs @@ -172,7 +144,7 @@ deflistItemToJATS opts term defs = do -- | Convert a list of lists of blocks to a list of JATS list items. listItemsToJATS :: PandocMonad m - => WriterOptions -> (Maybe [String]) -> [[Block]] -> DB m Doc + => WriterOptions -> Maybe [String] -> [[Block]] -> JATS m Doc listItemsToJATS opts markers items = case markers of Nothing -> vcat <$> mapM (listItemToJATS opts Nothing) items @@ -180,7 +152,7 @@ listItemsToJATS opts markers items = -- | Convert a list of blocks into a JATS list item. listItemToJATS :: PandocMonad m - => WriterOptions -> (Maybe String) -> [Block] -> DB m Doc + => WriterOptions -> Maybe String -> [Block] -> JATS m Doc listItemToJATS opts mbmarker item = do contents <- blocksToJATS opts item return $ inTagsIndented "list-item" $ @@ -188,7 +160,7 @@ listItemToJATS opts mbmarker item = do $$ contents -- | Convert a Pandoc block element to JATS. -blockToJATS :: PandocMonad m => WriterOptions -> Block -> DB m Doc +blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m Doc blockToJATS _ Null = return empty -- Bibliography reference: blockToJATS opts (Div ('r':'e':'f':'-':_,_,_) [Para lst]) = @@ -203,7 +175,7 @@ blockToJATS opts (Div (ident,_,kvs) bs) = do [(k,v) | (k,v) <- kvs, k `elem` ["specific-use", "content-type", "orientation", "position"]] return $ inTags True "boxed-text" attr contents -blockToJATS _ h@(Header _ _ _) = do +blockToJATS _ h@(Header{}) = do -- should not occur after hierarchicalize, except inside lists/blockquotes report $ BlockNotRendered h return empty @@ -256,9 +228,9 @@ blockToJATS _ (CodeBlock (ident,classes,kvs) str) = return $ else languagesByExtension . map toLower $ s langs = concatMap langsFrom classes blockToJATS _ (BulletList []) = return empty -blockToJATS opts (BulletList lst) = do +blockToJATS opts (BulletList lst) = inTags True "list" [("list-type", "bullet")] <$> - listItemsToJATS opts Nothing lst + listItemsToJATS opts Nothing lst blockToJATS _ (OrderedList _ []) = return empty blockToJATS opts (OrderedList (start, numstyle, delimstyle) items) = do let listType = case numstyle of @@ -277,7 +249,7 @@ blockToJATS opts (OrderedList (start, numstyle, delimstyle) items) = do orderedListMarkers (start, numstyle, delimstyle) inTags True "list" [("list-type", listType)] <$> listItemsToJATS opts markers items -blockToJATS opts (DefinitionList lst) = do +blockToJATS opts (DefinitionList lst) = inTags True "def-list" [] <$> deflistItemsToJATS opts lst blockToJATS _ b@(RawBlock f str) | f == "jats" = return $ text str -- raw XML block @@ -312,7 +284,7 @@ tableRowToJATS :: PandocMonad m => WriterOptions -> Bool -> [[Block]] - -> DB m Doc + -> JATS m Doc tableRowToJATS opts isHeader cols = (inTagsIndented "tr" . vcat) <$> mapM (tableItemToJATS opts isHeader) cols @@ -320,17 +292,17 @@ tableItemToJATS :: PandocMonad m => WriterOptions -> Bool -> [Block] - -> DB m Doc + -> JATS m Doc tableItemToJATS opts isHeader item = (inTags True (if isHeader then "th" else "td") [] . vcat) <$> mapM (blockToJATS opts) item -- | Convert a list of inline elements to JATS. -inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> DB m Doc +inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m Doc inlinesToJATS opts lst = hcat <$> mapM (inlineToJATS opts) lst -- | Convert an inline element to JATS. -inlineToJATS :: PandocMonad m => WriterOptions -> Inline -> DB m Doc +inlineToJATS :: PandocMonad m => WriterOptions -> Inline -> JATS m Doc inlineToJATS _ (Str str) = return $ text $ escapeStringForXML str inlineToJATS opts (Emph lst) = inTagsSimple "italic" <$> inlinesToJATS opts lst @@ -400,7 +372,7 @@ inlineToJATS _ (Math t str) = do case res of Right r -> inTagsSimple "alternatives" $ cr <> rawtex $$ - (text $ Xml.ppcElement conf $ fixNS r) + text (Xml.ppcElement conf $ fixNS r) Left _ -> rawtex inlineToJATS _ (Link _attr [Str t] ('m':'a':'i':'l':'t':'o':':':email, _)) | escapeURI t == email = diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 1a36f987b..976450dcd 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -41,7 +41,7 @@ import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isPunctuation, ord, toLower) import Data.List (foldl', intercalate, intersperse, isInfixOf, nubBy, stripPrefix, (\\)) -import Data.Maybe (catMaybes, fromMaybe, isJust) +import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe) import Data.Text (Text) import qualified Data.Text as T import Network.URI (unEscapeString) @@ -102,10 +102,10 @@ startingState options = WriterState { , stUrl = False , stGraphics = False , stLHS = False - , stBook = (case writerTopLevelDivision options of - TopLevelPart -> True - TopLevelChapter -> True - _ -> False) + , stBook = case writerTopLevelDivision options of + TopLevelPart -> True + TopLevelChapter -> True + _ -> False , stCsquotes = False , stHighlighting = False , stIncremental = writerIncremental options @@ -134,14 +134,14 @@ pandocToLaTeX options (Pandoc meta blocks) = do let method = writerCiteMethod options let blocks' = if method == Biblatex || method == Natbib then case reverse blocks of - (Div (_,["references"],_) _):xs -> reverse xs - _ -> blocks + Div (_,["references"],_) _:xs -> reverse xs + _ -> blocks else blocks -- see if there are internal links let isInternalLink (Link _ _ ('#':xs,_)) = [xs] isInternalLink _ = [] modify $ \s -> s{ stInternalLinks = query isInternalLink blocks' } - let template = maybe "" id $ writerTemplate options + let template = fromMaybe "" $ writerTemplate options -- set stBook depending on documentclass let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options @@ -190,8 +190,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do docLangs <- catMaybes <$> mapM (toLang . Just) (ordNub (query (extract "lang") blocks)) let hasStringValue x = isJust (getField x metadata :: Maybe String) - let geometryFromMargins = intercalate [','] $ catMaybes $ - map (\(x,y) -> + let geometryFromMargins = intercalate [','] $ mapMaybe (\(x,y) -> ((x ++ "=") ++) <$> getField y metadata) [("lmargin","margin-left") ,("rmargin","margin-right") @@ -256,7 +255,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do (case getField "papersize" metadata of Just ("A4" :: String) -> resetField "papersize" ("a4" :: String) - _ -> id) $ + _ -> id) metadata let context' = -- note: lang is used in some conditionals in the template, @@ -287,9 +286,9 @@ pandocToLaTeX options (Pandoc meta blocks) = do ) $ maybe id (defField "polyglossia-lang" . toPolyObj) mblang $ defField "polyglossia-otherlangs" (map toPolyObj docLangs) - $ defField "latex-dir-rtl" - (getField "dir" context == Just ("rtl" :: String)) - $ context + $ + defField "latex-dir-rtl" + (getField "dir" context == Just ("rtl" :: String)) context case writerTemplate options of Nothing -> return main Just tpl -> renderTemplate' tpl context' @@ -357,7 +356,7 @@ toLabel z = go `fmap` stringToLaTeX URLString z where go [] = "" go (x:xs) | (isLetter x || isDigit x) && isAscii x = x:go xs - | elem x ("_-+=:;." :: String) = x:go xs + | x `elem` ("_-+=:;." :: String) = x:go xs | otherwise = "ux" ++ printf "%x" (ord x) ++ go xs -- | Puts contents into LaTeX command. @@ -369,9 +368,13 @@ toSlides bs = do opts <- gets stOptions let slideLevel = fromMaybe (getSlideLevel bs) $ writerSlideLevel opts let bs' = prepSlides slideLevel bs - concat `fmap` (mapM (elementToBeamer slideLevel) $ hierarchicalize bs') + concat `fmap` mapM (elementToBeamer slideLevel) (hierarchicalize bs') elementToBeamer :: PandocMonad m => Int -> Element -> LW m [Block] +elementToBeamer _slideLevel (Blk (Div attr bs)) = do + -- make sure we support "blocks" inside divs + bs' <- concat `fmap` mapM (elementToBeamer 0) (hierarchicalize bs) + return [Div attr bs'] elementToBeamer _slideLevel (Blk b) = return [b] elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts) | lvl > slideLevel = do @@ -381,7 +384,7 @@ elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts) : bs ++ [RawBlock "latex" "\\end{block}"] | lvl < slideLevel = do bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts - return $ (Header lvl (ident,classes,kvs) tit) : bs + return $ Header lvl (ident,classes,kvs) tit : bs | otherwise = do -- lvl == slideLevel -- note: [fragile] is required or verbatim breaks let hasCodeBlock (CodeBlock _ _) = [True] @@ -480,8 +483,8 @@ blockToLaTeX (Div (identifier,classes,kvs) bs) = do wrapNotes txt = if beamer && "notes" `elem` classes then "\\note" <> braces txt -- speaker notes else linkAnchor $$ txt - fmap (wrapColumns . wrapColumn . wrapDir . wrapLang . wrapNotes) - $ blockListToLaTeX bs + (wrapColumns . wrapColumn . wrapDir . wrapLang . wrapNotes) + <$> blockListToLaTeX bs blockToLaTeX (Plain lst) = inlineListToLaTeX $ dropWhile isLineBreakOrSpace lst -- title beginning with fig: indicates that the image is a figure @@ -517,7 +520,7 @@ blockToLaTeX (Para [Str ".",Space,Str ".",Space,Str "."]) = do else inlineListToLaTeX [Str ".",Space,Str ".",Space,Str "."] blockToLaTeX (Para lst) = inlineListToLaTeX $ dropWhile isLineBreakOrSpace lst -blockToLaTeX (LineBlock lns) = do +blockToLaTeX (LineBlock lns) = blockToLaTeX $ linesToPara lns blockToLaTeX (BlockQuote lst) = do beamer <- gets stBeamer @@ -645,12 +648,11 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do Example -> "1" DefaultStyle -> "1" let enum = text $ "enum" ++ map toLower (toRomanNumeral oldlevel) - let stylecommand = if numstyle == DefaultStyle && numdelim == DefaultDelim - then empty - else if beamer - then brackets (todelim exemplar) - else "\\def" <> "\\label" <> enum <> - braces (todelim $ tostyle enum) + let stylecommand + | numstyle == DefaultStyle && numdelim == DefaultDelim = empty + | beamer = brackets (todelim exemplar) + | otherwise = "\\def" <> "\\label" <> enum <> + braces (todelim $ tostyle enum) let resetcounter = if start == 1 || oldlevel > 4 then empty else "\\setcounter" <> braces enum <> @@ -674,7 +676,8 @@ blockToLaTeX (DefinitionList lst) = do else empty return $ text ("\\begin{description}" ++ inc) $$ spacing $$ vcat items $$ "\\end{description}" -blockToLaTeX HorizontalRule = return $ +blockToLaTeX HorizontalRule = + return "\\begin{center}\\rule{0.5\\linewidth}{\\linethickness}\\end{center}" blockToLaTeX (Header level (id',classes,_) lst) = do modify $ \s -> s{stInHeading = True} @@ -682,7 +685,7 @@ blockToLaTeX (Header level (id',classes,_) lst) = do modify $ \s -> s{stInHeading = False} return hdr blockToLaTeX (Table caption aligns widths heads rows) = do - let toHeaders hs = do contents <- (tableRowToLaTeX True aligns widths) hs + let toHeaders hs = do contents <- tableRowToLaTeX True aligns widths hs return ("\\toprule" $$ contents $$ "\\midrule") let removeNote (Note _) = Span ("", [], []) [] removeNote x = x @@ -702,7 +705,7 @@ blockToLaTeX (Table caption aligns widths heads rows) = do else text "\\caption" <> braces captionText <> "\\tabularnewline" rows' <- mapM (tableRowToLaTeX False aligns widths) rows - let colDescriptors = text $ concat $ map toColDescriptor aligns + let colDescriptors = text $ concatMap toColDescriptor aligns modify $ \s -> s{ stTable = True } return $ "\\begin{longtable}[]" <> braces ("@{}" <> colDescriptors <> "@{}") @@ -812,10 +815,10 @@ listItemToLaTeX lst -- we need to put some text before a header if it's the first -- element in an item. This will look ugly in LaTeX regardless, but -- this will keep the typesetter from throwing an error. - | ((Header _ _ _) :_) <- lst = - blockListToLaTeX lst >>= return . (text "\\item ~" $$) . (nest 2) + | (Header _ _ _ :_) <- lst = + blockListToLaTeX lst >>= return . (text "\\item ~" $$) . nest 2 | otherwise = blockListToLaTeX lst >>= return . (text "\\item" $$) . - (nest 2) + nest 2 defListItemToLaTeX :: PandocMonad m => ([Inline], [[Block]]) -> LW m Doc defListItemToLaTeX (term, defs) = do @@ -832,7 +835,7 @@ defListItemToLaTeX (term, defs) = do else term' def' <- liftM vsep $ mapM blockListToLaTeX defs return $ case defs of - (((Header _ _ _) : _) : _) -> + ((Header _ _ _ : _) : _) -> "\\item" <> brackets term'' <> " ~ " $$ def' _ -> "\\item" <> brackets term'' $$ def' @@ -849,16 +852,16 @@ sectionHeader unnumbered ident level lst = do plain <- stringToLaTeX TextString $ concatMap stringify lst let removeInvalidInline (Note _) = [] removeInvalidInline (Span (id', _, _) _) | not (null id') = [] - removeInvalidInline (Image _ _ _) = [] + removeInvalidInline (Image{}) = [] removeInvalidInline x = [x] let lstNoNotes = foldr (mappend . (\x -> walkM removeInvalidInline x)) mempty lst txtNoNotes <- inlineListToLaTeX lstNoNotes -- footnotes in sections don't work (except for starred variants) -- unless you specify an optional argument: -- \section[mysec]{mysec\footnote{blah}} - optional <- if unnumbered || lstNoNotes == lst || lstNoNotes == [] + optional <- if unnumbered || lstNoNotes == lst || null lstNoNotes then return empty - else do + else return $ brackets txtNoNotes let contents = if render Nothing txt == plain then braces txt @@ -983,7 +986,7 @@ inlineToLaTeX (Strikeout lst) = do return $ inCmd "sout" contents inlineToLaTeX (Superscript lst) = inlineListToLaTeX lst >>= return . inCmd "textsuperscript" -inlineToLaTeX (Subscript lst) = do +inlineToLaTeX (Subscript lst) = inlineListToLaTeX lst >>= return . inCmd "textsubscript" inlineToLaTeX (SmallCaps lst) = inlineListToLaTeX lst >>= return . inCmd "textsc" @@ -1018,7 +1021,7 @@ inlineToLaTeX (Code (_,classes,_) str) = do $ stringToLaTeX CodeString str where escapeSpaces = concatMap (\c -> if c == ' ' then "\\ " else [c]) - let highlightCode = do + let highlightCode = case highlight (writerSyntaxMap opts) formatLaTeXInline ("",classes,[]) str of Left msg -> do @@ -1038,10 +1041,10 @@ inlineToLaTeX (Quoted qt lst) = do if csquotes then return $ "\\enquote" <> braces contents else do - let s1 = if (not (null lst)) && (isQuoted (head lst)) + let s1 = if not (null lst) && isQuoted (head lst) then "\\," else empty - let s2 = if (not (null lst)) && (isQuoted (last lst)) + let s2 = if not (null lst) && isQuoted (last lst) then "\\," else empty let inner = s1 <> contents <> s2 @@ -1071,7 +1074,7 @@ inlineToLaTeX il@(RawInline f str) | otherwise = do report $ InlineNotRendered il return empty -inlineToLaTeX (LineBreak) = do +inlineToLaTeX LineBreak = do emptyLine <- gets stEmptyLine setEmptyLine True return $ (if emptyLine then "~" else "") <> "\\\\" <> cr @@ -1111,7 +1114,7 @@ inlineToLaTeX (Image attr _ (source, _)) = do modify $ \s -> s{ stGraphics = True } opts <- gets stOptions let showDim dir = let d = text (show dir) <> "=" - in case (dimension dir attr) of + in case dimension dir attr of Just (Pixel a) -> [d <> text (showInInch opts (Pixel a)) <> "in"] Just (Percent a) -> @@ -1165,7 +1168,8 @@ setEmptyLine :: PandocMonad m => Bool -> LW m () setEmptyLine b = modify $ \st -> st{ stEmptyLine = b } citationsToNatbib :: PandocMonad m => [Citation] -> LW m Doc -citationsToNatbib (one:[]) +citationsToNatbib + [one] = citeCommand c p s k where Citation { citationId = k @@ -1185,9 +1189,11 @@ citationsToNatbib cits where noPrefix = all (null . citationPrefix) noSuffix = all (null . citationSuffix) - ismode m = all (((==) m) . citationMode) - p = citationPrefix $ head $ cits - s = citationSuffix $ last $ cits + ismode m = all ((==) m . citationMode) + p = citationPrefix $ + head cits + s = citationSuffix $ + last cits ks = intercalate ", " $ map citationId cits citationsToNatbib (c:cs) | citationMode c == AuthorInText = do @@ -1221,7 +1227,8 @@ citeArguments :: PandocMonad m => [Inline] -> [Inline] -> String -> LW m Doc citeArguments p s k = do let s' = case s of - (Str (x:[]) : r) | isPunctuation x -> dropWhile (== Space) r + (Str + [x] : r) | isPunctuation x -> dropWhile (== Space) r (Str (x:xs) : r) | isPunctuation x -> Str xs : r _ -> s pdoc <- inlineListToLaTeX p @@ -1233,7 +1240,8 @@ citeArguments p s k = do return $ optargs <> braces (text k) citationsToBiblatex :: PandocMonad m => [Citation] -> LW m Doc -citationsToBiblatex (one:[]) +citationsToBiblatex + [one] = citeCommand cmd p s k where Citation { citationId = k @@ -1264,8 +1272,8 @@ citationsToBiblatex _ = return empty -- Determine listings language from list of class attributes. getListingsLanguage :: [String] -> Maybe String -getListingsLanguage [] = Nothing -getListingsLanguage (x:xs) = toListingsLanguage x <|> getListingsLanguage xs +getListingsLanguage xs + = foldr ((<|>) . toListingsLanguage) Nothing xs mbBraced :: String -> String mbBraced x = if not (all isAlphaNum x) diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 40c0dd815..ad3de41eb 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -104,8 +104,7 @@ pandocToMan opts (Pandoc meta blocks) = do $ setFieldsFromTitle $ defField "has-tables" hasTables $ defField "hyphenate" True - $ defField "pandoc-version" pandocVersion - $ metadata + $ defField "pandoc-version" pandocVersion metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -115,7 +114,7 @@ notesToMan :: PandocMonad m => WriterOptions -> [[Block]] -> StateT WriterState notesToMan opts notes = if null notes then return empty - else mapM (\(num, note) -> noteToMan opts num note) (zip [1..] notes) >>= + else mapM (uncurry (noteToMan opts)) (zip [1..] notes) >>= return . (text ".SH NOTES" $$) . vcat -- | Return man representation of a note. @@ -141,7 +140,7 @@ escapeString = escapeStringUsing manEscapes -- | Escape a literal (code) section for Man. escapeCode :: String -> String -escapeCode = concat . intersperse "\n" . map escapeLine . lines where +escapeCode = intercalate "\n" . map escapeLine . lines where escapeLine codeline = case escapeStringUsing (manEscapes ++ backslashEscapes "\t ") codeline of a@('.':_) -> "\\&" ++ a @@ -157,7 +156,7 @@ breakSentence [] = ([],[]) breakSentence xs = let isSentenceEndInline (Str ys@(_:_)) | last ys == '.' = True isSentenceEndInline (Str ys@(_:_)) | last ys == '?' = True - isSentenceEndInline (LineBreak) = True + isSentenceEndInline LineBreak = True isSentenceEndInline _ = False (as, bs) = break isSentenceEndInline xs in case bs of @@ -226,12 +225,12 @@ blockToMan opts (Table caption alignments widths headers rows) = then repeat "" else map (printf "w(%0.1fn)" . (70 *)) widths -- 78n default width - 8n indent = 70n - let coldescriptions = text $ intercalate " " + let coldescriptions = text $ unwords (zipWith (\align width -> aligncode align ++ width) alignments iwidths) ++ "." colheadings <- mapM (blockListToMan opts) headers let makeRow cols = text "T{" $$ - (vcat $ intersperse (text "T}@T{") cols) $$ + vcat (intersperse (text "T}@T{") cols) $$ text "T}" let colheadings' = if all null headers then empty @@ -248,7 +247,8 @@ 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 length markers) + let indent = 1 + + maximum (map length markers) contents <- mapM (\(num, item) -> orderedListItemToMan opts num indent item) $ zip markers items return (vcat contents) @@ -259,9 +259,9 @@ blockToMan opts (DefinitionList items) = do -- | Convert bullet list item (list of blocks) to man. bulletListItemToMan :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m Doc bulletListItemToMan _ [] = return empty -bulletListItemToMan opts ((Para first):rest) = - bulletListItemToMan opts ((Plain first):rest) -bulletListItemToMan opts ((Plain first):rest) = do +bulletListItemToMan opts (Para first:rest) = + bulletListItemToMan opts (Plain first:rest) +bulletListItemToMan opts (Plain first:rest) = do first' <- blockToMan opts (Plain first) rest' <- blockListToMan opts rest let first'' = text ".IP \\[bu] 2" $$ first' @@ -282,8 +282,8 @@ orderedListItemToMan :: PandocMonad m -> [Block] -- ^ list item (list of blocks) -> StateT WriterState m Doc orderedListItemToMan _ _ _ [] = return empty -orderedListItemToMan opts num indent ((Para first):rest) = - orderedListItemToMan opts num indent ((Plain first):rest) +orderedListItemToMan opts num indent (Para first:rest) = + orderedListItemToMan opts num indent (Plain first:rest) orderedListItemToMan opts num indent (first:rest) = do first' <- blockToMan opts first rest' <- blockListToMan opts rest @@ -332,9 +332,9 @@ inlineListToMan opts lst = mapM (inlineToMan opts) lst >>= (return . hcat) -- | Convert Pandoc inline element to man. inlineToMan :: PandocMonad m => WriterOptions -> Inline -> StateT WriterState m Doc inlineToMan opts (Span _ ils) = inlineListToMan opts ils -inlineToMan opts (Emph lst) = do +inlineToMan opts (Emph lst) = withFontFeature 'I' (inlineListToMan opts lst) -inlineToMan opts (Strong lst) = do +inlineToMan opts (Strong lst) = withFontFeature 'B' (inlineListToMan opts lst) inlineToMan opts (Strikeout lst) = do contents <- inlineListToMan opts lst @@ -382,7 +382,7 @@ inlineToMan opts (Link _ txt (src, _)) = do char '<' <> text srcSuffix <> char '>' _ -> linktext <> text " (" <> text src <> char ')' inlineToMan opts (Image attr alternate (source, tit)) = do - let txt = if (null alternate) || (alternate == [Str ""]) || + let txt = if null alternate || (alternate == [Str ""]) || (alternate == [Str source]) -- to prevent autolinks then [Str "image"] else alternate @@ -392,7 +392,7 @@ inlineToMan _ (Note contents) = do -- add to notes in state modify $ \st -> st{ stNotes = contents : stNotes st } notes <- gets stNotes - let ref = show $ (length notes) + let ref = show (length notes) return $ char '[' <> text ref <> char ']' fontChange :: PandocMonad m => StateT WriterState m Doc diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 5d812b169..a1f30cb0e 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -397,11 +397,19 @@ blockToMarkdown' :: PandocMonad m blockToMarkdown' _ Null = return empty blockToMarkdown' opts (Div attrs ils) = do contents <- blockListToMarkdown opts ils - return $ if isEnabled Ext_raw_html opts && - isEnabled Ext_markdown_in_html_blocks opts - then tagWithAttrs "div" attrs <> blankline <> - contents <> blankline <> "</div>" <> blankline - else contents <> blankline + return $ + case () of + _ | isEnabled Ext_fenced_divs opts && + attrs /= nullAttr -> + nowrap (text ":::" <+> attrsToMarkdown attrs) $$ + chomp contents $$ + text ":::" <> blankline + | isEnabled Ext_native_divs opts || + (isEnabled Ext_raw_html opts && + isEnabled Ext_markdown_in_html_blocks opts) -> + tagWithAttrs "div" attrs <> blankline <> + contents <> blankline <> "</div>" <> blankline + | otherwise -> contents <> blankline blockToMarkdown' opts (Plain inlines) = do contents <- inlineListToMarkdown opts inlines -- escape if para starts with ordered list marker diff --git a/src/Text/Pandoc/Writers/Math.hs b/src/Text/Pandoc/Writers/Math.hs index 61358378b..477f5a0b1 100644 --- a/src/Text/Pandoc/Writers/Math.hs +++ b/src/Text/Pandoc/Writers/Math.hs @@ -22,7 +22,7 @@ texMathToInlines mt inp = do res <- convertMath writePandoc mt inp case res of Right (Just ils) -> return ils - Right (Nothing) -> do + Right Nothing -> do report $ CouldNotConvertTeXMath inp "" return [mkFallback mt inp] Left il -> return [il] @@ -39,7 +39,7 @@ mkFallback mt str = Str (delim ++ str ++ delim) convertMath :: PandocMonad m => (DisplayType -> [Exp] -> a) -> MathType -> String -> m (Either Inline a) -convertMath writer mt str = do +convertMath writer mt str = case writer dt <$> readTeX str of Right r -> return (Right r) Left e -> do diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs index 68c0d6096..223d1bcc1 100644 --- a/src/Text/Pandoc/Writers/Ms.hs +++ b/src/Text/Pandoc/Writers/Ms.hs @@ -121,15 +121,14 @@ pandocToMs opts (Pandoc meta blocks) = do $ defField "toc" (writerTableOfContents opts) $ defField "title-meta" titleMeta $ defField "author-meta" (intercalate "; " authorsMeta) - $ defField "highlighting-macros" highlightingMacros - $ metadata + $ defField "highlighting-macros" highlightingMacros metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context -- | Association list of characters to escape. msEscapes :: Map.Map Char String -msEscapes = Map.fromList $ +msEscapes = Map.fromList [ ('\160', "\\~") , ('\'', "\\[aq]") , ('`', "\\`") @@ -146,9 +145,7 @@ msEscapes = Map.fromList $ ] escapeChar :: Char -> String -escapeChar c = case Map.lookup c msEscapes of - Just s -> s - Nothing -> [c] +escapeChar c = fromMaybe [c] (Map.lookup c msEscapes) -- | Escape | character, used to mark inline math, inside math. escapeBar :: String -> String @@ -175,7 +172,7 @@ toSmallCaps (c:cs) -- | Escape a literal (code) section for Ms. escapeCode :: String -> String -escapeCode = concat . intersperse "\n" . map escapeLine . lines +escapeCode = intercalate "\n" . map escapeLine . lines where escapeCodeChar ' ' = "\\ " escapeCodeChar '\t' = "\\\t" escapeCodeChar c = escapeChar c @@ -194,7 +191,7 @@ breakSentence [] = ([],[]) breakSentence xs = let isSentenceEndInline (Str ys@(_:_)) | last ys == '.' = True isSentenceEndInline (Str ys@(_:_)) | last ys == '?' = True - isSentenceEndInline (LineBreak) = True + isSentenceEndInline LineBreak = True isSentenceEndInline _ = False (as, bs) = break isSentenceEndInline xs in case bs of @@ -283,11 +280,11 @@ blockToMs opts (Header level (ident,classes,_) inlines) = do level <= writerTOCDepth opts then text ".XS" $$ backlink <> doubleQuotes ( - nowrap ((text (replicate level '\t') <> + nowrap (text (replicate level '\t') <> (if null secnum then empty else text secnum <> text "\\~\\~") - <> contents))) + <> contents)) $$ text ".XE" else empty modify $ \st -> st{ stFirstPara = True } @@ -325,12 +322,12 @@ blockToMs opts (Table caption alignments widths headers rows) = then repeat "" else map (printf "w(%0.1fn)" . (70 *)) widths -- 78n default width - 8n indent = 70n - let coldescriptions = text $ intercalate " " + let coldescriptions = text $ unwords (zipWith (\align width -> aligncode align ++ width) alignments iwidths) ++ "." colheadings <- mapM (blockListToMs opts) headers let makeRow cols = text "T{" $$ - (vcat $ intersperse (text "T}\tT{") cols) $$ + vcat (intersperse (text "T}\tT{") cols) $$ text "T}" let colheadings' = if all null headers then empty @@ -349,7 +346,8 @@ 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 length markers) + let indent = 2 + + maximum (map length markers) contents <- mapM (\(num, item) -> orderedListItemToMs opts num indent item) $ zip markers items setFirstPara @@ -362,9 +360,9 @@ blockToMs opts (DefinitionList items) = do -- | Convert bullet list item (list of blocks) to ms. bulletListItemToMs :: PandocMonad m => WriterOptions -> [Block] -> MS m Doc bulletListItemToMs _ [] = return empty -bulletListItemToMs opts ((Para first):rest) = - bulletListItemToMs opts ((Plain first):rest) -bulletListItemToMs opts ((Plain first):rest) = do +bulletListItemToMs opts (Para first:rest) = + bulletListItemToMs opts (Plain first:rest) +bulletListItemToMs opts (Plain first:rest) = do first' <- blockToMs opts (Plain first) rest' <- blockListToMs opts rest let first'' = text ".IP \\[bu] 3" $$ first' @@ -385,8 +383,8 @@ orderedListItemToMs :: PandocMonad m -> [Block] -- ^ list item (list of blocks) -> MS m Doc orderedListItemToMs _ _ _ [] = return empty -orderedListItemToMs opts num indent ((Para first):rest) = - orderedListItemToMs opts num indent ((Plain first):rest) +orderedListItemToMs opts num indent (Para first:rest) = + orderedListItemToMs opts num indent (Plain first:rest) orderedListItemToMs opts num indent (first:rest) = do first' <- blockToMs opts first rest' <- blockListToMs opts rest @@ -409,9 +407,9 @@ definitionListItemToMs opts (label, defs) = do then return empty else liftM vcat $ forM defs $ \blocks -> do let (first, rest) = case blocks of - ((Para x):y) -> (Plain x,y) - (x:y) -> (x,y) - [] -> (Plain [], []) + (Para x:y) -> (Plain x,y) + (x:y) -> (x,y) + [] -> (Plain [], []) -- should not happen rest' <- liftM vcat $ mapM (\item -> blockToMs opts item) rest @@ -503,7 +501,7 @@ inlineToMs _ il@(RawInline f str) | otherwise = do report $ InlineNotRendered il return empty -inlineToMs _ (LineBreak) = return $ cr <> text ".br" <> cr +inlineToMs _ LineBreak = return $ cr <> text ".br" <> cr inlineToMs opts SoftBreak = handleNotes opts $ case writerWrapText opts of @@ -539,8 +537,7 @@ handleNotes opts fallback = do then return fallback else do modify $ \st -> st{ stNotes = [] } - res <- vcat <$> mapM (handleNote opts) notes - return res + vcat <$> mapM (handleNote opts) notes handleNote :: PandocMonad m => WriterOptions -> Note -> MS m Doc handleNote opts bs = do @@ -589,7 +586,7 @@ styleToMs sty = vcat $ colordefs ++ map (toMacro sty) alltoktypes allcolors = catMaybes $ ordNub $ [defaultColor sty, backgroundColor sty, lineNumberColor sty, lineNumberBackgroundColor sty] ++ - concatMap colorsForToken (map snd (tokenStyles sty)) + concatMap (colorsForToken. snd) (tokenStyles sty) colorsForToken ts = [tokenColor ts, tokenBackground ts] hexColor :: Color -> String diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs index c934fe4d9..1fb685985 100644 --- a/src/Text/Pandoc/Writers/Native.hs +++ b/src/Text/Pandoc/Writers/Native.hs @@ -39,7 +39,8 @@ import Text.Pandoc.Pretty prettyList :: [Doc] -> Doc prettyList ds = - "[" <> (cat $ intersperse (cr <> ",") $ map (nest 1) ds) <> "]" + "[" <> + cat (intersperse (cr <> ",") $ map (nest 1) ds) <> "]" -- | Prettyprint Pandoc block element. prettyBlock :: Block -> Doc @@ -49,12 +50,12 @@ prettyBlock (BlockQuote blocks) = "BlockQuote" $$ prettyList (map prettyBlock blocks) prettyBlock (OrderedList attribs blockLists) = "OrderedList" <> space <> text (show attribs) $$ - (prettyList $ map (prettyList . map prettyBlock) blockLists) + prettyList (map (prettyList . map prettyBlock) blockLists) prettyBlock (BulletList blockLists) = "BulletList" $$ - (prettyList $ map (prettyList . map prettyBlock) blockLists) + prettyList (map (prettyList . map prettyBlock) blockLists) prettyBlock (DefinitionList items) = "DefinitionList" $$ - (prettyList $ map deflistitem items) + prettyList (map deflistitem items) where deflistitem (term, defs) = "(" <> text (show term) <> "," <> cr <> nest 1 (prettyList $ map (prettyList . map prettyBlock) defs) <> ")" prettyBlock (Table caption aligns widths header rows) = diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 32fcb0292..fcd551227 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -89,7 +89,7 @@ pandocToODT opts doc@(Pandoc meta _) = do -- picEntriesRef <- P.newIORef ([] :: [Entry]) doc' <- walkM (transformPicMath opts) $ walk fixDisplayMath doc newContents <- lift $ writeOpenDocument opts{writerWrapText = WrapNone} doc' - epochtime <- floor `fmap` (lift P.getPOSIXTime) + epochtime <- floor `fmap` lift P.getPOSIXTime let contentEntry = toEntry "content.xml" epochtime $ fromTextLazy $ TL.fromStrict newContents picEntries <- gets stEntries @@ -111,10 +111,9 @@ pandocToODT opts doc@(Pandoc meta _) = do $ fromStringLazy $ render Nothing $ text "<?xml version=\"1.0\" encoding=\"utf-8\"?>" $$ - ( inTags True "manifest:manifest" + (inTags True "manifest:manifest" [("xmlns:manifest","urn:oasis:names:tc:opendocument:xmlns:manifest:1.0") - ,("manifest:version","1.2")] - $ ( selfClosingTag "manifest:file-entry" + ,("manifest:version","1.2")] ( selfClosingTag "manifest:file-entry" [("manifest:media-type","application/vnd.oasis.opendocument.text") ,("manifest:full-path","/")] $$ vcat ( map toFileEntry $ files ) @@ -126,15 +125,14 @@ pandocToODT opts doc@(Pandoc meta _) = do $ fromStringLazy $ render Nothing $ text "<?xml version=\"1.0\" encoding=\"utf-8\"?>" $$ - ( inTags True "office:document-meta" + (inTags True "office:document-meta" [("xmlns:office","urn:oasis:names:tc:opendocument:xmlns:office:1.0") ,("xmlns:xlink","http://www.w3.org/1999/xlink") ,("xmlns:dc","http://purl.org/dc/elements/1.1/") ,("xmlns:meta","urn:oasis:names:tc:opendocument:xmlns:meta:1.0") ,("xmlns:ooo","http://openoffice.org/2004/office") ,("xmlns:grddl","http://www.w3.org/2003/g/data-view#") - ,("office:version","1.2")] - $ ( inTagsSimple "office:meta" $ + ,("office:version","1.2")] ( inTagsSimple "office:meta" $ ( inTagsSimple "dc:title" (text $ escapeStringForXML (stringify title)) $$ @@ -156,7 +154,7 @@ pandocToODT opts doc@(Pandoc meta _) = do updateStyleWithLang :: PandocMonad m => Maybe Lang -> Archive -> O m Archive updateStyleWithLang Nothing arch = return arch updateStyleWithLang (Just lang) arch = do - epochtime <- floor `fmap` (lift P.getPOSIXTime) + epochtime <- floor `fmap` lift P.getPOSIXTime return arch{ zEntries = [if eRelativePath e == "styles.xml" then case parseXMLDoc (toStringLazy (fromEntry e)) of @@ -196,7 +194,7 @@ transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = catchError _ -> [("width", show ptX ++ "pt"), ("height", show ptY ++ "pt")] where ratio = ptX / ptY - getDim dir = case (dimension dir attr) of + getDim dir = case dimension dir attr of Just (Percent i) -> Just $ Percent i Just dim -> Just $ Inch $ inInch opts dim Nothing -> Nothing @@ -206,7 +204,7 @@ transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = catchError (mbMimeType >>= extensionFromMimeType) let newsrc = "Pictures/" ++ show (length entries) <.> extension let toLazy = B.fromChunks . (:[]) - epochtime <- floor `fmap` (lift P.getPOSIXTime) + epochtime <- floor `fmap` lift P.getPOSIXTime let entry = toEntry newsrc epochtime $ toLazy img modify $ \st -> st{ stEntries = entry : entries } return $ Image newattr lab (newsrc, t)) @@ -222,7 +220,7 @@ transformPicMath _ (Math t math) = do Right r -> do let conf = useShortEmptyTags (const False) defaultConfigPP let mathml = ppcTopElement conf r - epochtime <- floor `fmap` (lift $ P.getPOSIXTime) + epochtime <- floor `fmap` (lift P.getPOSIXTime) let dirname = "Formula-" ++ show (length entries) ++ "/" let fname = dirname ++ "content.xml" let entry = toEntry fname epochtime (fromStringLazy mathml) diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs index 52577ac17..3a2467c65 100644 --- a/src/Text/Pandoc/Writers/OPML.hs +++ b/src/Text/Pandoc/Writers/OPML.hs @@ -56,9 +56,9 @@ writeOPML opts (Pandoc meta blocks) = do meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta metadata <- metaToJSON opts (writeMarkdown def . Pandoc nullMeta) - (\ils -> T.stripEnd <$> (writeMarkdown def $ Pandoc nullMeta [Plain ils])) + (\ils -> T.stripEnd <$> writeMarkdown def (Pandoc nullMeta [Plain ils])) meta' - main <- (render colwidth . vcat) <$> (mapM (elementToOPML opts) elements) + main <- (render colwidth . vcat) <$> mapM (elementToOPML opts) elements let context = defField "body" main metadata case writerTemplate opts of Nothing -> return main @@ -67,7 +67,7 @@ writeOPML opts (Pandoc meta blocks) = do writeHtmlInlines :: PandocMonad m => [Inline] -> m Text writeHtmlInlines ils = - T.strip <$> (writeHtml5String def $ Pandoc nullMeta [Plain ils]) + T.strip <$> writeHtml5String def (Pandoc nullMeta [Plain ils]) -- date format: RFC 822: Thu, 14 Jul 2005 23:41:05 GMT showDateTimeRFC822 :: UTCTime -> String @@ -80,7 +80,7 @@ convertDate ils = maybe "" showDateTimeRFC822 $ #else parseTime #endif - defaultTimeLocale "%F" =<< (normalizeDate $ stringify ils) + defaultTimeLocale "%F" =<< normalizeDate (stringify ils) -- | Convert an Element to OPML. elementToOPML :: PandocMonad m => WriterOptions -> Element -> m Doc @@ -100,7 +100,7 @@ elementToOPML opts (Sec _ _num _ title elements) = do then return mempty else do blks <- mapM fromBlk blocks writeMarkdown def $ Pandoc nullMeta blks - let attrs = [("text", unpack htmlIls)] ++ + let attrs = ("text", unpack htmlIls) : [("_note", unpack md) | not (null blocks)] o <- mapM (elementToOPML opts) rest return $ inTags True "outline" attrs $ vcat o diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 04cae0b4b..ac4a85670 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -117,7 +117,7 @@ increaseIndent :: PandocMonad m => OD m () increaseIndent = modify $ \s -> s { stIndentPara = 1 + stIndentPara s } resetIndent :: PandocMonad m => OD m () -resetIndent = modify $ \s -> s { stIndentPara = (stIndentPara s) - 1 } +resetIndent = modify $ \s -> s { stIndentPara = stIndentPara s - 1 } inTightList :: PandocMonad m => OD m a -> OD m a inTightList f = modify (\s -> s { stTight = True }) >> f >>= \r -> @@ -135,7 +135,7 @@ inParagraphTags d = do b <- gets stFirstPara a <- if b then do modify $ \st -> st { stFirstPara = False } - return $ [("text:style-name", "First_20_paragraph")] + return [("text:style-name", "First_20_paragraph")] else return [("text:style-name", "Text_20_body")] return $ inTags False "text:p" a d @@ -213,16 +213,15 @@ writeOpenDocument opts (Pandoc meta blocks) = do b <- render' `fmap` blocksToOpenDocument opts blocks return (b, m) let styles = stTableStyles s ++ stParaStyles s ++ - map snd (reverse $ sortBy (comparing fst) $ - Map.elems (stTextStyles s)) + map snd (sortBy (flip (comparing fst)) ( + Map.elems (stTextStyles s))) listStyle (n,l) = inTags True "text:list-style" [("style:name", "L" ++ show n)] (vcat l) let listStyles = map listStyle (stListStyles s) let automaticStyles = vcat $ reverse $ styles ++ listStyles let context = defField "body" body $ defField "toc" (writerTableOfContents opts) - $ defField "automatic-styles" (render' automaticStyles) - $ metadata + $defField "automatic-styles" (render' automaticStyles) metadata case writerTemplate opts of Nothing -> return body Just tpl -> renderTemplate' tpl context @@ -297,7 +296,7 @@ deflistItemToOpenDocument o (t,d) = do ds = if isTightList d then "Definition_20_Definition_20_Tight" else "Definition_20_Definition" t' <- withParagraphStyle o ts [Para t] - d' <- liftM vcat $ mapM (withParagraphStyle o ds . (map plainToPara)) d + d' <- liftM vcat $ mapM (withParagraphStyle o ds . map plainToPara) d return $ t' $$ d' inBlockQuote :: PandocMonad m @@ -307,8 +306,8 @@ inBlockQuote o i (b:bs) ni <- paraStyle [("style:parent-style-name","Quotations")] go =<< inBlockQuote o ni (map plainToPara l) - | Para l <- b = do go =<< inParagraphTagsWithStyle ("P" ++ show i) <$> inlinesToOpenDocument o l - | otherwise = do go =<< blockToOpenDocument o b + | Para l <- b = go =<< inParagraphTagsWithStyle ("P" ++ show i) <$> inlinesToOpenDocument o l + | otherwise = go =<< blockToOpenDocument o b where go block = ($$) block <$> inBlockQuote o i bs inBlockQuote _ _ [] = resetIndent >> return empty @@ -446,7 +445,7 @@ inlineToOpenDocument o ils SoftBreak | writerWrapText o == WrapPreserve -> return $ preformatted "\n" - | otherwise -> return $ space + | otherwise ->return space Span attr xs -> withLangFromAttr attr (inlinesToOpenDocument o xs) LineBreak -> return $ selfClosingTag "text:line-break" [] Str s -> return $ handleSpaces $ escapeStringForXML s @@ -556,7 +555,7 @@ tableStyle num wcs = [ ("style:name" , tableId ++ "." ++ [c]) , ("style:family", "table-column" )] $ selfClosingTag "style:table-column-properties" - [("style:rel-column-width", printf "%d*" $ (floor $ w * 65535 :: Integer))] + [("style:rel-column-width", printf "%d*" (floor $ w * 65535 :: Integer))] cellStyle = inTags True "style:style" [ ("style:name" , tableId ++ ".A1") , ("style:family", "table-cell" )] $ @@ -584,8 +583,10 @@ paraStyle attrs = do , ("style:auto-text-indent" , "false" )] else [] attributes = indent ++ tight - paraProps = when (not $ null attributes) $ - selfClosingTag "style:paragraph-properties" attributes + paraProps = if null attributes + then mempty + else selfClosingTag + "style:paragraph-properties" attributes addParaStyle $ inTags True "style:style" (styleAttr ++ attrs) paraProps return pn @@ -643,7 +644,7 @@ withLangFromAttr :: PandocMonad m => Attr -> OD m a -> OD m a withLangFromAttr (_,_,kvs) action = case lookup "lang" kvs of Nothing -> action - Just l -> do + Just l -> case parseBCP47 l of Right lang -> withTextStyle (Language lang) action Left _ -> do diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index cfbacdaed..aab8a3bf0 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -97,15 +97,14 @@ pandocToRST (Pandoc meta blocks) = do pics <- gets (reverse . stImages) >>= pictRefsToRST hasMath <- gets stHasMath rawTeX <- gets stHasRawTeX - let main = render' $ foldl ($+$) empty $ [body, notes, refs, pics] + let main = render' $ foldl ($+$) empty [body, notes, refs, pics] let context = defField "body" main $ defField "toc" (writerTableOfContents opts) $ defField "toc-depth" (show $ writerTOCDepth opts) $ defField "math" hasMath $ defField "title" (render Nothing title :: String) $ defField "math" hasMath - $ defField "rawtex" rawTeX - $ metadata + $ defField "rawtex" rawTeX metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -126,7 +125,7 @@ refsToRST refs = mapM keyToRST refs >>= return . vcat keyToRST :: PandocMonad m => ([Inline], (String, String)) -> RST m Doc keyToRST (label, (src, _)) = do label' <- inlineListToRST label - let label'' = if ':' `elem` ((render Nothing label') :: String) + let label'' = if ':' `elem` (render Nothing label' :: String) then char '`' <> label' <> char '`' else label' return $ nowrap $ ".. _" <> label'' <> ": " <> text src @@ -134,7 +133,7 @@ keyToRST (label, (src, _)) = do -- | Return RST representation of notes. notesToRST :: PandocMonad m => [[Block]] -> RST m Doc notesToRST notes = - mapM (\(num, note) -> noteToRST num note) (zip [1..] notes) >>= + mapM (uncurry noteToRST) (zip [1..] notes) >>= return . vsep -- | Return RST representation of a note. @@ -226,7 +225,7 @@ blockToRST (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do else ":figclass: " <> text (unwords cls) return $ hang 3 ".. " (fig $$ alt $$ classes $$ dims $+$ capt) $$ blankline blockToRST (Para inlines) - | LineBreak `elem` inlines = do -- use line block if LineBreaks + | LineBreak `elem` inlines = linesToLineBlock $ splitBy (==LineBreak) inlines | otherwise = do contents <- inlineListToRST inlines @@ -237,7 +236,7 @@ blockToRST (RawBlock f@(Format f') str) | f == "rst" = return $ text str | otherwise = return $ blankline <> ".. raw:: " <> text (map toLower f') $+$ - (nest 3 $ text str) $$ blankline + nest 3 (text str) $$ blankline blockToRST HorizontalRule = return $ blankline $$ "--------------" $$ blankline blockToRST (Header level (name,classes,_) inlines) = do @@ -279,7 +278,7 @@ blockToRST (CodeBlock (_,classes,kvs) str) = do blockToRST (BlockQuote blocks) = do tabstop <- gets $ writerTabStop . stOptions contents <- blockListToRST blocks - return $ (nest tabstop contents) <> blankline + return $ nest tabstop contents <> blankline blockToRST (Table caption aligns widths headers rows) = do caption' <- inlineListToRST caption let blocksToDoc opts bs = do @@ -302,13 +301,13 @@ blockToRST (BulletList items) = do return $ blankline $$ chomp (vcat contents) $$ blankline blockToRST (OrderedList (start, style', delim) items) = do let markers = if start == 1 && style' == DefaultStyle && delim == DefaultDelim - then take (length items) $ repeat "#." + then replicate (length items) "#." else take (length items) $ orderedListMarkers (start, style', delim) let maxMarkerLength = maximum $ map length markers let markers' = map (\m -> let s = maxMarkerLength - length m in m ++ replicate s ' ') markers - contents <- mapM (\(item, num) -> orderedListItemToRST item num) $ + contents <- mapM (uncurry orderedListItemToRST) $ zip markers' items -- ensure that sublists have preceding blank line return $ blankline $$ chomp (vcat contents) $$ blankline @@ -345,7 +344,8 @@ definitionListItemToRST (label, defs) = do linesToLineBlock :: PandocMonad m => [[Inline]] -> RST m Doc linesToLineBlock inlineLines = do lns <- mapM inlineListToRST inlineLines - return $ (vcat $ map (hang 2 (text "| ")) lns) <> blankline + return $ + vcat (map (hang 2 (text "| ")) lns) <> blankline -- | Convert list of Pandoc block elements to RST. blockListToRST' :: PandocMonad m @@ -397,7 +397,7 @@ inlineListToRST lst = removeSpaceAfterDisplayMath [] = [] insertBS :: [Inline] -> [Inline] -- insert '\ ' where needed insertBS (x:y:z:zs) - | isComplex y && (surroundComplex x z) = + | isComplex y && surroundComplex x z = x : y : insertBS (z : zs) insertBS (x:y:zs) | isComplex x && not (okAfterComplex y) = @@ -437,8 +437,8 @@ inlineListToRST lst = isComplex (Strikeout _) = True isComplex (Superscript _) = True isComplex (Subscript _) = True - isComplex (Link _ _ _) = True - isComplex (Image _ _ _) = True + isComplex (Link{}) = True + isComplex (Image{}) = True isComplex (Code _ _) = True isComplex (Math _ _) = True isComplex (Cite _ (x:_)) = isComplex x @@ -512,7 +512,7 @@ inlineToRST il@(RawInline f x) modify $ \st -> st{ stHasRawTeX = True } return $ ":raw-latex:`" <> text x <> "`" | otherwise = empty <$ report (InlineNotRendered il) -inlineToRST (LineBreak) = return cr -- there's no line break in RST (see Para) +inlineToRST LineBreak = return cr -- there's no line break in RST (see Para) inlineToRST Space = return space inlineToRST SoftBreak = do wrapText <- gets $ writerWrapText . stOptions @@ -540,7 +540,7 @@ inlineToRST (Link _ txt (src, tit)) = do Just (src',tit') -> if src == src' && tit == tit' then return $ "`" <> linktext <> "`_" - else do -- duplicate label, use non-reference link + else return $ "`" <> linktext <> " <" <> text src <> ">`__" Nothing -> do modify $ \st -> st { stLinks = (txt,(src,tit)):refs } @@ -553,7 +553,7 @@ inlineToRST (Note contents) = do -- add to notes in state notes <- gets stNotes modify $ \st -> st { stNotes = contents:notes } - let ref = show $ (length notes) + 1 + let ref = show $ length notes + 1 return $ " [" <> text ref <> "]_" registerImage :: PandocMonad m => Attr -> [Inline] -> Target -> Maybe String -> RST m Doc @@ -578,7 +578,7 @@ imageDimsToRST attr = do then empty else ":name: " <> text ident showDim dir = let cols d = ":" <> text (show dir) <> ": " <> text (show d) - in case (dimension dir attr) of + in case dimension dir attr of Just (Percent a) -> case dir of Height -> empty diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 2b05f2f7e..917fef3eb 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -113,7 +113,7 @@ writeRTF options doc = do $ metamap metadata <- metaToJSON options (fmap concat . mapM (blockToRTF 0 AlignDefault)) - (inlinesToRTF) + inlinesToRTF meta' body <- blocksToRTF 0 AlignDefault blocks let isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options @@ -121,14 +121,13 @@ writeRTF options doc = do toc <- tableOfContents $ filter isTOCHeader blocks let context = defField "body" body $ defField "spacer" spacer - $ (if writerTableOfContents options - then defField "table-of-contents" toc - -- for backwards compatibility, - -- we populate toc with the contents - -- of the toc rather than a boolean: - . defField "toc" toc - else id) - $ metadata + $(if writerTableOfContents options + then defField "table-of-contents" toc + -- for backwards compatibility, + -- we populate toc with the contents + -- of the toc rather than a boolean: + . defField "toc" toc + else id) metadata T.pack <$> case writerTemplate options of Just tpl -> renderTemplate' tpl context @@ -141,12 +140,12 @@ writeRTF options doc = do tableOfContents :: PandocMonad m => [Block] -> m String tableOfContents headers = do let contents = map elementToListItem $ hierarchicalize headers - blocksToRTF 0 AlignDefault $ + blocksToRTF 0 AlignDefault [Header 1 nullAttr [Str "Contents"], BulletList contents] elementToListItem :: Element -> [Block] elementToListItem (Blk _) = [] -elementToListItem (Sec _ _ _ sectext subsecs) = [Plain sectext] ++ +elementToListItem (Sec _ _ _ sectext subsecs) = Plain sectext : if null subsecs then [] else [BulletList (map elementToListItem subsecs)] @@ -163,11 +162,11 @@ handleUnicode (c:cs) = lower = r + 0xDC00 in enc (chr upper) ++ enc (chr lower) ++ handleUnicode cs else enc c ++ handleUnicode cs - else c:(handleUnicode cs) + else c:handleUnicode cs where surrogate x = not ( (0x0000 <= ord x && ord x <= 0xd7ff) || (0xe000 <= ord x && ord x <= 0xffff) ) - enc x = '\\':'u':(show (ord x)) ++ "?" + enc x = '\\':'u':show (ord x) ++ "?" -- | Escape special characters. escapeSpecial :: String -> String @@ -203,8 +202,8 @@ rtfParSpaced spaceAfter indent firstLineIndent alignment content = AlignCenter -> "\\qc " AlignDefault -> "\\ql " in "{\\pard " ++ alignString ++ - "\\f0 \\sa" ++ (show spaceAfter) ++ " \\li" ++ (show indent) ++ - " \\fi" ++ (show firstLineIndent) ++ " " ++ content ++ "\\par}\n" + "\\f0 \\sa" ++ show spaceAfter ++ " \\li" ++ show indent ++ + " \\fi" ++ show firstLineIndent ++ " " ++ content ++ "\\par}\n" -- | Default paragraph. rtfPar :: Int -- ^ block indent (in twips) @@ -269,7 +268,7 @@ blockToRTF indent alignment (LineBlock lns) = blockToRTF indent alignment (BlockQuote lst) = blocksToRTF (indent + indentIncrement) alignment lst blockToRTF indent _ (CodeBlock _ str) = - return $ rtfPar indent 0 AlignLeft ("\\f1 " ++ (codeStringToRTF str)) + return $ rtfPar indent 0 AlignLeft ("\\f1 " ++ codeStringToRTF str) blockToRTF _ _ b@(RawBlock f str) | f == Format "rtf" = return str | otherwise = do @@ -279,7 +278,7 @@ blockToRTF indent alignment (BulletList lst) = (spaceAtEnd . concat) <$> mapM (listItemToRTF alignment indent (bulletMarker indent)) lst blockToRTF indent alignment (OrderedList attribs lst) = (spaceAtEnd . concat) <$> - mapM (\(x,y) -> listItemToRTF alignment indent x y) + mapM (uncurry (listItemToRTF alignment indent)) (zip (orderedMarkers indent attribs) lst) blockToRTF indent alignment (DefinitionList lst) = (spaceAtEnd . concat) <$> mapM (definitionListItemToRTF alignment indent) lst @@ -288,7 +287,7 @@ blockToRTF indent _ HorizontalRule = return $ blockToRTF indent alignment (Header level _ lst) = do contents <- inlinesToRTF lst return $ rtfPar indent 0 alignment $ - "\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ contents + "\\b \\fs" ++ show (40 - (level * 4)) ++ " " ++ contents blockToRTF indent alignment (Table caption aligns sizes headers rows) = do caption' <- inlinesToRTF caption header' <- if all null headers @@ -302,9 +301,9 @@ tableRowToRTF :: PandocMonad m tableRowToRTF header indent aligns sizes' cols = do let totalTwips = 6 * 1440 -- 6 inches let sizes = if all (== 0) sizes' - then take (length cols) $ repeat (1.0 / fromIntegral (length cols)) + then replicate (length cols) (1.0 / fromIntegral (length cols)) else sizes' - columns <- concat <$> mapM (\(x,y) -> tableItemToRTF indent x y) + columns <- concat <$> mapM (uncurry (tableItemToRTF indent)) (zip aligns cols) let rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips)) (0 :: Integer) sizes @@ -326,8 +325,8 @@ tableItemToRTF indent alignment item = do -- lists as after regular lists. spaceAtEnd :: String -> String spaceAtEnd str = - if isSuffixOf "\\par}\n" str - then (take ((length str) - 6) str) ++ "\\sa180\\par}\n" + if "\\par}\n" `isSuffixOf` str + then take ((length str) - 6) str ++ "\\sa180\\par}\n" else str -- | Convert list item (list of blocks) to RTF. @@ -338,11 +337,11 @@ listItemToRTF :: PandocMonad m -> [Block] -- ^ list item (list of blocks) -> m String listItemToRTF alignment indent marker [] = return $ - rtfCompact (indent + listIncrement) (0 - listIncrement) alignment - (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ") + rtfCompact (indent + listIncrement) (negate listIncrement) alignment + (marker ++ "\\tx" ++ show listIncrement ++ "\\tab ") listItemToRTF alignment indent marker list = do (first:rest) <- mapM (blockToRTF (indent + listIncrement) alignment) list - let listMarker = "\\fi" ++ show (0 - listIncrement) ++ " " ++ marker ++ + let listMarker = "\\fi" ++ show (negate listIncrement) ++ " " ++ marker ++ "\\tx" ++ show listIncrement ++ "\\tab" let insertListMarker ('\\':'f':'i':'-':d:xs) | isDigit d = listMarker ++ dropWhile isDigit xs @@ -400,7 +399,7 @@ inlineToRTF (Quoted SingleQuote lst) = do inlineToRTF (Quoted DoubleQuote lst) = do contents <- inlinesToRTF lst return $ "\\u8220\"" ++ contents ++ "\\u8221\"" -inlineToRTF (Code _ str) = return $ "{\\f1 " ++ (codeStringToRTF str) ++ "}" +inlineToRTF (Code _ str) = return $ "{\\f1 " ++ codeStringToRTF str ++ "}" inlineToRTF (Str str) = return $ stringToRTF str inlineToRTF (Math t str) = texMathToInlines t str >>= inlinesToRTF inlineToRTF (Cite _ lst) = inlinesToRTF lst @@ -409,12 +408,12 @@ inlineToRTF il@(RawInline f str) | otherwise = do return $ InlineNotRendered il return "" -inlineToRTF (LineBreak) = return "\\line " +inlineToRTF LineBreak = return "\\line " inlineToRTF SoftBreak = return " " inlineToRTF Space = return " " inlineToRTF (Link _ text (src, _)) = do contents <- inlinesToRTF text - return $ "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++ + return $ "{\\field{\\*\\fldinst{HYPERLINK \"" ++ codeStringToRTF src ++ "\"}}{\\fldrslt{\\ul\n" ++ contents ++ "\n}}}\n" inlineToRTF (Image _ _ (source, _)) = return $ "{\\cf1 [image: " ++ source ++ "]\\cf0}" diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 8f1a06688..0b951b0c9 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -268,19 +268,19 @@ gridTable opts blocksToDoc headless aligns widths headers rows = do else handleGivenWidths widths let hpipeBlocks blocks = hcat [beg, middle, end] where h = maximum (1 : map height blocks) - sep' = lblock 3 $ vcat (map text $ replicate h " | ") - beg = lblock 2 $ vcat (map text $ replicate h "| ") - end = lblock 2 $ vcat (map text $ replicate h " |") + sep' = lblock 3 $ vcat (replicate h (text " | ")) + beg = lblock 2 $ vcat (replicate h (text "| ")) + end = lblock 2 $ vcat (replicate h (text " |")) middle = chomp $ hcat $ intersperse sep' blocks let makeRow = hpipeBlocks . zipWith lblock widthsInChars let head' = makeRow rawHeaders let rows' = map (makeRow . map chomp) rawRows let borderpart ch align widthInChars = - (if (align == AlignLeft || align == AlignCenter) + (if align == AlignLeft || align == AlignCenter then char ':' else char ch) <> text (replicate widthInChars ch) <> - (if (align == AlignRight || align == AlignCenter) + (if align == AlignRight || align == AlignCenter then char ':' else char ch) let border ch aligns' widthsInChars' = diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs index dfdb443a2..aa87c55e1 100644 --- a/src/Text/Pandoc/Writers/TEI.hs +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -79,10 +79,10 @@ writeTEI opts (Pandoc meta blocks) = do meta' main <- (render' . vcat) <$> mapM (elementToTEI opts startLvl) elements let context = defField "body" main - $ defField "mathml" (case writerHTMLMathMethod opts of - MathML -> True - _ -> False) - $ metadata + $ + defField "mathml" (case writerHTMLMathMethod opts of + MathML -> True + _ -> False) metadata case writerTemplate opts of Nothing -> return main Just tpl -> renderTemplate' tpl context @@ -121,7 +121,7 @@ plainToPara x = x deflistItemsToTEI :: PandocMonad m => WriterOptions -> [([Inline],[[Block]])] -> m Doc deflistItemsToTEI opts items = - vcat <$> mapM (\(term, defs) -> deflistItemToTEI opts term defs) items + vcat <$> mapM (uncurry (deflistItemToTEI opts)) items -- | Convert a term and a list of blocks into a TEI varlistentry. deflistItemToTEI :: PandocMonad m @@ -146,7 +146,7 @@ imageToTEI _ attr src = return $ selfClosingTag "graphic" $ ("url", src) : idAndRole attr ++ dims where dims = go Width "width" ++ go Height "depth" - go dir dstr = case (dimension dir attr) of + go dir dstr = case dimension dir attr of Just a -> [(dstr, show a)] Nothing -> [] @@ -159,7 +159,7 @@ blockToTEI opts (Div (ident,_,_) [Para lst]) = do let attribs = [("id", ident) | not (null ident)] inTags False "p" attribs <$> inlinesToTEI opts lst blockToTEI opts (Div _ bs) = blocksToTEI opts $ map plainToPara bs -blockToTEI _ h@(Header _ _ _) = do +blockToTEI _ h@(Header{}) = do -- should not occur after hierarchicalize, except inside lists/blockquotes report $ BlockNotRendered h return empty @@ -214,7 +214,7 @@ blockToTEI opts (OrderedList (start, numstyle, _) (first:rest)) = do else do fi <- blocksToTEI opts $ map plainToPara first re <- listItemsToTEI opts rest - return $ (inTags True "item" [("n",show start)] fi) $$ re + return $ inTags True "item" [("n",show start)] fi $$ re return $ inTags True "list" attribs items blockToTEI opts (DefinitionList lst) = do let attribs = [("type", "definition")] @@ -295,28 +295,31 @@ inlineToTEI _ (Code _ str) = return $ inlineToTEI _ (Math t str) = return $ case t of InlineMath -> inTags False "formula" [("notation","TeX")] $ - text (str) + text str DisplayMath -> inTags True "figure" [("type","math")] $ - inTags False "formula" [("notation","TeX")] $ text (str) + inTags False "formula" [("notation","TeX")] $ text str inlineToTEI _ il@(RawInline f x) | f == "tei" = return $ text x | otherwise = empty <$ report (InlineNotRendered il) inlineToTEI _ LineBreak = return $ selfClosingTag "lb" [] -inlineToTEI _ Space = return $ space +inlineToTEI _ Space = + return space -- because we use \n for LineBreak, we can't do soft breaks: -inlineToTEI _ SoftBreak = return $ space +inlineToTEI _ SoftBreak = + return space inlineToTEI opts (Link attr txt (src, _)) | Just email <- stripPrefix "mailto:" src = do let emailLink = text $ - escapeStringForXML $ email + escapeStringForXML email case txt of - [Str s] | escapeURI s == email -> return $ emailLink + [Str s] | escapeURI s == email -> + return emailLink _ -> do linktext <- inlinesToTEI opts txt return $ linktext <+> char '(' <> emailLink <> char ')' | otherwise = - (if isPrefixOf "#" src + (if "#" `isPrefixOf` src then inTags False "ref" $ ("target", drop 1 src) : idAndRole attr else inTags False "ref" $ ("target", src) : idAndRole attr ) <$> inlinesToTEI opts txt diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 549d4f3d9..15dd2e3d9 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -71,7 +71,7 @@ type TI m = StateT WriterState m -- | Convert Pandoc to Texinfo. writeTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeTexinfo options document = - evalStateT (pandocToTexinfo options $ wrapTop document) $ + evalStateT (pandocToTexinfo options $ wrapTop document) WriterState { stStrikeout = False, stSuperscript = False, stEscapeComma = False, stSubscript = False, stIdentifiers = Set.empty, stOptions = options} @@ -102,8 +102,8 @@ pandocToTexinfo options (Pandoc meta blocks) = do $ defField "titlepage" titlePage $ defField "subscript" (stSubscript st) $ defField "superscript" (stSuperscript st) - $ defField "strikeout" (stStrikeout st) - $ metadata + $ + defField "strikeout" (stStrikeout st) metadata case writerTemplate options of Nothing -> return body Just tpl -> renderTemplate' tpl context @@ -166,11 +166,11 @@ blockToTexinfo (BlockQuote lst) = do contents $$ text "@end quotation" -blockToTexinfo (CodeBlock _ str) = do +blockToTexinfo (CodeBlock _ str) = return $ blankline $$ - text "@verbatim" $$ - flush (text str) $$ - text "@end verbatim" <> blankline + text "@verbatim" $$ + flush (text str) $$ + text "@end verbatim" <> blankline blockToTexinfo b@(RawBlock f str) | f == "texinfo" = return $ text str @@ -218,7 +218,7 @@ blockToTexinfo HorizontalRule = text "@bigskip@hrule@bigskip" $$ text "@end iftex" $$ text "@ifnottex" $$ - text (take 72 $ repeat '-') $$ + text (replicate 72 '-') $$ text "@end ifnottex" blockToTexinfo (Header 0 _ lst) = do @@ -339,8 +339,8 @@ blockListToTexinfo (x:xs) = do Para _ -> do xs' <- blockListToTexinfo xs case xs of - ((CodeBlock _ _):_) -> return $ x' $$ xs' - _ -> return $ x' $+$ xs' + (CodeBlock _ _:_) -> return $ x' $$ xs' + _ -> return $ x' $+$ xs' _ -> do xs' <- blockListToTexinfo xs return $ x' $$ xs' @@ -437,7 +437,7 @@ inlineToTexinfo (Subscript lst) = do inlineToTexinfo (SmallCaps lst) = inlineListToTexinfo lst >>= return . inCmd "sc" -inlineToTexinfo (Code _ str) = do +inlineToTexinfo (Code _ str) = return $ text $ "@code{" ++ stringToTexinfo str ++ "}" inlineToTexinfo (Quoted SingleQuote lst) = do @@ -459,7 +459,7 @@ inlineToTexinfo il@(RawInline f str) | otherwise = do report $ InlineNotRendered il return empty -inlineToTexinfo (LineBreak) = return $ text "@*" <> cr +inlineToTexinfo LineBreak = return $ text "@*" <> cr inlineToTexinfo SoftBreak = do wrapText <- gets (writerWrapText . stOptions) case wrapText of @@ -472,7 +472,7 @@ inlineToTexinfo (Link _ txt (src@('#':_), _)) = do contents <- escapeCommas $ inlineListToTexinfo txt return $ text "@ref" <> braces (text (stringToTexinfo src) <> text "," <> contents) -inlineToTexinfo (Link _ txt (src, _)) = do +inlineToTexinfo (Link _ txt (src, _)) = case txt of [Str x] | escapeURI x == src -> -- autolink do return $ text $ "@url{" ++ x ++ "}" @@ -484,7 +484,7 @@ inlineToTexinfo (Link _ txt (src, _)) = do inlineToTexinfo (Image attr alternate (source, _)) = do content <- escapeCommas $ inlineListToTexinfo alternate opts <- gets stOptions - let showDim dim = case (dimension dim attr) of + let showDim dim = case dimension dim attr of (Just (Pixel a)) -> showInInch opts (Pixel a) ++ "in" (Just (Percent _)) -> "" (Just d) -> show d diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 5ee9d3250..11fb2ae12 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -297,7 +297,7 @@ definitionListItemToTextile opts (label, items) = do labelText <- inlineListToTextile opts label contents <- mapM (blockListToTextile opts) items return $ "<dt>" ++ labelText ++ "</dt>\n" ++ - (intercalate "\n" $ map (\d -> "<dd>" ++ d ++ "</dd>") contents) + intercalate "\n" (map (\d -> "<dd>" ++ d ++ "</dd>") contents) -- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed. isSimpleList :: Block -> Bool @@ -350,7 +350,7 @@ tableRowToTextile opts alignStrings rownum cols' = do 0 -> "header" x | x `rem` 2 == 1 -> "odd" _ -> "even" - cols'' <- sequence $ zipWith + cols'' <- zipWithM (\alignment item -> tableItemToTextile opts celltype alignment item) alignStrings cols' return $ "<tr class=\"" ++ rowclass ++ "\">\n" ++ unlines cols'' ++ "</tr>" @@ -483,7 +483,7 @@ inlineToTextile opts (Image attr@(_, cls, _) alt (source, tit)) = do then "" else "(" ++ unwords cls ++ ")" showDim dir = let toCss str = Just $ show dir ++ ":" ++ str ++ ";" - in case (dimension dir attr) of + in case dimension dir attr of Just (Percent a) -> toCss $ show (Percent a) Just dim -> toCss $ showInPixel opts dim ++ "px" Nothing -> Nothing diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs index 67dcd72d1..29849aa51 100644 --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -37,6 +37,7 @@ import Control.Monad.State.Strict (StateT, evalStateT, gets, modify) import Data.Default (Default (..)) import Data.List (intercalate, isInfixOf, isPrefixOf, transpose) import qualified Data.Map as Map +import Data.Maybe (fromMaybe) import Data.Text (Text, breakOnAll, pack) import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Definition @@ -75,8 +76,7 @@ pandocToZimWiki opts (Pandoc meta blocks) = do --let header = "Content-Type: text/x-zim-wiki\nWiki-Format: zim 0.4\n" let main = body let context = defField "body" main - $ defField "toc" (writerTableOfContents opts) - $ metadata + $ defField "toc" (writerTableOfContents opts) metadata case writerTemplate opts of Just tpl -> renderTemplate' tpl context Nothing -> return main @@ -118,12 +118,12 @@ blockToZimWiki opts (Para inlines) = do contents <- inlineListToZimWiki opts inlines return $ contents ++ if null indent then "\n" else "" -blockToZimWiki opts (LineBlock lns) = do +blockToZimWiki opts (LineBlock lns) = blockToZimWiki opts $ linesToPara lns blockToZimWiki opts b@(RawBlock f str) | f == Format "zimwiki" = return str - | f == Format "html" = do cont <- indentFromHTML opts str; return cont + | f == Format "html" = indentFromHTML opts str | otherwise = do report $ BlockNotRendered b return "" @@ -142,9 +142,7 @@ blockToZimWiki _ (CodeBlock (_,classes,_) str) = do return $ case classes of [] -> "'''\n" ++ cleanupCode str ++ "\n'''\n" -- turn no lang block into a quote block (x:_) -> "{{{code: lang=\"" ++ - (case Map.lookup x langmap of - Nothing -> x - Just y -> y) ++ "\" linenumbers=\"True\"\n" ++ str ++ "\n}}}\n" -- for zim's code plugin, go verbatim on the lang spec + (fromMaybe x (Map.lookup x langmap)) ++ "\" linenumbers=\"True\"\n" ++ str ++ "\n}}}\n" -- for zim's code plugin, go verbatim on the lang spec blockToZimWiki opts (BlockQuote blocks) = do contents <- blockListToZimWiki opts blocks @@ -157,12 +155,12 @@ blockToZimWiki opts (Table capt aligns _ headers rows) = do c <- inlineListToZimWiki opts capt return $ "" ++ c ++ "\n" headers' <- if all null headers - then zipWithM (tableItemToZimWiki opts) aligns (rows !! 0) - else mapM (inlineListToZimWiki opts) (map removeFormatting headers) -- emphasis, links etc. are not allowed in table headers + 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 length) $ transpose (headers':rows') let padTo (width, al) s = - case (width - length s) of + case width - length s of x | x > 0 -> if al == AlignLeft || al == AlignDefault then s ++ replicate x ' ' @@ -171,14 +169,11 @@ blockToZimWiki opts (Table capt aligns _ headers rows) = do else replicate (x `div` 2) ' ' ++ s ++ replicate (x - x `div` 2) ' ' | otherwise -> s - let borderCell (width, al) _ = - if al == AlignLeft - then ":"++ replicate (width-1) '-' - else if al == AlignDefault - then replicate width '-' - else if al == AlignRight - then replicate (width-1) '-' ++ ":" - else ":" ++ replicate (width-2) '-' ++ ":" + let borderCell (width, al) _ + | al == AlignLeft = ":"++ replicate (width-1) '-' + | al == AlignDefault = replicate width '-' + | al == AlignRight = replicate (width-1) '-' ++ ":" + | otherwise = ":" ++ replicate (width-2) '-' ++ ":" let underheader = "|" ++ intercalate "|" (zipWith borderCell (zip widths aligns) headers') ++ "|" let renderRow cells = "|" ++ intercalate "|" (zipWith padTo (zip widths aligns) cells) ++ "|" return $ captionDoc ++ @@ -188,19 +183,19 @@ blockToZimWiki opts (Table capt aligns _ headers rows) = do blockToZimWiki opts (BulletList items) = do indent <- gets stIndent modify $ \s -> s { stIndent = stIndent s ++ "\t" } - contents <- (mapM (listItemToZimWiki opts) items) + contents <- mapM (listItemToZimWiki opts) items modify $ \s -> s{ stIndent = indent } -- drop 1 (stIndent s) } return $ vcat contents ++ if null indent then "\n" else "" blockToZimWiki opts (OrderedList _ items) = do indent <- gets stIndent modify $ \s -> s { stIndent = stIndent s ++ "\t", stItemNum = 1 } - contents <- (mapM (orderedListItemToZimWiki opts) items) + contents <- mapM (orderedListItemToZimWiki opts) items modify $ \s -> s{ stIndent = indent } -- drop 1 (stIndent s) } return $ vcat contents ++ if null indent then "\n" else "" blockToZimWiki opts (DefinitionList items) = do - contents <- (mapM (definitionListItemToZimWiki opts) items) + contents <- mapM (definitionListItemToZimWiki opts) items return $ vcat contents definitionListItemToZimWiki :: PandocMonad m @@ -218,19 +213,19 @@ indentFromHTML :: PandocMonad m => WriterOptions -> String -> ZW m String indentFromHTML _ str = do indent <- gets stIndent itemnum <- gets stItemNum - if isInfixOf "<li>" str then return $ indent ++ show itemnum ++ "." - else if isInfixOf "</li>" str then return "\n" - else if isInfixOf "<li value=" str then do + if "<li>" `isInfixOf` str then return $ indent ++ show itemnum ++ "." + else if "</li>" `isInfixOf` str then return "\n" + else if "<li value=" `isInfixOf` str then do -- poor man's cut let val = drop 10 $ reverse $ drop 1 $ reverse str --let val = take ((length valls) - 2) valls modify $ \s -> s { stItemNum = read val } return "" - else if isInfixOf "<ol>" str then do + else if "<ol>" `isInfixOf` str then do let olcount=countSubStrs "<ol>" str modify $ \s -> s { stIndent = stIndent s ++ replicate olcount '\t', stItemNum = 1 } return "" - else if isInfixOf "</ol>" str then do + else if "</ol>" `isInfixOf` str then do let olcount=countSubStrs "/<ol>" str modify $ \s -> s{ stIndent = drop olcount (stIndent s) } return "" @@ -286,7 +281,7 @@ blockListToZimWiki opts blocks = vcat <$> mapM (blockToZimWiki opts) blocks -- | Convert list of Pandoc inline elements to ZimWiki. inlineListToZimWiki :: PandocMonad m => WriterOptions -> [Inline] -> ZW m String -inlineListToZimWiki opts lst = concat <$> (mapM (inlineToZimWiki opts) lst) +inlineListToZimWiki opts lst = concat <$> mapM (inlineToZimWiki opts) lst -- | Convert Pandoc inline element to ZimWiki. inlineToZimWiki :: PandocMonad m @@ -335,7 +330,7 @@ inlineToZimWiki _ (Str str) = do then return $ substitute "|" "\\|" . escapeString $ str else if inLink - then return $ str + then return str else return $ escapeString str inlineToZimWiki _ (Math mathType str) = return $ delim ++ str ++ delim -- note: str should NOT be escaped @@ -346,7 +341,7 @@ inlineToZimWiki _ (Math mathType str) = return $ delim ++ str ++ delim -- note -- | f == Format "html" = return $ "<html>" ++ str ++ "</html>" inlineToZimWiki opts il@(RawInline f str) | f == Format "zimwiki" = return str - | f == Format "html" = do cont <- indentFromHTML opts str; return cont + | f == Format "html" = indentFromHTML opts str | otherwise = do report $ InlineNotRendered il return "" |