diff options
Diffstat (limited to 'src/Text')
32 files changed, 188 insertions, 192 deletions
diff --git a/src/Text/Pandoc/CSS.hs b/src/Text/Pandoc/CSS.hs index 41be1ea13..d44b5e1e2 100644 --- a/src/Text/Pandoc/CSS.hs +++ b/src/Text/Pandoc/CSS.hs @@ -40,4 +40,4 @@ pickStylesToKVs props styleAttr = pickStyleAttrProps :: [String] -> String -> Maybe String pickStyleAttrProps lookupProps styleAttr = do styles <- eitherToMaybe $ parse styleAttrParser "" styleAttr - foldOrElse Nothing $ map (flip lookup styles) lookupProps + foldOrElse Nothing $ map (`lookup` styles) lookupProps diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs index cc72967e4..9c90b229e 100644 --- a/src/Text/Pandoc/Highlighting.hs +++ b/src/Text/Pandoc/Highlighting.hs @@ -81,12 +81,17 @@ highlight :: SyntaxMap -> Attr -- ^ Attributes of the CodeBlock -> String -- ^ Raw contents of the CodeBlock -> Either String a -highlight syntaxmap formatter (_, classes, keyvals) rawCode = +highlight syntaxmap formatter (ident, classes, keyvals) rawCode = let firstNum = fromMaybe 1 (safeRead (fromMaybe "1" $ lookup "startFrom" keyvals)) fmtOpts = defaultFormatOpts{ startNumber = firstNum, + lineAnchors = any (`elem` + ["line-anchors", "lineAnchors"]) classes, numberLines = any (`elem` - ["number","numberLines", "number-lines"]) classes } + ["number","numberLines", "number-lines"]) classes, + lineIdPrefix = if null ident + then mempty + else T.pack (ident ++ "-") } tokenizeOpts = TokenizerConfig{ syntaxMap = syntaxmap , traceOutput = False } classes' = map T.pack classes diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index 27d5c6a9c..b4206b84b 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 @@ -296,8 +301,8 @@ findpHYs x factor = if u == 1 -- dots per meter then \z -> z * 254 `div` 10000 else const 72 - in ( factor $ (shift x1 24) + (shift x2 16) + (shift x3 8) + x4, - factor $ (shift y1 24) + (shift y2 16) + (shift y3 8) + y4 ) + in ( factor $ shift x1 24 + shift x2 16 + shift x3 8 + x4, + factor $ shift y1 24 + shift y2 16 + shift y3 8 + y4 ) | otherwise = findpHYs $ B.drop 1 x -- read another byte gifSize :: ByteString -> Maybe ImageSize diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs index 4723c1119..7f4ae2ada 100644 --- a/src/Text/Pandoc/Logging.hs +++ b/src/Text/Pandoc/Logging.hs @@ -230,7 +230,7 @@ showLogMessage msg = "Skipped '" ++ s ++ "' at " ++ showPos pos CouldNotParseYamlMetadata s pos -> "Could not parse YAML metadata at " ++ showPos pos ++ - if null s then "" else (": " ++ s) + if null s then "" else ": " ++ s DuplicateLinkReference s pos -> "Duplicate link reference '" ++ s ++ "' at " ++ showPos pos DuplicateNoteReference s pos -> @@ -260,20 +260,20 @@ showLogMessage msg = "Docx parser warning: " ++ s CouldNotFetchResource fp s -> "Could not fetch resource '" ++ fp ++ "'" ++ - if null s then "" else (": " ++ s) + if null s then "" else ": " ++ s CouldNotDetermineImageSize fp s -> "Could not determine image size for '" ++ fp ++ "'" ++ - if null s then "" else (": " ++ s) + if null s then "" else ": " ++ s CouldNotConvertImage fp s -> "Could not convert image '" ++ fp ++ "'" ++ - if null s then "" else (": " ++ s) + if null s then "" else ": " ++ s CouldNotDetermineMimeType fp -> "Could not determine mime type for '" ++ fp ++ "'" CouldNotConvertTeXMath s m -> "Could not convert TeX math '" ++ s ++ "', rendering as TeX" ++ - if null m then "" else (':':'\n':m) + if null m then "" else ':' : '\n' : m CouldNotParseCSS m -> - "Could not parse CSS" ++ if null m then "" else (':':'\n':m) + "Could not parse CSS" ++ if null m then "" else ':' : '\n' : m Fetching fp -> "Fetching " ++ fp ++ "..." Extracting fp -> @@ -301,7 +301,7 @@ showLogMessage msg = "The term " ++ t ++ " has no translation defined." CouldNotLoadTranslations lang m -> "Could not load translations for " ++ lang ++ - if null m then "" else ('\n':m) + if null m then "" else '\n' : m messageVerbosity:: LogMessage -> Verbosity messageVerbosity msg = diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index 35c17c2ac..581f4c82a 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -261,4 +261,4 @@ instance Default WriterOptions where -- | Returns True if the given extension is enabled. isEnabled :: Extension -> WriterOptions -> Bool -isEnabled ext opts = ext `extensionEnabled` (writerExtensions opts) +isEnabled ext opts = ext `extensionEnabled` writerExtensions opts diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index a02034de4..61d3caf3d 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -188,12 +188,12 @@ where import Control.Monad.Identity import Control.Monad.Reader -import Data.Char (chr, isAlphaNum, isAscii, isHexDigit, isPunctuation, isSpace, +import Data.Char (chr, isAlphaNum, isAscii, isAsciiUpper, 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.Maybe (mapMaybe) import Data.Monoid ((<>)) import qualified Data.Set as Set import Data.Text (Text) @@ -354,7 +354,7 @@ oneOfStringsCI = oneOfStrings' ciMatch -- this optimizes toLower by checking common ASCII case -- first, before calling the expensive unicode-aware -- function: - toLower' c | c >= 'A' && c <= 'Z' = chr (ord c + 32) + toLower' c | isAsciiUpper c = chr (ord c + 32) | isAscii c = c | otherwise = toLower c @@ -497,19 +497,19 @@ romanNumeral upperCase = do lookAhead $ oneOf romanDigits let [one, five, ten, fifty, hundred, fivehundred, thousand] = map char romanDigits - thousands <- many thousand >>= (return . (1000 *) . length) + thousands <- ((1000 *) . length) <$> many thousand ninehundreds <- option 0 $ try $ hundred >> thousand >> return 900 - fivehundreds <- many fivehundred >>= (return . (500 *) . length) + fivehundreds <- ((500 *) . length) <$> many fivehundred fourhundreds <- option 0 $ try $ hundred >> fivehundred >> return 400 - hundreds <- many hundred >>= (return . (100 *) . length) + hundreds <- ((100 *) . length) <$> many hundred nineties <- option 0 $ try $ ten >> hundred >> return 90 - fifties <- many fifty >>= (return . (50 *) . length) + fifties <- ((50 *) . length) <$> many fifty forties <- option 0 $ try $ ten >> fifty >> return 40 - tens <- many ten >>= (return . (10 *) . length) + tens <- ((10 *) . length) <$> many ten nines <- option 0 $ try $ one >> ten >> return 9 - fives <- many five >>= (return . (5 *) . length) + fives <- ((5 *) . length) <$> many five fours <- option 0 $ try $ one >> five >> return 4 - ones <- many one >>= (return . length) + ones <- length <$> many one let total = thousands + ninehundreds + fivehundreds + fourhundreds + hundreds + nineties + fifties + forties + tens + nines + fives + fours + ones @@ -545,7 +545,7 @@ emailAddress = try $ toResult <$> mailbox <*> (char '@' *> domain) isEmailPunct c = c `elem` "!\"#$%&'*+-/=?^_{|}~;" -- note: sepBy1 from parsec consumes input when sep -- succeeds and p fails, so we use this variant here. - sepby1 p sep = (:) <$> p <*> (many (try $ sep >> p)) + sepby1 p sep = (:) <$> p <*> many (try $ sep >> p) uriScheme :: Stream s m Char => ParserT s st m String @@ -568,7 +568,7 @@ uri = try $ do let percentEscaped = try $ char '%' >> skipMany1 (satisfy isHexDigit) let entity = () <$ characterReference let punct = skipMany1 (char ',') - <|> () <$ (satisfy (\c -> not (isSpace c) && c /= '<' && c /= '>')) + <|> () <$ satisfy (\c -> not (isSpace c) && c /= '<' && c /= '>') let uriChunk = skipMany1 wordChar <|> percentEscaped <|> entity @@ -837,7 +837,7 @@ blankLineBlockLine = try (char '|' >> blankline) lineBlockLines :: Monad m => ParserT [Char] st m [String] lineBlockLines = try $ do lines' <- many1 (lineBlockLine <|> ((:[]) <$> blankLineBlockLine)) - skipMany $ blankline + skipMany blankline return lines' -- | Parse a table using 'headerParser', 'rowParser', @@ -868,10 +868,10 @@ tableWith' headerParser rowParser lineParser footerParser = try $ do lines' <- sequence <$> rowParser indices `sepEndBy1` lineParser footerParser numColumns <- getOption readerColumns - let widths = if (indices == []) + let widths = if null indices then replicate (length aligns) 0.0 else widthsFromIndices numColumns indices - return $ (aligns, widths, heads, lines') + return (aligns, widths, heads, lines') -- Calculate relative widths of table columns, based on indices widthsFromIndices :: Int -- Number of columns on terminal @@ -1271,7 +1271,7 @@ registerHeader (ident,classes,kvs) header' = do then do let id' = uniqueIdent (B.toList header') ids let id'' = if Ext_ascii_identifiers `extensionEnabled` exts - then catMaybes $ map toAsciiChar id' + then mapMaybe toAsciiChar id' else id' updateState $ updateIdentifierList $ Set.insert id' updateState $ updateIdentifierList $ Set.insert id'' @@ -1417,10 +1417,10 @@ a <+?> b = a >>= flip fmap (try b <|> return mempty) . (<>) extractIdClass :: Attr -> Attr extractIdClass (ident, cls, kvs) = (ident', cls', kvs') where - ident' = case (lookup "id" kvs) of + ident' = case lookup "id" kvs of Just v -> v Nothing -> ident - cls' = case (lookup "class" kvs) of + cls' = case lookup "class" kvs of Just cl -> words cl Nothing -> cls kvs' = filter (\(k,_) -> k /= "id" || k /= "class") kvs diff --git a/src/Text/Pandoc/Pretty.hs b/src/Text/Pandoc/Pretty.hs index ed6dde149..f95bfa8e0 100644 --- a/src/Text/Pandoc/Pretty.hs +++ b/src/Text/Pandoc/Pretty.hs @@ -357,7 +357,7 @@ mergeBlocks addSpace (IsBlock w1 lns1) (IsBlock w2 lns2) = | otherwise -> (lns1, lns2) pad n s = s ++ replicate (n - realLength s) ' ' sp "" = "" - sp xs = if addSpace then (' ' : xs) else xs + sp xs = if addSpace then ' ' : xs else xs offsetOf :: D -> Int offsetOf (Text o _) = o diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs index 6b864521f..47f4c4088 100644 --- a/src/Text/Pandoc/Readers/CommonMark.hs +++ b/src/Text/Pandoc/Readers/CommonMark.hs @@ -59,7 +59,7 @@ readCommonMark opts s = return $ -- | Returns True if the given extension is enabled. enabled :: Extension -> ReaderOptions -> Bool -enabled ext opts = ext `extensionEnabled` (readerExtensions opts) +enabled ext opts = ext `extensionEnabled` readerExtensions opts convertEmojis :: String -> String convertEmojis (':':xs) = 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/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 8d37deb26..2b667c63c 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -141,7 +141,7 @@ type TagParser m = HTMLParser m [Tag Text] pHtml :: PandocMonad m => TagParser m Blocks pHtml = try $ do - (TagOpen "html" attr) <- lookAhead $ pAnyTag + (TagOpen "html" attr) <- lookAhead pAnyTag for_ (lookup "lang" attr) $ updateState . B.setMeta "lang" . B.text . T.unpack pInTags "html" block @@ -152,7 +152,7 @@ pBody = pInTags "body" block pHead :: PandocMonad m => TagParser m Blocks pHead = pInTags "head" $ pTitle <|> pMetaTag <|> pBaseTag <|> (mempty <$ pAnyTag) where pTitle = pInTags "title" inline >>= setTitle . trimInlines - setTitle t = mempty <$ (updateState $ B.setMeta "title" t) + setTitle t = mempty <$ updateState (B.setMeta "title" t) pMetaTag = do mt <- pSatisfy (matchTagOpen "meta" []) let name = T.unpack $ fromAttrib "name" mt @@ -233,7 +233,7 @@ eFootnote :: PandocMonad m => TagParser m () eFootnote = try $ do let notes = ["footnote", "rearnote"] guardEnabled Ext_epub_html_exts - (TagOpen tag attr') <- lookAhead $ pAnyTag + (TagOpen tag attr') <- lookAhead pAnyTag let attr = toStringAttr attr' guard (maybe False (flip elem notes) (lookup "type" attr)) let ident = fromMaybe "" (lookup "id" attr) @@ -478,7 +478,7 @@ pTable = try $ do let pTh = option [] $ pInTags "tr" (pCell "th") pTr = try $ skipMany pBlank >> pInTags "tr" (pCell "td" <|> pCell "th") - pTBody = do pOptInTag "tbody" $ many1 pTr + pTBody = pOptInTag "tbody" $ many1 pTr head'' <- pOptInTag "thead" pTh head' <- map snd <$> (pOptInTag "tbody" $ @@ -1133,6 +1133,7 @@ htmlTag :: (HasReaderOptions st, Monad m) -> ParserT [Char] st m (Tag String, String) htmlTag f = try $ do lookAhead (char '<') + startpos <- getPosition inp <- getInput let ts = canonicalizeTags $ parseTagsOptions parseOptions{ optTagWarning = False @@ -1153,11 +1154,17 @@ htmlTag f = try $ do [] -> False (c:cs) -> isLetter c && all isNameChar cs - let endAngle = try $ do char '>' - pos <- getPosition - guard $ (sourceLine pos == ln && - sourceColumn pos >= col) || - sourceLine pos > ln + let endpos = if ln == 1 + then setSourceColumn startpos + (sourceColumn startpos + (col - 1)) + else setSourceColumn (setSourceLine startpos + (sourceLine startpos + (ln - 1))) + col + let endAngle = try $ + do char '>' + pos <- getPosition + guard $ pos >= endpos + let handleTag tagname = do -- basic sanity check, since the parser is very forgiving -- and finds tags in stuff like x<y) @@ -1172,8 +1179,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, "") @@ -1255,7 +1263,7 @@ renderTags' = renderTagsOptions renderOptions{ optMinimize = matchTags ["hr", "br", "img", "meta", "link"] , optRawTag = matchTags ["script", "style"] } - where matchTags = \tags -> flip elem tags . T.toLower + where matchTags tags = flip elem tags . T.toLower -- EPUB Specific diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index a982029af..9bac3d3a7 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -1132,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)) diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 2a88b39ec..8fc92f7e8 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -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) @@ -1409,7 +1419,7 @@ tableWith headerParser rowParser lineParser footerParser = try $ do lines' <- fmap sequence $ rowParser indices `sepEndBy1` lineParser footerParser numColumns <- getOption readerColumns - let widths = if indices == [] + let widths = if null indices then replicate (length aligns) 0.0 else widthsFromIndices numColumns indices return (aligns, widths, heads, lines') @@ -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) @@ -1998,7 +2006,7 @@ cite = do guardEnabled Ext_citations textualCite <|> do (cs, raw) <- withRaw normalCite - return $ (flip B.cite (B.text raw)) <$> cs + return $ flip B.cite (B.text raw) <$> cs textualCite :: PandocMonad m => MarkdownParser m (F Inlines) textualCite = try $ do @@ -2085,15 +2093,15 @@ citation = try $ do return $ do x <- pref y <- suff - return $ Citation{ citationId = key - , citationPrefix = B.toList x - , citationSuffix = B.toList y - , citationMode = if suppress_author - then SuppressAuthor - else NormalCitation - , citationNoteNum = 0 - , citationHash = 0 - } + return Citation{ citationId = key + , citationPrefix = B.toList x + , citationSuffix = B.toList y + , citationMode = if suppress_author + then SuppressAuthor + else NormalCitation + , citationNoteNum = 0 + , citationHash = 0 + } smart :: PandocMonad m => MarkdownParser m (F Inlines) smart = do diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs index 06b2dcaaa..73bed545e 100644 --- a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs @@ -82,7 +82,7 @@ tryModifyState f = ArrowState $ \(state,a) instance Cat.Category (ArrowState s) where id = ArrowState id - arrow2 . arrow1 = ArrowState $ (runArrowState arrow2).(runArrowState arrow1) + arrow2 . arrow1 = ArrowState $ runArrowState arrow2 . runArrowState arrow1 instance Arrow (ArrowState state) where arr = ignoringState diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index 44bd89278..4189d5aaa 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs +++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs @@ -293,7 +293,7 @@ withNewStyle a = proc x -> do modifier <- arr modifierFromStyleDiff -< triple fShouldTrace <- isStyleToTrace -< style case fShouldTrace of - Right shouldTrace -> do + Right shouldTrace -> if shouldTrace then do pushStyle -< style @@ -357,7 +357,7 @@ modifierFromStyleDiff propertyTriple = hasChangedM property triple@(_, textProps,_) = fromMaybe False $ (/=) <$> property textProps <*> lookupPreviousValueM property triple - lookupPreviousValue f = lookupPreviousStyleValue ((fmap f).textProperties) + lookupPreviousValue f = lookupPreviousStyleValue (fmap f . textProperties) lookupPreviousValueM f = lookupPreviousStyleValue ((f =<<).textProperties) @@ -803,9 +803,9 @@ read_frame_text_box = matchingElement NsDraw "text-box" arr read_img_with_caption -< toList paragraphs read_img_with_caption :: [Block] -> Inlines -read_img_with_caption ((Para ((Image attr alt (src,title)) : [])) : _) = +read_img_with_caption ((Para [Image attr alt (src,title)]) : _) = singleton (Image attr alt (src, 'f':'i':'g':':':title)) -- no text, default caption -read_img_with_caption ((Para ((Image attr _ (src,title)) : txt)) : _) = +read_img_with_caption (Para (Image attr _ (src,title) : txt) : _) = singleton (Image attr txt (src, 'f':'i':'g':':':title) ) -- override caption with the text that follows read_img_with_caption ( (Para (_ : xs)) : ys) = read_img_with_caption ((Para xs) : ys) diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index f8c2b8cb7..a3b4f2ff1 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -387,7 +387,7 @@ table = try $ do char '.' rawcapt <- trim <$> anyLine parseFromString' (mconcat <$> many inline) rawcapt - rawrows <- many1 $ (skipMany ignorableRow) >> tableRow + rawrows <- many1 $ skipMany ignorableRow >> tableRow skipMany ignorableRow blanklines let (headers, rows) = case rawrows of @@ -438,8 +438,7 @@ maybeExplicitBlock name blk = try $ do -- | Any inline element inline :: PandocMonad m => ParserT [Char] ParserState m Inlines -inline = do - choice inlineParsers <?> "inline" +inline = choice inlineParsers <?> "inline" -- | Inline parsers tried in order inlineParsers :: PandocMonad m => [ParserT [Char] ParserState m Inlines] @@ -610,7 +609,7 @@ escapedInline = escapedEqs <|> escapedTag escapedEqs :: PandocMonad m => ParserT [Char] ParserState m Inlines escapedEqs = B.str <$> - (try $ string "==" *> manyTill anyChar' (try $ string "==")) + try (string "==" *> manyTill anyChar' (try $ string "==")) -- | literal text escaped btw <notextile> tags escapedTag :: PandocMonad m => ParserT [Char] ParserState m Inlines @@ -643,7 +642,7 @@ code2 = do -- | Html / CSS attributes attributes :: PandocMonad m => ParserT [Char] ParserState m Attr -attributes = (foldl (flip ($)) ("",[],[])) <$> +attributes = foldl (flip ($)) ("",[],[]) <$> try (do special <- option id specialAttribute attrs <- many attribute return (special : attrs)) diff --git a/src/Text/Pandoc/Readers/TikiWiki.hs b/src/Text/Pandoc/Readers/TikiWiki.hs index ad35a6935..4a66cc13d 100644 --- a/src/Text/Pandoc/Readers/TikiWiki.hs +++ b/src/Text/Pandoc/Readers/TikiWiki.hs @@ -501,7 +501,7 @@ escapedChar = try $ do string "~" inner <- many1 $ oneOf "0123456789" string "~" - return $B.str [(toEnum ((read inner) :: Int)) :: Char] + return $B.str [(toEnum (read inner :: Int)) :: Char] -- UNSUPPORTED, as there doesn't seem to be any facility in calibre -- for this @@ -587,8 +587,7 @@ macroAttr = try $ do return (key, value) macroAttrs :: PandocMonad m => TikiWikiParser m [(String, String)] -macroAttrs = try $ do - sepEndBy macroAttr spaces +macroAttrs = try $ sepEndBy macroAttr spaces -- ~np~ __not bold__ ~/np~ noparse :: PandocMonad m => TikiWikiParser m B.Inlines @@ -641,8 +640,7 @@ wikiLinkText start middle end = do where linkContent = do char '|' - mystr <- many (noneOf middle) - return mystr + many (noneOf middle) externalLink :: PandocMonad m => TikiWikiParser m B.Inlines externalLink = makeLink "[" "]|" "]" diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index fdf7a827a..3fc54aaab 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -560,7 +560,7 @@ endline = try $ do notFollowedBy quote notFollowedBy list notFollowedBy table - return $ B.softbreak + return B.softbreak str :: T2T Inlines str = try $ do diff --git a/src/Text/Pandoc/SelfContained.hs b/src/Text/Pandoc/SelfContained.hs index d3b768109..7cdd6f6e1 100644 --- a/src/Text/Pandoc/SelfContained.hs +++ b/src/Text/Pandoc/SelfContained.hs @@ -124,6 +124,7 @@ convertTags (t@(TagOpen "link" as):ts) = rest Right (mime, bs) | "text/css" `isPrefixOf` mime + && null (fromAttrib "media" t) && not ("</" `B.isInfixOf` bs) -> do rest <- convertTags $ dropWhile (==TagClose "link") ts diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 60c8e1a0c..e0ea8b5e7 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -519,8 +519,8 @@ uniqueIdent title' usedIdents -- | True if block is a Header block. isHeaderBlock :: Block -> Bool -isHeaderBlock (Header{}) = True -isHeaderBlock _ = False +isHeaderBlock Header{} = True +isHeaderBlock _ = False -- | Shift header levels up or down. headerShift :: Int -> Pandoc -> Pandoc @@ -584,7 +584,7 @@ renderTags' = renderTagsOptions renderOptions{ optMinimize = matchTags ["hr", "br", "img", "meta", "link"] , optRawTag = matchTags ["script", "style"] } - where matchTags = \tags -> flip elem tags . map toLower + where matchTags tags = flip elem tags . map toLower -- -- File handling diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index bf58a755f..3231e1e30 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -219,7 +219,7 @@ blockToAsciiDoc opts (Table caption aligns widths headers rows) = do AlignCenter -> "^" AlignRight -> ">" AlignDefault -> "") ++ - if wi == 0 then "" else (show wi ++ "%") + if wi == 0 then "" else show wi ++ "%" let headerspec = if all null headers then empty else text "options=\"header\"," diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index cf96393ca..633f42442 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -64,7 +64,6 @@ data FbRenderState = FbRenderState { footnotes :: [ (Int, String, [Content]) ] -- ^ #, ID, text , imagesToFetch :: [ (String, String) ] -- ^ filename, URL or path , parentListMarker :: String -- ^ list marker of the parent ordered list - , parentBulletLevel :: Int -- ^ nesting level of the unordered list , writerOptions :: WriterOptions } deriving (Show) @@ -73,7 +72,7 @@ type FBM m = StateT FbRenderState m newFB :: FbRenderState newFB = FbRenderState { footnotes = [], imagesToFetch = [] - , parentListMarker = "", parentBulletLevel = 0 + , parentListMarker = "" , writerOptions = def } data ImageMode = NormalImage | InlineImage deriving (Eq) @@ -95,9 +94,9 @@ pandocToFB2 :: PandocMonad m pandocToFB2 opts (Pandoc meta blocks) = do modify (\s -> s { writerOptions = opts }) desc <- description meta - fp <- frontpage meta + title <- cMapM toXml . docTitle $ meta secs <- renderSections 1 blocks - let body = el "body" $ fp ++ secs + let body = el "body" $ el "title" (el "p" title) : secs notes <- renderFootnotes (imgs,missing) <- fmap imagesToFetch get >>= \s -> lift (fetchImages s) let body' = replaceImagesWithAlt missing body @@ -111,17 +110,9 @@ pandocToFB2 opts (Pandoc meta blocks) = do in [ uattr "xmlns" xmlns , attr ("xmlns", "l") xlink ] -frontpage :: PandocMonad m => Meta -> FBM m [Content] -frontpage meta' = do - t <- cMapM toXml . docTitle $ meta' - return - [ el "title" (el "p" t) - , el "annotation" (map (el "p" . cMap plain) - (docAuthors meta' ++ [docDate meta'])) - ] - description :: PandocMonad m => Meta -> FBM m Content description meta' = do + let genre = el "genre" "unrecognised" bt <- booktitle meta' let as = authors meta' dd <- docdate meta' @@ -131,7 +122,7 @@ description meta' = do _ -> [] where iso639 = takeWhile (/= '-') -- Convert BCP 47 to ISO 639 return $ el "description" - [ el "title-info" (bt ++ as ++ dd ++ lang) + [ el "title-info" (genre : (bt ++ as ++ dd ++ lang)) , el "document-info" [ el "program-used" "pandoc" ] -- FIXME: +version ] @@ -338,7 +329,7 @@ blockToXml (LineBlock lns) = blockToXml (OrderedList a bss) = do state <- get let pmrk = parentListMarker state - let markers = map (pmrk ++) $ orderedListMarkers a + let markers = (pmrk ++) <$> orderedListMarkers a let mkitem mrk bs = do modify (\s -> s { parentListMarker = mrk ++ " "}) item <- cMapM blockToXml $ plainToPara $ indentBlocks (mrk ++ " ") bs @@ -347,32 +338,21 @@ blockToXml (OrderedList a bss) = do concat <$> zipWithM mkitem markers bss blockToXml (BulletList bss) = do state <- get - let level = parentBulletLevel state let pmrk = parentListMarker state - let prefix = replicate (length pmrk) ' ' - let bullets = ["\x2022", "\x25e6", "*", "\x2043", "\x2023"] - let mrk = prefix ++ bullets !! (level `mod` length bullets) + let mrk = pmrk ++ "•" let mkitem bs = do - modify (\s -> s { parentBulletLevel = level+1 }) + modify (\s -> s { parentListMarker = mrk ++ " "}) item <- cMapM blockToXml $ plainToPara $ indentBlocks (mrk ++ " ") bs - modify (\s -> s { parentBulletLevel = level }) -- restore bullet level + modify (\s -> s { parentListMarker = pmrk }) -- old parent marker 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,14 +383,6 @@ 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) = - Plain inlines : Plain [LineBreak] : 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] diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index ffcde3ce7..1999bdbcf 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -101,6 +101,7 @@ data WriterState = WriterState , stHtml5 :: Bool -- ^ Use HTML5 , stEPUBVersion :: Maybe EPUBVersion -- ^ EPUB version if for epub , stSlideVariant :: HTMLSlideVariant + , stCodeBlockNum :: Int -- ^ Number of code block } defaultWriterState :: WriterState @@ -108,7 +109,8 @@ defaultWriterState = WriterState {stNotes= [], stMath = False, stQuotes = False, stHighlighting = False, stSecNum = [], stElement = False, stHtml5 = False, stEPUBVersion = Nothing, - stSlideVariant = NoSlides} + stSlideVariant = NoSlides, + stCodeBlockNum = 0} -- Helpers to render HTML with the appropriate function. @@ -438,7 +440,7 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen [] -> [] (x:xs) -> x ++ concatMap inDiv xs let inNl x = mconcat $ nl opts : intersperse (nl opts) x ++ [nl opts] - let classes' = ["titleslide" | titleSlide] ++ ["slide" | slide] ++ + let classes' = ["title-slide" | titleSlide] ++ ["slide" | slide] ++ ["section" | (slide || writerSectionDivs opts) && not html5 ] ++ ["level" ++ show level | slide || writerSectionDivs opts ] @@ -655,7 +657,7 @@ blockToHtml opts (LineBlock lns) = return $ H.div ! A.class_ "line-block" $ htmlLines blockToHtml opts (Div attr@(ident, classes, kvs') bs) = do html5 <- gets stHtml5 - let kvs = kvs' ++ + let kvs = [(k,v) | (k,v) <- kvs', k /= "width"] ++ if "column" `elem` classes then let w = fromMaybe "48%" (lookup "width" kvs') in [("style", "width:" ++ w ++ ";min-width:" ++ w ++ @@ -664,7 +666,12 @@ blockToHtml opts (Div attr@(ident, classes, kvs') bs) = do let speakerNotes = "notes" `elem` classes -- we don't want incremental output inside speaker notes, see #1394 let opts' = if speakerNotes then opts{ writerIncremental = False } else opts - contents <- blockListToHtml opts' bs + contents <- if "columns" `elem` classes + then -- we don't use blockListToHtml because it inserts + -- a newline between the column divs, which throws + -- off widths! see #4028 + mconcat <$> mapM (blockToHtml opts) bs + else blockListToHtml opts' bs let contents' = nl opts >> contents >> nl opts let (divtag, classes') = if html5 && "section" `elem` classes then (H5.section, filter (/= "section") classes) @@ -698,6 +705,12 @@ blockToHtml _ HorizontalRule = do html5 <- gets stHtml5 return $ if html5 then H5.hr else H.hr blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do + id'' <- if null id' + then do + modify $ \st -> st{ stCodeBlockNum = stCodeBlockNum st + 1 } + codeblocknum <- gets stCodeBlockNum + return ("cb" ++ show codeblocknum) + else return id' let tolhs = isEnabled Ext_literate_haskell opts && any (\c -> map toLower c == "haskell") classes && any (\c -> map toLower c == "literate") classes @@ -711,7 +724,7 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do else rawCode hlCode = if isJust (writerHighlightStyle opts) then highlight (writerSyntaxMap opts) formatHtmlBlock - (id',classes',keyvals) adjCode + (id'',classes',keyvals) adjCode else Left "" case hlCode of Left msg -> do @@ -720,7 +733,7 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do addAttrs opts (id',classes,keyvals) $ H.pre $ H.code $ toHtml adjCode Right h -> modify (\st -> st{ stHighlighting = True }) >> - addAttrs opts (id',[],keyvals) h + addAttrs opts (id'',[],keyvals) h blockToHtml opts (BlockQuote blocks) = do -- in S5, treat list in blockquote specially -- if default is incremental, make it nonincremental; @@ -1100,7 +1113,7 @@ inlineToHtml opts inline = do let link = H.a ! A.href (toValue $ "#" ++ revealSlash ++ writerIdentifierPrefix opts ++ "fn" ++ ref) - ! A.class_ "footnoteRef" + ! A.class_ "footnote-ref" ! prefixedId opts ("fnref" ++ ref) $ (if isJust epubVersion then id @@ -1120,7 +1133,7 @@ blockListToNote :: PandocMonad m => WriterOptions -> String -> [Block] -> StateT blockListToNote opts ref blocks = -- If last block is Para or Plain, include the backlink at the end of -- that block. Otherwise, insert a new Plain block with the backlink. - let backlink = [Link ("",["footnoteBack"],[]) [Str "↩"] ("#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref,[])] + let backlink = [Link ("",["footnote-back"],[]) [Str "↩"] ("#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref,[])] blocks' = if null blocks then [] else let lastBlock = last blocks diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 4afa23cb9..ba274fb59 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -204,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 (subListParName `isInfixOf` s) = [("BulletsAndNumberingListType", "NumberedList")] - | isBulletList && not (isInfixOf subListParName s) + | isBulletList && not (subListParName `isInfixOf` s) = [("BulletsAndNumberingListType", "BulletList")] | otherwise = [] indent = [("LeftIndent", show indt)] @@ -350,7 +350,7 @@ blockToICML opts style (Table caption aligns widths headers rows) = cells <- rowsToICML tabl (0::Int) let colWidths w = [("SingleColumnWidth",show $ 500 * w) | w > 0] - let tupToDoc tup = selfClosingTag "Column" $ ("Name",show $ fst tup) : (colWidths $ snd tup) + 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") diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index 2aac777c6..0ac37efba 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -37,7 +37,6 @@ import Data.Generics (everywhere, mkT) 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 -> (unwords (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 @@ -110,14 +85,12 @@ 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) (fmap render' . inlinesToJATS opts') - meta' + meta main <- (render' . vcat) <$> mapM (elementToJATS opts' startLvl) elements back <- (render' . vcat) <$> @@ -132,7 +105,7 @@ docToJATS opts (Pandoc meta blocks) = do 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')] @@ -144,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. @@ -155,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 (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 @@ -171,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 @@ -179,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" $ @@ -187,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]) = @@ -311,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 @@ -319,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 diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index ab1e90b3b..156af4bb2 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -371,6 +371,10 @@ toSlides bs = do 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 @@ -831,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' 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/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index fcd551227..390d7c3ba 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -116,8 +116,8 @@ pandocToODT opts doc@(Pandoc meta _) = do ,("manifest:version","1.2")] ( selfClosingTag "manifest:file-entry" [("manifest:media-type","application/vnd.oasis.opendocument.text") ,("manifest:full-path","/")] - $$ vcat ( map toFileEntry $ files ) - $$ vcat ( map toFileEntry $ formulas ) + $$ vcat ( map toFileEntry files ) + $$ vcat ( map toFileEntry formulas ) ) ) let archive' = addEntryToArchive manifestEntry archive diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index ac4a85670..702349636 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -572,7 +572,7 @@ paraStyle attrs = do t <- gets stTight let styleAttr = [ ("style:name" , "P" ++ show pn) , ("style:family" , "paragraph" )] - indentVal = flip (++) "in" . show $ if b then (max 0.5 i) else i + indentVal = flip (++) "in" . show $ if b then max 0.5 i else i tight = if t then [ ("fo:margin-top" , "0in" ) , ("fo:margin-bottom" , "0in" )] else [] diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index aab8a3bf0..42d4d0040 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -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 diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 917fef3eb..955b3f7f1 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -326,7 +326,7 @@ tableItemToRTF indent alignment item = do spaceAtEnd :: String -> String spaceAtEnd str = if "\\par}\n" `isSuffixOf` str - then take ((length str) - 6) str ++ "\\sa180\\par}\n" + then take (length str - 6) str ++ "\\sa180\\par}\n" else str -- | Convert list item (list of blocks) to RTF. diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs index aa87c55e1..8e9d155fa 100644 --- a/src/Text/Pandoc/Writers/TEI.hs +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -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 diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs index 29849aa51..30317db73 100644 --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -142,7 +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=\"" ++ - (fromMaybe x (Map.lookup x langmap)) ++ "\" 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 @@ -156,7 +156,7 @@ blockToZimWiki opts (Table capt aligns _ headers rows) = do return $ "" ++ c ++ "\n" headers' <- if all null headers then zipWithM (tableItemToZimWiki opts) aligns (head rows) - else mapM ((inlineListToZimWiki opts) . removeFormatting)headers -- emphasis, links etc. are not allowed in table headers + 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 = |