darcs-benchmark-0.1.6: TabularRST.hs

module TabularRST where

import Data.List (intersperse, transpose)
import Text.Tabular

-- RST renderer for tabular
-- (being incubated; when this matures, it should become part of tabular)

-- | for simplicity, we assume that each cell is rendered
--   on a single line
render :: (rh -> String)
       -> (ch -> String)
       -> (a -> String)
       -> Table rh ch a
       -> String
render fr fc f (Table rh ch cells) =
  unlines $ [ bar DoubleLine
            , renderColumns sizes ch2
            , bar DoubleLine
            ] ++
            (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) ++
            [ bar DoubleLine, "" ] -- note the extra blank line
 where
  bar = concat . renderTHLine sizes ch2
  renderTHLine _ _ NoLine = []
  renderTHLine w h SingleLine = [renderHLine' w '-' h]
  renderTHLine w h DoubleLine = [renderHLine' w '=' h]
  -- ch2 and cell2 include the row and column labels
  ch2 = Group DoubleLine [Header "", fmap fc ch]
  cells2 = headerContents ch2
         : zipWith (\h cs -> h : map f cs) rhStrings cells
  --
  renderR (cs,h) = renderColumns sizes $ Group DoubleLine
                    [ Header h
                    , fmap fst $ zipHeader "" (map f cs) ch]
  rhStrings = map fr $ headerContents rh
  -- maximum width for each column
  sizes   = map (maximum . map length) . transpose $ cells2
  renderRs (Header s)   = [s]
  renderRs (Group p hs) = concat . intersperse sep . map renderRs $ hs
    where sep = renderHLine sizes ch2 p

-- | We stop rendering on the shortest list!
renderColumns :: [Int] -- ^ max width for each column
              -> Header String
              -> String
renderColumns is h = coreLine
 where
  coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h
  helper = either hsep (uncurry padLeft)
  hsep :: Properties -> String
  hsep _ = "  "

renderHLine :: [Int] -- ^ width specifications
            -> Header String
            -> Properties
            -> [String]
renderHLine _ _ _ = []

renderHLine' :: [Int] -> Char -> Header String -> String
renderHLine' is sep h = coreLine
 where
  coreLine        = concatMap helper $ flattenHeader $ zipHeader 0 is h
  helper          = either vsep dashes
  dashes (i,_)    = replicate i sep
  vsep _          = "  "

padLeft :: Int -> String -> String
padLeft l s = padding ++ s
 where padding = replicate (l - length s) ' '