aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Readers
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Readers')
-rw-r--r--src/Text/Pandoc/Readers/Docx.hs19
-rw-r--r--src/Text/Pandoc/Readers/Docx/Fields.hs89
-rw-r--r--src/Text/Pandoc/Readers/Docx/Lists.hs8
-rw-r--r--src/Text/Pandoc/Readers/Docx/Parse.hs105
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs17
-rw-r--r--src/Text/Pandoc/Readers/JATS.hs1
-rw-r--r--src/Text/Pandoc/Readers/LaTeX.hs52
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs92
-rw-r--r--src/Text/Pandoc/Readers/Muse.hs265
-rw-r--r--src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs4
-rw-r--r--src/Text/Pandoc/Readers/Odt/ContentReader.hs19
-rw-r--r--src/Text/Pandoc/Readers/Odt/Namespaces.hs2
-rw-r--r--src/Text/Pandoc/Readers/Odt/StyleReader.hs43
-rw-r--r--src/Text/Pandoc/Readers/Org/Blocks.hs2
-rw-r--r--src/Text/Pandoc/Readers/RST.hs33
-rw-r--r--src/Text/Pandoc/Readers/Textile.hs13
-rw-r--r--src/Text/Pandoc/Readers/TikiWiki.hs14
-rw-r--r--src/Text/Pandoc/Readers/Txt2Tags.hs4
-rw-r--r--src/Text/Pandoc/Readers/Vimwiki.hs4
19 files changed, 476 insertions, 310 deletions
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index e0f32b908..c24c43901 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -81,7 +81,7 @@ import qualified Data.ByteString.Lazy as B
import Data.Default (Default)
import Data.List (delete, intersect)
import qualified Data.Map as M
-import Data.Maybe (isJust)
+import Data.Maybe (isJust, fromMaybe)
import Data.Sequence (ViewL (..), viewl)
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
@@ -187,7 +187,7 @@ bodyPartsToMeta' :: PandocMonad m => [BodyPart] -> DocxContext m (M.Map String M
bodyPartsToMeta' [] = return M.empty
bodyPartsToMeta' (bp : bps)
| (Paragraph pPr parParts) <- bp
- , (c : _)<- intersect (pStyle pPr) (M.keys metaStyles)
+ , (c : _)<- (pStyle pPr) `intersect` (M.keys metaStyles)
, (Just metaField) <- M.lookup c metaStyles = do
inlines <- smushInlines <$> mapM parPartToInlines parParts
remaining <- bodyPartsToMeta' bps
@@ -340,7 +340,7 @@ blocksToInlinesWarn cmtId blks = do
notParaOrPlain (Para _) = False
notParaOrPlain (Plain _) = False
notParaOrPlain _ = True
- unless (null $ filter notParaOrPlain blkList) $
+ unless ( not (any notParaOrPlain blkList)) $
lift $ P.report $ DocxParserWarning $
"Docx comment " ++ cmtId ++ " will not retain formatting"
return $ blocksToInlines' blkList
@@ -351,7 +351,7 @@ blocksToInlinesWarn cmtId blks = do
parPartToInlines :: PandocMonad m => ParPart -> DocxContext m Inlines
parPartToInlines parPart =
case parPart of
- (BookMark _ anchor) | not $ anchor `elem` dummyAnchors -> do
+ (BookMark _ anchor) | notElem anchor dummyAnchors -> do
inHdrBool <- asks docxInHeaderBlock
ils <- parPartToInlines' parPart
immedPrevAnchor <- gets docxImmedPrevAnchor
@@ -444,8 +444,13 @@ parPartToInlines' (ExternalHyperLink target runs) = do
return $ link target "" ils
parPartToInlines' (PlainOMath exps) =
return $ math $ writeTeX exps
-parPartToInlines' (SmartTag runs) = do
+parPartToInlines' (SmartTag runs) =
smushInlines <$> mapM runToInlines runs
+parPartToInlines' (Field info runs) =
+ case info of
+ HyperlinkField url -> parPartToInlines' $ ExternalHyperLink url runs
+ UnknownField -> smushInlines <$> mapM runToInlines runs
+parPartToInlines' NullParPart = return mempty
isAnchorSpan :: Inline -> Bool
isAnchorSpan (Span (_, classes, kvs) _) =
@@ -621,9 +626,7 @@ bodyPartToBlocks (ListItem pPr numId lvl (Just levelInfo) parparts) = do
(_, fmt,txt, startFromLevelInfo) = levelInfo
start = case startFromState of
Just n -> n + 1
- Nothing -> case startFromLevelInfo of
- Just n' -> n'
- Nothing -> 1
+ Nothing -> fromMaybe 1 startFromLevelInfo
kvs = [ ("level", lvl)
, ("num-id", numId)
, ("format", fmt)
diff --git a/src/Text/Pandoc/Readers/Docx/Fields.hs b/src/Text/Pandoc/Readers/Docx/Fields.hs
new file mode 100644
index 000000000..6eeb55d2f
--- /dev/null
+++ b/src/Text/Pandoc/Readers/Docx/Fields.hs
@@ -0,0 +1,89 @@
+{-
+Copyright (C) 2014-2018 Jesse Rosenthal <jrosenthal@jhu.edu>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : Text.Pandoc.Readers.Docx.Fields
+ Copyright : Copyright (C) 2014-2018 Jesse Rosenthal
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
+ Stability : alpha
+ Portability : portable
+
+For parsing Field definitions in instText tags, as described in
+ECMA-376-1:2016, §17.16.5 -}
+
+module Text.Pandoc.Readers.Docx.Fields ( FieldInfo(..)
+ , parseFieldInfo
+ ) where
+
+import Text.Parsec
+import Text.Parsec.String (Parser)
+
+type URL = String
+
+data FieldInfo = HyperlinkField URL
+ | UnknownField
+ deriving (Show)
+
+parseFieldInfo :: String -> Either ParseError FieldInfo
+parseFieldInfo = parse fieldInfo ""
+
+fieldInfo :: Parser FieldInfo
+fieldInfo =
+ try (HyperlinkField <$> hyperlink)
+ <|>
+ return UnknownField
+
+escapedQuote :: Parser String
+escapedQuote = string "\\\""
+
+inQuotes :: Parser String
+inQuotes =
+ (try escapedQuote) <|> (anyChar >>= (\c -> return [c]))
+
+quotedString :: Parser String
+quotedString = do
+ char '"'
+ concat <$> manyTill inQuotes (try (char '"'))
+
+unquotedString :: Parser String
+unquotedString = manyTill anyChar (try $ lookAhead space *> return () <|> eof)
+
+fieldArgument :: Parser String
+fieldArgument = quotedString <|> unquotedString
+
+-- there are other switches, but this is the only one I've seen in the wild so far, so it's the first one I'll implement. See §17.16.5.25
+hyperlinkSwitch :: Parser (String, String)
+hyperlinkSwitch = do
+ sw <- string "\\l"
+ spaces
+ farg <- fieldArgument
+ return (sw, farg)
+
+hyperlink :: Parser URL
+hyperlink = do
+ many space
+ string "HYPERLINK"
+ spaces
+ farg <- fieldArgument
+ switches <- spaces *> many hyperlinkSwitch
+ let url = case switches of
+ ("\\l", s) : _ -> farg ++ ('#': s)
+ _ -> farg
+ return url
diff --git a/src/Text/Pandoc/Readers/Docx/Lists.hs b/src/Text/Pandoc/Readers/Docx/Lists.hs
index fa4870fff..c0f05094a 100644
--- a/src/Text/Pandoc/Readers/Docx/Lists.hs
+++ b/src/Text/Pandoc/Readers/Docx/Lists.hs
@@ -44,14 +44,14 @@ isListItem (Div (_, classes, _) _) | "list-item" `elem` classes = True
isListItem _ = False
getLevel :: Block -> Maybe Integer
-getLevel (Div (_, _, kvs) _) = fmap read $ lookup "level" kvs
+getLevel (Div (_, _, kvs) _) = read <$> lookup "level" kvs
getLevel _ = Nothing
getLevelN :: Block -> Integer
getLevelN b = fromMaybe (-1) (getLevel b)
getNumId :: Block -> Maybe Integer
-getNumId (Div (_, _, kvs) _) = fmap read $ lookup "num-id" kvs
+getNumId (Div (_, _, kvs) _) = read <$> lookup "num-id" kvs
getNumId _ = Nothing
getNumIdN :: Block -> Integer
@@ -140,8 +140,8 @@ flatToBullets' num xs@(b : elems)
(children, remaining) =
span
(\b' ->
- (getLevelN b') > bLevel ||
- ((getLevelN b') == bLevel && (getNumIdN b') == bNumId))
+ getLevelN b' > bLevel ||
+ (getLevelN b' == bLevel && getNumIdN b' == bNumId))
xs
in
case getListType b of
diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs
index b79b39369..c123a0018 100644
--- a/src/Text/Pandoc/Readers/Docx/Parse.hs
+++ b/src/Text/Pandoc/Readers/Docx/Parse.hs
@@ -54,6 +54,7 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..)
, TrackedChange(..)
, ChangeType(..)
, ChangeInfo(..)
+ , FieldInfo(..)
, archiveToDocx
, archiveToDocxWithWarnings
) where
@@ -70,6 +71,7 @@ import qualified Data.Map as M
import Data.Maybe
import System.FilePath
import Text.Pandoc.Readers.Docx.Util
+import Text.Pandoc.Readers.Docx.Fields
import Text.Pandoc.Shared (filteredFilesFromArchive, safeRead)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.TeXMath (Exp)
@@ -90,10 +92,19 @@ data ReaderEnv = ReaderEnv { envNotes :: Notes
}
deriving Show
-data ReaderState = ReaderState { stateWarnings :: [String] }
+data ReaderState = ReaderState { stateWarnings :: [String]
+ , stateFldCharState :: FldCharState
+ }
deriving Show
-data DocxError = DocxError | WrongElem
+data FldCharState = FldCharOpen
+ | FldCharFieldInfo FieldInfo
+ | FldCharContent FieldInfo [Run]
+ | FldCharClosed
+ deriving (Show)
+
+data DocxError = DocxError
+ | WrongElem
deriving Show
type D = ExceptT DocxError (ReaderT ReaderEnv (State ReaderState))
@@ -265,6 +276,9 @@ data ParPart = PlainRun Run
| Chart -- placeholder for now
| PlainOMath [Exp]
| SmartTag [Run]
+ | Field FieldInfo [Run]
+ | NullParPart -- when we need to return nothing, but
+ -- not because of an error.
deriving Show
data Run = Run RunStyle [RunElem]
@@ -328,7 +342,9 @@ archiveToDocxWithWarnings archive = do
(styles, parstyles) = archiveToStyles archive
rEnv =
ReaderEnv notes comments numbering rels media Nothing styles parstyles InDocument
- rState = ReaderState { stateWarnings = [] }
+ rState = ReaderState { stateWarnings = []
+ , stateFldCharState = FldCharClosed
+ }
(eitherDoc, st) = runD (archiveToDocument archive) rEnv rState
case eitherDoc of
Right doc -> Right (Docx doc, stateWarnings st)
@@ -342,9 +358,7 @@ archiveToDocument zf = do
docElem <- maybeToD $ (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry
let namespaces = elemToNameSpaces docElem
bodyElem <- maybeToD $ findChildByName namespaces "w" "body" docElem
- let bodyElem' = case walkDocument namespaces bodyElem of
- Just e -> e
- Nothing -> bodyElem
+ let bodyElem' = fromMaybe bodyElem (walkDocument namespaces bodyElem)
body <- elemToBody namespaces bodyElem'
return $ Document namespaces body
@@ -587,7 +601,7 @@ elemToTblLook ns element | isElem ns "w" "tblLook" element =
Just bitMask -> testBitMask bitMask 0x020
Nothing -> False
in
- return $ TblLook{firstRowFormatting = firstRowFmt}
+ return TblLook{firstRowFormatting = firstRowFmt}
elemToTblLook _ _ = throwError WrongElem
elemToRow :: NameSpaces -> Element -> D Row
@@ -607,7 +621,7 @@ elemToCell _ _ = throwError WrongElem
elemToParIndentation :: NameSpaces -> Element -> Maybe ParIndentation
elemToParIndentation ns element | isElem ns "w" "ind" element =
- Just $ ParIndentation {
+ Just ParIndentation {
leftParIndent =
findAttrByName ns "w" "left" element >>=
stringToInteger
@@ -736,9 +750,77 @@ elemToParPart ns element
, c_ns <- "http://schemas.openxmlformats.org/drawingml/2006/chart"
, Just _ <- findElement (QName "chart" (Just c_ns) (Just "c")) drawingElem
= return Chart
+{-
+The next one is a bit complicated. fldChar fields work by first
+having a <w:fldChar fldCharType="begin"> in a run, then a run with
+<w:instrText>, then a <w:fldChar fldCharType="separate"> run, then the
+content runs, and finally a <w:fldChar fldCharType="end"> run. For
+example (omissions and my comments in brackets):
+
+ <w:r>
+ [...]
+ <w:fldChar w:fldCharType="begin"/>
+ </w:r>
+ <w:r>
+ [...]
+ <w:instrText xml:space="preserve"> HYPERLINK [hyperlink url] </w:instrText>
+ </w:r>
+ <w:r>
+ [...]
+ <w:fldChar w:fldCharType="separate"/>
+ </w:r>
+ <w:r w:rsidRPr=[...]>
+ [...]
+ <w:t>Foundations of Analysis, 2nd Edition</w:t>
+ </w:r>
+ <w:r>
+ [...]
+ <w:fldChar w:fldCharType="end"/>
+ </w:r>
+
+So we do this in a number of steps. If we encounter the fldchar begin
+tag, we start open a fldchar state variable (see state above). We add
+the instrtext to it as FieldInfo. Then we close that and start adding
+the runs when we get to separate. Then when we get to end, we produce
+the Field type with approriate FieldInfo and Runs.
+-}
elemToParPart ns element
- | isElem ns "w" "r" element =
- elemToRun ns element >>= (\r -> return $ PlainRun r)
+ | isElem ns "w" "r" element
+ , Just fldChar <- findChildByName ns "w" "fldChar" element
+ , Just fldCharType <- findAttrByName ns "w" "fldCharType" fldChar = do
+ fldCharState <- gets stateFldCharState
+ case fldCharState of
+ FldCharClosed | fldCharType == "begin" -> do
+ modify $ \st -> st {stateFldCharState = FldCharOpen}
+ return NullParPart
+ FldCharFieldInfo info | fldCharType == "separate" -> do
+ modify $ \st -> st {stateFldCharState = FldCharContent info []}
+ return NullParPart
+ FldCharContent info runs | fldCharType == "end" -> do
+ modify $ \st -> st {stateFldCharState = FldCharClosed}
+ return $ Field info $ reverse runs
+ _ -> throwError WrongElem
+elemToParPart ns element
+ | isElem ns "w" "r" element
+ , Just instrText <- findChildByName ns "w" "instrText" element = do
+ fldCharState <- gets stateFldCharState
+ case fldCharState of
+ FldCharOpen -> do
+ info <- eitherToD $ parseFieldInfo $ strContent instrText
+ modify $ \st -> st{stateFldCharState = FldCharFieldInfo info}
+ return NullParPart
+ _ -> return NullParPart
+elemToParPart ns element
+ | isElem ns "w" "r" element = do
+ run <- elemToRun ns element
+ -- we check to see if we have an open FldChar in state that we're
+ -- recording.
+ fldCharState <- gets stateFldCharState
+ case fldCharState of
+ FldCharContent info runs -> do
+ modify $ \st -> st{stateFldCharState = FldCharContent info (run : runs)}
+ return NullParPart
+ _ -> return $ PlainRun run
elemToParPart ns element
| Just change <- getTrackedChange ns element = do
runs <- mapD (elemToRun ns) (elChildren element)
@@ -1089,8 +1171,7 @@ elemToRunElems ns element
let font = do
fontElem <- findElement (qualName "rFonts") element
stringToFont =<<
- foldr (<|>) Nothing (
- map (flip findAttr fontElem . qualName) ["ascii", "hAnsi"])
+ foldr ((<|>) . (flip findAttr fontElem . qualName)) Nothing ["ascii", "hAnsi"]
local (setFont font) (mapD (elemToRunElem ns) (elChildren element))
elemToRunElems _ _ = throwError WrongElem
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index e8dd9ec11..0e79f9ec3 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -43,14 +43,14 @@ module Text.Pandoc.Readers.HTML ( readHtml
) where
import Control.Applicative ((<|>))
-import Control.Arrow ((***))
+import Control.Arrow (first)
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 (isPrefixOf)
import Data.List.Split (wordsBy, splitWhen)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust, isNothing)
@@ -531,15 +531,18 @@ pCol = try $ do
skipMany pBlank
optional $ pSatisfy (matchTagClose "col")
skipMany pBlank
- return $ case lookup "width" attribs of
+ let width = case lookup "width" attribs of
Nothing -> case lookup "style" attribs of
Just ('w':'i':'d':'t':'h':':':xs) | '%' `elem` xs ->
- fromMaybe 0.0 $ safeRead ('0':'.':filter
+ fromMaybe 0.0 $ safeRead (filter
(`notElem` (" \t\r\n%'\";" :: [Char])) xs)
_ -> 0.0
Just x | not (null x) && last x == '%' ->
- fromMaybe 0.0 $ safeRead ('0':'.':init x)
+ fromMaybe 0.0 $ safeRead (init x)
_ -> 0.0
+ if width > 0.0
+ then return $ width / 100.0
+ else return 0.0
pColgroup :: PandocMonad m => TagParser m [Double]
pColgroup = try $ do
@@ -774,7 +777,7 @@ pCode = try $ do
(TagOpen open attr') <- pSatisfy $ tagOpen (`elem` ["code","tt"]) (const True)
let attr = toStringAttr attr'
result <- manyTill pAnyTag (pCloses open)
- return $ B.codeWith (mkAttr attr) $ intercalate " " $ lines $ T.unpack $
+ return $ B.codeWith (mkAttr attr) $ unwords $ lines $ T.unpack $
innerText result
pSpan :: PandocMonad m => TagParser m Inlines
@@ -1224,7 +1227,7 @@ stripPrefixes = map stripPrefix
stripPrefix :: Tag Text -> Tag Text
stripPrefix (TagOpen s as) =
- TagOpen (stripPrefix' s) (map (stripPrefix' *** id) as)
+ TagOpen (stripPrefix' s) (map (first stripPrefix') as)
stripPrefix (TagClose s) = TagClose (stripPrefix' s)
stripPrefix x = x
diff --git a/src/Text/Pandoc/Readers/JATS.hs b/src/Text/Pandoc/Readers/JATS.hs
index 9223db68c..8158a4511 100644
--- a/src/Text/Pandoc/Readers/JATS.hs
+++ b/src/Text/Pandoc/Readers/JATS.hs
@@ -494,4 +494,3 @@ parseInline (Elem e) =
"" -> []
l -> [l]
return $ codeWith (attrValue "id" e,classes',[]) $ strContentRecursive e
-
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs
index 62d240688..1ce3d18e5 100644
--- a/src/Text/Pandoc/Readers/LaTeX.hs
+++ b/src/Text/Pandoc/Readers/LaTeX.hs
@@ -272,10 +272,8 @@ rawLaTeXBlock = do
lookAhead (try (char '\\' >> letter))
-- we don't want to apply newly defined latex macros to their own
-- definitions:
- (do (_, raw) <- rawLaTeXParser macroDef
- (guardDisabled Ext_latex_macros >> return raw) <|> return "")
- <|> (do (_, raw) <- rawLaTeXParser (environment <|> blockCommand)
- applyMacros raw)
+ snd <$> rawLaTeXParser macroDef
+ <|> ((snd <$> rawLaTeXParser (environment <|> blockCommand)) >>= applyMacros)
rawLaTeXInline :: (PandocMonad m, HasMacros s, HasReaderOptions s)
=> ParserT String s m String
@@ -333,13 +331,16 @@ totoks pos t =
-> (T.pack "\n",
T.span isSpaceOrTab r2)
_ -> (mempty, (mempty, r1))
+ ws = "\\" <> w1 <> w2 <> w3
in case T.uncons r3 of
Just ('\n', _) ->
Tok pos (CtrlSeq " ") ("\\" <> w1)
- : totoks (incSourceColumn pos 1) r1
+ : totoks (incSourceColumn pos (T.length ws))
+ r1
_ ->
- Tok pos (CtrlSeq " ") ("\\" <> w1 <> w2 <> w3)
- : totoks (incSourceColumn pos 1) r3
+ Tok pos (CtrlSeq " ") ws
+ : totoks (incSourceColumn pos (T.length ws))
+ r3
| otherwise ->
Tok pos (CtrlSeq (T.singleton d)) (T.pack [c,d])
: totoks (incSourceColumn pos 2) rest'
@@ -350,7 +351,7 @@ totoks pos t =
Tok pos (Arg i) ("#" <> t1)
: totoks (incSourceColumn pos (1 + T.length t1)) t2
Nothing ->
- Tok pos Symbol ("#")
+ Tok pos Symbol "#"
: totoks (incSourceColumn pos 1) t2
| c == '^' ->
case T.uncons rest of
@@ -368,10 +369,10 @@ totoks pos t =
| d < '\128' ->
Tok pos Esc1 (T.pack ['^','^',d])
: totoks (incSourceColumn pos 3) rest''
- _ -> Tok pos Symbol ("^") :
- Tok (incSourceColumn pos 1) Symbol ("^") :
+ _ -> Tok pos Symbol "^" :
+ Tok (incSourceColumn pos 1) Symbol "^" :
totoks (incSourceColumn pos 2) rest'
- _ -> Tok pos Symbol ("^")
+ _ -> Tok pos Symbol "^"
: totoks (incSourceColumn pos 1) rest
| otherwise ->
Tok pos Symbol (T.singleton c) : totoks (incSourceColumn pos 1) rest
@@ -404,7 +405,7 @@ satisfyTok f =
| otherwise = Nothing
updatePos :: SourcePos -> Tok -> [Tok] -> SourcePos
updatePos _spos _ (Tok pos _ _ : _) = pos
- updatePos spos _ [] = spos
+ updatePos spos _ [] = incSourceColumn spos 1
doMacros :: PandocMonad m => Int -> LP m ()
doMacros n = do
@@ -442,19 +443,22 @@ doMacros n = do
Just o ->
(:) <$> option o bracketedToks
<*> count (numargs - 1) getarg
- let addTok (Tok _ (Arg i) _) acc | i > 0
- , i <= numargs =
- foldr addTok acc (args !! (i - 1))
+ -- first boolean param is true if we're tokenizing
+ -- an argument (in which case we don't want to
+ -- expand #1 etc.)
+ let addTok False (Tok _ (Arg i) _) acc | i > 0
+ , i <= numargs =
+ foldr (addTok True) acc (args !! (i - 1))
-- add space if needed after control sequence
-- see #4007
- addTok (Tok _ (CtrlSeq x) txt)
+ addTok _ (Tok _ (CtrlSeq x) txt)
acc@(Tok _ Word _ : _)
| not (T.null txt) &&
- (isLetter (T.last txt)) =
+ isLetter (T.last txt) =
Tok spos (CtrlSeq x) (txt <> " ") : acc
- addTok t acc = setpos spos t : acc
+ addTok _ t acc = setpos spos t : acc
ts' <- getInput
- setInput $ foldr addTok ts' newtoks
+ setInput $ foldr (addTok False) ts' newtoks
case expansionPoint of
ExpandWhenUsed ->
if n > 20 -- detect macro expansion loops
@@ -1240,7 +1244,7 @@ inlineEnvironments = M.fromList [
]
inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)
-inlineCommands = M.union inlineLanguageCommands $ M.fromList $
+inlineCommands = M.union inlineLanguageCommands $ M.fromList
[ ("emph", extractSpaces emph <$> tok)
, ("textit", extractSpaces emph <$> tok)
, ("textsl", extractSpaces emph <$> tok)
@@ -1497,7 +1501,7 @@ foreignlanguage :: PandocMonad m => LP m Inlines
foreignlanguage = do
babelLang <- T.unpack . untokenize <$> braced
case babelLangToBCP47 babelLang of
- Just lang -> spanWith ("", [], [("lang", renderLang $ lang)]) <$> tok
+ Just lang -> spanWith ("", [], [("lang", renderLang lang)]) <$> tok
_ -> tok
inlineLanguageCommands :: PandocMonad m => M.Map Text (LP m Inlines)
@@ -2017,7 +2021,7 @@ closing = do
return $ para (trimInlines contents) <> sigs
blockCommands :: PandocMonad m => M.Map Text (LP m Blocks)
-blockCommands = M.fromList $
+blockCommands = M.fromList
[ ("par", mempty <$ skipopts)
, ("parbox", skipopts >> braced >> grouped blocks)
, ("title", mempty <$ (skipopts *>
@@ -2101,7 +2105,7 @@ environments = M.fromList
resetCaption *> simpTable "longtable" False >>= addTableCaption)
, ("table", env "table" $
resetCaption *> skipopts *> blocks >>= addTableCaption)
- , ("tabular*", env "tabular" $ simpTable "tabular*" True)
+ , ("tabular*", env "tabular*" $ simpTable "tabular*" True)
, ("tabularx", env "tabularx" $ simpTable "tabularx" True)
, ("tabular", env "tabular" $ simpTable "tabular" False)
, ("quote", blockQuote <$> env "quote" blocks)
@@ -2440,7 +2444,7 @@ parseAligns = try $ do
spaces
spec <- braced
case safeRead ds of
- Just n -> do
+ Just n ->
getInput >>= setInput . (mconcat (replicate n spec) ++)
Nothing -> fail $ "Could not parse " ++ ds ++ " as number"
bgroup
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index aaefa5ba1..14cf73de4 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -36,7 +36,7 @@ import Control.Monad
import Control.Monad.Except (throwError)
import Data.Char (isAlphaNum, isPunctuation, isSpace, toLower)
import qualified Data.HashMap.Strict as H
-import Data.List (findIndex, intercalate, sortBy, transpose)
+import Data.List (intercalate, sortBy, transpose, elemIndex)
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid ((<>))
@@ -122,6 +122,13 @@ spnl = try $ do
skipSpaces
notFollowedBy (char '\n')
+spnl' :: PandocMonad m => ParserT [Char] st m String
+spnl' = try $ do
+ xs <- many spaceChar
+ ys <- option "" $ try $ (:) <$> newline
+ <*> (many spaceChar <* notFollowedBy (char '\n'))
+ return (xs ++ ys)
+
indentSpaces :: PandocMonad m => MarkdownParser m String
indentSpaces = try $ do
tabStop <- getOption readerTabStop
@@ -148,19 +155,25 @@ litChar = escapedChar'
-- | Parse a sequence of inline elements between square brackets,
-- including inlines between balanced pairs of square brackets.
inlinesInBalancedBrackets :: PandocMonad m => MarkdownParser m (F Inlines)
-inlinesInBalancedBrackets = try $ char '[' >> go 1
- where go :: PandocMonad m => Int -> MarkdownParser m (F Inlines)
- go 0 = return mempty
- go openBrackets =
- (mappend <$> (bracketedSpan <|> link <|> image) <*>
- go openBrackets)
- <|> ((if openBrackets > 1
- then (return (B.str "]") <>)
- else id) <$>
- (char ']' >> go (openBrackets - 1)))
- <|> ((return (B.str "[") <>) <$>
- (char '[' >> go (openBrackets + 1)))
- <|> (mappend <$> inline <*> go openBrackets)
+inlinesInBalancedBrackets =
+ try $ char '[' >> withRaw (go 1) >>=
+ parseFromString inlines . stripBracket . snd
+ where stripBracket [] = []
+ stripBracket xs = if last xs == ']' then init xs else xs
+ go :: PandocMonad m => Int -> MarkdownParser m ()
+ go 0 = return ()
+ go openBrackets =
+ (() <$ (escapedChar <|>
+ code <|>
+ rawHtmlInline <|>
+ rawLaTeXInline') >> go openBrackets)
+ <|>
+ (do char ']'
+ Control.Monad.when (openBrackets > 1) $ go (openBrackets - 1))
+ <|>
+ (char '[' >> go (openBrackets + 1))
+ <|>
+ (anyChar >> go openBrackets)
--
-- document structure
@@ -242,13 +255,13 @@ yamlMetaBlock = try $ do
v' <- yamlToMeta v
let k' = T.unpack k
updateState $ \st -> st{ stateMeta' =
- (do m <- stateMeta' st
- -- if there's already a value, leave it unchanged
- case lookupMeta k' m of
- Just _ -> return m
- Nothing -> do
- v'' <- v'
- return $ B.setMeta (T.unpack k) v'' m)}
+ do m <- stateMeta' st
+ -- if there's already a value, leave it unchanged
+ case lookupMeta k' m of
+ Just _ -> return m
+ Nothing -> do
+ v'' <- v'
+ return $ B.setMeta (T.unpack k) v'' m}
) alist
Right Yaml.Null -> return ()
Right _ -> do
@@ -581,7 +594,7 @@ setextHeader = try $ do
underlineChar <- oneOf setextHChars
many (char underlineChar)
blanklines
- let level = fromMaybe 0 (findIndex (== underlineChar) setextHChars) + 1
+ let level = fromMaybe 0 (elemIndex underlineChar setextHChars) + 1
attr' <- registerHeader attr (runF text defaultParserState)
guardDisabled Ext_implicit_header_references
<|> registerImplicitHeader raw attr'
@@ -836,7 +849,7 @@ orderedListStart mbstydelim = try $ do
return (num, style, delim))
listStart :: PandocMonad m => MarkdownParser m ()
-listStart = bulletListStart <|> (Control.Monad.void (orderedListStart Nothing))
+listStart = bulletListStart <|> Control.Monad.void (orderedListStart Nothing)
listLine :: PandocMonad m => Int -> MarkdownParser m String
listLine continuationIndent = try $ do
@@ -866,7 +879,7 @@ rawListItem fourSpaceRule start = try $ do
pos2 <- getPosition
let continuationIndent = if fourSpaceRule
then 4
- else (sourceColumn pos2 - sourceColumn pos1)
+ else sourceColumn pos2 - sourceColumn pos1
first <- listLineCommon
rest <- many (do notFollowedBy listStart
notFollowedBy (() <$ codeBlockFenced)
@@ -897,10 +910,10 @@ listContinuation continuationIndent = try $ do
return $ concat (x:xs) ++ blanks
notFollowedByDivCloser :: PandocMonad m => MarkdownParser m ()
-notFollowedByDivCloser = do
+notFollowedByDivCloser =
guardDisabled Ext_fenced_divs <|>
- do divLevel <- stateFencedDivLevel <$> getState
- guard (divLevel < 1) <|> notFollowedBy divFenceEnd
+ do divLevel <- stateFencedDivLevel <$> getState
+ guard (divLevel < 1) <|> notFollowedBy divFenceEnd
notFollowedByHtmlCloser :: PandocMonad m => MarkdownParser m ()
notFollowedByHtmlCloser = do
@@ -1117,10 +1130,9 @@ rawTeXBlock = do
lookAhead $ try $ char '\\' >> letter
result <- (B.rawBlock "context" . trim . concat <$>
many1 ((++) <$> (rawConTeXtEnvironment <|> conTeXtCommand)
- <*> (blanklines <|> many spaceChar)))
+ <*> spnl'))
<|> (B.rawBlock "latex" . trim . concat <$>
- many1 ((++) <$> rawLaTeXBlock
- <*> (blanklines <|> many spaceChar)))
+ many1 ((++) <$> rawLaTeXBlock <*> spnl'))
return $ case B.toList result of
[RawBlock _ cs]
| all (`elem` [' ','\t','\n']) cs -> return mempty
@@ -1208,7 +1220,7 @@ simpleTableHeader headless = try $ do
if headless
then lookAhead anyLine
else return rawContent
- let aligns = zipWith alignType (map ((: [])) rawHeads) lengths
+ let aligns = zipWith alignType (map (: []) rawHeads) lengths
let rawHeads' = if headless
then replicate (length dashes) ""
else rawHeads
@@ -1404,11 +1416,11 @@ pipeTableHeaderPart = try $ do
skipMany spaceChar
let len = length pipe + maybe 0 (const 1) left + maybe 0 (const 1) right
return
- ((case (left,right) of
- (Nothing,Nothing) -> AlignDefault
- (Just _,Nothing) -> AlignLeft
- (Nothing,Just _) -> AlignRight
- (Just _,Just _) -> AlignCenter), len)
+ (case (left,right) of
+ (Nothing,Nothing) -> AlignDefault
+ (Just _,Nothing) -> AlignLeft
+ (Nothing,Just _) -> AlignRight
+ (Just _,Just _) -> AlignCenter, len)
-- Succeed only if current line contains a pipe.
scanForPipe :: PandocMonad m => ParserT [Char] st m ()
@@ -1915,7 +1927,7 @@ rawConTeXtEnvironment = try $ do
(try $ string "\\stop" >> string completion)
return $ "\\start" ++ completion ++ concat contents ++ "\\stop" ++ completion
-inBrackets :: PandocMonad m => (ParserT [Char] st m Char) -> ParserT [Char] st m String
+inBrackets :: PandocMonad m => ParserT [Char] st m Char -> ParserT [Char] st m String
inBrackets parser = do
char '['
contents <- many parser
@@ -1959,7 +1971,6 @@ divHtml = try $ do
divFenced :: PandocMonad m => MarkdownParser m (F Blocks)
divFenced = try $ do
guardEnabled Ext_fenced_divs
- nonindentSpaces
string ":::"
skipMany (char ':')
skipMany spaceChar
@@ -1974,7 +1985,6 @@ divFenced = try $ do
divFenceEnd :: PandocMonad m => MarkdownParser m ()
divFenceEnd = try $ do
- nonindentSpaces
string ":::"
skipMany (char ':')
blanklines
@@ -2136,6 +2146,6 @@ doubleQuoted :: PandocMonad m => MarkdownParser m (F Inlines)
doubleQuoted = try $ do
doubleQuoteStart
contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)
- (withQuoteContext InDoubleQuote $ doubleQuoteEnd >> return
+ withQuoteContext InDoubleQuote (doubleQuoteEnd >> return
(fmap B.doubleQuoted . trimInlinesF $ contents))
- <|> (return $ return (B.str "\8220") <> contents)
+ <|> return (return (B.str "\8220") <> contents)
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index 78c567759..8f36db9d1 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -42,7 +42,8 @@ module Text.Pandoc.Readers.Muse (readMuse) where
import Control.Monad
import Control.Monad.Except (throwError)
import Data.Char (isLetter)
-import Data.List (stripPrefix)
+import Data.List (stripPrefix, intercalate)
+import Data.List.Split (splitOn)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Text (Text, unpack)
@@ -78,7 +79,8 @@ type MuseParser = ParserT String ParserState
parseMuse :: PandocMonad m => MuseParser m Pandoc
parseMuse = do
many directive
- blocks <- parseBlocks
+ blocks <- mconcat <$> many block
+ eof
st <- getState
let doc = runF (do Pandoc _ bs <- B.doc <$> blocks
meta <- stateMeta' st
@@ -86,13 +88,6 @@ parseMuse = do
reportLogMessages
return doc
-parseBlocks :: PandocMonad m => MuseParser m (F Blocks)
-parseBlocks = do
- res <- mconcat <$> many block
- spaces
- eof
- return res
-
--
-- utility functions
--
@@ -155,10 +150,8 @@ parseDirectiveKey = do
parseEmacsDirective :: PandocMonad m => MuseParser m (String, F Inlines)
parseEmacsDirective = do
key <- parseDirectiveKey
- space
- spaces
- raw <- manyTill anyChar eol
- value <- parseFromString (trimInlinesF . mconcat <$> many inline) raw
+ spaceChar
+ value <- trimInlinesF . mconcat <$> manyTill (choice inlineList) eol
return (key, value)
parseAmuseDirective :: PandocMonad m => MuseParser m (String, F Inlines)
@@ -187,17 +180,19 @@ directive = do
-- block parsers
--
-block :: PandocMonad m => MuseParser m (F Blocks)
-block = do
- res <- mempty <$ skipMany1 blankline
- <|> blockElements
- <|> para
- skipMany blankline
+parseBlock :: PandocMonad m => MuseParser m (F Blocks)
+parseBlock = do
+ res <- blockElements <|> para
+ optionMaybe blankline
trace (take 60 $ show $ B.toList $ runF res defaultParserState)
return res
+block :: PandocMonad m => MuseParser m (F Blocks)
+block = parseBlock <* skipMany blankline
+
blockElements :: PandocMonad m => MuseParser m (F Blocks)
-blockElements = choice [ comment
+blockElements = choice [ mempty <$ blankline
+ , comment
, separator
, header
, example
@@ -221,7 +216,7 @@ blockElements = choice [ comment
comment :: PandocMonad m => MuseParser m (F Blocks)
comment = try $ do
char ';'
- optionMaybe (spaceChar >> (many $ noneOf "\n"))
+ optionMaybe (spaceChar >> many (noneOf "\n"))
eol
return mempty
@@ -257,15 +252,26 @@ example = try $ do
-- in case opening and/or closing tags are on separate lines.
chop :: String -> String
chop = lchop . rchop
- where lchop s = case s of
+
+lchop :: String -> String
+lchop s = case s of
'\n':ss -> ss
_ -> s
- rchop = reverse . lchop . reverse
+
+rchop :: String -> String
+rchop = reverse . lchop . reverse
+
+dropSpacePrefix :: [String] -> [String]
+dropSpacePrefix lns =
+ map (drop maxIndent) lns
+ where flns = filter (not . all (== ' ')) lns
+ maxIndent = if null flns then maximum (map length lns) else length $ takeWhile (== ' ') $ foldl1 commonPrefix flns
exampleTag :: PandocMonad m => MuseParser m (F Blocks)
-exampleTag = do
+exampleTag = try $ do
+ many spaceChar
(attr, contents) <- htmlElement "example"
- return $ return $ B.codeBlockWith attr $ chop contents
+ return $ return $ B.codeBlockWith attr $ rchop $ intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop contents
literal :: PandocMonad m => MuseParser m (F Blocks)
literal = do
@@ -309,7 +315,6 @@ verseLine = do
verseLines :: PandocMonad m => MuseParser m (F Blocks)
verseLines = do
- optionMaybe blankline -- Skip blankline after opening tag on separate line
lns <- many verseLine
lns' <- mapM (parseFromString' (trimInlinesF . mconcat <$> many inline)) lns
return $ B.lineBlock <$> sequence lns'
@@ -317,7 +322,7 @@ verseLines = do
verseTag :: PandocMonad m => MuseParser m (F Blocks)
verseTag = do
(_, content) <- htmlElement "verse"
- parseFromString verseLines content
+ parseFromString verseLines (intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop content)
commentTag :: PandocMonad m => MuseParser m (F Blocks)
commentTag = parseHtmlContent "comment" anyChar >> return mempty
@@ -330,9 +335,8 @@ para = do
let f = if st /= ListItemState && indent >= 2 && indent < 6 then B.blockQuote else id
fmap (f . B.para) . trimInlinesF . mconcat <$> many1Till inline endOfParaElement
where
- endOfParaElement = lookAhead $ endOfInput <|> endOfPara <|> newBlockElement
+ endOfParaElement = lookAhead $ endOfInput <|> newBlockElement
endOfInput = try $ skipMany blankline >> skipSpaces >> eof
- endOfPara = try $ blankline >> skipMany1 blankline
newBlockElement = try $ blankline >> void blockElements
noteMarker :: PandocMonad m => MuseParser m String
@@ -349,7 +353,7 @@ amuseNoteBlock = try $ do
guardEnabled Ext_amuse
pos <- getPosition
ref <- noteMarker <* spaceChar
- content <- listItemContents $ 3 + length ref
+ content <- listItemContents
oldnotes <- stateNotes' <$> getState
case M.lookup ref oldnotes of
Just _ -> logMessage $ DuplicateNoteReference ref pos
@@ -379,31 +383,28 @@ emacsNoteBlock = try $ do
-- Verse markup
--
-lineVerseLine :: PandocMonad m => MuseParser m String
+lineVerseLine :: PandocMonad m => MuseParser m (F Inlines)
lineVerseLine = try $ do
- char '>'
- white <- many1 (char ' ' >> pure '\160')
- rest <- anyLine
- return $ tail white ++ rest
+ string "> "
+ indent <- B.str <$> many (char ' ' >> pure '\160')
+ rest <- manyTill (choice inlineList) eol
+ return $ trimInlinesF $ mconcat (pure indent : rest)
-blanklineVerseLine :: PandocMonad m => MuseParser m Char
-blanklineVerseLine = try $ char '>' >> blankline
+blanklineVerseLine :: PandocMonad m => MuseParser m (F Inlines)
+blanklineVerseLine = try $ do
+ char '>'
+ blankline
+ pure mempty
lineBlock :: PandocMonad m => MuseParser m (F Blocks)
lineBlock = try $ do
- lns <- many1 (pure <$> blanklineVerseLine <|> lineVerseLine)
- lns' <- mapM (parseFromString' (trimInlinesF . mconcat <$> many inline)) lns
- return $ B.lineBlock <$> sequence lns'
+ lns <- many1 (blanklineVerseLine <|> lineVerseLine)
+ return $ B.lineBlock <$> sequence lns
--
-- lists
--
-listLine :: PandocMonad m => Int -> MuseParser m String
-listLine markerLength = try $ do
- indentWith markerLength
- manyTill anyChar eol
-
withListContext :: PandocMonad m => MuseParser m a -> MuseParser m a
withListContext p = do
state <- getState
@@ -413,96 +414,71 @@ withListContext p = do
updateState (\st -> st {stateParserContext = oldContext})
return parsed
-listContinuation :: PandocMonad m => Int -> MuseParser m [String]
-listContinuation markerLength = try $ do
- result <- many1 $ listLine markerLength
- blank <- option id ((++ [""]) <$ blankline)
- return $ blank result
-
-listStart :: PandocMonad m => MuseParser m Int -> MuseParser m Int
-listStart marker = try $ do
- preWhitespace <- length <$> many spaceChar
- st <- stateParserContext <$> getState
- getPosition >>= \pos -> guard (st == ListItemState || sourceColumn pos /= 1)
- markerLength <- marker
- void spaceChar <|> eol
- return $ preWhitespace + markerLength + 1
-
-dropSpacePrefix :: [String] -> [String]
-dropSpacePrefix lns =
- map (drop maxIndent) lns
- where flns = filter (not . all (== ' ')) lns
- maxIndent = if null flns then 0 else length $ takeWhile (== ' ') $ foldl1 commonPrefix flns
-
-listItemContents :: PandocMonad m => Int -> MuseParser m (F Blocks)
-listItemContents markerLength = do
- firstLine <- manyTill anyChar eol
- restLines <- many $ listLine markerLength
- blank <- option id ((++ [""]) <$ blankline)
- let first = firstLine : blank restLines
- rest <- many $ listContinuation markerLength
- let allLines = concat (first : rest)
- parseFromString (withListContext parseBlocks) $ unlines (dropSpacePrefix allLines)
-
-listItem :: PandocMonad m => MuseParser m Int -> MuseParser m (F Blocks)
-listItem start = try $ do
- markerLength <- start
- listItemContents markerLength
+listItemContents' :: PandocMonad m => Int -> MuseParser m (F Blocks)
+listItemContents' col = do
+ first <- try $ withListContext parseBlock
+ rest <- many $ try (skipMany blankline >> indentWith col >> withListContext parseBlock)
+ return $ mconcat (first : rest)
-bulletListItems :: PandocMonad m => MuseParser m (F [Blocks])
-bulletListItems = sequence <$> many1 (listItem bulletListStart)
+listItemContents :: PandocMonad m => MuseParser m (F Blocks)
+listItemContents = do
+ pos <- getPosition
+ let col = sourceColumn pos - 1
+ listItemContents' col
-bulletListStart :: PandocMonad m => MuseParser m Int
-bulletListStart = listStart (char '-' >> return 1)
+listItem :: PandocMonad m => Int -> MuseParser m a -> MuseParser m (F Blocks)
+listItem n p = try $ do
+ optionMaybe blankline
+ count n spaceChar
+ p
+ void spaceChar <|> lookAhead eol
+ listItemContents
bulletList :: PandocMonad m => MuseParser m (F Blocks)
-bulletList = do
- listItems <- bulletListItems
- return $ B.bulletList <$> listItems
-
-orderedListStart :: PandocMonad m
- => ListNumberStyle
- -> ListNumberDelim
- -> MuseParser m Int
-orderedListStart style delim = listStart (snd <$> withHorizDisplacement (orderedListMarker style delim))
+bulletList = try $ do
+ many spaceChar
+ pos <- getPosition
+ let col = sourceColumn pos
+ guard $ col /= 1
+ char '-'
+ void spaceChar <|> lookAhead eol
+ first <- listItemContents
+ rest <- many $ listItem (col - 1) (char '-')
+ return $ B.bulletList <$> sequence (first : rest)
orderedList :: PandocMonad m => MuseParser m (F Blocks)
orderedList = try $ do
- p@(_, style, delim) <- lookAhead (many spaceChar *> anyOrderedListMarker <* (eol <|> void spaceChar))
+ many spaceChar
+ pos <- getPosition
+ let col = sourceColumn pos
+ guard $ col /= 1
+ p@(_, style, delim) <- anyOrderedListMarker
guard $ style `elem` [Decimal, LowerAlpha, UpperAlpha, LowerRoman, UpperRoman]
guard $ delim == Period
- items <- sequence <$> many1 (listItem $ orderedListStart style delim)
- return $ B.orderedListWith p <$> items
-
-definitionListItem :: PandocMonad m => MuseParser m (F (Inlines, [Blocks]))
-definitionListItem = try $ do
- rawTerm <- termParser
- term <- parseFromString (trimInlinesF . mconcat <$> many inline) rawTerm
- many1 spaceChar
- string "::"
- firstLine <- manyTill anyChar eol
- restLines <- manyTill anyLine endOfListItemElement
- let lns = dropWhile (== ' ') firstLine : dropSpacePrefix restLines
- lineContent <- parseFromString (withListContext parseBlocks) $ unlines lns
- pure $ do lineContent' <- lineContent
+ void spaceChar <|> lookAhead eol
+ first <- listItemContents
+ rest <- many $ listItem (col - 1) (orderedListMarker style delim)
+ return $ B.orderedListWith p <$> sequence (first : rest)
+
+definitionListItem :: PandocMonad m => Int -> MuseParser m (F (Inlines, [Blocks]))
+definitionListItem n = try $ do
+ count n spaceChar
+ pos <- getPosition
+ term <- trimInlinesF . mconcat <$> manyTill (choice inlineList) (string "::")
+ void spaceChar <|> lookAhead eol
+ contents <- listItemContents' $ sourceColumn pos
+ pure $ do lineContent' <- contents
term' <- term
pure (term', [lineContent'])
- where
- termParser = (guardDisabled Ext_amuse <|> void spaceChar) >> -- Initial space is required by Amusewiki, but not Emacs Muse
- many spaceChar >>
- many1Till (noneOf "\n") (lookAhead (void (try (spaceChar >> string "::"))))
- endOfInput = lookAhead $ try $ skipMany blankline >> skipSpaces >> eof
- twoBlankLines = try $ blankline >> skipMany1 blankline
- newDefinitionListItem = try $ void termParser
- endOfListItemElement = lookAhead $ endOfInput <|> newDefinitionListItem <|> twoBlankLines
-
-definitionListItems :: PandocMonad m => MuseParser m (F [(Inlines, [Blocks])])
-definitionListItems = sequence <$> many1 definitionListItem
definitionList :: PandocMonad m => MuseParser m (F Blocks)
-definitionList = do
- listItems <- definitionListItems
- return $ B.definitionList <$> listItems
+definitionList = try $ do
+ many spaceChar
+ pos <- getPosition
+ guardDisabled Ext_amuse <|> guard (sourceColumn pos /= 1) -- Initial space is required by Amusewiki, but not Emacs Muse
+ first <- definitionListItem 0
+ rest <- many $ try (optionMaybe blankline >> definitionListItem (sourceColumn pos - 1))
+ return $ B.definitionList <$> sequence (first : rest)
--
-- tables
@@ -590,16 +566,14 @@ tableParseCaption :: PandocMonad m => MuseParser m MuseTableElement
tableParseCaption = try $ do
many spaceChar
string "|+"
- contents <- trimInlinesF . mconcat <$> many1Till inline (lookAhead $ string "+|")
- string "+|"
- return $ MuseCaption contents
+ MuseCaption <$> (trimInlinesF . mconcat <$> many1Till inline (string "+|"))
--
-- inline parsers
--
inlineList :: PandocMonad m => [MuseParser m (F Inlines)]
-inlineList = [ endline
+inlineList = [ whitespace
, br
, anchor
, footnote
@@ -617,13 +591,12 @@ inlineList = [ endline
, code
, codeTag
, inlineLiteralTag
- , whitespace
, str
, symbol
]
inline :: PandocMonad m => MuseParser m (F Inlines)
-inline = choice inlineList <?> "inline"
+inline = choice [endline, linebreak] <|> choice inlineList <?> "inline"
endline :: PandocMonad m => MuseParser m (F Inlines)
endline = try $ do
@@ -657,23 +630,23 @@ footnote = try $ do
let contents' = runF contents st { stateNotes' = M.empty }
return $ B.note contents'
+linebreak :: PandocMonad m => MuseParser m (F Inlines)
+linebreak = try $ do
+ skipMany spaceChar
+ newline
+ notFollowedBy newline
+ return $ return B.space
+
whitespace :: PandocMonad m => MuseParser m (F Inlines)
-whitespace = fmap return (lb <|> regsp)
- where lb = try $ skipMany spaceChar >> linebreak >> return B.space
- regsp = try $ skipMany1 spaceChar >> return B.space
+whitespace = try $ do
+ skipMany1 spaceChar
+ return $ return B.space
br :: PandocMonad m => MuseParser m (F Inlines)
br = try $ do
string "<br>"
return $ return B.linebreak
-linebreak :: PandocMonad m => MuseParser m (F Inlines)
-linebreak = newline >> notFollowedBy newline >> (lastNewline <|> innerNewline)
- where lastNewline = do
- eof
- return $ return mempty
- innerNewline = return $ return B.space
-
emphasisBetween :: (PandocMonad m, Show a) => MuseParser m a -> MuseParser m (F Inlines)
emphasisBetween c = try $ enclosedInlines c c
@@ -724,28 +697,23 @@ verbatimTag = do
return $ return $ B.text content
nbsp :: PandocMonad m => MuseParser m (F Inlines)
-nbsp = do
- guardDisabled Ext_amuse -- Supported only by Emacs Muse
+nbsp = try $ do
string "~~"
return $ return $ B.str "\160"
code :: PandocMonad m => MuseParser m (F Inlines)
code = try $ do
- pos <- getPosition
- sp <- if sourceColumn pos == 1
- then pure mempty
- else skipMany1 spaceChar >> pure B.space
- char '='
+ atStart $ char '='
contents <- many1Till (noneOf "\n\r" <|> (newline <* notFollowedBy newline)) $ char '='
guard $ not $ null contents
guard $ head contents `notElem` " \t\n"
guard $ last contents `notElem` " \t\n"
notFollowedBy $ satisfy isLetter
- return $ return (sp B.<> B.code contents)
+ return $ return $ B.code contents
codeTag :: PandocMonad m => MuseParser m (F Inlines)
codeTag = do
- (attrs, content) <- parseHtmlContentWithAttrs "code" anyChar
+ (attrs, content) <- htmlElement "code"
return $ return $ B.codeWith attrs content
inlineLiteralTag :: PandocMonad m => MuseParser m (F Inlines)
@@ -786,8 +754,7 @@ link = try $ do
linkContent :: PandocMonad m => MuseParser m (F Inlines)
linkContent = do
char '['
- res <- many1Till anyChar $ char ']'
- parseFromString (mconcat <$> many1 inline) res
+ trimInlinesF . mconcat <$> many1Till inline (string "]")
linkText :: PandocMonad m => MuseParser m (String, String, Maybe (F Inlines))
linkText = do
diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs
index cdfa8f8df..ef8b2d18a 100644
--- a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs
+++ b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs
@@ -211,9 +211,9 @@ a ^>>?% f = arr a >>?^ (uncurry f)
---
(>>?%?) :: (ArrowChoice a)
=> FallibleArrow a x f (b,b')
- -> (b -> b' -> (Either f c))
+ -> (b -> b' -> Either f c)
-> FallibleArrow a x f c
-a >>?%? f = a >>?^? (uncurry f)
+a >>?%? f = a >>?^? uncurry f
infixr 1 >>?, >>?^, >>?^?
infixr 1 ^>>?, >>?!
diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs
index cc9b798b3..380f16c66 100644
--- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs
+++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs
@@ -322,7 +322,7 @@ type InlineModifier = Inlines -> Inlines
modifierFromStyleDiff :: PropertyTriple -> InlineModifier
modifierFromStyleDiff propertyTriple =
composition $
- (getVPosModifier propertyTriple)
+ getVPosModifier propertyTriple
: map (first ($ propertyTriple) >>> ifThen_else ignore)
[ (hasEmphChanged , emph )
, (hasChanged isStrong , strong )
@@ -352,7 +352,7 @@ modifierFromStyleDiff propertyTriple =
]
hasChanged property triple@(_, property -> newProperty, _) =
- maybe True (/=newProperty) (lookupPreviousValue property triple)
+ (/= Just newProperty) (lookupPreviousValue property triple)
hasChangedM property triple@(_, textProps,_) =
fromMaybe False $ (/=) <$> property textProps <*> lookupPreviousValueM property triple
@@ -362,7 +362,7 @@ modifierFromStyleDiff propertyTriple =
lookupPreviousValueM f = lookupPreviousStyleValue ((f =<<).textProperties)
lookupPreviousStyleValue f (ReaderState{..},_,mFamily)
- = ( findBy f $ extendedStylePropertyChain styleTrace styleSet )
+ = findBy f (extendedStylePropertyChain styleTrace styleSet)
<|> ( f =<< fmap (lookupDefaultStyle' styleSet) mFamily )
@@ -793,8 +793,7 @@ read_image_src = matchingElement NsDraw "image"
Left _ -> returnV "" -< ()
read_frame_title :: InlineMatcher
-read_frame_title = matchingElement NsSVG "title"
- $ (matchChildContent [] read_plain_text)
+read_frame_title = matchingElement NsSVG "title" (matchChildContent [] read_plain_text)
read_frame_text_box :: InlineMatcher
read_frame_text_box = matchingElement NsDraw "text-box"
@@ -803,12 +802,12 @@ 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) : _) =
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)
+read_img_with_caption ( Para (_ : xs) : ys) =
+ read_img_with_caption (Para xs : ys)
read_img_with_caption _ =
mempty
@@ -909,8 +908,8 @@ post_process (Pandoc m blocks) =
Pandoc m (post_process' blocks)
post_process' :: [Block] -> [Block]
-post_process' ((Table _ a w h r) : (Div ("", ["caption"], _) [Para inlines] ) : xs) =
- (Table inlines a w h r) : ( post_process' xs )
+post_process' (Table _ a w h r : Div ("", ["caption"], _) [Para inlines] : xs) =
+ Table inlines a w h r : post_process' xs
post_process' bs = bs
read_body :: OdtReader _x (Pandoc, MediaBag)
diff --git a/src/Text/Pandoc/Readers/Odt/Namespaces.hs b/src/Text/Pandoc/Readers/Odt/Namespaces.hs
index 3c11aeb8e..92e12931d 100644
--- a/src/Text/Pandoc/Readers/Odt/Namespaces.hs
+++ b/src/Text/Pandoc/Readers/Odt/Namespaces.hs
@@ -48,7 +48,7 @@ instance NameSpaceID Namespace where
findID :: NameSpaceIRI -> Maybe Namespace
-findID iri = listToMaybe [nsID | (iri',~nsID) <- nsIDs, iri' `isPrefixOf` iri]
+findID iri = listToMaybe [nsID | (iri',nsID) <- nsIDs, iri' `isPrefixOf` iri]
nsIDmap :: NameSpaceIRIs Namespace
nsIDmap = foldr (uncurry $ flip M.insert) M.empty nsIDs
diff --git a/src/Text/Pandoc/Readers/Odt/StyleReader.hs b/src/Text/Pandoc/Readers/Odt/StyleReader.hs
index 6129c1664..58be8e4a3 100644
--- a/src/Text/Pandoc/Readers/Odt/StyleReader.hs
+++ b/src/Text/Pandoc/Readers/Odt/StyleReader.hs
@@ -131,13 +131,12 @@ type StyleReaderSafe a b = XMLReaderSafe FontPitches a b
-- | A reader for font pitches
fontPitchReader :: XMLReader _s _x FontPitches
fontPitchReader = executeIn NsOffice "font-face-decls" (
- ( withEveryL NsStyle "font-face" $ liftAsSuccess (
+ withEveryL NsStyle "font-face" (liftAsSuccess (
findAttr' NsStyle "name"
&&&
lookupDefaultingAttr NsStyle "font-pitch"
- )
- )
- >>?^ ( M.fromList . (foldl accumLegalPitches []) )
+ ))
+ >>?^ ( M.fromList . foldl accumLegalPitches [] )
)
where accumLegalPitches ls (Nothing,_) = ls
accumLegalPitches ls (Just n,p) = (n,p):ls
@@ -383,11 +382,11 @@ data ListLevelStyle = ListLevelStyle { listLevelType :: ListLevelType
instance Show ListLevelStyle where
show ListLevelStyle{..} = "<LLS|"
- ++ (show listLevelType)
+ ++ show listLevelType
++ "|"
- ++ (maybeToString listItemPrefix)
- ++ (show listItemFormat)
- ++ (maybeToString listItemSuffix)
+ ++ maybeToString listItemPrefix
+ ++ show listItemFormat
+ ++ maybeToString listItemSuffix
++ ">"
where maybeToString = fromMaybe ""
@@ -483,14 +482,14 @@ readTextProperties =
( liftA6 PropT
( searchAttr NsXSL_FO "font-style" False isFontEmphasised )
( searchAttr NsXSL_FO "font-weight" False isFontBold )
- ( findPitch )
+ findPitch
( getAttr NsStyle "text-position" )
- ( readUnderlineMode )
- ( readStrikeThroughMode )
+ readUnderlineMode
+ readStrikeThroughMode
)
where isFontEmphasised = [("normal",False),("italic",True),("oblique",True)]
isFontBold = ("normal",False):("bold",True)
- :(map ((,True).show) ([100,200..900]::[Int]))
+ :map ((,True).show) ([100,200..900]::[Int])
readUnderlineMode :: StyleReaderSafe _x (Maybe UnderlineMode)
readUnderlineMode = readLineMode "text-underline-mode"
@@ -510,7 +509,7 @@ readLineMode modeAttr styleAttr = proc x -> do
Nothing -> returnA -< Just UnderlineModeNormal
else returnA -< Nothing
where
- isLinePresent = [("none",False)] ++ map (,True)
+ isLinePresent = ("none",False) : map (,True)
[ "dash" , "dot-dash" , "dot-dot-dash" , "dotted"
, "long-dash" , "solid" , "wave"
]
@@ -547,20 +546,18 @@ readListStyle =
findAttr NsStyle "name"
>>?! keepingTheValue
( liftA ListStyle
- $ ( liftA3 SM.union3
+ $ liftA3 SM.union3
( readListLevelStyles NsText "list-level-style-number" LltNumbered )
( readListLevelStyles NsText "list-level-style-bullet" LltBullet )
- ( readListLevelStyles NsText "list-level-style-image" LltImage )
- ) >>^ M.mapMaybe chooseMostSpecificListLevelStyle
+ ( readListLevelStyles NsText "list-level-style-image" LltImage ) >>^ M.mapMaybe chooseMostSpecificListLevelStyle
)
--
readListLevelStyles :: Namespace -> ElementName
-> ListLevelType
-> StyleReaderSafe _x (SM.SetMap Int ListLevelStyle)
readListLevelStyles namespace elementName levelType =
- ( tryAll namespace elementName (readListLevelStyle levelType)
+ tryAll namespace elementName (readListLevelStyle levelType)
>>^ SM.fromList
- )
--
readListLevelStyle :: ListLevelType -> StyleReader _x (Int, ListLevelStyle)
@@ -632,7 +629,7 @@ parents style styles = unfoldr findNextParent style -- Ha!
getStyleFamily :: Style -> Styles -> Maybe StyleFamily
getStyleFamily style@Style{..} styles
= styleFamily
- <|> (F.asum $ map (`getStyleFamily` styles) $ parents style styles)
+ <|> F.asum (map (`getStyleFamily` styles) $ parents style styles)
-- | Each 'Style' has certain 'StyleProperties'. But sometimes not all property
-- values are specified. Instead, a value might be inherited from a
@@ -654,7 +651,7 @@ stylePropertyChain style styles
--
extendedStylePropertyChain :: [Style] -> Styles -> [StyleProperties]
extendedStylePropertyChain [] _ = []
-extendedStylePropertyChain [style] styles = (stylePropertyChain style styles)
- ++ (maybeToList (fmap (lookupDefaultStyle' styles) (getStyleFamily style styles)))
-extendedStylePropertyChain (style:trace) styles = (stylePropertyChain style styles)
- ++ (extendedStylePropertyChain trace styles)
+extendedStylePropertyChain [style] styles = stylePropertyChain style styles
+ ++ maybeToList (fmap (lookupDefaultStyle' styles) (getStyleFamily style styles))
+extendedStylePropertyChain (style:trace) styles = stylePropertyChain style styles
+ ++ extendedStylePropertyChain trace styles
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index c5a7d8e10..fa016283c 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -516,7 +516,7 @@ include = try $ do
blocksParser <- case includeArgs of
("example" : _) -> return $ pure . B.codeBlock <$> parseRaw
["export"] -> return . returnF $ B.fromList []
- ("export" : format : []) -> return $ pure . B.rawBlock format <$> parseRaw
+ ["export", format] -> return $ pure . B.rawBlock format <$> parseRaw
("src" : rest) -> do
let attr = case rest of
[lang] -> (mempty, [lang], mempty)
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 27ce5fa2d..e88d997f0 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -352,7 +352,7 @@ singleHeader' :: PandocMonad m => RSTParser m (Inlines, Char)
singleHeader' = try $ do
notFollowedBy' whitespace
lookAhead $ anyLine >> oneOf underlineChars
- txt <- trimInlines . mconcat <$> many1 (do {notFollowedBy newline; inline})
+ txt <- trimInlines . mconcat <$> many1 (notFollowedBy blankline >> inline)
pos <- getPosition
let len = sourceColumn pos - 1
blankline
@@ -972,11 +972,16 @@ extractCaption = do
legend <- optional blanklines >> (mconcat <$> many block)
return (capt,legend)
--- divide string by blanklines
+-- divide string by blanklines, and surround with
+-- \begin{aligned}...\end{aligned} if needed.
toChunks :: String -> [String]
toChunks = dropWhile null
- . map (trim . unlines)
+ . map (addAligned . trim . unlines)
. splitBy (all (`elem` (" \t" :: String))) . lines
+ -- we put this in an aligned environment if it contains \\, see #4254
+ where addAligned s = if "\\\\" `isInfixOf` s
+ then "\\begin{aligned}\n" ++ s ++ "\n\\end{aligned}"
+ else s
codeblock :: [String] -> Maybe String -> String -> String -> RSTParser m Blocks
codeblock classes numberLines lang body =
@@ -1157,9 +1162,19 @@ anchor = try $ do
refs <- referenceNames
blanklines
b <- block
- -- put identifier on next block:
let addDiv ref = B.divWith (ref, [], [])
- return $ foldr addDiv b refs
+ let emptySpanWithId id' = Span (id',[],[]) []
+ -- put identifier on next block:
+ case B.toList b of
+ [Header lev (_,classes,kvs) txt] ->
+ case reverse refs of
+ [] -> return b
+ (r:rs) -> return $ B.singleton $
+ Header lev (r,classes,kvs)
+ (txt ++ map emptySpanWithId rs)
+ -- we avoid generating divs for headers,
+ -- because it hides them from promoteHeader, see #4240
+ _ -> return $ foldr addDiv b refs
headerBlock :: PandocMonad m => RSTParser m [Char]
headerBlock = do
@@ -1248,7 +1263,7 @@ simpleTableHeader headless = try $ do
let rawHeads = if headless
then replicate (length dashes) ""
else simpleTableSplitLine indices rawContent
- heads <- mapM ( (parseFromString' (mconcat <$> many plain)) . trim) rawHeads
+ heads <- mapM ( parseFromString' (mconcat <$> many plain) . trim) rawHeads
return (heads, aligns, indices)
-- Parse a simple table.
@@ -1399,7 +1414,7 @@ renderRole contents fmt role attr = case role of
pepUrl = "http://www.python.org/dev/peps/pep-" ++ padNo ++ "/"
addClass :: String -> Attr -> Attr
-addClass c (ident, classes, keyValues) = (ident, union classes [c], keyValues)
+addClass c (ident, classes, keyValues) = (ident, classes `union` [c], keyValues)
roleName :: PandocMonad m => RSTParser m String
roleName = many1 (letter <|> char '-')
@@ -1439,7 +1454,7 @@ endline = try $ do
notFollowedBy blankline
-- parse potential list-starts at beginning of line differently in a list:
st <- getState
- when ((stateParserContext st) == ListItemState) $ notFollowedBy (anyOrderedListMarker >> spaceChar) >>
+ when (stateParserContext st == ListItemState) $ notFollowedBy (anyOrderedListMarker >> spaceChar) >>
notFollowedBy' bulletListStart
return B.softbreak
@@ -1562,7 +1577,7 @@ note = try $ do
-- not yet in this implementation.
updateState $ \st -> st{ stateNotes = [] }
contents <- parseFromString' parseBlocks raw
- let newnotes = if (ref == "*" || ref == "#") -- auto-numbered
+ let newnotes = if ref == "*" || ref == "#" -- auto-numbered
-- delete the note so the next auto-numbered note
-- doesn't get the same contents:
then deleteFirstsBy (==) notes [(ref,raw)]
diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs
index 46d6301e4..30bb6a715 100644
--- a/src/Text/Pandoc/Readers/Textile.hs
+++ b/src/Text/Pandoc/Readers/Textile.hs
@@ -110,7 +110,7 @@ noteBlock = try $ do
startPos <- getPosition
ref <- noteMarker
optional blankline
- contents <- fmap unlines $ many1Till anyLine (blanklines <|> noteBlock)
+ contents <- unlines <$> many1Till anyLine (blanklines <|> noteBlock)
endPos <- getPosition
let newnote = (ref, contents ++ "\n")
st <- getState
@@ -360,7 +360,7 @@ cellAttributes = try $ do
tableCell :: PandocMonad m => ParserT [Char] ParserState m ((Bool, Alignment), Blocks)
tableCell = try $ do
char '|'
- (isHeader, alignment) <- option (False, AlignDefault) $ cellAttributes
+ (isHeader, alignment) <- option (False, AlignDefault) cellAttributes
notFollowedBy blankline
raw <- trim <$>
many (noneOf "|\n" <|> try (char '\n' <* notFollowedBy blankline))
@@ -499,7 +499,7 @@ copy = do
note :: PandocMonad m => ParserT [Char] ParserState m Inlines
note = try $ do
- ref <- (char '[' *> many1 digit <* char ']')
+ ref <- char '[' *> many1 digit <* char ']'
notes <- stateNotes <$> getState
case lookup ref notes of
Nothing -> fail "note not found"
@@ -530,7 +530,7 @@ hyphenedWords = do
wordChunk :: PandocMonad m => ParserT [Char] ParserState m String
wordChunk = try $ do
hd <- noneOf wordBoundaries
- tl <- many ( (noneOf wordBoundaries) <|>
+ tl <- many ( noneOf wordBoundaries <|>
try (notFollowedBy' note *> oneOf markupChars
<* lookAhead (noneOf wordBoundaries) ) )
return $ hd:tl
@@ -614,7 +614,7 @@ escapedEqs = B.str <$>
-- | literal text escaped btw <notextile> tags
escapedTag :: PandocMonad m => ParserT [Char] ParserState m Inlines
escapedTag = B.str <$>
- (try $ string "<notextile>" *>
+ try (string "<notextile>" *>
manyTill anyChar' (try $ string "</notextile>"))
-- | Any special symbol defined in wordBoundaries
@@ -630,7 +630,8 @@ code = code1 <|> code2
-- any character except a newline before a blank line
anyChar' :: PandocMonad m => ParserT [Char] ParserState m Char
anyChar' =
- satisfy (/='\n') <|> (try $ char '\n' <* notFollowedBy blankline)
+ satisfy (/='\n') <|>
+ try (char '\n' <* notFollowedBy blankline)
code1 :: PandocMonad m => ParserT [Char] ParserState m Inlines
code1 = B.code <$> surrounded (char '@') anyChar'
diff --git a/src/Text/Pandoc/Readers/TikiWiki.hs b/src/Text/Pandoc/Readers/TikiWiki.hs
index 4a66cc13d..a92f7bed2 100644
--- a/src/Text/Pandoc/Readers/TikiWiki.hs
+++ b/src/Text/Pandoc/Readers/TikiWiki.hs
@@ -168,7 +168,7 @@ table = try $ do
where
-- The headers are as many empty srings as the number of columns
-- in the first row
- headers rows = map (B.plain . B.str) $replicate (length $ rows !! 0) ""
+ headers rows = map (B.plain . B.str) $replicate (length $ head rows) ""
para :: PandocMonad m => TikiWikiParser m B.Blocks
para = fmap (result . mconcat) ( many1Till inline endOfParaElement)
@@ -238,8 +238,8 @@ fixListNesting [first] = [recurseOnList first]
fixListNesting (first:second:rest) =
let secondBlock = head $ B.toList second in
case secondBlock of
- BulletList _ -> fixListNesting $ (mappend (recurseOnList first) (recurseOnList second)) : rest
- OrderedList _ _ -> fixListNesting $ (mappend (recurseOnList first) (recurseOnList second)) : rest
+ BulletList _ -> fixListNesting $ mappend (recurseOnList first) (recurseOnList second) : rest
+ OrderedList _ _ -> fixListNesting $ mappend (recurseOnList first) (recurseOnList second) : rest
_ -> recurseOnList first : fixListNesting (second:rest)
-- This function walks the Block structure for fixListNesting,
@@ -285,7 +285,7 @@ spanFoldUpList ln (first:rest) =
-- level and of the same type.
splitListNesting :: ListNesting -> (ListNesting, B.Blocks) -> Bool
splitListNesting ln1 (ln2, _)
- | (lnnest ln1) < (lnnest ln2) =
+ | lnnest ln1 < lnnest ln2 =
True
| ln1 == ln2 =
True
@@ -341,7 +341,7 @@ listItemLine nest = lineContent >>= parseContent
lineContent = do
content <- anyLine
continuation <- optionMaybe listContinuation
- return $ filterSpaces content ++ "\n" ++ maybe "" id continuation
+ return $ filterSpaces content ++ "\n" ++ Data.Maybe.fromMaybe "" continuation
filterSpaces = reverse . dropWhile (== ' ') . reverse
listContinuation = string (replicate nest '+') >> lineContent
parseContent x = do
@@ -410,7 +410,7 @@ inline = choice [ whitespace
] <?> "inline"
whitespace :: PandocMonad m => TikiWikiParser m B.Inlines
-whitespace = (lb <|> regsp)
+whitespace = lb <|> regsp
where lb = try $ skipMany spaceChar >> linebreak >> return B.space
regsp = try $ skipMany1 spaceChar >> return B.space
@@ -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
diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs
index 68399afc9..b4f4bc564 100644
--- a/src/Text/Pandoc/Readers/Txt2Tags.hs
+++ b/src/Text/Pandoc/Readers/Txt2Tags.hs
@@ -36,7 +36,7 @@ import Control.Monad.Except (catchError, throwError)
import Control.Monad.Reader (Reader, asks, runReader)
import Data.Char (toLower)
import Data.Default
-import Data.List (intercalate, intersperse, transpose)
+import Data.List (intercalate, transpose)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
@@ -463,7 +463,7 @@ titleLink = try $ do
char ']'
let link' = last tokens
guard $ not $ null link'
- let tit = concat (intersperse " " (init tokens))
+ let tit = unwords (init tokens)
return $ B.link link' "" (B.text tit)
-- Link with image
diff --git a/src/Text/Pandoc/Readers/Vimwiki.hs b/src/Text/Pandoc/Readers/Vimwiki.hs
index 162fb371e..d717a1ba8 100644
--- a/src/Text/Pandoc/Readers/Vimwiki.hs
+++ b/src/Text/Pandoc/Readers/Vimwiki.hs
@@ -388,9 +388,7 @@ bulletListMarkers = "ul" <$ (char '*' <|> char '-')
orderedListMarkers :: PandocMonad m => VwParser m String
orderedListMarkers =
- ("ol" <$choice (orderedListMarker Decimal Period:(($OneParen)
- <$> orderedListMarker
- <$> [Decimal, LowerRoman, UpperRoman, LowerAlpha, UpperAlpha])))
+ ("ol" <$choice (orderedListMarker Decimal Period:(($OneParen) . orderedListMarker <$> [Decimal, LowerRoman, UpperRoman, LowerAlpha, UpperAlpha])))
<|> ("ol" <$ char '#')
--many need trimInlines
generated by cgit v1.2.3 (git 2.46.0) at 2025-11-12 05:45:47 +0000