@@ -1,4 +1,3 @@
1−{-# LANGUAGE BangPatterns #-}
21{-# LANGUAGE CPP #-}
32{-# LANGUAGE FlexibleInstances #-}
43{-# LANGUAGE MultiParamTypeClasses #-}
@@ -32,7 +31,6 @@ import Control.Monad
3231import Control.Monad.Except (throwError)
3332import Data.Char (isDigit, isLetter, toUpper, chr)
3433import Data.Default
35−import Data.Functor (($>))
3634import Data.List (intercalate)
3735import qualified Data.Map as M
3836import Data.Maybe (fromMaybe, maybeToList)
@@ -58,6 +56,7 @@ import Text.Pandoc.Readers.LaTeX.Types (ExpansionPoint (..), Macro (..),
5856 ArgSpec (..), Tok (..), TokType (..))
5957import Text.Pandoc.Readers.LaTeX.Parsing
6058import Text.Pandoc.Readers.LaTeX.Accent (accentCommands)
59+import Text.Pandoc.Readers.LaTeX.Table (tableEnvironments)
6160import Text.Pandoc.Readers.LaTeX.Lang (polyglossiaLangToBCP47,
6261 babelLangToBCP47)
6362import Text.Pandoc.Readers.LaTeX.SIunitx
@@ -551,12 +550,8 @@ inlineCommand' = try $ do
551550 <|> ignore rawcommand
552551 lookupListDefault raw names inlineCommands
553552
554−
555553tok :: PandocMonad m => LP m Inlines
556−tok = try $ spaces >> grouped inline <|> inlineCommand' <|> singleChar'
557− where singleChar' = do
558− Tok _ _ t <- singleChar
559− return $ str t
554+tok = tokWith inline
560555
561556opt :: PandocMonad m => LP m Inlines
562557opt = do
@@ -1118,12 +1113,6 @@ treatAsInline = Set.fromList
11181113 , "pagebreak"
11191114 ]
11201115
1121−label :: PandocMonad m => LP m ()
1122−label = do
1123− controlSeq "label"
1124− t <- braced
1125− updateState $ \st -> st{ sLastLabel = Just $ untokenize t }
1126−
11271116dolabel :: PandocMonad m => LP m Inlines
11281117dolabel = do
11291118 v <- braced
@@ -1421,13 +1410,6 @@ bracketedNum = do
14211410 Just i -> return i
14221411 _ -> return 0
14231412
1424−setCaption :: PandocMonad m => LP m ()
1425−setCaption = try $ do
1426− skipopts
1427− ils <- tok
1428− optional $ try $ spaces *> label
1429− updateState $ \st -> st{ sCaption = Just ils }
1430−
14311413looseItem :: PandocMonad m => LP m Blocks
14321414looseItem = do
14331415 inListItem <- sInListItem <$> getState
@@ -1441,10 +1423,6 @@ epigraph = do
14411423 p2 <- grouped block
14421424 return $ divWith ("", ["epigraph"], []) (p1 <> p2)
14431425
1444−resetCaption :: PandocMonad m => LP m ()
1445−resetCaption = updateState $ \st -> st{ sCaption = Nothing
1446− , sLastLabel = Nothing }
1447−
14481426section :: PandocMonad m => Attr -> Int -> LP m Blocks
14491427section (ident, classes, kvs) lvl = do
14501428 skipopts
@@ -1585,7 +1563,7 @@ blockCommands = M.fromList
15851563 , ("item", looseItem)
15861564 , ("documentclass", skipopts *> braced *> preamble)
15871565 , ("centerline", para . trimInlines <$> (skipopts *> tok))
1588− , ("caption", mempty <$ setCaption)
1566+ , ("caption", mempty <$ setCaption inline)
15891567 , ("bibliography", mempty <$ (skipopts *> braced >>=
15901568 addMeta "bibliography" . splitBibs . untokenize))
15911569 , ("addbibresource", mempty <$ (skipopts *> braced >>=
@@ -1623,7 +1601,8 @@ blockCommands = M.fromList
16231601
16241602
16251603environments :: PandocMonad m => M.Map Text (LP m Blocks)
1626−environments = M.fromList
1604+environments = M.union (tableEnvironments blocks inline) $
1605+ M.fromList
16271606 [ ("document", env "document" blocks <* skipMany anyTok)
16281607 , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))
16291608 , ("sloppypar", env "sloppypar" blocks)
@@ -1633,13 +1612,6 @@ environments = M.fromList
16331612 , ("figure", env "figure" $ skipopts *> figure)
16341613 , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)
16351614 , ("center", divWith ("", ["center"], []) <$> env "center" blocks)
1636− , ("longtable", env "longtable" $
1637− resetCaption *> simpTable "longtable" False >>= addTableCaption)
1638− , ("table", env "table" $
1639− skipopts *> resetCaption *> blocks >>= addTableCaption)
1640− , ("tabular*", env "tabular*" $ simpTable "tabular*" True)
1641− , ("tabularx", env "tabularx" $ simpTable "tabularx" True)
1642− , ("tabular", env "tabular" $ simpTable "tabular" False)
16431615 , ("quote", blockQuote <$> env "quote" blocks)
16441616 , ("quotation", blockQuote <$> env "quotation" blocks)
16451617 , ("verse", blockQuote <$> env "verse" blocks)
@@ -1805,9 +1777,6 @@ italicize (Para ils) = Para [Emph ils]
18051777italicize (Plain ils) = Plain [Emph ils]
18061778italicize x = x
18071779
1808−env :: PandocMonad m => Text -> LP m a -> LP m a
1809−env name p = p <* end_ name
1810−
18111780rawEnv :: PandocMonad m => Text -> LP m Blocks
18121781rawEnv name = do
18131782 exts <- getOption readerExtensions
@@ -2045,333 +2014,6 @@ orderedList' = try $ do
20452014 bs <- listenv "enumerate" (many item)
20462015 return $ orderedListWith (start, style, delim) bs
20472016
2048−-- tables
2049−
2050−hline :: PandocMonad m => LP m ()
2051−hline = try $ do
2052− spaces
2053− controlSeq "hline" <|>
2054− -- booktabs rules:
2055− controlSeq "toprule" <|>
2056− controlSeq "bottomrule" <|>
2057− controlSeq "midrule" <|>
2058− controlSeq "endhead" <|>
2059− controlSeq "endfirsthead"
2060− spaces
2061− optional opt
2062− return ()
2063−
2064−lbreak :: PandocMonad m => LP m Tok
2065−lbreak = (controlSeq "\\" <|> controlSeq "tabularnewline")
2066− <* skipopts <* spaces
2067−
2068−amp :: PandocMonad m => LP m Tok
2069−amp = symbol '&'
2070−
2071−-- Split a Word into individual Symbols (for parseAligns)
2072−splitWordTok :: PandocMonad m => LP m ()
2073−splitWordTok = do
2074− inp <- getInput
2075− case inp of
2076− (Tok spos Word t : rest) ->
2077− setInput $ map (Tok spos Symbol . T.singleton) (T.unpack t) <> rest
2078− _ -> return ()
2079−
2080−parseAligns :: PandocMonad m => LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
2081−parseAligns = try $ do
2082− let maybeBar = skipMany
2083− (try $ sp *> (() <$ symbol '|' <|> () <$ (symbol '@' >> braced)))
2084− let cAlign = AlignCenter <$ symbol 'c'
2085− let lAlign = AlignLeft <$ symbol 'l'
2086− let rAlign = AlignRight <$ symbol 'r'
2087− let parAlign = AlignLeft <$ symbol 'p'
2088− -- aligns from tabularx
2089− let xAlign = AlignLeft <$ symbol 'X'
2090− let mAlign = AlignLeft <$ symbol 'm'
2091− let bAlign = AlignLeft <$ symbol 'b'
2092− let alignChar = splitWordTok *> ( cAlign <|> lAlign <|> rAlign <|> parAlign
2093− <|> xAlign <|> mAlign <|> bAlign )
2094− let alignPrefix = symbol '>' >> braced
2095− let alignSuffix = symbol '<' >> braced
2096− let colWidth = try $ do
2097− symbol '{'
2098− ds <- trim . untokenize <$> manyTill anyTok (controlSeq "linewidth")
2099− spaces
2100− symbol '}'
2101− return $ safeRead ds
2102− let alignSpec = do
2103− pref <- option [] alignPrefix
2104− spaces
2105− al <- alignChar
2106− width <- colWidth <|> option Nothing (do s <- untokenize <$> braced
2107− pos <- getPosition
2108− report $ SkippedContent s pos
2109− return Nothing)
2110− spaces
2111− suff <- option [] alignSuffix
2112− return (al, width, (pref, suff))
2113− let starAlign = do -- '*{2}{r}' == 'rr', we just expand like a macro
2114− symbol '*'
2115− spaces
2116− ds <- trim . untokenize <$> braced
2117− spaces
2118− spec <- braced
2119− case safeRead ds of
2120− Just n ->
2121− getInput >>= setInput . (mconcat (replicate n spec) ++)
2122− Nothing -> Prelude.fail $ "Could not parse " <> T.unpack ds <> " as number"
2123− bgroup
2124− spaces
2125− maybeBar
2126− aligns' <- many $ try $ spaces >> optional starAlign >>
2127− (alignSpec <* maybeBar)
2128− spaces
2129− egroup
2130− spaces
2131− return $ map toSpec aligns'
2132− where
2133− toColWidth (Just w) | w > 0 = ColWidth w
2134− toColWidth _ = ColWidthDefault
2135− toSpec (x, y, z) = (x, toColWidth y, z)
2136−
2137−-- N.B. this parser returns a Row that may have erroneous empty cells
2138−-- in it. See the note above fixTableHead for details.
2139−parseTableRow :: PandocMonad m
2140− => Text -- ^ table environment name
2141− -> [([Tok], [Tok])] -- ^ pref/suffixes
2142− -> LP m Row
2143−parseTableRow envname prefsufs = do
2144− notFollowedBy (spaces *> end_ envname)
2145− -- add prefixes and suffixes in token stream:
2146− let celltoks (pref, suff) = do
2147− prefpos <- getPosition
2148− contents <- mconcat <$>
2149− many ( snd <$> withRaw (controlSeq "parbox" >> parbox) -- #5711
2150− <|>
2151− snd <$> withRaw (inlineEnvironment <|> dollarsMath)
2152− <|>
2153− (do notFollowedBy
2154− (() <$ amp <|> () <$ lbreak <|> end_ envname)
2155− count 1 anyTok) )
2156−
2157− suffpos <- getPosition
2158− option [] (count 1 amp)
2159− return $ map (setpos prefpos) pref ++ contents ++ map (setpos suffpos) suff
2160− rawcells <- mapM celltoks prefsufs
2161− cells <- mapM (parseFromToks parseTableCell) rawcells
2162− spaces
2163− return $ Row nullAttr cells
2164−
2165−parseTableCell :: PandocMonad m => LP m Cell
2166−parseTableCell = do
2167− spaces
2168− updateState $ \st -> st{ sInTableCell = True }
2169− cell' <- multicolumnCell
2170− <|> multirowCell
2171− <|> parseSimpleCell
2172− <|> parseEmptyCell
2173− updateState $ \st -> st{ sInTableCell = False }
2174− spaces
2175− return cell'
2176− where
2177− -- The parsing of empty cells is important in LaTeX, especially when dealing
2178− -- with multirow/multicolumn. See #6603.
2179− parseEmptyCell = spaces $> emptyCell
2180−
2181−cellAlignment :: PandocMonad m => LP m Alignment
2182−cellAlignment = skipMany (symbol '|') *> alignment <* skipMany (symbol '|')
2183− where
2184− alignment = do
2185− c <- untoken <$> singleChar
2186− return $ case c of
2187− "l" -> AlignLeft
2188− "r" -> AlignRight
2189− "c" -> AlignCenter
2190− "*" -> AlignDefault
2191− _ -> AlignDefault
2192−
2193−plainify :: Blocks -> Blocks
2194−plainify bs = case toList bs of
2195− [Para ils] -> plain (fromList ils)
2196− _ -> bs
2197−
2198−multirowCell :: PandocMonad m => LP m Cell
2199−multirowCell = controlSeq "multirow" >> do
2200− -- Full prototype for \multirow macro is:
2201− -- \multirow[vpos]{nrows}[bigstruts]{width}[vmove]{text}
2202− -- However, everything except `nrows` and `text` make
2203− -- sense in the context of the Pandoc AST
2204− _ <- optional $ symbol '[' *> cellAlignment <* symbol ']' -- vertical position
2205− nrows <- fmap (fromMaybe 1 . safeRead . untokenize) braced
2206− _ <- optional $ symbol '[' *> manyTill anyTok (symbol ']') -- bigstrut-related
2207− _ <- symbol '{' *> manyTill anyTok (symbol '}') -- Cell width
2208− _ <- optional $ symbol '[' *> manyTill anyTok (symbol ']') -- Length used for fine-tuning
2209− content <- symbol '{' *> (plainify <$> blocks) <* symbol '}'
2210− return $ cell AlignDefault (RowSpan nrows) (ColSpan 1) content
2211−
2212−multicolumnCell :: PandocMonad m => LP m Cell
2213−multicolumnCell = controlSeq "multicolumn" >> do
2214− span' <- fmap (fromMaybe 1 . safeRead . untokenize) braced
2215− alignment <- symbol '{' *> cellAlignment <* symbol '}'
2216−
2217− let singleCell = do
2218− content <- plainify <$> blocks
2219− return $ cell alignment (RowSpan 1) (ColSpan span') content
2220−
2221− -- Two possible contents: either a \multirow cell, or content.
2222− -- E.g. \multicol{1}{c}{\multirow{2}{1em}{content}}
2223− -- Note that a \multirow cell can be nested in a \multicolumn,
2224− -- but not the other way around. See #6603
2225− let nestedCell = do
2226− (Cell _ _ (RowSpan rs) _ bs) <- multirowCell
2227− return $ cell
2228− alignment
2229− (RowSpan rs)
2230− (ColSpan span')
2231− (fromList bs)
2232−
2233− symbol '{' *> (nestedCell <|> singleCell) <* symbol '}'
2234−
2235−-- Parse a simple cell, i.e. not multirow/multicol
2236−parseSimpleCell :: PandocMonad m => LP m Cell
2237−parseSimpleCell = simpleCell <$> (plainify <$> blocks)
2238−
2239−-- LaTeX tables are stored with empty cells underneath multirow cells
2240−-- denoting the grid spaces taken up by them. More specifically, if a
2241−-- cell spans m rows, then it will overwrite all the cells in the
2242−-- columns it spans for (m-1) rows underneath it, requiring padding
2243−-- cells in these places. These padding cells need to be removed for
2244−-- proper table reading. See #6603.
2245−--
2246−-- These fixTable functions do not otherwise fix up malformed
2247−-- input tables: that is left to the table builder.
2248−fixTableHead :: TableHead -> TableHead
2249−fixTableHead (TableHead attr rows) = TableHead attr rows'
2250− where
2251− rows' = fixTableRows rows
2252−
2253−fixTableBody :: TableBody -> TableBody
2254−fixTableBody (TableBody attr rhc th tb)
2255− = TableBody attr rhc th' tb'
2256− where
2257− th' = fixTableRows th
2258− tb' = fixTableRows tb
2259−
2260−fixTableRows :: [Row] -> [Row]
2261−fixTableRows = fixTableRows' $ repeat Nothing
2262− where
2263− fixTableRows' oldHang (Row attr cells : rs)
2264− = let (newHang, cells') = fixTableRow oldHang cells
2265− rs' = fixTableRows' newHang rs
2266− in Row attr cells' : rs'
2267− fixTableRows' _ [] = []
2268−
2269−-- The overhang is represented as Just (relative cell dimensions) or
2270−-- Nothing for an empty grid space.
2271−fixTableRow :: [Maybe (ColSpan, RowSpan)] -> [Cell] -> ([Maybe (ColSpan, RowSpan)], [Cell])
2272−fixTableRow oldHang cells
2273− -- If there's overhang, drop cells until their total width meets the
2274− -- width of the occupied grid spaces (or we run out)
2275− | (n, prefHang, restHang) <- splitHang oldHang
2276− , n > 0
2277− = let cells' = dropToWidth getCellW n cells
2278− (restHang', cells'') = fixTableRow restHang cells'
2279− in (prefHang restHang', cells'')
2280− -- Otherwise record the overhang of a pending cell and fix the rest
2281− -- of the row
2282− | c@(Cell _ _ h w _):cells' <- cells
2283− = let h' = max 1 h
2284− w' = max 1 w
2285− oldHang' = dropToWidth getHangW w' oldHang
2286− (newHang, cells'') = fixTableRow oldHang' cells'
2287− in (toHang w' h' <> newHang, c : cells'')
2288− | otherwise
2289− = (oldHang, [])
2290− where
2291− getCellW (Cell _ _ _ w _) = w
2292− getHangW = maybe 1 fst
2293− getCS (ColSpan n) = n
2294−
2295− toHang c r
2296− | r > 1 = [Just (c, r)]
2297− | otherwise = replicate (getCS c) Nothing
2298−
2299− -- Take the prefix of the overhang list representing filled grid
2300− -- spaces. Also return the remainder and the length of this prefix.
2301− splitHang = splitHang' 0 id
2302−
2303− splitHang' !n l (Just (c, r):xs)
2304− = splitHang' (n + c) (l . (toHang c (r-1) ++)) xs
2305− splitHang' n l xs = (n, l, xs)
2306−
2307− -- Drop list items until the total width of the dropped items
2308− -- exceeds the passed width.
2309− dropToWidth _ n l | n < 1 = l
2310− dropToWidth wproj n (c:cs) = dropToWidth wproj (n - wproj c) cs
2311− dropToWidth _ _ [] = []
2312−
2313−simpTable :: PandocMonad m => Text -> Bool -> LP m Blocks
2314−simpTable envname hasWidthParameter = try $ do
2315− when hasWidthParameter $ () <$ (spaces >> tok)
2316− skipopts
2317− colspecs <- parseAligns
2318− let (aligns, widths, prefsufs) = unzip3 colspecs
2319− optional $ controlSeq "caption" *> setCaption
2320− spaces
2321− optional label
2322− spaces
2323− optional lbreak
2324− spaces
2325− skipMany hline
2326− spaces
2327− header' <- option [] . try . fmap (:[]) $
2328− parseTableRow envname prefsufs <* lbreak <* many1 hline
2329− spaces
2330− rows <- sepEndBy (parseTableRow envname prefsufs)
2331− (lbreak <* optional (skipMany hline))
2332− spaces
2333− optional $ controlSeq "caption" *> setCaption
2334− spaces
2335− optional label
2336− spaces
2337− optional lbreak
2338− spaces
2339− lookAhead $ controlSeq "end" -- make sure we're at end
2340− let th = fixTableHead $ TableHead nullAttr header'
2341− let tbs = [fixTableBody $ TableBody nullAttr 0 [] rows]
2342− let tf = TableFoot nullAttr []
2343− return $ table emptyCaption (zip aligns widths) th tbs tf
2344−
2345−addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
2346−addTableCaption = walkM go
2347− where go (Table attr c spec th tb tf) = do
2348− st <- getState
2349− let mblabel = sLastLabel st
2350− capt <- case (sCaption st, mblabel) of
2351− (Just ils, Nothing) -> return $ caption Nothing (plain ils)
2352− (Just ils, Just lab) -> do
2353− num <- getNextNumber sLastTableNum
2354− setState
2355− st{ sLastTableNum = num
2356− , sLabels = M.insert lab
2357− [Str (renderDottedNum num)]
2358− (sLabels st) }
2359− return $ caption Nothing (plain ils) -- add number??
2360− (Nothing, _) -> return c
2361− let attr' = case (attr, mblabel) of
2362− ((_,classes,kvs), Just ident) ->
2363− (ident,classes,kvs)
2364− _ -> attr
2365− return $ addAttrDiv attr' $ Table nullAttr capt spec th tb tf
2366− go x = return x
2367−
2368−-- TODO: For now we add a Div to contain table attributes, since
2369−-- most writers don't do anything yet with attributes on Table.
2370−-- This can be removed when that changes.
2371−addAttrDiv :: Attr -> Block -> Block
2372−addAttrDiv ("",[],[]) b = b
2373−addAttrDiv attr b = Div attr [b]
2374−
23752017block :: PandocMonad m => LP m Blocks
23762018block = do
23772019 res <- (mempty <$ spaces1)