diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) Eric Kow 2008. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/Text/Tabular.hs b/Text/Tabular.hs new file mode 100644 --- /dev/null +++ b/Text/Tabular.hs @@ -0,0 +1,168 @@ +-- | Note: the core types and comibnators +-- from this module are from Toxaris in a #haskell +-- conversation on 2008-08-24 +module Text.Tabular where + +import Data.List (intersperse) +import Control.Monad.State (evalState, State, get, put) + +data Properties = NoLine | SingleLine | DoubleLine +data Header h = Header h | Group Properties [Header h] + +-- | +-- > example = Table +-- > (Group SingleLine +-- > [ Group NoLine [Header "A 1", Header "A 2"] +-- > , Group NoLine [Header "B 1", Header "B 2", Header "B 3"] +-- > ]) +-- > (Group DoubleLine +-- > [ Group SingleLine [Header "memtest 1", Header "memtest 2"] +-- > , Group SingleLine [Header "time test 1", Header "time test 2"] +-- > ]) +-- > [ ["hog", "terrible", "slow", "slower"] +-- > , ["pig", "not bad", "fast", "slowest"] +-- > , ["good", "awful" , "intolerable", "bearable"] +-- > , ["better", "no chance", "crawling", "amazing"] +-- > , ["meh", "well...", "worst ever", "ok"] +-- > ] +-- +-- > -- Text.Tabular.AsciiArt.render example id +-- > -- +-- > -- || memtest 1 | memtest 2 || time test | time test 2 +-- > -- ====++===========+===========++=============+============ +-- > -- A 1 || hog | terrible || slow | slower +-- > -- A 2 || pig | not bad || fast | slowest +-- > -- ----++-----------+-----------++-------------+------------ +-- > -- 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]] + +-- ---------------------------------------------------------------------- +-- * Helper functions for rendering +-- ---------------------------------------------------------------------- + +-- | Retrieve the strings in a header +headerStrings :: Header String -> [String] +headerStrings (Header s) = [s] +headerStrings (Group _ hs) = concatMap headerStrings hs + +instance Functor Header where + fmap f (Header s) = Header (f s) + fmap f (Group p hs) = Group p (map (fmap f) hs) + +-- | 'zipHeader' @e@ @ss@ @h@ returns the same structure +-- as @h@ except with all the text replaced by the contents +-- of @ss@. +-- +-- If @ss@ has too many cells, the excess is ignored. +-- If it has too few cells, the missing ones (at the end) +-- and replaced with the empty contents @e@ +zipHeader :: h -> [h] -> Header a -> Header (h,a) +zipHeader e ss h = evalState (helper h) ss + where + helper (Header x) = + do cells <- get + string <- case cells of + [] -> return (e,x) + (s:ss) -> put ss >> return (s,x) + return $ Header string + helper (Group s hs) = + Group s `fmap` mapM helper hs + +flattenHeader :: Header h -> [Either Properties h] +flattenHeader (Header s) = [Right s] +flattenHeader (Group l s) = + concat . intersperse [Left l] . map flattenHeader $ s + +-- | The idea is to deal with the fact that Properties +-- (e.g. borders) are not standalone cells but attributes +-- of a cell. A border is just a CSS decoration of a +-- TD element. +-- +-- squish @decorator f h@ applies @f@ to every item +-- in the list represented by @h@ (see 'flattenHeader'), +-- additionally applying @decorator@ if the item is +-- followed by some kind of boundary +-- +-- So +-- @ +-- o o o | o o o | o o +-- @ +-- gets converted into +-- @ +-- O O X O O X O O +-- @ +squish :: (Properties -> b -> b) + -> (h -> b) + -> Header h + -> [b] +squish decorator f h = helper $ flattenHeader h + where + helper [] = [] + helper (Left p:es) = helper es + helper (Right x:es) = + case es of + (Left p:es2) -> decorator p (f x) : helper es2 + _ -> f x : helper es + +-- ---------------------------------------------------------------------- +-- * Combinators +-- ---------------------------------------------------------------------- + +-- | Convenience type for just one row (or column). +-- To be used with combinators as follows: +-- +-- > example2 = +-- > empty ^..^ col "memtest 1" [] ^|^ col "memtest 2" [] +-- > ^||^ col "time test "[] ^|^ col "time test 2" [] +-- > +.+ row "A 1" ["hog", "terrible", "slow", "slower"] +-- > +.+ row "A 2" ["pig", "not bad", "fast", "slowest"] +-- > +----+ +-- > 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] + +empty :: Table a +empty = Table (Group NoLine []) (Group NoLine []) [] + +col :: String -> [a] -> SemiTable a +col header cells = SemiTable (Header header) cells + +-- | Column header +colH :: String -> SemiTable a +colH header = col header [] + +row :: String -> [a] -> SemiTable a +row = col + +rowH :: String -> SemiTable a +rowH = colH + +beside :: Properties -> Table a -> SemiTable a -> Table 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 prop (Table rows1 cols data1) + (SemiTable rows2 data2) = + Table (Group prop [rows1, rows2]) cols (data1 ++ [data2]) + +-- | besides +(^..^) = beside NoLine +-- | besides with a line +(^|^) = beside SingleLine +-- | besides with a double line +(^||^) = beside DoubleLine + +-- | below +(+.+) = below NoLine +-- | below with a line +(+----+) = below SingleLine +-- | below with a double line +(+====+) = below DoubleLine + + diff --git a/Text/Tabular/AsciiArt.hs b/Text/Tabular/AsciiArt.hs new file mode 100644 --- /dev/null +++ b/Text/Tabular/AsciiArt.hs @@ -0,0 +1,63 @@ +module Text.Tabular.AsciiArt where + +import Data.List (intersperse, transpose) +import Text.Tabular + +-- | 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) = + unlines $ [ renderColumns sizes ch2 + , concat $ renderHLine sizes ch2 DoubleLine + ] ++ + (renderRs $ fmap renderR $ zipHeader [] cells rh) + where + -- ch2 and cell2 include the row and column labels + ch2 = Group DoubleLine [Header "", ch] + cells2 = headerStrings 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 + -- 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 = + concatMap helper $ flattenHeader $ zipHeader 0 is h + where + helper = either hsep (uncurry padLeft) + hsep :: Properties -> String + hsep NoLine = "" + hsep SingleLine = " | " + hsep DoubleLine = " || " + +renderHLine :: [Int] -- ^ width specifications + -> Header String + -> Properties + -> [String] +renderHLine _ _ NoLine = [] +renderHLine w h SingleLine = [renderHLine' w '-' h] +renderHLine w h DoubleLine = [renderHLine' w '=' h] + +renderHLine' :: [Int] -> Char -> Header String -> String +renderHLine' is sep h = concatMap helper + $ flattenHeader $ zipHeader 0 is h + where + helper = either vsep dashes + dashes (i,_) = replicate i sep + vsep NoLine = "" + vsep SingleLine = sep : "+" ++ [sep] + vsep DoubleLine = sep : "++" ++ [sep] + +padLeft :: Int -> String -> String +padLeft l s = padding ++ s + where padding = replicate (l - length s) ' ' diff --git a/Text/Tabular/Html.hs b/Text/Tabular/Html.hs new file mode 100644 --- /dev/null +++ b/Text/Tabular/Html.hs @@ -0,0 +1,57 @@ +module Text.Tabular.Html where + +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) = + table $ header +++ body + where + header = tr (myTh "" +++ headerCore) + headerCore = concatHtml $ squish applyVAttr myTh ch + -- + body = concatHtml $ squish applyHAttr tr + $ fmap fst + $ zipHeader noHtml rows ch + rows = zipWith (\h cs -> myTh h +++ doRow cs) + rhStrings cells + doRow cs = concatHtml $ squish applyVAttr myTd $ + fmap fst $ zipHeader "" (map f cs) ch + -- + myTh = th . stringToHtml + myTd = td . stringToHtml + rhStrings = headerStrings rh + applyVAttr p x = x ! vAttr p + applyHAttr p x = x ! hAttr p + +vAttr :: Properties -> [HtmlAttr] +vAttr DoubleLine = [theclass "thickright"] +vAttr SingleLine = [theclass "thinright"] +vAttr _ = [] + +hAttr :: Properties -> [HtmlAttr] +hAttr DoubleLine = [theclass "thickbottom"] +hAttr SingleLine = [theclass "thinbottom"] +hAttr _ = [] + + +-- | Convenience function to add a CSS string to your +-- HTML document +css :: String -> Html +css c = style (stringToHtml c) ! [ thetype "text/css" ] + +-- | You need to incorporate some CSS into your file with +-- the classes @thinbottom@, @thinright@, @thickbottom@ +-- and @thickright@. See 'css' +defaultCss :: String +defaultCss = unlines + [ "table { border-collapse: collapse; border: 1px solid; }" + , "th { padding:0.2em; background-color: #eeeeee }" + , "td { padding:0.2em; }" + , ".thinbottom { }" + , ".thickbottom { border-bottom: 1px solid }" + , ".thinright { border-right: 1px solid }" + , ".thickright { border-right: 3px solid }" + ] diff --git a/Text/Tabular/Latex.hs b/Text/Tabular/Latex.hs new file mode 100644 --- /dev/null +++ b/Text/Tabular/Latex.hs @@ -0,0 +1,48 @@ +module Text.Tabular.Latex where + +import Data.List (intersperse) +import Text.Tabular + + +render :: (a -> String) -> Table 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) = + unlines $ ( "\\begin{tabular}{" ++ hspec ++ "}") + : [ addTableNl header + , hline + , (concatMap (either vAttr addTableNl) $ + flattenHeader $ fmap row $ zipHeader [] cells rh) + , "\\end{tabular}" ] + where + ch2 = Group DoubleLine [(Header ""),ch] + hspec = concatMap (either hAttr fst) $ flattenHeader + $ zipHeader "" cols ch2 + header = texCols . map label . headerStrings $ ch2 + -- + row (cs,h) = texCols $ label h : map f cs + texCols = concat . intersperse " & " + texRows = map addTableNl + rhStrings = headerStrings rh + + +hline :: String +hline = "\\hline" + +addTableNl :: String -> String +addTableNl = (++ "\\\\\n") + +label :: String -> String +label s = "\\textbf{" ++ s ++ "}" + +hAttr :: Properties -> String +hAttr NoLine = "" +hAttr SingleLine = "|" +hAttr DoubleLine = "||" + +vAttr :: Properties -> String +vAttr NoLine = "" +vAttr SingleLine = hline +vAttr DoubleLine = hline ++ hline diff --git a/example/sample1.hs b/example/sample1.hs new file mode 100644 --- /dev/null +++ b/example/sample1.hs @@ -0,0 +1,42 @@ +import Text.Tabular +import Text.Html + +import qualified Text.Tabular.AsciiArt as A +import qualified Text.Tabular.Html as H +import qualified Text.Tabular.Latex as L + +main = + do writeFile "sample1.txt" $ A.render id example2 + writeFile "sample1.html" $ renderHtml $ + H.css H.defaultCss +++ H.render id example2 + writeFile "sample1T.tex" $ L.render id example2 + putStrLn $ "wrote sample1.txt, sample1.html and sample1T.tex" + putStrLn $ "(hint: pdflatex sample1)" + +-- | an example table showing grouped columns and rows +sample1 = Table + (Group SingleLine + [ Group NoLine [Header "A 1", Header "A 2"] + , Group NoLine [Header "B 1", Header "B 2", Header "B 3"] + ]) + (Group DoubleLine + [ Group SingleLine [Header "memtest 1", Header "memtest 2"] + , Group SingleLine [Header "time test 1", Header "time test 2"] + ]) + [ ["hog", "terrible", "slow", "slower"] + , ["pig", "not bad", "fast", "slowest"] + , ["good", "awful" , "intolerable", "bearable"] + , ["better", "no chance", "crawling", "amazing"] + , ["meh", "well...", "worst ever", "ok"] + ] + +-- | the same example built a slightly different way +example2 = + empty ^..^ colH "memtest 1" ^|^ colH "memtest 2" + ^||^ colH "time test" ^|^ colH "time test 2" + +.+ row "A 1" ["hog", "terrible", "slow", "slower"] + +.+ row "A 2" ["pig", "not bad", "fast", "slowest"] + +----+ + row "B 1" ["good", "awful", "intolerable", "bearable"] + +.+ row "B 2" ["better", "no chance", "crawling", "amazing"] + +.+ row "B 3" ["meh", "well...", "worst ever", "ok"] diff --git a/example/sample1.tex b/example/sample1.tex new file mode 100644 --- /dev/null +++ b/example/sample1.tex @@ -0,0 +1,5 @@ +\documentclass{article} + +\begin{document} +\include{sample1T} +\end{document} diff --git a/tabular.cabal b/tabular.cabal new file mode 100644 --- /dev/null +++ b/tabular.cabal @@ -0,0 +1,38 @@ +name: tabular +version: 0.1 +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. + . + Below is an example of the kind of output this library produces. + The tabular package can group rows and columns, each group + having one of three separators (no line, single line, double line) + between its members. + . + > || memtest 1 | memtest 2 || time test | time test 2 + > ====++===========+===========++=============+============ + > A 1 || hog | terrible || slow | slower + > A 2 || pig | not bad || fast | slowest + > ----++-----------+-----------++-------------+------------ + > B 1 || good | awful || intolerable | bearable + > B 2 || better | no chance || crawling | amazing + > B 3 || meh | well... || worst ever | ok +category: Text +license: BSD3 +license-file: LICENSE +author: Eric Kow +maintainer: +homepage: http://code.haskell.org/~kowey/tabular +build-Depends: base >= 2.1 && < 3.1, mtl >= 1 && < 1.2, + html >= 1.0 && < 2.0 +build-type: Simple +ghc-options: +exposed-modules: Text.Tabular, + Text.Tabular.AsciiArt, + Text.Tabular.Html, + Text.Tabular.Latex +data-files: example/sample1.hs, + example/sample1.tex