tabular (empty) → 0.1

raw patch · 9 files changed

+450/−0 lines, 9 filesdep +basedep +htmldep +mtlsetup-changed

Dependencies added: base, html, mtl

Files

• LICENSE +26/−0
• Setup.lhs +3/−0
• Text/Tabular.hs +168/−0
• Text/Tabular/AsciiArt.hs +63/−0
• Text/Tabular/Html.hs +57/−0
• Text/Tabular/Latex.hs +48/−0
• example/sample1.hs +42/−0
• example/sample1.tex +5/−0
• tabular.cabal +38/−0

@@ -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.

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -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++

@@ -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) ' '

@@ -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 }"+  ]

@@ -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

@@ -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"]

@@ -0,0 +1,5 @@+\documentclass{article}++\begin{document}+\include{sample1T}+\end{document}

@@ -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:          <E.Y.Kow@brighton.ac.uk>+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