aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Extensions.hs2
-rw-r--r--src/Text/Pandoc/Lua/Filter.hs2
-rw-r--r--src/Text/Pandoc/Lua/Module/Pandoc.hs2
-rw-r--r--src/Text/Pandoc/Lua/Module/System.hs4
-rw-r--r--src/Text/Pandoc/Parsing.hs14
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs4
-rw-r--r--src/Text/Pandoc/Readers/Ipynb.hs2
-rw-r--r--src/Text/Pandoc/Readers/LaTeX.hs61
-rw-r--r--src/Text/Pandoc/Readers/Man.hs3
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs12
-rw-r--r--src/Text/Pandoc/Readers/Org/Blocks.hs2
-rw-r--r--src/Text/Pandoc/Readers/RST.hs2
-rw-r--r--src/Text/Pandoc/Readers/TikiWiki.hs4
-rw-r--r--src/Text/Pandoc/Writers/EPUB.hs14
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs1
-rw-r--r--src/Text/Pandoc/Writers/JATS.hs4
-rw-r--r--src/Text/Pandoc/Writers/Shared.hs6
17 files changed, 84 insertions, 55 deletions
diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs
index f85b23abd..6cb87eef6 100644
--- a/src/Text/Pandoc/Extensions.hs
+++ b/src/Text/Pandoc/Extensions.hs
@@ -227,7 +227,7 @@ plainExtensions = extensionsFromList
, Ext_strikeout
]
--- | Extensions to be used with github-flavored markdown.
+-- | Extensions to be used with PHP Markdown Extra.
phpMarkdownExtraExtensions :: Extensions
phpMarkdownExtraExtensions = extensionsFromList
[ Ext_footnotes
diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs
index 553dda8de..e8958347d 100644
--- a/src/Text/Pandoc/Lua/Filter.hs
+++ b/src/Text/Pandoc/Lua/Filter.hs
@@ -129,7 +129,7 @@ walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc
walkMWithLuaFilter f =
walkInlines f >=> walkBlocks f >=> walkMeta f >=> walkPandoc f
-mconcatMapM :: (Monad m, Functor m) => (a -> m [a]) -> [a] -> m [a]
+mconcatMapM :: (Monad m) => (a -> m [a]) -> [a] -> m [a]
mconcatMapM f = fmap mconcat . mapM f
hasOneOf :: LuaFilter -> [String] -> Bool
diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs
index 8f7653550..09892db49 100644
--- a/src/Text/Pandoc/Lua/Module/Pandoc.hs
+++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -46,7 +46,7 @@ pushModule datadir = do
LuaUtil.addFunction "walk_inline" walkInline
return 1
-walkElement :: (Pushable a, Walkable [Inline] a, Walkable [Block] a)
+walkElement :: (Walkable [Inline] a, Walkable [Block] a)
=> a -> LuaFilter -> Lua a
walkElement x f = walkInlines f x >>= walkBlocks f
diff --git a/src/Text/Pandoc/Lua/Module/System.hs b/src/Text/Pandoc/Lua/Module/System.hs
index 5149c2112..50db21244 100644
--- a/src/Text/Pandoc/Lua/Module/System.hs
+++ b/src/Text/Pandoc/Lua/Module/System.hs
@@ -27,8 +27,8 @@ pushModule = do
addField "arch" arch
addField "os" os
addFunction "environment" env
- addFunction "get_current_directory" getwd
+ addFunction "get_working_directory" getwd
addFunction "with_environment" with_env
- addFunction "with_temp_directory" with_tmpdir
+ addFunction "with_temporary_directory" with_tmpdir
addFunction "with_working_directory" with_wd
return 1
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 15349314f..49249bec8 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -313,8 +313,7 @@ many1Till p end = do
return (first:rest)
-- | Like @manyTill@, but also returns the result of end parser.
-manyUntil :: (Stream s m t)
- => ParserT s u m a
+manyUntil :: ParserT s u m a
-> ParserT s u m b
-> ParserT s u m ([a], b)
manyUntil p end = scan
@@ -328,8 +327,7 @@ manyUntil p end = scan
-- | Like @sepBy1@ from Parsec,
-- but does not fail if it @sep@ succeeds and @p@ fails.
-sepBy1' :: (Stream s m t)
- => ParsecT s u m a
+sepBy1' :: ParsecT s u m a
-> ParsecT s u m sep
-> ParsecT s u m [a]
sepBy1' p sep = (:) <$> p <*> many (try $ sep >> p)
@@ -440,7 +438,7 @@ stringAnyCase (x:xs) = do
return (firstChar:rest)
-- | Parse contents of 'str' using 'parser' and return result.
-parseFromString :: (Monad m, Stream s m Char, IsString s)
+parseFromString :: (Stream s m Char, IsString s)
=> ParserT s st m r
-> String
-> ParserT s st m r
@@ -458,7 +456,7 @@ parseFromString parser str = do
-- | Like 'parseFromString' but specialized for 'ParserState'.
-- This resets 'stateLastStrPos', which is almost always what we want.
-parseFromString' :: (Monad m, Stream s m Char, IsString s)
+parseFromString' :: (Stream s m Char, IsString s)
=> ParserT s ParserState m a
-> String
-> ParserT s ParserState m a
@@ -1019,7 +1017,7 @@ gridTableFooter = blanklines
---
-- | Removes the ParsecT layer from the monad transformer stack
-readWithM :: (Monad m, Stream s m Char, ToString s)
+readWithM :: (Stream s m Char, ToString s)
=> ParserT s st m a -- ^ parser
-> st -- ^ initial state
-> s -- ^ input
@@ -1410,7 +1408,7 @@ extractIdClass (ident, cls, kvs) = (ident', cls', kvs')
Nothing -> cls
kvs' = filter (\(k,_) -> k /= "id" || k /= "class") kvs
-insertIncludedFile' :: (PandocMonad m, HasIncludeFiles st, Monad mf)
+insertIncludedFile' :: (PandocMonad m, HasIncludeFiles st)
=> ParserT [a] st m (mf Blocks)
-> (String -> [a])
-> [FilePath] -> FilePath
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 78b377993..392530609 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -435,7 +435,7 @@ eSection = try $ do
TagOpen tag _ <- lookAhead $ pSatisfy sectTag
setInChapter (pInTags tag block)
-headerLevel :: PandocMonad m => Text -> TagParser m Int
+headerLevel :: Text -> TagParser m Int
headerLevel tagtype =
case safeRead (T.unpack (T.drop 1 tagtype)) of
Just level ->
@@ -1129,7 +1129,7 @@ _ `closes` _ = False
--- parsers for use in markdown, textile readers
-- | Matches a stretch of HTML in balanced tags.
-htmlInBalanced :: (HasReaderOptions st, Monad m)
+htmlInBalanced :: Monad m
=> (Tag String -> Bool)
-> ParserT String st m String
htmlInBalanced f = try $ do
diff --git a/src/Text/Pandoc/Readers/Ipynb.hs b/src/Text/Pandoc/Readers/Ipynb.hs
index 04e0b1595..dbca5a59f 100644
--- a/src/Text/Pandoc/Readers/Ipynb.hs
+++ b/src/Text/Pandoc/Readers/Ipynb.hs
@@ -53,7 +53,7 @@ readIpynb opts t = do
Right (notebook3 :: Notebook NbV3) -> notebookToPandoc opts notebook3
Left err -> throwError $ PandocIpynbDecodingError err
-notebookToPandoc :: (PandocMonad m, FromJSON (Notebook a))
+notebookToPandoc :: PandocMonad m
=> ReaderOptions -> Notebook a -> m Pandoc
notebookToPandoc opts notebook = do
let cells = notebookCells notebook
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs
index 6734bc32d..0202c1fc4 100644
--- a/src/Text/Pandoc/Readers/LaTeX.hs
+++ b/src/Text/Pandoc/Readers/LaTeX.hs
@@ -1379,7 +1379,7 @@ doref cls = do
""
(inBrackets $ str refstr)
-lookupListDefault :: (Show k, Ord k) => v -> [k] -> M.Map k v -> v
+lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
lookupListDefault d = (fromMaybe d .) . lookupList
where lookupList l m = msum $ map (`M.lookup` m) l
@@ -1502,12 +1502,15 @@ macroDef =
guardDisabled Ext_latex_macros <|>
updateState (\s -> s{ sMacros = M.insert name macro' (sMacros s) })
environmentDef = do
- (name, macro1, macro2) <- newenvironment
- guardDisabled Ext_latex_macros <|>
- do updateState $ \s -> s{ sMacros =
- M.insert name macro1 (sMacros s) }
- updateState $ \s -> s{ sMacros =
- M.insert ("end" <> name) macro2 (sMacros s) }
+ mbenv <- newenvironment
+ case mbenv of
+ Nothing -> return ()
+ Just (name, macro1, macro2) -> do
+ guardDisabled Ext_latex_macros <|>
+ do updateState $ \s -> s{ sMacros =
+ M.insert name macro1 (sMacros s) }
+ updateState $ \s -> s{ sMacros =
+ M.insert ("end" <> name) macro2 (sMacros s) }
-- @\newenvironment{envname}[n-args][default]{begin}{end}@
-- is equivalent to
-- @\newcommand{\envname}[n-args][default]{begin}@
@@ -1580,14 +1583,16 @@ newcommand = do
: (contents' ++
[ Tok pos Symbol "}", Tok pos Symbol "}" ])
_ -> contents'
- when (mtype == "newcommand") $ do
- macros <- sMacros <$> getState
- case M.lookup name macros of
- Just _ -> report $ MacroAlreadyDefined (T.unpack txt) pos
- Nothing -> return ()
- return (name, Macro ExpandWhenUsed argspecs optarg contents)
-
-newenvironment :: PandocMonad m => LP m (Text, Macro, Macro)
+ macros <- sMacros <$> getState
+ case M.lookup name macros of
+ Just macro
+ | mtype == "newcommand" -> do
+ report $ MacroAlreadyDefined (T.unpack txt) pos
+ return (name, macro)
+ | mtype == "providecommand" -> return (name, macro)
+ _ -> return (name, Macro ExpandWhenUsed argspecs optarg contents)
+
+newenvironment :: PandocMonad m => LP m (Maybe (Text, Macro, Macro))
newenvironment = do
pos <- getPosition
Tok _ (CtrlSeq mtype) _ <- controlSeq "newenvironment" <|>
@@ -1604,13 +1609,17 @@ newenvironment = do
let argspecs = map (\i -> ArgNum i) [1..numargs]
startcontents <- spaces >> bracedOrToken
endcontents <- spaces >> bracedOrToken
- when (mtype == "newenvironment") $ do
- macros <- sMacros <$> getState
- case M.lookup name macros of
- Just _ -> report $ MacroAlreadyDefined (T.unpack name) pos
- Nothing -> return ()
- return (name, Macro ExpandWhenUsed argspecs optarg startcontents,
- Macro ExpandWhenUsed [] Nothing endcontents)
+ macros <- sMacros <$> getState
+ case M.lookup name macros of
+ Just _
+ | mtype == "newenvironment" -> do
+ report $ MacroAlreadyDefined (T.unpack name) pos
+ return Nothing
+ | mtype == "provideenvironment" -> do
+ return Nothing
+ _ -> return $ Just (name,
+ Macro ExpandWhenUsed argspecs optarg startcontents,
+ Macro ExpandWhenUsed [] Nothing endcontents)
bracketedNum :: PandocMonad m => LP m Int
bracketedNum = do
@@ -1640,6 +1649,12 @@ looseItem = do
skipopts
return mempty
+epigraph :: PandocMonad m => LP m Blocks
+epigraph = do
+ p1 <- grouped blocks
+ p2 <- grouped blocks
+ return $ divWith ("", ["epigraph"], []) (p1 <> p2)
+
resetCaption :: PandocMonad m => LP m ()
resetCaption = updateState $ \st -> st{ sCaption = (Nothing, Nothing) }
@@ -1795,6 +1810,8 @@ blockCommands = M.fromList
, ("usepackage", include "usepackage")
-- preamble
, ("PackageError", mempty <$ (braced >> braced >> braced))
+ -- epigraph package
+ , ("epigraph", epigraph)
]
diff --git a/src/Text/Pandoc/Readers/Man.hs b/src/Text/Pandoc/Readers/Man.hs
index a9676c960..c21fd00c3 100644
--- a/src/Text/Pandoc/Readers/Man.hs
+++ b/src/Text/Pandoc/Readers/Man.hs
@@ -323,8 +323,7 @@ parseItalic [] = do
parseItalic args = return $
emph $ mconcat $ intersperse B.space $ map linePartsToInlines args
-parseAlternatingFonts :: PandocMonad m
- => [Inlines -> Inlines]
+parseAlternatingFonts :: [Inlines -> Inlines]
-> [Arg]
-> ManParser m Inlines
parseAlternatingFonts constructors args = return $ mconcat $
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index ab5aa6b05..3d2ba490d 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -857,7 +857,8 @@ listLine continuationIndent = try $ do
listLineCommon :: PandocMonad m => MarkdownParser m String
listLineCommon = concat <$> manyTill
- ( many1 (satisfy $ \c -> c /= '\n' && c /= '<')
+ ( many1 (satisfy $ \c -> c `notElem` ['\n', '<', '`'])
+ <|> fmap snd (withRaw code)
<|> fmap snd (htmlTag isCommentTag)
<|> count 1 anyChar
) newline
@@ -932,14 +933,14 @@ listItem :: PandocMonad m
-> MarkdownParser m a
-> MarkdownParser m (F Blocks)
listItem fourSpaceRule start = try $ do
- (first, continuationIndent) <- rawListItem fourSpaceRule start
- continuations <- many (listContinuation continuationIndent)
-- parsing with ListItemState forces markers at beginning of lines to
-- count as list item markers, even if not separated by blank space.
-- see definition of "endline"
state <- getState
let oldContext = stateParserContext state
setState $ state {stateParserContext = ListItemState}
+ (first, continuationIndent) <- rawListItem fourSpaceRule start
+ continuations <- many (listContinuation continuationIndent)
-- parse the extracted block, which may contain various block elements:
let raw = concat (first:continuations)
contents <- parseFromString' parseBlocks raw
@@ -1583,8 +1584,9 @@ code = try $ do
starts <- many1 (char '`')
skipSpaces
result <- (trim . concat) <$>
- manyTill (many1 (noneOf "`\n") <|> many1 (char '`') <|>
- (char '\n' >> notFollowedBy' blankline >> return " "))
+ manyTill (notFollowedBy (inList >> listStart) >>
+ (many1 (noneOf "`\n") <|> many1 (char '`') <|>
+ (char '\n' >> notFollowedBy' blankline >> return " ")))
(try (skipSpaces >> count (length starts) (char '`') >>
notFollowedBy (char '`')))
rawattr <-
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 9c409510f..46ddc4257 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -772,7 +772,7 @@ bulletList = try $ do
fmap (B.bulletList . compactify) . sequence
<$> many1 (listItem (bulletListStart `indented` indent))
-indented :: Monad m => OrgParser m Int -> Int -> OrgParser m Int
+indented :: OrgParser m Int -> Int -> OrgParser m Int
indented indentedMarker minIndent = try $ do
n <- indentedMarker
guard (minIndent <= n)
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index b54f5ccbf..105d27088 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -645,7 +645,7 @@ directive' = do
name = trim $ fromMaybe "" (lookup "name" fields)
classes = words $ maybe "" trim (lookup "class" fields)
keyvals = [(k, trim v) | (k, v) <- fields, k /= "name", k /= "class"]
- imgAttr cl = ("", classes ++ alignClasses, widthAttr ++ heightAttr)
+ imgAttr cl = (name, classes ++ alignClasses, widthAttr ++ heightAttr)
where
alignClasses = words $ maybe "" trim (lookup cl fields) ++
maybe "" (\x -> "align-" ++ trim x)
diff --git a/src/Text/Pandoc/Readers/TikiWiki.hs b/src/Text/Pandoc/Readers/TikiWiki.hs
index 8e01a80f8..5daf6b0bb 100644
--- a/src/Text/Pandoc/Readers/TikiWiki.hs
+++ b/src/Text/Pandoc/Readers/TikiWiki.hs
@@ -54,10 +54,10 @@ type TikiWikiParser = ParserT [Char] ParserState
-- utility functions
--
-tryMsg :: PandocMonad m => String -> TikiWikiParser m a -> TikiWikiParser m a
+tryMsg :: String -> TikiWikiParser m a -> TikiWikiParser m a
tryMsg msg p = try p <?> msg
-skip :: PandocMonad m => TikiWikiParser m a -> TikiWikiParser m ()
+skip :: TikiWikiParser m a -> TikiWikiParser m ()
skip parser = Control.Monad.void parser
nested :: PandocMonad m => TikiWikiParser m a -> TikiWikiParser m a
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index 82b6e8221..fdcab1442 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -41,6 +41,7 @@ import qualified Text.Pandoc.Class as P
import Data.Time
import Text.Pandoc.Definition
import Text.Pandoc.Error
+import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.MIME (MimeType, extensionFromMimeType, getMimeType)
import Text.Pandoc.Options (EPUBVersion (..), HTMLMathMethod (..),
@@ -450,14 +451,23 @@ pandocToEPUB version opts doc = do
Nothing -> return ([],[])
Just img -> do
let coverImage = takeFileName img
+ imgContent <- lift $ P.readFileLazy img
+ (coverImageWidth, coverImageHeight) <-
+ case imageSize opts' (B.toStrict imgContent) of
+ Right sz -> return $ sizeInPixels sz
+ Left err' -> (0, 0) <$ report
+ (CouldNotDetermineImageSize img err')
cpContent <- lift $ writeHtml
opts'{ writerVariables =
("coverpage","true"):
("pagetitle",
escapeStringForXML plainTitle):
+ ("cover-image", coverImage):
+ ("cover-image-width", show coverImageWidth):
+ ("cover-image-height",
+ show coverImageHeight):
cssvars True ++ vars }
- (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"../media/" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])
- imgContent <- lift $ P.readFileLazy img
+ (Pandoc meta [])
coverEntry <- mkEntry "text/cover.xhtml" cpContent
coverImageEntry <- mkEntry ("media/" ++ coverImage)
imgContent
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index ca44583ab..241479157 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -621,6 +621,7 @@ toAttrs kvs = do
if x `Set.member` (html5Attributes <> rdfaAttributes)
|| ':' `elem` x -- e.g. epub: namespace
|| "data-" `isPrefixOf` x
+ || "aria-" `isPrefixOf` x
then Just $ customAttribute (fromString x) (toValue y)
else Just $ customAttribute (fromString ("data-" ++ x))
(toValue y)
diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs
index 145d37bee..61a68d543 100644
--- a/src/Text/Pandoc/Writers/JATS.hs
+++ b/src/Text/Pandoc/Writers/JATS.hs
@@ -88,7 +88,9 @@ docToJATS opts (Pandoc meta blocks) = do
mapM (elementToJATS opts' startLvl) elements
notes <- reverse . map snd <$> gets jatsNotes
backs <- mapM (elementToJATS opts' startLvl) backElements
- let fns = inTagsIndented "fn-group" $ vcat notes
+ let fns = if null notes
+ then mempty
+ else inTagsIndented "fn-group" $ vcat notes
let back = render' $ vcat backs $$ fns
let date = case getField "date" metadata -- an object
`mplus`
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index 1f55be797..a9163b3b9 100644
--- a/src/Text/Pandoc/Writers/Shared.hs
+++ b/src/Text/Pandoc/Writers/Shared.hs
@@ -63,7 +63,7 @@ import Text.Pandoc.XML (escapeStringForXML)
-- Variables overwrite metadata fields with the same names.
-- If multiple variables are set with the same name, a list is
-- assigned. Does nothing if 'writerTemplate' is Nothing.
-metaToJSON :: (Functor m, Monad m, ToJSON a)
+metaToJSON :: (Monad m, ToJSON a)
=> WriterOptions
-> ([Block] -> m a)
-> ([Inline] -> m a)
@@ -76,7 +76,7 @@ metaToJSON opts blockWriter inlineWriter meta
-- | Like 'metaToJSON', but does not include variables and is
-- not sensitive to 'writerTemplate'.
-metaToJSON' :: (Functor m, Monad m, ToJSON a)
+metaToJSON' :: (Monad m, ToJSON a)
=> ([Block] -> m a)
-> ([Inline] -> m a)
-> Meta
@@ -99,7 +99,7 @@ addVariablesToJSON opts metadata =
where combineMetadata (Object o1) (Object o2) = Object $ H.union o1 o2
combineMetadata x _ = x
-metaValueToJSON :: (Functor m, Monad m, ToJSON a)
+metaValueToJSON :: (Monad m, ToJSON a)
=> ([Block] -> m a)
-> ([Inline] -> m a)
-> MetaValue
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-24 01:41:48 +0000