diff --git a/Text/Tabular.hs b/Text/Tabular.hs --- a/Text/Tabular.hs +++ b/Text/Tabular.hs @@ -36,16 +36,38 @@ -- > -- B 1 || good | awful || intolerable | bearable -- > -- B 2 || better | no chance || crawling | amazing -- > -- B 3 || meh | well... || worst ever | ok -data Table a = Table (Header String) (Header String) [[a]] +data Table rh ch a = Table (Header rh) (Header ch) [[a]] -- ---------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------- + +{- +-- | A 'Table' of "FancyCell" +type FancyTable d a = Table (FancyCell d a) + +-- | 'FancyCell' @decorations a@ is a table cell that is associated with +-- decorations of your choosing (for example, a cell colour) as well as +-- instructions to merge that cell with its neighbours down or to the +-- right. We include special versions of the rendering functions that +-- recognise the merge instructions, but you will have to supply the +-- code that deals with the decorations. +type FancyCell decorations a = (a, Maybe decorations, Maybe MergeInfo) + + +data MergeInfo = MergeInfo { mergeDown :: Int + , mergeRight :: Int + } +-} + +-- ---------------------------------------------------------------------- -- * Helper functions for rendering -- ---------------------------------------------------------------------- --- | Retrieve the strings in a header -headerStrings :: Header String -> [String] -headerStrings (Header s) = [s] -headerStrings (Group _ hs) = concatMap headerStrings hs +-- | Retrieve the contents of a header +headerContents :: Header h -> [h] +headerContents (Header s) = [s] +headerContents (Group _ hs) = concatMap headerContents hs instance Functor Header where fmap f (Header s) = Header (f s) @@ -122,47 +144,51 @@ -- > row "B 1" ["good", "awful", "intolerable", "bearable"] -- > +.+ row "B 2" ["better", "no chance", "crawling", "amazing"] -- > +.+ row "B 3" ["meh", "well...", "worst ever", "ok"] -data SemiTable a = SemiTable (Header String) [a] +data SemiTable h a = SemiTable (Header h) [a] -empty :: Table a +empty :: Table rh ch a empty = Table (Group NoLine []) (Group NoLine []) [] -col :: String -> [a] -> SemiTable a +col :: ch -> [a] -> SemiTable ch a col header cells = SemiTable (Header header) cells -- | Column header -colH :: String -> SemiTable a +colH :: ch -> SemiTable ch a colH header = col header [] -row :: String -> [a] -> SemiTable a +row :: rh -> [a] -> SemiTable rh a row = col -rowH :: String -> SemiTable a +rowH :: rh -> SemiTable rh a rowH = colH -beside :: Properties -> Table a -> SemiTable a -> Table a +beside :: Properties -> Table rh ch a -> SemiTable ch a -> Table rh ch a beside prop (Table rows cols1 data1) (SemiTable cols2 data2) = Table rows (Group prop [cols1, cols2]) (zipWith (++) data1 [data2]) -below :: Properties -> Table a -> SemiTable a -> Table a +below :: Properties -> Table rh ch a -> SemiTable rh a -> Table rh ch a below prop (Table rows1 cols data1) (SemiTable rows2 data2) = Table (Group prop [rows1, rows2]) cols (data1 ++ [data2]) -- | besides +(^..^) :: Table rh ch a -> SemiTable ch a -> Table rh ch a (^..^) = beside NoLine -- | besides with a line +(^|^) :: Table rh ch a -> SemiTable ch a -> Table rh ch a (^|^) = beside SingleLine -- | besides with a double line +(^||^) :: Table rh ch a -> SemiTable ch a -> Table rh ch a (^||^) = beside DoubleLine -- | below +(+.+) :: Table rh ch a -> SemiTable rh a -> Table rh ch a (+.+) = below NoLine -- | below with a line +(+----+) :: Table rh ch a -> SemiTable rh a -> Table rh ch a (+----+) = below SingleLine -- | below with a double line +(+====+) :: Table rh ch a -> SemiTable rh a -> Table rh ch a (+====+) = below DoubleLine - - diff --git a/Text/Tabular/AsciiArt.hs b/Text/Tabular/AsciiArt.hs --- a/Text/Tabular/AsciiArt.hs +++ b/Text/Tabular/AsciiArt.hs @@ -5,22 +5,26 @@ -- | for simplicity, we assume that each cell is rendered -- on a single line -render :: (a -> String) -> Table a -> String -render f (Table rh ch cells) = +render :: (rh -> String) + -> (ch -> String) + -> (a -> String) + -> Table rh ch a + -> String +render fr fc f (Table rh ch cells) = unlines $ [ renderColumns sizes ch2 , concat $ renderHLine sizes ch2 DoubleLine ] ++ - (renderRs $ fmap renderR $ zipHeader [] cells rh) + (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) where -- ch2 and cell2 include the row and column labels - ch2 = Group DoubleLine [Header "", ch] - cells2 = headerStrings ch2 + 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 = headerStrings rh + rhStrings = map fr $ headerContents rh -- maximum width for each column sizes = map (maximum . map length) . transpose $ cells2 renderRs (Header s) = [s] diff --git a/Text/Tabular/Csv.hs b/Text/Tabular/Csv.hs new file mode 100644 --- /dev/null +++ b/Text/Tabular/Csv.hs @@ -0,0 +1,20 @@ +module Text.Tabular.Csv where + +import Data.List (intersperse, transpose) +import Text.CSV (printCSV) +import Text.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) = + printCSV $ chStrings : cells2 + where + -- cell2 includes the row and column labels + cells2 = zipWith (\h cs -> h : map f cs) rhStrings cells + chStrings = map fc $ headerContents ch + rhStrings = map fr $ headerContents rh diff --git a/Text/Tabular/Html.hs b/Text/Tabular/Html.hs --- a/Text/Tabular/Html.hs +++ b/Text/Tabular/Html.hs @@ -3,14 +3,14 @@ import Text.Tabular import Text.Html --- | for simplicity, we assume that each cell is rendered --- on a single line -render :: (a -> String) -> Table a -> Html -render f (Table rh ch cells) = +render :: (rh -> Html) + -> (ch -> Html) + -> (a -> Html) -> Table rh ch a -> Html +render fr fc f (Table rh ch cells) = table $ header +++ body where - header = tr (myTh "" +++ headerCore) - headerCore = concatHtml $ squish applyVAttr myTh ch + header = tr (myTh noHtml +++ headerCore) + headerCore = concatHtml $ squish applyVAttr myTh (fmap fc ch) -- body = concatHtml $ squish applyHAttr tr $ fmap fst @@ -18,11 +18,11 @@ rows = zipWith (\h cs -> myTh h +++ doRow cs) rhStrings cells doRow cs = concatHtml $ squish applyVAttr myTd $ - fmap fst $ zipHeader "" (map f cs) ch + fmap fst $ zipHeader noHtml (map f cs) (fmap fc ch) -- - myTh = th . stringToHtml - myTd = td . stringToHtml - rhStrings = headerStrings rh + myTh = th + myTd = td + rhStrings = map fr $ headerContents rh applyVAttr p x = x ! vAttr p applyHAttr p x = x ! hAttr p @@ -50,8 +50,8 @@ [ "table { border-collapse: collapse; border: 1px solid; }" , "th { padding:0.2em; background-color: #eeeeee }" , "td { padding:0.2em; }" - , ".thinbottom { }" - , ".thickbottom { border-bottom: 1px solid }" + , ".thinbottom { border-bottom: 1px solid }" + , ".thickbottom { border-bottom: 3px solid }" , ".thinright { border-right: 1px solid }" , ".thickright { border-right: 3px solid }" ] diff --git a/Text/Tabular/Latex.hs b/Text/Tabular/Latex.hs --- a/Text/Tabular/Latex.hs +++ b/Text/Tabular/Latex.hs @@ -4,28 +4,33 @@ import Text.Tabular -render :: (a -> String) -> Table a -> String +render :: (rh -> String) + -> (ch -> String) + -> (a -> String) + -> Table rh ch a -> String render = renderUsing (repeat "r") renderUsing :: [String] -- ^ column header specifications including label (l,h,p{3cm},etc) - -> (a -> String) -> Table a -> String -renderUsing cols f (Table rh ch cells) = + -> (rh -> String) + -> (ch -> String) + -> (a -> String) -> Table rh ch a -> String +renderUsing cols fr fc f (Table rh ch cells) = unlines $ ( "\\begin{tabular}{" ++ hspec ++ "}") : [ addTableNl header , hline , (concatMap (either vAttr addTableNl) $ - flattenHeader $ fmap row $ zipHeader [] cells rh) + flattenHeader $ fmap row $ zipHeader [] cells $ fmap fr rh) , "\\end{tabular}" ] where - ch2 = Group DoubleLine [(Header ""),ch] + ch2 = Group DoubleLine [(Header ""),fmap fc ch] hspec = concatMap (either hAttr fst) $ flattenHeader $ zipHeader "" cols ch2 - header = texCols . map label . headerStrings $ ch2 + header = texCols . map label . headerContents $ ch2 -- row (cs,h) = texCols $ label h : map f cs texCols = concat . intersperse " & " texRows = map addTableNl - rhStrings = headerStrings rh + rhStrings = headerContents rh hline :: String diff --git a/example/sample1.hs b/example/sample1.hs --- a/example/sample1.hs +++ b/example/sample1.hs @@ -1,15 +1,17 @@ import Text.Tabular -import Text.Html +import Text.Html (renderHtml, stringToHtml, (+++)) import qualified Text.Tabular.AsciiArt as A import qualified Text.Tabular.Html as H import qualified Text.Tabular.Latex as L +import qualified Text.Tabular.Csv as C main = - do writeFile "sample1.txt" $ A.render id example2 + do writeFile "sample1.txt" $ A.render id id id example2 writeFile "sample1.html" $ renderHtml $ - H.css H.defaultCss +++ H.render id example2 - writeFile "sample1T.tex" $ L.render id example2 + H.css H.defaultCss +++ H.render stringToHtml stringToHtml stringToHtml example2 + writeFile "sample1T.tex" $ L.render id id id example2 + writeFile "sample1.csv" $ C.render id id id example2 putStrLn $ "wrote sample1.txt, sample1.html and sample1T.tex" putStrLn $ "(hint: pdflatex sample1)" diff --git a/tabular.cabal b/tabular.cabal --- a/tabular.cabal +++ b/tabular.cabal @@ -1,11 +1,11 @@ name: tabular -version: 0.1.0.2 +version: 0.2.1.0 synopsis: Two-dimensional data tables with rendering functions description: Tabular provides a Haskell representation of two-dimensional data tables, the kind that you might find in a spreadsheet or or a research report. It also comes with some default rendering functions for turning those tables into ASCII art, - HTML or LaTeX. + CSV, HTML or LaTeX. . Below is an example of the kind of output this library produces. The tabular package can group rows and columns, each group @@ -27,11 +27,13 @@ maintainer: homepage: http://code.haskell.org/~kowey/tabular build-Depends: base >= 2.1 && < 3.1, mtl >= 1 && < 1.2, + csv >= 0.1 && < 0.2, html >= 1.0 && < 2.0 build-type: Simple ghc-options: exposed-modules: Text.Tabular, Text.Tabular.AsciiArt, + Text.Tabular.Csv, Text.Tabular.Html, Text.Tabular.Latex data-files: example/sample1.hs,