RST Reader: parse list table directive (#3688)

Closes #3432.
2017-05-24 03:53:04 +09:00 · 2017-05-24 03:53:04 +09:00 · c0c54b7906
commit c0c54b7906
parent 8edeaa9349
2 changed files with 317 additions and 1 deletions
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@ -58,7 +58,6 @@ import Text.Printf (printf)
 -- [ ] .. parsed-literal
 -- [ ] :widths: attribute in .. table
 -- [ ] .. csv-table
 -- [ ] .. list-table
 -- | Parse reStructuredText string and return Pandoc document.
 readRST :: PandocMonad m
@ -676,6 +675,7 @@ directive' = do
                          (lengthToDim . filter (not . isSpace))
  case label of
        "table" -> tableDirective top fields body'
        "list-table" -> listTableDirective top fields body'
        "line-block" -> lineBlockDirective body'
        "raw" -> return $ B.rawBlock (trim top) (stripTrailingNewlines body)
        "role" -> addNewRole top $ map (\(k,v) -> (k, trim v)) fields
@ -762,6 +762,33 @@ tableDirective top _fields body = do
                                  aligns' widths' header' rows'
       _ -> return mempty
 -- TODO: :stub-columns:.
 -- Only the first row becomes the header even if header-rows: > 1, since Pandoc doesn't support a table with multiple header rows.
 -- We don't need to parse :align: as it represents the whole table align. 
 listTableDirective :: PandocMonad m => String -> [(String, String)] -> String -> RSTParser m Blocks
 listTableDirective top fields body = do
  bs <- parseFromString parseBlocks body
  title <- parseFromString (trimInlines . mconcat <$> many inline) top
  let rows = takeRows $ B.toList bs
      headerRowsNum = fromMaybe (0 :: Int) $ lookup "header-rows" fields >>= safeRead
      (headerRow,bodyRows,numOfCols) = case rows of
        x:xs -> if headerRowsNum > 0 then (x, xs, length x) else ([], rows, length x)
        _ -> ([],[],0)
      widths = case trim <$> lookup "widths" fields of
        Just "auto" -> replicate numOfCols 0
        Just specs -> normWidths $ map (fromMaybe (0 :: Double) . safeRead) $ splitBy (`elem` (" ," :: String)) specs
        _ -> replicate numOfCols 0
  return $ B.table title
             (zip (replicate numOfCols AlignDefault) widths)
             headerRow
             bodyRows
    where takeRows [BulletList rows] = map takeCells rows
          takeRows _ = []
          takeCells [BulletList cells] = map B.fromList cells
          takeCells _ = []
          normWidths ws = map (/ max 1 (sum ws)) ws
 -- TODO:
 --  - Only supports :format: fields with a single format for :raw: roles,
 --    change Text.Pandoc.Definition.Format to fix
--- a/test/command/3432.md
+++ b/test/command/3432.md
@ -0,0 +1,289 @@
 List-table with header-rows and widths options. 
 ```
 % pandoc -f rst
 .. list-table:: Frozen Delights!
   :widths: 15 10 30
   :header-rows: 1
   * - Treat
     - Quantity
     - Description
   * - Albatross
     - 2.99
     - On a stick!
   * - Crunchy Frog
     - 1.49
     - If we took the bones out, it wouldn't be
       crunchy, now would it?
   * - Gannet Ripple
     - 1.99
     - On a stick!
 ^D
 <table>
 <caption>Frozen Delights!</caption>
 <colgroup>
 <col style="width: 27%" />
 <col style="width: 18%" />
 <col style="width: 54%" />
 </colgroup>
 <thead>
 <tr class="header">
 <th>Treat</th>
 <th>Quantity</th>
 <th>Description</th>
 </tr>
 </thead>
 <tbody>
 <tr class="odd">
 <td>Albatross</td>
 <td>2.99</td>
 <td>On a stick!</td>
 </tr>
 <tr class="even">
 <td>Crunchy Frog</td>
 <td>1.49</td>
 <td>If we took the bones out, it wouldn't be crunchy, now would it?</td>
 </tr>
 <tr class="odd">
 <td>Gannet Ripple</td>
 <td>1.99</td>
 <td>On a stick!</td>
 </tr>
 </tbody>
 </table>
 ```
 List-table whose widths is "auto". 
 ```
 % pandoc -f rst
 .. list-table:: Frozen Delights!
   :header-rows: 1
   :widths: auto
   * - Treat
     - Quantity
     - Description
   * - Albatross
     - 2.99
     - On a stick!
   * - Crunchy Frog
     - 1.49
     - If we took the bones out, it wouldn't be
       crunchy, now would it?
   * - Gannet Ripple
     - 1.99
     - On a stick!
 ^D
 <table>
 <caption>Frozen Delights!</caption>
 <thead>
 <tr class="header">
 <th>Treat</th>
 <th>Quantity</th>
 <th>Description</th>
 </tr>
 </thead>
 <tbody>
 <tr class="odd">
 <td>Albatross</td>
 <td>2.99</td>
 <td>On a stick!</td>
 </tr>
 <tr class="even">
 <td>Crunchy Frog</td>
 <td>1.49</td>
 <td>If we took the bones out, it wouldn't be crunchy, now would it?</td>
 </tr>
 <tr class="odd">
 <td>Gannet Ripple</td>
 <td>1.99</td>
 <td>On a stick!</td>
 </tr>
 </tbody>
 </table>
 ```
 List-table with header-rows which is bigger than 1. Only the first row is treated as a header. 
 ```
 % pandoc -f rst
 .. list-table:: Frozen Delights!
   :header-rows: 2
   * - Treat
     - Quantity
     - Description
   * - Albatross
     - 2.99
     - On a stick!
   * - Crunchy Frog
     - 1.49
     - If we took the bones out, it wouldn't be
       crunchy, now would it?
   * - Gannet Ripple
     - 1.99
     - On a stick!
 ^D
 <table>
 <caption>Frozen Delights!</caption>
 <thead>
 <tr class="header">
 <th>Treat</th>
 <th>Quantity</th>
 <th>Description</th>
 </tr>
 </thead>
 <tbody>
 <tr class="odd">
 <td>Albatross</td>
 <td>2.99</td>
 <td>On a stick!</td>
 </tr>
 <tr class="even">
 <td>Crunchy Frog</td>
 <td>1.49</td>
 <td>If we took the bones out, it wouldn't be crunchy, now would it?</td>
 </tr>
 <tr class="odd">
 <td>Gannet Ripple</td>
 <td>1.99</td>
 <td>On a stick!</td>
 </tr>
 </tbody>
 </table>
 ```
 List-table without header-rows.
 ```
 % pandoc -f rst
 .. list-table:: Frozen Delights!
   * - Albatross
     - 2.99
     - On a stick!
   * - Crunchy Frog
     - 1.49
     - If we took the bones out, it wouldn't be
       crunchy, now would it?
   * - Gannet Ripple
     - 1.99
     - On a stick!
 ^D
 <table>
 <caption>Frozen Delights!</caption>
 <tbody>
 <tr class="odd">
 <td>Albatross</td>
 <td>2.99</td>
 <td>On a stick!</td>
 </tr>
 <tr class="even">
 <td>Crunchy Frog</td>
 <td>1.49</td>
 <td>If we took the bones out, it wouldn't be crunchy, now would it?</td>
 </tr>
 <tr class="odd">
 <td>Gannet Ripple</td>
 <td>1.99</td>
 <td>On a stick!</td>
 </tr>
 </tbody>
 </table>
 ```
 List-table with empty cells. You need a space after '-', otherwise the row will disapear. Parser for Bulletlists causes this ristriction. 
 ```
 % pandoc -f rst
 .. list-table:: Frozen Delights!
   :header-rows: 2
   * - Treat
     - Quantity
     - Description
   * - Albatross
     - 2.99
     - 
   * - Crunchy Frog
     - 
     - If we took the bones out, it wouldn't be
       crunchy, now would it?
   * - Gannet Ripple
     - 1.99
     - On a stick!
 ^D
 <table>
 <caption>Frozen Delights!</caption>
 <thead>
 <tr class="header">
 <th>Treat</th>
 <th>Quantity</th>
 <th>Description</th>
 </tr>
 </thead>
 <tbody>
 <tr class="odd">
 <td>Albatross</td>
 <td>2.99</td>
 <td></td>
 </tr>
 <tr class="even">
 <td>Crunchy Frog</td>
 <td></td>
 <td>If we took the bones out, it wouldn't be crunchy, now would it?</td>
 </tr>
 <tr class="odd">
 <td>Gannet Ripple</td>
 <td>1.99</td>
 <td>On a stick!</td>
 </tr>
 </tbody>
 </table>
 ```
 List-table with a cell having a bulletlist
 ```
 % pandoc -f rst
 .. list-table:: Frozen Delights!
   * - Albatross
     - 2.99
     - + On a stick!
       + In a cup!
   * - Crunchy Frog
     - 1.49
     - If we took the bones out, it wouldn't be
       crunchy, now would it?
   * - Gannet Ripple
     - 1.99
     - On a stick!
 ^D
 <table>
 <caption>Frozen Delights!</caption>
 <tbody>
 <tr class="odd">
 <td>Albatross</td>
 <td>2.99</td>
 <td><ul>
 <li>On a stick!</li>
 <li>In a cup!</li>
 </ul></td>
 </tr>
 <tr class="even">
 <td>Crunchy Frog</td>
 <td>1.49</td>
 <td>If we took the bones out, it wouldn't be crunchy, now would it?</td>
 </tr>
 <tr class="odd">
 <td>Gannet Ripple</td>
 <td>1.99</td>
 <td>On a stick!</td>
 </tr>
 </tbody>
 </table>
 ```