8699461 · typeable/pandoc

git.iko.soy/typeable/pandoc

Moved generic grid table functions from RST reader -> Parsing.

Here they can be used by the Markdown reader as well.

commit869946114e0b2ca9fa877ad32af6713f37fbd69f authorJohn MacFarlane <jgm@berkeley.edu> dateMon 5 Jul 2010, 14:34 (16 years ago) parentbd03209

2 files changed+91−76

compare with master

unifiedsplit

src/Text/Pandoc/Parsing.hs+85−3 src/Text/Pandoc/Readers/RST.hs+6−73

src/Text/Pandoc/Parsing.hs+85−3

@@ -53,6 +53,10 @@ module Text.Pandoc.Parsing ( (>>~),

5353 anyOrderedListMarker,

5454 orderedListMarker,

5555 charRef,

56+ gridTableHeader,

57+ gridTableRow,

58+ gridTableSep,

59+ gridTableFooter,

5660 readWith,

5761 testStringWith,

5862 ParserState (..),

@@ -72,10 +76,10 @@ import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)

7276import Text.ParserCombinators.Parsec

7377import Text.Pandoc.CharacterReferences ( characterReference )

7478import Data.Char ( toLower, toUpper, ord, isAscii )

75−import Data.List ( intercalate )

79+import Data.List ( intercalate, transpose )

7680import Network.URI ( parseURI, URI (..), isAllowedInURI )

77−import Control.Monad (join)

78−import Text.Pandoc.Shared (escapeURI)

81+import Control.Monad ( join, liftM )

82+import Text.Pandoc.Shared

7983import qualified Data.Map as M

8084

8185-- | Like >>, but returns the operation on the left.

@@ -404,6 +408,84 @@ charRef = do

404408 c <- characterReference

405409 return $ Str [c]

406410

411+-- grid tables, common to RST and Markdown:

412+

413+gridTableSplitLine :: [Int] -> String -> [String]

414+gridTableSplitLine indices line =

415+ map removeFinalBar $ tail $ splitByIndices (init indices) line

416+

417+gridPart :: Char -> GenParser Char st (Int, Int)

418+gridPart ch = do

419+ dashes <- many1 (char ch)

420+ char '+'

421+ return (length dashes, length dashes + 1)

422+

423+gridDashedLines :: Char -> GenParser Char st [(Int,Int)]

424+gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) >>~ blankline

425+

426+removeFinalBar :: String -> String

427+removeFinalBar = reverse . dropWhile (=='|') . dropWhile (`elem` " \t") .

428+ reverse

429+

430+-- | Separator between rows of grid table.

431+gridTableSep :: Char -> GenParser Char ParserState Char

432+gridTableSep ch = try $ gridDashedLines ch >> return '\n'

433+

434+-- | Parse header for a grid table.

435+gridTableHeader :: Bool -- ^ Headerless table

436+ -> GenParser Char ParserState ([String], [Alignment], [Int])

437+gridTableHeader headless = try $ do

438+ optional blanklines

439+ dashes <- gridDashedLines '-'

440+ rawContent <- if headless

441+ then return $ repeat ""

442+ else many1

443+ (notFollowedBy (gridTableSep '=') >> char '|' >> many1Till anyChar newline)

444+ if headless

445+ then return ()

446+ else gridTableSep '=' >> return ()

447+ let lines' = map snd dashes

448+ let indices = scanl (+) 0 lines'

449+ let aligns = replicate (length lines') AlignDefault -- RST does not have a notion of alignments

450+ let rawHeads = if headless

451+ then replicate (length dashes) ""

452+ else map (intercalate " ") $ transpose

453+ $ map (gridTableSplitLine indices) rawContent

454+ return (rawHeads, aligns, indices)

455+

456+gridTableRawLine :: [Int] -> GenParser Char ParserState [String]

457+gridTableRawLine indices = do

458+ char '|'

459+ line <- many1Till anyChar newline

460+ return (gridTableSplitLine indices $ removeTrailingSpace line)

461+

462+-- | Parse row of grid table.

463+gridTableRow :: GenParser Char ParserState Block

464+ -> [Int]

465+ -> GenParser Char ParserState [[Block]]

466+gridTableRow block indices = do

467+ colLines <- many1 (gridTableRawLine indices)

468+ let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $

469+ transpose colLines

470+ mapM (liftM compactifyCell . parseFromString (many block)) cols

471+

472+removeOneLeadingSpace :: [String] -> [String]

473+removeOneLeadingSpace xs =

474+ if all startsWithSpace xs

475+ then map (drop 1) xs

476+ else xs

477+ where startsWithSpace "" = True

478+ startsWithSpace (y:_) = y == ' '

479+

480+compactifyCell :: [Block] -> [Block]

481+compactifyCell bs = head $ compactify [bs]

482+

483+-- | Parse footer for a grid table.

484+gridTableFooter :: GenParser Char ParserState [Char]

485+gridTableFooter = blanklines

486+

487+---

488+

407489-- | Parse a string with a given parser and state.

408490readWith :: GenParser Char ParserState a -- ^ parser

409491 -> ParserState -- ^ initial state

src/Text/Pandoc/Readers/RST.hs+6−73

@@ -34,7 +34,7 @@ import Text.Pandoc.Definition

3434import Text.Pandoc.Shared

3535import Text.Pandoc.Parsing

3636import Text.ParserCombinators.Parsec

37−import Control.Monad ( when, unless, liftM )

37+import Control.Monad ( when, unless )

3838import Data.List ( findIndex, intercalate, transpose, sort )

3939import qualified Data.Map as M

4040import Text.Printf ( printf )

@@ -608,41 +608,20 @@ dashedLine ch = do

608608simpleDashedLines :: Char -> GenParser Char st [(Int,Int)]

609609simpleDashedLines ch = try $ many1 (dashedLine ch)

610610

611−gridPart :: Char -> GenParser Char st (Int, Int)

612−gridPart ch = do

613− dashes <- many1 (char ch)

614− char '+'

615− return (length dashes, length dashes + 1)

616−

617−gridDashedLines :: Char -> GenParser Char st [(Int,Int)]

618−gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) >>~ blankline

619−

620611-- Parse a table row separator

621612simpleTableSep :: Char -> GenParser Char ParserState Char

622613simpleTableSep ch = try $ simpleDashedLines ch >> newline

623614

624−gridTableSep :: Char -> GenParser Char ParserState Char

625−gridTableSep ch = try $ gridDashedLines ch >> return '\n'

626−

627615-- Parse a table footer

628616simpleTableFooter :: GenParser Char ParserState [Char]

629617simpleTableFooter = try $ simpleTableSep '=' >> blanklines

630618

631−gridTableFooter :: GenParser Char ParserState [Char]

632−gridTableFooter = blanklines

633−

634619-- Parse a raw line and split it into chunks by indices.

635620simpleTableRawLine :: [Int] -> GenParser Char ParserState [String]

636621simpleTableRawLine indices = do

637622 line <- many1Till anyChar newline

638623 return (simpleTableSplitLine indices line)

639624

640−gridTableRawLine :: [Int] -> GenParser Char ParserState [String]

641−gridTableRawLine indices = do

642− char '|'

643− line <- many1Till anyChar newline

644− return (gridTableSplitLine indices $ removeTrailingSpace line)

645−

646625-- Parse a table row and return a list of blocks (columns).

647626simpleTableRow :: [Int] -> GenParser Char ParserState [[Block]]

648627simpleTableRow indices = do

@@ -652,38 +631,11 @@ simpleTableRow indices = do

652631 let cols = map unlines . transpose $ firstLine : colLines

653632 mapM (parseFromString (many plain)) cols

654633

655−gridTableRow :: [Int]

656− -> GenParser Char ParserState [[Block]]

657−gridTableRow indices = do

658− colLines <- many1 (gridTableRawLine indices)

659− let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $

660− transpose colLines

661− mapM (liftM compactifyCell . parseFromString (many block)) cols

662−

663−compactifyCell :: [Block] -> [Block]

664−compactifyCell bs = head $ compactify [bs]

665−

666634simpleTableSplitLine :: [Int] -> String -> [String]

667635simpleTableSplitLine indices line =

668636 map removeLeadingTrailingSpace

669637 $ tail $ splitByIndices (init indices) line

670638

671−gridTableSplitLine :: [Int] -> String -> [String]

672−gridTableSplitLine indices line =

673− map removeFinalBar $ tail $ splitByIndices (init indices) line

674−

675−removeFinalBar :: String -> String

676−removeFinalBar = reverse . dropWhile (=='|') . dropWhile (`elem` " \t") .

677− reverse

678−

679−removeOneLeadingSpace :: [String] -> [String]

680−removeOneLeadingSpace xs =

681− if all startsWithSpace xs

682− then map (drop 1) xs

683− else xs

684− where startsWithSpace "" = True

685− startsWithSpace (y:_) = y == ' '

686−

687639-- Calculate relative widths of table columns, based on indices

688640widthsFromIndices :: Int -- Number of columns on terminal

689641 -> [Int] -- Indices

@@ -725,30 +677,10 @@ simpleTableHeader headless = try $ do

725677 else simpleTableSplitLine indices rawContent

726678 return (rawHeads, aligns, indices)

727679

728−gridTableHeader :: Bool -- ^ Headerless table

729− -> GenParser Char ParserState ([String], [Alignment], [Int])

730−gridTableHeader headless = try $ do

731− optional blanklines

732− dashes <- gridDashedLines '-'

733− rawContent <- if headless

734− then return $ repeat ""

735− else many1

736− (notFollowedBy (gridTableSep '=') >> char '|' >> many1Till anyChar newline)

737− if headless

738− then return ()

739− else gridTableSep '=' >> return ()

740− let lines' = map snd dashes

741− let indices = scanl (+) 0 lines'

742− let aligns = replicate (length lines') AlignDefault -- RST does not have a notion of alignments

743− let rawHeads = if headless

744− then replicate (length dashes) ""

745− else map (intercalate " ") $ transpose

746− $ map (gridTableSplitLine indices) rawContent

747− return (rawHeads, aligns, indices)

748−

749680-- Parse a table using 'headerParser', 'lineParser', and 'footerParser'.

750681tableWith :: GenParser Char ParserState ([[Char]], [Alignment], [Int])

751− -> ([Int] -> GenParser Char ParserState [[Block]])

682+ -> ([Int]

683+ -> GenParser Char ParserState [[Block]])

752684 -> GenParser Char ParserState sep

753685 -> GenParser Char ParserState end

754686 -> GenParser Char ParserState Block

@@ -778,9 +710,10 @@ simpleTable headless = do

778710-- which may be grid, separated by blank lines, and

779711-- ending with a footer (dashed line followed by blank line).

780712gridTable :: Bool -- ^ Headerless table

781− -> GenParser Char ParserState Block

713+ -> GenParser Char ParserState Block

782714gridTable headless =

783− tableWith (gridTableHeader headless) gridTableRow (gridTableSep '-') gridTableFooter

715+ tableWith (gridTableHeader headless) (gridTableRow block) (gridTableSep '-') gridTableFooter

716+

784717

785718table :: GenParser Char ParserState Block

786719table = gridTable False <|> simpleTable False <|>