tabular-0.2.2.7/0000755000000000000000000000000012473563446011516 5ustar0000000000000000tabular-0.2.2.7/LICENSE0000644000000000000000000000267112473563446012531 0ustar0000000000000000Copyright (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. tabular-0.2.2.7/Setup.lhs0000644000000000000000000000011412473563446013322 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain tabular-0.2.2.7/tabular.cabal0000644000000000000000000000451412473563446014140 0ustar0000000000000000name: tabular version: 0.2.2.7 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, simple text with an arbitrary delimiter, 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 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: Eric Kow homepage: http://hub.darcs.net/kowey/tabular cabal-version: >= 1.8 build-type: Simple extra-doc-files: example/sample1.hs, example/sample1.tex source-repository head type: darcs location: http://hub.darcs.net/kowey/tabular library build-Depends: base >= 2.1 && < 5, mtl >= 1 && < 2.3, csv >= 0.1 && < 0.2, html >= 1.0 && < 2.0 exposed-modules: Text.Tabular, Text.Tabular.AsciiArt, Text.Tabular.SimpleText, Text.Tabular.Csv, Text.Tabular.Html, Text.Tabular.Latex tabular-0.2.2.7/example/0000755000000000000000000000000012473563446013151 5ustar0000000000000000tabular-0.2.2.7/example/sample1.hs0000644000000000000000000000347412473563446015057 0ustar0000000000000000import Text.Tabular import Text.Html (renderHtml, stringToHtml, (+++)) import qualified Text.Tabular.AsciiArt as A import qualified Text.Tabular.SimpleText as S 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 id id example2 writeFile "sample1.tab" $ S.render "\t" id id id example2 writeFile "sample1.html" $ renderHtml $ 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)" -- | 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"] tabular-0.2.2.7/example/sample1.tex0000644000000000000000000000011412473563446015231 0ustar0000000000000000\documentclass{article} \begin{document} \include{sample1T} \end{document} tabular-0.2.2.7/Text/0000755000000000000000000000000012473563446012442 5ustar0000000000000000tabular-0.2.2.7/Text/Tabular.hs0000644000000000000000000001525412473563446014377 0ustar0000000000000000-- | Note: the core types and comibnators -- from this module are from Toxaris in a #haskell -- conversation on 2008-08-24 {-# LANGUAGE FlexibleContexts #-} 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 id id id example -- > -- -- > -- || 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 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 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) 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 h a = SemiTable (Header h) [a] empty :: Table rh ch a empty = Table (Group NoLine []) (Group NoLine []) [] col :: ch -> [a] -> SemiTable ch a col header cells = SemiTable (Header header) cells -- | Column header colH :: ch -> SemiTable ch a colH header = col header [] row :: rh -> [a] -> SemiTable rh a row = col rowH :: rh -> SemiTable rh a rowH = colH 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 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 tabular-0.2.2.7/Text/Tabular/0000755000000000000000000000000012473563446014034 5ustar0000000000000000tabular-0.2.2.7/Text/Tabular/AsciiArt.hs0000644000000000000000000000473612473563446016101 0ustar0000000000000000module 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 :: (rh -> String) -> (ch -> String) -> (a -> String) -> Table rh ch a -> String render fr fc f (Table rh ch cells) = unlines $ [ bar SingleLine -- +--------------------------------------+ , renderColumns sizes ch2 , bar DoubleLine -- +======================================+ ] ++ (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) ++ [ bar SingleLine ] -- +--------------------------------------+ where bar = concat . renderHLine sizes ch2 -- 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 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 = [ '+', sep ] ++ coreLine ++ [sep, '+'] where coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h helper = either vsep dashes dashes (i,_) = replicate i sep vsep NoLine = [sep] vsep SingleLine = sep : "+" ++ [sep] vsep DoubleLine = sep : "++" ++ [sep] padLeft :: Int -> String -> String padLeft l s = padding ++ s where padding = replicate (l - length s) ' ' tabular-0.2.2.7/Text/Tabular/Csv.hs0000644000000000000000000000111212473563446015116 0ustar0000000000000000module 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 tabular-0.2.2.7/Text/Tabular/Html.hs0000644000000000000000000000332212473563446015274 0ustar0000000000000000module Text.Tabular.Html where import Text.Tabular import Text.Html 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 noHtml +++ headerCore) headerCore = concatHtml $ squish applyVAttr myTh (fmap fc ch) -- body = concatHtml $ squish applyHAttr tr $ fmap fst $ zipHeader noHtml rows rh rows = zipWith (\h cs -> myTh h +++ doRow cs) rhStrings cells doRow cs = concatHtml $ squish applyVAttr myTd $ fmap fst $ zipHeader noHtml (map f cs) (fmap fc ch) -- myTh = th myTd = td rhStrings = map fr $ headerContents 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 { border-bottom: 1px solid }" , ".thickbottom { border-bottom: 3px solid }" , ".thinright { border-right: 1px solid }" , ".thickright { border-right: 3px solid }" ] tabular-0.2.2.7/Text/Tabular/Latex.hs0000644000000000000000000000266212473563446015453 0ustar0000000000000000module Text.Tabular.Latex where import Data.List (intersperse) import Text.Tabular 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) -> (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 $ fmap fr rh) , "\\end{tabular}" ] where ch2 = Group DoubleLine [(Header ""),fmap fc ch] hspec = concatMap (either hAttr fst) $ flattenHeader $ zipHeader "" cols ch2 header = texCols . map label . headerContents $ ch2 -- row (cs,h) = texCols $ label h : map f cs texCols = concat . intersperse " & " texRows = map addTableNl rhStrings = headerContents 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 tabular-0.2.2.7/Text/Tabular/SimpleText.hs0000644000000000000000000000205512473563446016470 0ustar0000000000000000module Text.Tabular.SimpleText where import Data.List (intersperse, transpose) import Text.Tabular render :: String -- ^ delim -> (rh -> String) -> (ch -> String) -> (a -> String) -> Table rh ch a -> String render delim fr fc f (Table rh ch cells) = unlines $ [ renderColumns delim ch2 ] ++ (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) where -- 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 delim $ Group DoubleLine [ Header h , fmap fst $ zipHeader "" (map f cs) ch] rhStrings = map fr $ headerContents rh renderRs (Header s) = [s] renderRs (Group _ hs) = concatMap renderRs hs renderColumns :: String -> Header String -> String renderColumns delim h = concatMap helper $ flattenHeader h where helper = either (const delim) id