@@ -31,7 +31,7 @@ module Text.Pandoc.Readers.Markdown (
3131 readMarkdown
3232 ) where
3333
34−import Data.List ( findIndex, sortBy )
34+import Data.List ( findIndex, sortBy, transpose )
3535import Data.Char ( isAlphaNum )
3636import Text.ParserCombinators.Pandoc
3737import Text.Pandoc.Definition
@@ -88,6 +88,7 @@ setextHChars = ['=','-']
8888blockQuoteChar = '>'
8989hyphenChar = '-'
9090ellipsesChar = '.'
91+listColSepChar = '|'
9192
9293-- treat these as potentially non-text when parsing inline:
9394specialChars = [escapeChar, labelStart, labelEnd, emphStart, emphEnd,
@@ -106,9 +107,9 @@ indentSpaces = do
106107 state <- getState
107108 let tabStop = stateTabStop state
108109 count tabStop (char ' ') <|>
109− (do{skipNonindentSpaces; string "\t"}) <?> "indentation"
110+ (do{nonindentSpaces; string "\t"}) <?> "indentation"
110111
111−skipNonindentSpaces = do
112+nonindentSpaces = do
112113 state <- getState
113114 let tabStop = stateTabStop state
114115 choice (map (\n -> (try (count n (char ' ')))) (reverse [0..(tabStop - 1)]))
@@ -192,7 +193,7 @@ parseMarkdown = do
192193
193194parseBlocks = manyTill block eof
194195
195−block = choice [ codeBlock, note, referenceKey, header, hrule, list,
196+block = choice [ header, table, codeBlock, note, referenceKey, hrule, list,
196197 blockQuote, htmlBlock, rawLaTeXEnvironment', para,
197198 plain, blankBlock, nullBlock ] <?> "block"
198199
@@ -322,7 +323,7 @@ emacsBoxQuote = try (do
322323 return raw)
323324
324325emailBlockQuoteStart = try (do
325− skipNonindentSpaces
326+ nonindentSpaces
326327 char blockQuoteChar
327328 option ' ' (char ' ')
328329 return "> ")
@@ -356,7 +357,7 @@ list = choice [ bulletList, orderedList ] <?> "list"
356357
357358bulletListStart = try (do
358359 option ' ' newline -- if preceded by a Plain block in a list context
359− skipNonindentSpaces
360+ nonindentSpaces
360361 notFollowedBy' hrule -- because hrules start out just like lists
361362 oneOf bulletListMarkers
362363 spaceChar
@@ -364,7 +365,7 @@ bulletListStart = try (do
364365
365366orderedListStart = try (do
366367 option ' ' newline -- if preceded by a Plain block in a list context
367− skipNonindentSpaces
368+ nonindentSpaces
368369 many1 digit <|> (do{failIfStrict; count 1 letter})
369370 delim <- oneOf orderedListDelimiters
370371 if delim /= '.' then failIfStrict else return ()
@@ -501,7 +502,7 @@ rawHtmlBlocks = try (do
501502--
502503
503504referenceKey = try (do
504− skipNonindentSpaces
505+ nonindentSpaces
505506 label <- reference
506507 char labelSep
507508 skipSpaces
@@ -523,6 +524,150 @@ rawLaTeXEnvironment' = do
523524 failIfStrict
524525 rawLaTeXEnvironment
525526
527+--
528+-- Tables
529+--
530+
531+-- | Parse a dashed line with optional trailing spaces; return its length
532+-- and the length including trailing space.
533+dashedLine ch = do
534+ dashes <- many1 (char ch)
535+ sp <- many spaceChar
536+ return $ (length dashes, length $ dashes ++ sp)
537+
538+-- | Parse a table header with dashed lines of '-' preceded by
539+-- one line of text.
540+simpleTableHeader = do
541+ rawContent <- anyLine
542+ initSp <- nonindentSpaces
543+ dashes <- many1 (dashedLine '-')
544+ newline
545+ let (lengths, lines) = unzip dashes
546+ let indices = scanl (+) (length initSp) lines
547+ let rawHeads = tail $ splitByIndices (init indices) rawContent
548+ let aligns = zipWith alignType (map (\a -> [a]) rawHeads) lengths
549+ return $ (rawHeads, aligns, indices)
550+
551+-- | Parse a table footer - dashed lines followed by blank line.
552+tableFooter = try $ do
553+ nonindentSpaces
554+ many1 (dashedLine '-')
555+ blanklines
556+
557+-- | Parse a table separator - dashed line.
558+tableSep = try $ do
559+ nonindentSpaces
560+ many1 (dashedLine '-')
561+ string "\n"
562+
563+-- | Parse a raw line and split it into chunks by indices.
564+rawTableLine indices = do
565+ notFollowedBy' (blanklines <|> tableFooter)
566+ line <- many1Till anyChar newline
567+ return $ map removeLeadingTrailingSpace $ tail $
568+ splitByIndices (init indices) line
569+
570+-- | Parse a table line and return a list of lists of blocks (columns).
571+tableLine indices = try $ do
572+ rawline <- rawTableLine indices
573+ mapM (parseFromStr (many plain)) rawline
574+
575+-- | Parse a multiline table row and return a list of blocks (columns).
576+multilineRow indices = try $ do
577+ colLines <- many1 (rawTableLine indices)
578+ option "" blanklines
579+ let cols = map unlines $ transpose colLines
580+ mapM (parseFromStr (many plain)) cols
581+
582+-- | Calculate relative widths of table columns, based on indices
583+widthsFromIndices :: Int -- ^ Number of columns on terminal
584+ -> [Int] -- ^ Indices
585+ -> [Float] -- ^ Fractional relative sizes of columns
586+widthsFromIndices _ [] = []
587+widthsFromIndices numColumns indices =
588+ let lengths = zipWith (-) indices (0:indices)
589+ totLength = sum lengths
590+ quotient = if totLength > numColumns
591+ then fromIntegral totLength
592+ else fromIntegral numColumns
593+ fracs = map (\l -> (fromIntegral l) / quotient) lengths in
594+ tail fracs
595+
596+-- | Parses a table caption: inlines beginning with 'Table:'
597+-- and followed by blank lines
598+tableCaption = try $ do
599+ nonindentSpaces
600+ string "Table:"
601+ result <- many1 inline
602+ blanklines
603+ return $ normalizeSpaces result
604+
605+-- | Parse a table using 'headerParser', 'lineParser', and 'footerParser'
606+tableWith headerParser lineParser footerParser = try $ do
607+ (rawHeads, aligns, indices) <- headerParser
608+ lines <- many1Till (lineParser indices) footerParser
609+ caption <- option [] tableCaption
610+ heads <- mapM (parseFromStr (many plain)) rawHeads
611+ state <- getState
612+ let numColumns = stateColumns state
613+ let widths = widthsFromIndices numColumns indices
614+ return $ Table caption aligns widths heads lines
615+
616+-- | Parse a simple table with '---' header and one line per row.
617+simpleTable = tableWith simpleTableHeader tableLine blanklines
618+
619+-- | Parse a multiline table: starts with row of '-' on top, then header
620+-- (which may be multiline), then the rows,
621+-- which may be multiline, separated by blank lines, and
622+-- ending with a footer (dashed line followed by blank line).
623+multilineTable = tableWith multilineTableHeader multilineRow tableFooter
624+
625+multilineTableHeader = try $ do
626+ tableSep
627+ rawContent <- many1 (do{notFollowedBy' tableSep;
628+ many1Till anyChar newline})
629+ initSp <- nonindentSpaces
630+ dashes <- many1 (dashedLine '-')
631+ newline
632+ let (lengths, lines) = unzip dashes
633+ let indices = scanl (+) (length initSp) lines
634+ let rawHeadsList = transpose $ map
635+ (\ln -> tail $ splitByIndices (init indices) ln)
636+ rawContent
637+ let rawHeads = map (joinWithSep " ") rawHeadsList
638+ let aligns = zipWith alignType rawHeadsList lengths
639+ return $ ((map removeLeadingTrailingSpace rawHeads),
640+ aligns, indices)
641+
642+-- | Returns the longest of a list of strings.
643+longest :: [String] -> String
644+longest [] = ""
645+longest [x] = x
646+longest (x:xs) =
647+ if (length x) >= (maximum $ map length xs)
648+ then x
649+ else longest xs
650+
651+-- | Returns an alignment type for a table, based on a list of strings
652+-- (the rows of the column header) and a number (the length of the
653+-- dashed line under the rows.
654+alignType :: [String] -> Int -> Alignment
655+alignType [] len = AlignDefault
656+alignType strLst len =
657+ let str = longest $ map removeTrailingSpace strLst
658+ leftSpace = if null str then False else ((str !! 0) `elem` " \t")
659+ rightSpace = (length str < len || (str !! (len - 1)) `elem` " \t") in
660+ case (leftSpace, rightSpace) of
661+ (True, False) -> AlignRight
662+ (False, True) -> AlignLeft
663+ (True, True) -> AlignCenter
664+ (False, False) -> AlignDefault
665+
666+table = do
667+ failIfStrict
668+ result <- simpleTable <|> multilineTable <?> "table"
669+ return result
670+
526671--
527672-- inline
528673--