rainbox (empty) → 0.2.0.0

raw patch · 23 files changed

+3177/−0 lines, 23 filesdep +QuickCheckdep +arraydep +basesetup-changed

Dependencies added: QuickCheck, array, base, rainbow, random, tasty, tasty-quickcheck, text, transformers

Files

• LICENSE +30/−0
• README.md +35/−0
• Setup.hs +2/−0
• lib/Rainbox.hs +162/−0
• lib/Rainbox/Array2d.hs +216/−0
• lib/Rainbox/Box.hs +341/−0
• lib/Rainbox/Box/Primitives.hs +536/−0
• lib/Rainbox/Reader.hs +293/−0
• lib/Rainbox/Tutorial.lhs +174/−0
• rainbox.cabal +119/−0
• sunlight-test.hs +14/−0
• test/Rainbox/Array2dTests.hs +389/−0
• test/Rainbox/Box/PrimitivesTests.hs +222/−0
• test/Rainbox/BoxDir.hs +7/−0
• test/Rainbox/BoxTests.hs +207/−0
• test/Rainbox/ReaderTests.hs +133/−0
• test/RainboxDir.hs +13/−0
• test/RainboxTests.hs +7/−0
• test/Test/Rainbow/Generators.hs +82/−0
• test/Visual.hs +154/−0
• test/rainbox-mosaic.hs +20/−0
• test/rainbox-test.hs +11/−0
• test/rainbox-visual.hs +10/−0

@@ -0,0 +1,30 @@+Copyright (c) 2014, Omari Norman++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Omari Norman nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT+OWNER 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,35 @@+Rainbox+=======++Provides pretty printing of boxes in two dimensions.  Rainbox is+useful for console programs that need to format tabular data.++Current development status+==========================++Currently the library is done and passes all tests; I'm working on+adding more tests and some documentation.++Documentation+=============++In addition to the Haddock documentation, a tutorial is available in+[the Rainbox.Tutorial module](lib/Rainbox/Tutorial.lhs).  This+module is best read in your text editor or through the Github web+interface, as it is written in literate Haskell, which HsColour does+not fare so well with.++Portability+===========++There's nothing unportable in Rainbox; however, it does use+[Rainbow](http://hackage.haskell.org/package/rainbow) which works+only on UNIX-like systems because it uses the UNIX terminfo library.+I only develop for UNIX-like systems because they are the only ones+I use.++License+=======++Rainbox is licensed under the BSD license; please see the LICENSE+file.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,162 @@+-- | Create grids of (possibly) colorful boxes.+--+-- For an introduction, see "Rainbox.Tutorial".  That file is+-- written in literate Haskell, so you will want to look at the+-- source itself.  HsColour does not do very well with literate+-- Haskell, so you will want to view the file in your text editor or+-- on Github:+--+-- <https://github.com/massysett/rainbox/blob/master/lib/Rainbox/Tutorial.lhs>+--+-- This module only helps you create simple grids of cells, rather+-- like a spreadsheet that does not allow you to merge or split+-- cells.  If your needs are more complicated, use "Rainbox.Box",+-- which allows you to build 'Box'es of arbitrary complexity by+-- pasting simpler 'Box'es together.  (You can of course use this+-- module together with "Rainbox.Box" to create very complex+-- layouts.)+module Rainbox+  ( -- * Backgrounds+    Background(..)+  , defaultBackground+  , backgroundFromChunk+  , same++  -- * Alignment+  , Align+  , Horiz+  , Vert+  , top+  , bottom+  , left+  , right+  , center++  -- * Bar+  , Bar(..)++  -- * Cell+  , Cell(..)++  -- * Creating Box and gluing them together++  -- | For simple needs you will only need 'gridByRows' or+  -- 'gridByCols'; 'boxCells' and 'glueBoxes' are provided for more+  -- complex needs.+  , gridByRows+  , gridByCols+  , checkGrid+  , boxCells+  , glueBoxes++  -- * Rendering+  , render+  , printBox+  ) where++import Rainbox.Box+import Rainbox.Array2d+import Data.Array+import Data.String++-- | A 'Cell' consists of multiple screen lines; each screen line is+-- a 'Bar'.+data Cell = Cell+  { bars :: [Bar]+  -- ^ Each Bar is one line on the screen.++  , horiz :: Align Horiz+  -- ^ How this Cell aligns compared to the other Cell in its+  -- column; use 'left', 'center', or 'right'.++  , vert :: Align Vert+  -- ^ How this Cell aligns compared to other Cell in its row; use+  -- 'top', 'center', or 'bottom'.++  , background :: Background+  -- ^ Background color for necessary padding that is added to the+  -- Cell to make it the correct width and height.  Does not affect+  -- the 'Chunk' contained in the 'bars'; these will use the colors+  -- that are designated in the 'Chunk' itself.+  } deriving (Eq, Show)++-- | Creates a Cell with a 'left' horizontal alignment, a 'top'+-- vertical alignment, and a 'defaultBackground'.  The cell will be+-- one 'Bar' tall and contain the text given in the string.+instance IsString Cell where+  fromString s = Cell [(fromString s)] left top defaultBackground++-- | Returns the width of each 'Bar' in the 'Cell'.+cellWidths :: Cell -> [Int]+cellWidths = map width . bars++-- | Transforms a grid of 'Cell' to a grid of 'Box' by adding+-- necessary padding to each 'Cell'.  In every row of the array, all+-- the 'Box' will have equal height; in every column of the array,+-- all the 'Box' will have equal width.+boxCells+  :: (Ix col, Ix row)+  => Array (col, row) Cell+  -> Array (col, row) Box+boxCells ay = cells $ mapTable conv tbl+  where+    tbl = table getWidth getHeight ay+      where+        getWidth _ = maximum . (0:) . concat . map cellWidths . map snd+        getHeight _ = maximum . (0:) . map (length . bars . snd)+    conv lCol lRow _ _ c = grow bk (Height lRow) (Width lCol) av ah bx+      where+        Cell bs ah av bk = c+        bx = barsToBox bk ah bs++-- | Use 'catH' and 'catV' to fuse an array of 'Box' into a single+-- 'Box'.  For example, if the 'bounds' of the array are+-- @((0,0),(3,5))@, then the array has the number of cells given by+-- @rangeSize ((0,0), (3,5))@ (that is, 24).  The upper left corner+-- is @(0,0)@ and the lower right corner is @(3,5)@; the upper right+-- and lower left corners are @(3,0)@ and @(0,5)@, respectively.+glueBoxes+  :: (Ix col, Ix row)+  => Array (col, row) Box+  -> Box+glueBoxes+  = catH defaultBackground top+  . map (catV defaultBackground left)+  . cols++-- | Creates a single 'Box' from a list of rows of 'Cell'.  Each+-- list is a row of 'Cell'.  The list of rows is from top to bottom;+-- within each row, the cells are given from left to right.+--+-- /This function is partial./  Each list of 'Cell' must be+-- the same length; otherwise, your program will crash.  Since you+-- will typically generate the list of rows using 'map' or list+-- comprehensions or the like, this isn't typically a problem; if it+-- is a problem, then check the inputs to this function with+-- 'checkGrid' before you apply it.++gridByRows :: [[Cell]] -> Box+gridByRows = glueBoxes . boxCells . arrayByRows++-- | Creates a single 'Box' from a list of columns of 'Cell'.  Each+-- list is a column of 'Cell'.  The list of columns is from left to+-- right; within each column, the cells are given from top to+-- bottom.+--+-- /This function is partial./  Each list of 'Cell' must be+-- the same length; otherwise, your program will crash.  Since you+-- will typically generate the list of columns using 'map' or list+-- comprehensions or the like, this isn't typically a problem; if it+-- is a problem, then check the inputs to this function with+-- 'checkGrid' before you apply it.++gridByCols :: [[Cell]] -> Box+gridByCols = glueBoxes . boxCells . arrayByCols++-- | Checks the input to 'gridByRows' or 'gridByCols' to ensure that+-- it is safe.  True if the list of list of 'Cell' is safe for+-- either of these functions; False if not.+checkGrid :: [[Cell]] -> Bool+checkGrid ls = case ls of+  [] -> True+  x:xs -> let len = length x in all ((== len) . length) xs

@@ -0,0 +1,216 @@+-- | Helpers for two-dimensional arrays.+module Rainbox.Array2d+  (+  -- * Tables+    Table+  , lCols+  , lRows+  , cells+  , table+  , labelCols+  , labelRows+  , mapTable+  , mapColLabels+  , mapRowLabels++  -- * Two-dimensional arrays+  , cols+  , rows+  , arrayByRows+  , arrayByCols+  ) where++import Data.Array++-- * Tables++-- | A Table is a two-dimensional array with two associated+-- one-dimensional arrays: an array of labels for each column, and+-- an array of labels for each row.+data Table lCol lRow col row a = Table+  { lCols :: Array col lCol+  -- ^ One label for each column+  , lRows :: Array row lRow+  -- ^ One label for each row+  , cells :: Array (col, row) a+  -- ^ Two-dimensional array of cells+  } deriving (Eq, Show)++instance (Ix col, Ix row) => Functor (Table lCol lRow col row) where+  fmap f t =  t { cells = fmap f . cells $ t }++-- | Make a new Table.+table+  :: (Ix col, Ix row)+  => (col -> [(row, a)] -> lCol)+  -- ^ Function to generate the column labels.  It is applied to the+  -- column index and the full contents of the column.+ +  -> (row -> [(col, a)] -> lRow)+  -- ^ Function to generate the row labels.  It is applied to the+  -- row index and the full contents of the row.++  -> Array (col, row) a+  -- ^ Cells of the table++  -> Table lCol lRow col row a+table fCol fRow ay = Table ayc ayr ay+  where+    ayc = labelCols fCol ay+    ayr = labelRows fRow ay++-- | Given a two-dimensional array and a function that generates+-- labels, return an array of column labels.+labelCols+  :: (Ix col, Ix row)+  => (col -> [(row, a)] -> lCol)+  -- ^ Function to generate the column labels.  It is applied to the+  -- column index and the full contents of the column.+  -> Array (col, row) a+  -> Array col lCol+labelCols f a = listArray (minCol, maxCol) es+  where+    ((minCol, minRow), (maxCol, maxRow)) = bounds a+    es = zipWith f ixsCols . map mkRow $ ixsCols+      where+        ixsCols = range (minCol, maxCol)+        mkRow col = zip ixsRows (map (\rw -> a ! (col, rw)) ixsRows)+          where+            ixsRows = range (minRow, maxRow)++-- | Given a two-dimensional array and a function that generates+-- labels, return an array of row labels.+labelRows+  :: (Ix col, Ix row)+  => (row -> [(col, a)] -> lRow)+  -- ^ Function to generate the row labels.  It is applied to the+  -- row index and the full contents of the row.+  -> Array (col, row) a+  -> Array row lRow+labelRows f a = listArray (minRow, maxRow) es+  where+    ((minCol, minRow), (maxCol, maxRow)) = bounds a+    es = zipWith f ixsRows . map mkCol $ ixsRows+      where+        ixsRows = range (minRow, maxRow)+        mkCol row = zip ixsCols (map (\cl -> a ! (cl, row)) ixsCols)+          where+            ixsCols = range (minCol, maxCol)++-- | Transform the cells of the table.  Similar to the Functor+-- instance, but the mapping function has access to the label and+-- index of each cell in the 'Table'.+mapTable+  :: (Ix col, Ix row)+  => (lCol -> lRow -> col -> row -> a -> b)+  -- ^ Function is passed the label for the column, the label for+  -- the row, the column index, the row index, and the contents of+  -- the cell.  It returns a new cell.+  -> Table lCol lRow col row a+  -> Table lCol lRow col row b+mapTable f (Table cs rs ls) = Table cs rs ls'+  where+    ls' = listArray (bounds ls) . map g . assocs $ ls+      where+        g ((col, row), e) = f (cs ! col) (rs ! row) col row e++-- | Transform the column labels.+mapColLabels+  :: (Ix col, Ix row)+  => (lCol -> col -> [(lRow, row, a)] -> lCol')+  -- ^ The function is passed the column label, column index, and+  -- the full contents of the column.+  -> Table lCol lRow col row a+  -> Table lCol' lRow col row a+mapColLabels f (Table cs rs ls) = Table cs' rs ls+  where+    ((colMin, rowMin), (colMax, rowMax)) = bounds ls+    cs' = listArray (colMin, colMax) es+      where+        es = zipWith3 f (elems cs) (indices cs) rws+          where+            rws = map mkRow . indices $ cs+              where+                mkRow idx = zipWith3 (,,) (elems rs)+                  (indices rs)+                  (map (ls !) (range ((idx, rowMin), (idx, rowMax))))++-- | Transform the row labels.+mapRowLabels+  :: (Ix col, Ix row)+  => (lRow -> row -> [(lCol, col, a)] -> lRow')+  -- ^ The function is passed the row label, the row index, and the+  -- full contents of the row.+  -> Table lCol lRow col row a+  -> Table lCol lRow' col row a+mapRowLabels f (Table cs rs ls) = Table cs rs' ls+  where+    ((colMin, rowMin), (colMax, rowMax)) = bounds ls+    rs' = listArray (rowMin, rowMax) es+      where+        es = zipWith3 f (elems rs) (indices rs) cls+          where+            cls = map mkCol . indices $ rs+              where+                mkCol idx = zipWith3 (,,) (elems cs)+                  (indices cs)+                  (map (ls !) (range ((colMin, idx), (colMax, idx))))++-- * Two-dimensional arrays++-- | Given a two-dimensional array, return a list of columns in+-- order.+cols+  :: (Ix col, Ix row)+  => Array (col, row) a+  -> [[a]]+cols ay = map getCol $ range (minCol, maxCol)+  where+    ((minCol, minRow), (maxCol, maxRow)) = bounds ay+    ixsRows = range (minRow, maxRow)+    getCol ixCol = map (\rw -> ay ! (ixCol, rw)) ixsRows++-- | Given a two-dimensional array, return a list of rows in order.+rows+  :: (Ix col, Ix row)+  => Array (col, row) a+  -> [[a]]+rows ay = map getRow $ range (minRow, maxRow)+  where+    ((minCol, minRow), (maxCol, maxRow)) = bounds ay+    ixsCols = range (minCol, maxCol)+    getRow ixRow = map (\cl -> ay ! (cl, ixRow)) ixsCols++-- | Generate a two-dimensional array from a list of rows.  Each row+-- must be of equal length; otherwise, the generated array will have+-- undefined elements.+arrayByRows+  :: [[a]]+  -> Array (Int, Int) a+arrayByRows ls = array ((0,0), (colMax, rowMax)) $ indexRows ls+  where+    rowMax = length ls - 1+    colMax = case ls of+      [] -> -1+      x:_ -> length x - 1++indexRows :: [[a]] -> [((Int, Int),a)]+indexRows = concat . map f . zip [0 ..]+  where+    f (rw, ls) = map g $ zip [0 ..] ls+      where+        g (cl, a) = ((cl, rw), a)++-- | Generate a two-dimensional array from a list of columns.  Each+-- column must be of equal length; otherwise, the generated array+-- will have undefined elements.+arrayByCols+  :: [[a]]+  -> Array (Int, Int) a+arrayByCols ls = listArray ((0,0), (colMax, rowMax)) . concat $ ls+  where+    colMax = length ls - 1+    rowMax = case ls of+      [] -> -1+      x:_ -> length x - 1+

@@ -0,0 +1,341 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Working with 'Box'.+--+-- A 'Box' is a rectangular block of text.  You can paste 'Box'+-- together to create new rectangles, and you can grow or reduce+-- existing 'Box' to create new 'Box'es.+--+-- There are only six primitive functions that make a 'Box':+--+-- * 'B.blank' - formats a blank box with nothing but a (possibly)+-- colorful background.  Useful to paste to other 'Box' to provide+-- white space.+--+-- * 'B.chunks' - Makes a box out of Rainbow 'Chunk'.+--+-- * 'B.catH' - paste 'Box' together horizontally+--+-- * 'B.catV' - paste 'Box' together vertically+--+-- * 'B.viewH' - view a 'Box', keeping the same height but possibly+-- trimming the width+--+-- * 'B.viewV' - view a 'Box', keeping the same width but possibly+-- trimming the height+--+-- The other functions use these building blocks to do other useful+-- things.+--+-- There are many crude diagrams in the Haddock documentation.  A+-- dash means a character with data; a period means a blank+-- character.  When you print your 'Box', the blank characters will+-- have the appropriate background color.+module Rainbox.Box+  ( -- * Backgrounds+    Background(..)+  , defaultBackground+  , backgroundFromChunk+  , backgroundToTextSpec+  , same+  +  -- * Height and columns+  , Height(..)+  , B.height+  , Width(..)+  , B.HasWidth(..)++  -- * Alignment+  , Align+  , Vert+  , Horiz+  , B.center+  , B.top+  , B.bottom+  , B.left+  , B.right++  -- * Box properties+  , B.Bar(..)+  , B.barToBox+  , B.barsToBox+  , B.Box+  , B.unBox++  -- * Making Boxes+  , B.blank+  , blankH+  , blankV+  , B.chunks+  , chunk++  -- * Pasting Boxes together+  , B.catH+  , B.catV+  , sepH+  , sepV+  , punctuateH+  , punctuateV++  -- * Viewing Boxes+  , view+  , B.viewH+  , B.viewV++  -- * Growing Boxes+  , grow+  , growH+  , growV+  , column++  -- * Resizing+  , resize+  , resizeH+  , resizeV++  -- * Printing Boxes+  , render+  , printBox+  ) where++import Data.Monoid+import Data.List (intersperse)+import qualified Data.Text as X+import System.Console.Rainbow+import System.Console.Rainbow.Types+import System.Console.Rainbow.Colors+import qualified Rainbox.Box.Primitives as B+import Rainbox.Box.Primitives+  ( Box+  , Align+  , Horiz+  , Vert+  , Height(..)+  , Width(..)+  , Background+  , unBox+  )+import qualified System.IO as IO++backgroundFromChunk :: Chunk -> B.Background+backgroundFromChunk (Chunk ts _) = B.Background bk8 bk256+  where+    bk8 = case getLast . background8 . style8 $ ts of+      Nothing -> c8_default+      Just c -> c+    bk256 = case getLast . background256 . style256 $ ts of+      Nothing -> c256_default+      Just c -> c++backgroundToTextSpec :: B.Background -> TextSpec+backgroundToTextSpec (B.Background bk8 bk256) = TextSpec+  { style8 = mempty { background8 = Last . Just $ bk8 }+  , style256 = mempty { background256 = Last . Just $ bk256 } }++-- | Use the default background colors of the current terminal.+defaultBackground :: B.Background+defaultBackground = B.Background c8_default c256_default++-- | Use the same color for 8 and 256-color backgrounds.+same :: Color8 -> B.Background+same c = B.Background c (to256 c)++--+-- # Box making+--++-- | A blank horizontal box with a given width and no height.+blankH :: Background -> Int -> Box+blankH bk i = B.blank bk (Height 0) (Width i)++-- | A blank vertical box with a given length.+blankV :: Background -> Int -> Box+blankV bk i = B.blank bk (Height i) (Width 0)++-- | A Box made of a single 'Chunk'.+chunk :: Chunk -> Box+chunk = B.chunks . (:[])++-- | Grow a box.  Each dimension of the result 'Box' is never smaller+-- than the corresponding dimension of the input 'Box'.  Analogous to+-- 'view', so you give the resulting dimensions that you want.  The+-- alignment is analogous to 'view'; for instance, if you specify+-- that the alignment is 'top' and 'left', the extra padding is+-- added to the right and bottom sides of the resulting 'Box'.++grow+  :: Background+  -> Height+  -> Width+  -> Align Vert+  -> Align Horiz+  -> Box+  -> Box+grow bk (B.Height h) (B.Width w) av ah+  = growH bk w ah+  . growV bk h av++-- | Grow a 'Box' horizontally.++growH+  :: Background+  -> Int+  -- ^ Resulting width+  -> Align Horiz+  -> Box+  -> Box+growH bk tgtW a b+  | tgtW < w = b+  | otherwise = B.catH bk B.top [lft, b, rt]+  where+    w = B.width b+    diff = tgtW - w+    (lft, rt) = (blankH bk wl, blankH bk wr)+    (wl, wr)+      | a == B.center = B.split diff+      | a == B.left = (0, diff)+      | otherwise = (diff, 0)++-- | Grow a 'Box' vertically.+growV+  :: Background+  -> Int+  -- ^ Resulting height+  -> Align Vert+  -> Box+  -> Box+growV bk tgtH a b+  | tgtH < h = b+  | otherwise = B.catV bk B.left [tp, b, bt]+  where+    h = B.height b+    diff = tgtH - h+    (tp, bt) = (blankV bk ht, blankV bk hb)+    (ht, hb)+      | a == B.center = B.split diff+      | a == B.top = (0, diff)+      | otherwise = (diff, 0)++-- | Returns a list of 'Box', each being exactly as wide as the+-- widest 'Box' in the input list.+column+  :: Background+  -> Align Horiz+  -> [Box]+  -> [Box]+column bk ah bs = map (growH bk w ah) bs+  where+    w = maximum . (0:) . map B.width $ bs++view+  :: Height+  -> Width+  -> Align Vert+  -> Align Horiz+  -> Box+  -> Box+view h w av ah+  = B.viewH (B.unWidth w) ah+  . B.viewV (B.unHeight h) av++--+-- # Resizing+--++-- | Resize a 'Box'.  Will grow or trim it as necessary in order to+-- reach the resulting size.  Returns an empty 'Box' if either+-- 'Height' or 'Width' is less than 1.++resize+  :: Background+  -> Height+  -> Width+  -> Align Vert+  -> Align Horiz+  -> Box+  -> Box+resize bk h w av ah+  = resizeH bk (unWidth w) ah+  . resizeV bk (unHeight h) av++-- | Resize horizontally.+resizeH+  :: Background+  -> Int+  -- ^ Resulting width+  -> Align Horiz+  -> Box+  -> Box+resizeH bk w a b+  | bw < w = growH bk w a b+  | bw > w = B.viewH w a b+  | otherwise = b+  where+    bw = B.width b++-- | Resize vertically.+resizeV+  :: Background+  -> Int+  -- ^ Resulting height+  -> Align Vert+  -> Box+  -> Box+resizeV bk h a b+  | bh < h = growV bk h a b+  | bh > h = B.viewV h a b+  | otherwise = b+  where+    bh = B.height b++--+-- # Glueing+--++-- | @sepH sep a bs@ lays out @bs@ horizontally with alignment @a@,+--   with @sep@ amount of space in between each.+sepH :: Background -> Int -> Align Vert -> [Box] -> Box+sepH bk sep a = punctuateH bk a bl+  where+    bl = blankH bk sep++-- | @sepV sep a bs@ lays out @bs@ vertically with alignment @a@,+--   with @sep@ amount of space in between each.+sepV :: Background -> Int -> Align Horiz -> [Box] -> Box+sepV bk sep a = punctuateV bk a bl+  where+    bl = blankV bk sep++-- | @punctuateH a p bs@ horizontally lays out the boxes @bs@ with a+--   copy of @p@ interspersed between each.+punctuateH :: Background -> Align Vert -> Box -> [Box] -> Box+punctuateH bk a sep = B.catH bk a . intersperse sep++-- | A vertical version of 'punctuateH'.+punctuateV :: Background -> Align Horiz -> Box -> [Box] -> Box+punctuateV bk a sep = B.catV bk a . intersperse sep++-- | Convert a 'Box' to Rainbow 'Chunk's.  You can then print it+-- using 'putChunks' or the like.+render :: Box -> [Chunk]+render bx = case unBox bx of+  B.NoHeight _ -> []+  B.WithHeight rw ->+    concat . concat . map (: [["\n"]])+    . map renderRod $ rw++renderRod :: B.Rod -> [Chunk]+renderRod = map toChunk . B.unRod+  where+    toChunk = either spcToChunk id . B.unNibble+    spcToChunk ss =+      Chunk (backgroundToTextSpec (B.spcBackground ss))+            (X.replicate (B.numSpaces ss) (X.singleton ' '))++-- | Prints a Box to standard output.  If standard output is not a+-- terminal, no colors are used.  Otherwise, colors are used if your+-- TERM environment variable suggests they are available.+printBox :: Box -> IO ()+printBox b = do+  t <- smartTermFromEnv IO.stdout+  hPutChunks IO.stdout t . render $ b+

@@ -0,0 +1,536 @@+-- | Box primitives.+--+-- This module provides all functions that have access to the+-- internals of a 'Box'.  There are only six functions that make a+-- 'Box':+--+-- * 'blank' - formats a blank box with nothing but a (possibly)+-- colorful background.  Useful to paste to other 'Box' to provide+-- white space.+--+-- * 'chunks' - Makes a box out of Rainbow 'Chunk'.+--+-- * 'catH' - paste 'Box' together horizontally+--+-- * 'catV' - paste 'Box' together vertically+--+-- * 'viewH' - view a 'Box', keeping the same height but possibly+-- trimming the width+--+-- * 'viewV' - view a 'Box', keeping the same width but possibly+-- trimming the height+--+-- There are many crude diagrams in the Haddock documentation.  A+-- dash means a character with data; a period means a blank+-- character.  When you print your 'Box', the blank characters will+-- have the appropriate background color.+module Rainbox.Box.Primitives+  ( -- * Background+    Background(..)++  -- * Alignment+  , Align+  , Vert+  , Horiz+  , center+  , top+  , bottom+  , left+  , right++  -- * Box+  , Bar(..)+  , Rod(..)+  , barToBox+  , barsToBox+  , Nibble+  , unNibble+  , Spaces+  , numSpaces+  , spcBackground+  , BoxP(..)+  , Box+  , unBox++  -- * Height and Width+  , Height(..)+  , height+  , Width(..)+  , HasWidth(..)++  -- * Making Boxes+  , blank+  , chunks+  , catH+  , catV+  , viewH+  , viewV++  -- * Helpers+  , split++  ) where++import qualified Data.Foldable as F+import System.Console.Rainbow.Types+import Data.Monoid+import qualified Data.Text as X+import Data.String+import System.Console.Rainbow.Colors++-- # Background++-- | Background colors to use when inserting necessary padding.+data Background = Background+  { boxBackground8 :: Color8+  , boxBackground256 :: Color256+  } deriving (Eq, Show)++-- # Box++data Spaces = Spaces+  { numSpaces :: Int+  , spcBackground :: Background+  } deriving (Eq, Show)++instance HasWidth Spaces where+  width = numSpaces++newtype Nibble = Nibble { unNibble :: Either Spaces Chunk }+  deriving (Eq, Show)++instance IsString Nibble where+  fromString = Nibble . Right . fromString++instance HasWidth Nibble where+  width = either width width . unNibble++-- | Occupies a single row on screen.  The 'Chunk' you place in a+-- 'Bar' should not have any control characters such as newlines or+-- tabs, as rainbox assumes that each character in a 'Bar' takes up+-- one screen column and that each character does not create+-- newlines.  Leave newline handling up to rainbox.  However,+-- rainbox will /not/ check to make sure that your inputs do not+-- contain newlines, tabs, or other spurious characters.  Similarly, use of+-- combining characters will create unexpected results, as Rainbox+-- will see something that takes up (for instance) two characters+-- and think it takes up two screen columns, when in reality it will+-- take up only one screen column.  So, if you need accented+-- characters, use a single Unicode code point, not two code points.+-- For example, for é, use U+00E9, not U+0065 and U+0301.+newtype Bar = Bar { unBar :: [Chunk] }+  deriving (Eq, Show)++barToBox :: Bar -> Box+barToBox = chunks . unBar++barsToBox :: Background -> Align Horiz -> [Bar] -> Box+barsToBox bk ah = catV bk ah . map barToBox++instance IsString Bar where+  fromString = Bar . (:[]) . fromString++instance Monoid Bar where+  mempty = Bar []+  mappend (Bar l) (Bar r) = Bar $ l ++ r++-- | A 'Box' has a width in columns and a height in rows.  Its+-- height and width both are always at least zero.  It can have+-- positive height even if its width is zero, and it can have+-- positive width even if its height is zero.+--+-- Each row in a 'Box' always has the same number of characters; a+-- 'Box' with zero height has no characters but still has a certain+-- width.++newtype Box = Box { unBox :: BoxP }+  deriving (Eq, Show)++newtype Rod = Rod { unRod :: [Nibble] }+  deriving (Eq, Show)++instance IsString Rod where+  fromString = Rod . (:[]) . fromString++instance HasWidth Rod where+  width = sum . map width . unRod++-- | Box payload.  Has the data of the box.+data BoxP+  = NoHeight Int+  -- ^ A Box with width but no height.  The Int must be at least+  -- zero.  If it is zero, the Box has no height and no width.+  | WithHeight [Rod]+  -- ^ A Box that has height of at least one.  It must have at least+  -- one component Bar.+  deriving (Eq, Show)++instance HasWidth BoxP where+  width b = case b of+    NoHeight w -> w+    WithHeight ns -> sum . map width $ ns++instance IsString Box where+  fromString = Box . WithHeight . (:[]) . fromString++-- # Height and Width++-- | A count of rows+newtype Height = Height { unHeight :: Int }+  deriving (Eq, Ord, Show)++-- | How many 'Rod' are in this 'Box'?+height :: Box -> Int+height b = case unBox b of+  NoHeight _ -> 0+  WithHeight rs -> length rs++-- | A count of columns+newtype Width = Width { unWidth :: Int }+  deriving (Eq, Ord, Show)++-- | How many columns are in this thing? A column is one character+-- wide.  Every 'Bar' in a 'Box' always has the same number of+-- columns.+--+-- This is for things that have a single, solitary width, not things+-- like columns that might have different widths at different+-- points.+class HasWidth a where+  width :: a -> Int++instance HasWidth Bar where+  width = sum . map (X.length . text) . unBar++instance HasWidth Box where+  width b = case unBox b of+    NoHeight i -> i+    WithHeight rs -> case rs of+      [] -> error "cols: error"+      x:_ -> width x++instance HasWidth Chunk where+  width = X.length . text++-- # Making Boxes++-- | A blank 'Box'.  Useful for aligning other 'Box'.+blank+  :: Background+  -> Height+  -> Width+  -> Box+blank bk r c+  | unHeight r < 1 = Box $ NoHeight (max 0 (unWidth c))+  | otherwise = Box . WithHeight $ replicate (unHeight r) row+  where+    row | unWidth c < 1 = Rod []+        | otherwise = Rod [ blanks bk (unWidth c) ]++-- | A 'Box' made of 'Chunk'.  Always one Bar tall, and has as many+-- columns as there are characters in the 'Chunk'.+chunks :: [Chunk] -> Box+chunks = Box . WithHeight . (:[]) . Rod . map (Nibble . Right)++-- | Alignment.+data Align a = Center | NonCenter a+  deriving (Eq, Show)++-- | Vertical alignment.+data Vert = ATop | ABottom+  deriving (Eq, Show)++-- | Horizontal alignment.+data Horiz = ALeft | ARight+  deriving (Eq, Show)++center :: Align a+center = Center++top :: Align Vert+top = NonCenter ATop++bottom :: Align Vert+bottom = NonCenter ABottom++left :: Align Horiz+left = NonCenter ALeft++right :: Align Horiz+right = NonCenter ARight++-- | Merge several Box horizontally into one Box.  That is, with+-- alignment set to ATop:+--+-- > --- ------- ----+-- > --- -------+-- > ---+--+-- becomes+--+-- > --------------+-- > ----------....+-- > ---...........+--+-- With alignment set to ABottom, becomes+--+-- > ---...........+-- > ----------....+-- > --------------++catH :: Background -> Align Vert -> [Box] -> Box+catH bk al bs+  | null bs = Box $ NoHeight 0+  | hght == 0 = Box . NoHeight . sum . map width $ bs+  | otherwise = Box . WithHeight . mergeHoriz . map (pad . unBox) $ bs+  where+    pad = padHoriz bk al hght+    hght = F.maximum . (0:) . map height $ bs++-- | Merge several Box vertically into one Box.  That is, with+-- alignment set to 'left':+--+-- > -------+-- > -------+-- >+-- > ---+-- > ---+-- >+-- > ----+-- > ----+--+-- becomes+--+-- > -------+-- > -------+-- > ---....+-- > ---....+-- > ---....+-- > ----...+-- > ----...+--+-- With alignment set to 'right', becomes+--+-- > -------+-- > -------+-- > ....---+-- > ....---+-- > ...----+-- > ...----++catV :: Background -> Align Horiz -> [Box] -> Box+catV bk al bs+  | null bs = Box $ NoHeight 0+  | otherwise = Box . foldr f (NoHeight w)+      . concat . map (flatten . unBox) $ bs+  where+    w = F.maximum . (0:) . map width $ bs+    f mayR bp = case mayR of+      Nothing -> bp+      Just rw -> case bp of+        WithHeight wh -> WithHeight $ padded : wh+        _ -> WithHeight [padded]+        where+          padded = padVert bk al w rw+    flatten bp = case bp of+      NoHeight _ -> [Nothing]+      WithHeight rs -> map Just rs+++-- | Given the resulting height, pad a list of Height.  So, when given+-- a height of 3 and an alignment of 'top':+--+-- > --------+-- > --------+--+-- becomes+--+-- > --------+-- > --------+-- > ........+--+-- where dashes is a 'Bar' with data, and dots is a blank 'Bar'.++padHoriz :: Background -> Align Vert -> Int -> BoxP -> [Rod]+padHoriz bk a hght bp = case bp of+  NoHeight w -> map (Rod . (:[])) . replicate h $ blanks bk w+  WithHeight rs -> concat [tp, rs, bot]+    where+      nPad = max 0 $ h - length rs+      (nATop, nBot) = case a of+        Center -> split nPad+        NonCenter ATop -> (0, nPad)+        NonCenter ABottom -> (nPad, 0)+      pad = Rod [blanks bk len]+        where+          len = case rs of+            [] -> 0+            x:_ -> width x+      (tp, bot) = (replicate nATop pad, replicate nBot pad)+  where+    h = max 0 hght++-- | Given the resulting width, pad a 'Bar'.  So, when given+-- a width of 10 and an alignment of 'right',+--+-- > -------+--+-- becomes+--+-- > ...-------++padVert+  :: Background+  -> Align Horiz+  -> Int+  -> Rod+  -> Rod+padVert bk a wdth rw@(Rod cs) = Rod . concat $ [lft, cs, rght]+  where+    nPad = max 0 $ w - width rw+    (nLeft, nRight) = case a of+      Center -> split nPad+      NonCenter ALeft -> (0, nPad)+      NonCenter ARight -> (nPad, 0)+    (lft, rght) = (mkPad nLeft, mkPad nRight)+    mkPad n+      | n == 0 = []+      | otherwise = [blanks bk n]+    w = max 0 wdth+++-- | Merge several horizontal Height into one set of horizontal 'Bar'.+-- That is:+--+-- > ----- ----- -----+-- > ----- ----- -----+-- > ----- ----- -----+--+-- into+--+-- > ---------------+-- > ---------------+-- > ---------------+--+-- Strange behavior will result if each input list is not exactly+-- the same length.++mergeHoriz :: [[Rod]] -> [Rod]+mergeHoriz = foldr (zipWith merge) (repeat (Rod []))+  where+    merge (Rod r1) (Rod r2) = Rod $ r1 ++ r2++-- # Viewing++-- | View a 'Box', possibly shrinking it.  You set the size of your+-- viewport and how it is oriented relative to the 'Box' as a whole.+-- The 'Box' returned may be smaller than the argument 'Box', but it+-- will never be bigger.+--+-- Examples:+--+-- >>> :set -XOverloadedStrings+-- >>> let box = catV defaultBackground top [ "ab", "cd" ]+-- >>> printBox . view (Height 1) (Width 1) left top $ box+-- a+--+-- >>> printBox . view (Height 1) (Width 1) right bottom $ box+-- d++viewV :: Int -> Align Vert -> Box -> Box+viewV hght a (Box b) = Box $ case b of+  WithHeight rs+    | h == 0 -> NoHeight . width . head $ rs+    | otherwise -> WithHeight $ case a of+        NonCenter ATop -> take h rs+        NonCenter ABottom -> drop extra rs+        Center -> drop nDrop . take nTake $ rs+          where+            (trimL, trimR) = split extra+            nTake = length rs - trimR+            nDrop = trimL+        where+          extra = max 0 $ length rs - h+  x -> x+  where+    h = max 0 hght++viewH :: Int -> Align Horiz -> Box -> Box+viewH wdth a (Box b) = Box $ case b of+  NoHeight nh -> NoHeight (min w nh)+  WithHeight rs -> WithHeight $ map f rs+    where+      f rw = case a of+        NonCenter ALeft -> takeChars w rw+        NonCenter ARight -> dropChars extra rw+        Center -> dropChars nDrop . takeChars nTake $ rw+          where+            (trimL, trimR) = split extra+            nTake = max 0 $ width rw - trimR+            nDrop = trimL+        where+          extra = max 0 $ width rw - w+  where+    w = max 0 wdth+++dropChars :: Int -> Rod -> Rod+dropChars colsIn = Rod . go colsIn . unRod+  where+    go n cs+      | n <= 0 = cs+      | otherwise = case cs of+         [] -> []+         x:xs+           | lenX <= n -> go (n - lenX) xs+           | otherwise -> x' : xs+           where+             lenX = case unNibble x of+              Left blnk -> numSpaces blnk+              Right chk -> X.length . text $ chk+             x' = case unNibble x of+              Left blnk -> Nibble . Left $+                blnk { numSpaces = numSpaces blnk - n }+              Right chk -> Nibble . Right $ +                chk { text = X.drop n . text $ chk }++takeChars :: Int -> Rod -> Rod+takeChars colsIn = Rod . go colsIn . unRod+  where+    go n cs+      | n <= 0 = []+      | otherwise = case cs of+          [] -> []+          x:xs+            | lenX <= n -> x : go (n - lenX) xs+            | otherwise -> [x']+            where+              (lenX, x') = case unNibble x of+                Left blnk ->+                  ( numSpaces blnk,+                    Nibble . Left $ blnk { numSpaces = n } )+                Right chk ->+                  ( X.length . text $ chk,+                    Nibble . Right $+                    chk { text = X.take n . text $ chk } )++--+-- # Helpers+--++-- | Generate spaces.+blanks+  :: Background+  -- ^ Background colors+  -> Int+  -- ^ Number of blanks+  -> Nibble+blanks bk c = Nibble (Left (Spaces c bk))++-- | Split a number into two parts, so that the sum of the two parts+-- is equal to the original number.+split :: Int -> (Int, Int)+split i = (r, r + rm)+  where+    (r, rm) = i `quotRem` 2+

@@ -0,0 +1,293 @@+-- | 'Box' with many functions in a 'Reader' monad.+--+-- The advantage of this module over "Rainbox" is that many of the+-- functions have fewer arguments because they are instead carried+-- in the 'Reader' monad.  This also allows you to use four infix+-- operators to easily join up 'Box'.  The disadvantage is that+-- using the 'Reader' monad adds a layer of indirection.+module Rainbox.Reader+  ( -- * Backgrounds+    B.Background(..)+  , R.defaultBackground+  , R.same++  -- * Box properties+  , B.Bar(..)+  , B.Box+  , B.unBox++  -- * Height and columns+  , B.Height(..)+  , B.height+  , B.Width(..)+  , B.HasWidth(..)++  -- * Alignment+  , B.Align+  , B.Vert+  , B.Horiz+  , B.center+  , B.top+  , B.bottom+  , B.left+  , B.right++  -- * Reader monad+  , Specs(..)+  , Env+  , runEnv++  -- * Making Boxes+  , B.blank+  , blankH+  , blankV+  , B.chunks+  , R.chunk++  -- * Pasting Boxes together+  , catH+  , catV+  , sepH+  , sepV+  , punctuateH+  , punctuateV+  , (<->)+  , (<+>)+  , (/-/)+  , (/+/)++  -- * Viewing Boxes+  , view+  , viewH+  , viewV++  -- * Growing Boxes+  , grow+  , growH+  , growV+  , column++  -- * Resizing+  , resize+  , resizeH+  , resizeV++  -- * Printing Boxes+  , R.render+  , R.printBox+  ) where+++import Control.Monad.Trans.Reader+import Data.Functor.Identity+import qualified Rainbox.Box.Primitives as B+import qualified Rainbox.Box as R+import Rainbox.Box.Primitives+  ( Box+  , Height+  , Width+  , Align+  , Horiz+  , Vert+  )++data Specs = Specs+  { background :: B.Background+  , alignH :: Align Horiz+  , alignV :: Align Vert+  , spaceH :: Int+  -- ^ Amount of intervening space for horizontal joins+  , spaceV :: Int+  --  ^ Amount of intervening space for vertical joins+  } deriving (Eq, Show)++type Env = ReaderT Specs++runEnv :: Specs -> Env Identity a -> a+runEnv s = runIdentity . ($ s) . runReaderT++blankH :: Monad m => Int -> Env m Box+blankH i = do+  b <- asks background+  return $ R.blankH b i++blankV :: Monad m => Int -> Env m Box+blankV i = do+  b <- asks background+  return $ R.blankV b i++catH :: Monad m => [Box] -> Env m Box+catH bxs = do+  bk <- asks background+  al <- asks alignV+  return $ B.catH bk al bxs++catV :: Monad m => [Box] -> Env m Box+catV bxs = do+  bk <- asks background+  al <- asks alignH+  return $ B.catV bk al bxs++grow :: Monad m => Height -> Width -> Box -> Env m Box+grow r c bx = do+  b <- asks background+  h <- asks alignH+  v <- asks alignV+  return $ R.grow b r c v h bx++growH :: Monad m => Int -> Box -> Env m Box+growH i bx = do+  b <- asks background+  h <- asks alignH+  return $ R.growH b i h bx++growV :: Monad m => Int -> Box -> Env m Box+growV i bx = do+  b <- asks background+  v <- asks alignV+  return $ R.growV b i v bx++column :: Monad m => [Box] -> Env m [Box]+column bs = do+  bk <- asks background+  ah <- asks alignH+  return $ R.column bk ah bs++resize+  :: Monad m => Height+  -> Width+  -> Box+  -> Env m Box+resize r c bx = do+  b <- asks background+  h <- asks alignH+  v <- asks alignV+  return $ R.resize b r c v h bx++resizeH+  :: Monad m => Int+  -> Box+  -> Env m Box+resizeH i bx = do+  b <- asks background+  h <- asks alignH+  return $ R.resizeH b i h bx++resizeV+  :: Monad m => Int+  -> Box+  -> Env m Box+resizeV i bx = do+  b <- asks background+  v <- asks alignV+  return $ R.resizeV b i v bx++sepH+  :: Monad m => Int+  -> [Box]+  -> Env m Box+sepH i bx = do+  b <- asks background+  v <- asks alignV+  return $ R.sepH b i v bx++sepV+  :: Monad m => Int+  -> [Box]+  -> Env m Box+sepV i bx = do+  b <- asks background+  h <- asks alignH+  return $ R.sepV b i h bx++punctuateH+  :: Monad m => Box+  -> [Box]+  -> Env m Box+punctuateH bx bxs = do+  b <- asks background+  v <- asks alignV+  return $ R.punctuateH b v bx bxs++punctuateV+  :: Monad m => Box+  -> [Box]+  -> Env m Box+punctuateV bx bxs = do+  b <- asks background+  h <- asks alignH+  return $ R.punctuateV b h bx bxs++view+  :: Monad m+  => Height+  -> Width+  -> Box+  -> Env m Box+view h w b = do+  av <- asks alignV+  ah <- asks alignH+  return $ R.view h w av ah b++viewH+  :: Monad m+  => Int+  -> Box+  -> Env m Box+viewH h b = do+  ah <- asks alignH+  return $ B.viewH h ah b++viewV+  :: Monad m+  => Int+  -> Box+  -> Env m Box+viewV h b = do+  av <- asks alignV+  return $ B.viewV h av b++-- | Paste two 'Box' together horizontally with no intervening+-- space.  Left fixity, precedence 5.+(<->) :: Monad m => Box -> Box -> Env m Box+(<->) l r = do+  b <- asks background+  a <- asks alignV+  return $ B.catH b a [l, r]++infixl 5 <->++-- | Paste two 'Box' together horizontally.  Intervening space is+-- determined by 'spaceH'.+-- Left fixity, precedence 5.+(<+>) :: Monad m => Box -> Box -> Env m Box+(<+>) l r = do+  bk <- asks background+  a <- asks alignV+  sp <- asks spaceH+  bx <- blankH sp+  return $ B.catH bk a [ l, bx, r ]++infixl 5 <+>++-- | Paste two 'Box' together vertically with no intervening space.+-- Left fixity, precedence 6.+(/-/) :: Monad m => Box -> Box -> Env m Box+(/-/) h l = do+  b <- asks background+  a <- asks alignH+  return $ B.catV b a [ h, l ]++infixl 6 /-/++-- | Paste two 'Box' together vertically.  Intervening space is+-- determined by 'spaceV'.  Left fixity, precedence 6.+(/+/) :: Monad m => Box -> Box -> Env m Box+(/+/) h l = do+  bk <- asks background+  a <- asks alignH+  sp <- asks spaceV+  bx <- blankV sp+  return $ B.catV bk a [ h, bx, l ]++infixl 6 /+/

@@ -0,0 +1,174 @@+Rainbox tutorial - introduction+===============================++Rainbox (that is, *Rain*bow and *box*) helps you create colorful,+nicely formatted text boxes.  It is based on the `rainbow` package,+which provides all the color support, so read the [documentation for+that](http://hackage.haskell.org/package/rainbow) before continuing.++[boxes](http://hackage.haskell.org/package/boxes) is a similar+package but without color support.++This file is written in literate Haskell, so it compile and run for+you.  It also means that the compiler checks the examples, which+keeps them accurate.  However, HsColour does not fare so well with+literate Haskell, so this file will not look good from the+hyperlinked source in Haddock.  You're better off viewing it from a+text editor or through [the Gihub+website](http://www.github.com/massysett/rainbox).++A grid of boxes+===============++`Rainbox` is built on `Rainbox.Box`, which contains the building+blocks to create rectangular boxes of text.  Each box is justified+as appropriate and is filled in with a background color to make it+rectangular.++If your needs are complex, use `Rainbox.Box`.  Using it you can+patch boxes together into sort of a crazy quilt.  For simpler needs+you can use `Rainbox`, which only allows you to create grids of+boxes, like a spreadsheet.  This tutorial will show you how to use+the `Rainbox` module.  Everything you need from this package will be+available from the `Rainbox` module.  You will also need to import+packages from `rainbow`:++> {-# LANGUAGE OverloadedStrings #-}+> -- | If you are viewing this module in Haddock, note+> -- that the tutorial is contained in the source code of the+> -- module, which is written in literate Haskell.+> -- It is best viewed in your text editor or through+> -- Github at+> --+> -- <https://github.com/massysett/rainbox/blob/master/lib/Rainbox/Tutorial.lhs>++> module Rainbox.Tutorial where+>+> import Data.List (intersperse)+> import Data.Monoid+> import Data.String+> import System.Console.Rainbow+> import Rainbox+++Making a table of name data+===========================++For this example, we'll print a table of names, addresses, and+account balances.  This type holds the data we're interested in:++> data Record = Record+>   { firstName :: String+>   , lastName :: String+>   , address :: [String]+>   , phone :: String+>   , email :: String+>   , balance :: String+>   } deriving Show++And let's make a list of some sample data:++> records :: [Record]+> records =+>   [ Record+>       { firstName = "Nell"+>       , lastName = "Langston"+>       , address = [ "Owings Mills, MD 21117" ]+>       , phone = "800-588-2300"+>       , email = "NellJLangston@dayrep.com"+>       , balance = "0"+>       }+> +>   , Record+>       { firstName = "Sharon"+>       , lastName = "Sutton"+>       , address = [ "37 Church Street", "Flushing, NY 11354" ]+>       , phone = "312-555-8100"+>       , email = "SharonJSutton@teleworm.us"+>       , balance = "1033.54"+>       }+> +>   , Record+>       { firstName = "Barack"+>       , lastName = "Obama"+>       , address = [ "1600 Pennsylvania Ave NW", "Washington, DC" ]+>       , phone = "877-CASH-NOW"+>       , email = "president@whitehouse.gov"+>       , balance = "23562.00"+>       }+> +>   , Record+>       { firstName = "Bert and Ernie"+>       , lastName = "Sesame"+>       , address = [ "123 Sesame Street", "Lower Level",+>                     "Sesame, WN V6B432" ]+>       , phone = "+45-123-4567"+>       , email = "lower@rhyta.com"+>       , balance = "100,451.05"+>       }+>+>   , Record+>       { firstName = "Vip"+>       , lastName = "Vipperman"+>       , address = [ "10000 Smiley Lane", "Denver, CO 80266" ]+>       , phone = "303-555-1212"+>       , email = "vipperman@rhyta.com"+>       , balance = "301.00"+>       }+>   ]++Building each row of cells+==========================++`Rainbox` works with rows of `Cell`s.  You build one list of `Cell`+for each row in your grid.  Here we will make the last name bold,+and the rest of the text will be plain.  We will also alternate each+row--every even row (starting with the first row) will be the+default color, and the odd rows will be yellow.  We'll make a+function that takes a `Record` and returns another function that,+when applied to a `Chunk` that contains the color for the row,+returns a list of `Cell`.  First let's make a small function that+will make a function that returns a `Cell` with our desired+defaults:++> cell :: [Chunk] -> Chunk -> Cell+> cell cks back = Cell brs left top (backgroundFromChunk back)+>   where+>     brs = map Bar . map ((:[]) . (<> back)) $ cks+++> recordToCells :: Record -> Chunk -> [Cell]+> recordToCells r ck = map ($ ck) $+>   [ cell . (:[]) . fromString . firstName $ r+>   , cell . (:[]) $ (fromString (lastName r) <> bold)+>   , cell . map fromString . address $ r+>   , cell . (:[]) . fromString . phone $ r+>   , cell . (:[]) . fromString . email $ r+>   , cell . (:[]) . fromString . balance $ r+>   ]++Zipping to get rows of cells+============================++> cellRows :: [[Cell]]+> cellRows = zipWith recordToCells records (cycle [mempty, f_yellow])++Adding white space between columns+==================================++If we print the table like it is now, there will be no whitespace,+as `Rainbox` does not add whitespace for you.  Fortunately this is+easy to add.  The string literal, " ", becomes a Cell due to the use+of the Overloaded Strings extension; the cell will have the default+background color.++> spacedOutCells :: [[Cell]]+> spacedOutCells = map (intersperse " ") cellRows++Printing the cells+==================++To see the result, run this function in ghci:++> printSampleBox :: IO ()+> printSampleBox = printBox . gridByRows $ spacedOutCells

@@ -0,0 +1,119 @@+-- Initial rainbox.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                rainbox+version:             0.2.0.0+synopsis:            Two-dimensional box pretty printing, with colors+description:         +  Prints boxes in two dimensions, with colors.  Boxes are+  automatically padded with necessary whitespace.+  .+  For more information, please see the Haddock documentation and+  .+  <http://www.github.com/massysett/rainbox>++homepage:            http://www.github.com/massysett/rainbox+license:             BSD3+license-file:        LICENSE+author:              Omari Norman+maintainer:          omari@smileystation.com+copyright:           2014 Omari Norman+category:            Text+build-type:          Simple+extra-source-files:  README.md, sunlight-test.hs+cabal-version:       >=1.10+tested-with: GHC ==7.4.1, GHC ==7.6.3++source-repository head+  type: git+  location: https://github.com/massysett/rainbox.git++library+  ghc-options: -Wall+  exposed-modules:     +      Rainbox+    , Rainbox.Reader+    , Rainbox.Box+    , Rainbox.Box.Primitives+    , Rainbox.Array2d+    , Rainbox.Tutorial++  build-depends:+      base >=4.5.0.0 && < 5+    , rainbow >= 0.12.0.0+    , text >= 0.11.3.1+    , transformers >= 0.3.0.0+    , array >= 0.4.0.1++  hs-source-dirs: lib+  default-language:    Haskell2010++Test-Suite rainbox-visual+  type: exitcode-stdio-1.0+  ghc-options: -Wall+  main-is: rainbox-visual.hs+  hs-source-dirs: test lib+  default-language:    Haskell2010+  ghc-prof-options: -fprof-auto -caf-all+  build-depends:+      tasty >= 0.8+    , tasty-quickcheck >= 0.8+    , array >= 0.4.0.1+    , base >= 4.5.0.0 && < 5+    , rainbow >= 0.12.0.0+    , text >= 0.11.3.1+    , transformers >= 0.3.0.0+    , random >= 1.0.0.0+    , QuickCheck >= 2.6 && < 2.7++  other-modules:+      Visual+    , Test.Rainbow.Generators++Executable rainbox-mosaic+  ghc-options: -Wall+  main-is: rainbox-mosaic.hs+  hs-source-dirs: test lib+  default-language: Haskell2010+  build-depends:+      QuickCheck >= 2.6 && < 2.7+    , base >= 4.5.0.0 && < 5+    , random >= 1.0.0.0+    , rainbow >= 0.12.0.0+    , text >= 0.11.3.1+    , tasty >= 0.8+    , tasty-quickcheck >= 0.8++  if ! flag(mosaic)+    buildable: False++Flag mosaic+  Description: Build the rainbox-mosaic executable.+  Default: False++Test-Suite rainbox-test+  type: exitcode-stdio-1.0+  ghc-options: -Wall+  Main-is: rainbox-test.hs+  hs-source-dirs: test lib+  default-language:    Haskell2010+  ghc-prof-options: -fprof-auto -caf-all+  build-depends:+      tasty >= 0.8+    , tasty-quickcheck >= 0.8+    , array >= 0.4.0.1+    , base >= 4.5.0.0 && < 5+    , rainbow >= 0.12.0.0+    , text >= 0.11.3.1+    , transformers >= 0.3.0.0+    , QuickCheck >= 2.6 && < 2.7++  other-modules:+      RainboxDir+    , RainboxTests+    , Rainbox.Array2dTests+    , Rainbox.BoxTests+    , Rainbox.ReaderTests+    , Rainbox.BoxDir+    , Rainbox.Box.PrimitivesTests+    , Test.Rainbow.Generators

@@ -0,0 +1,14 @@+module Main where++import Test.Sunlight++inputs = TestInputs+  { tiDescription = Nothing+  , tiCabal = "cabal"+  , tiLowest = ("7.4.1", "ghc-7.4.1", "ghc-pkg-7.4.1")+  , tiDefault = [ ("7.4.1", "ghc-7.4.1", "ghc-pkg-7.4.1")+                , ("7.6.3", "ghc-7.6.3", "ghc-pkg-7.6.3") ]+  , tiTest = []+  }++main = runTests inputs

@@ -0,0 +1,389 @@+module Rainbox.Array2dTests where++import Test.Tasty+import Test.QuickCheck+import Test.Tasty.QuickCheck (testProperty)+import Data.Array+import Rainbox.Array2d++-- | Generates a two-dimensional array of Int.  The size of the+-- array depends on the size parameter.+genArray :: Gen (Array (Int, Int) Int)+genArray = do+  bnds <- genBounds+  let nElems = rangeSize bnds+  es <- vectorOf nElems arbitraryBoundedIntegral+  return $ listArray bnds es++-- | Generates array bounds.  The size of the bounds depends on the+-- size parameter.+genBounds :: Gen ((Int, Int), (Int, Int))+genBounds = do+  w:x:y:z:[] <- vectorOf 4 arbitrarySizedIntegral+  let (minC, maxC) | w < x = (w, x)+                   | otherwise = (x, w)+      (minR, maxR) | y < z = (y, z)+                   | otherwise = (z, y)+  return ((minC, minR), (maxC, maxR))++genTable :: Gen (Table (Int, [(Int, Int)]) (Int, [(Int, Int)]) Int Int Int)+genTable = do+  ay <- genArray+  return $ table (,) (,) ay++type LabelF+  = (Int, [(Int, Int)])+  -> (Int, [(Int, Int)])+  -> Int -> Int -> Int -> Int++type ChangeLabelF+  = (Int, [(Int, Int)])+  -> Int+  -> [((Int, [(Int, Int)]), Int, Int)]+  -> Int++genLabelF :: Gen LabelF+genLabelF = arbitrary++genChangeLabelF :: Gen ChangeLabelF+genChangeLabelF = arbitrary++-- # Properties++-- | Bounds of columns in a Table matches those of the cells+propTableColsBounds+  :: (Ix col, Ix row)+  => Table lCol lRow col row a+  -> Bool+propTableColsBounds tbl = bounds cls == tgtBounds+  where+    cls = lCols tbl+    ((minC, _), (maxC, _)) = bounds . cells $ tbl+    tgtBounds = (minC, maxC)++-- | Bounds of rows in a Table matches those of the cells+propTableRowsBounds+  :: (Ix col, Ix row)+  => Table lCol lRow col row a+  -> Bool+propTableRowsBounds tbl = bounds rws == tgtBounds+  where+    rws = lRows tbl+    ((_, minR), (_, maxR)) = bounds . cells $ tbl+    tgtBounds = (minR, maxR)++-- | Generating a table using the contents of the rows as labels+-- allows reconstruction of the original array++propGenRebuildByRow+  :: (Ix col, Ix row, Eq a)+  => Array (col, row) a+  -> Bool+propGenRebuildByRow ay = ay == ay'+  where+    ay' = array (bounds ay) . concat . elems . lRows+      . table (\_ _ -> ()) fRow $ ay+    fRow rw ls = map g ls+      where+        g (col, a) = ((col, rw), a)++-- | Generating a table using the contents of the columns as labels+-- allows reconstruction of the original array++propGenRebuildByCol+  :: (Ix col, Ix row, Eq a)+  => Array (col, row) a+  -> Bool+propGenRebuildByCol ay = ay == ay'+  where+    ay' = array (bounds ay) . concat . elems . lCols+      . table fCol (\_ _ -> ()) $ ay+    fCol cl ls = map g ls+      where+        g (rw, a) = ((cl, rw), a)++-- | Round-tripping through rows and arrayByRows+propRoundTripRows+  :: Eq a+  => Array (Int, Int) a+  -> Bool+propRoundTripRows ay = sameShape ay ay'+  where+    ay' = arrayByRows . rows $ ay++-- | Round-tripping through columns and arrayByCols+propRoundTripCols+  :: (Eq a, Show a)+  => Array (Int, Int) a+  -> Bool+propRoundTripCols ay = sameShape ay ay'+  where+    ay' = arrayByCols . cols $ ay++-- | True if both arrays have the same shape; that is, the same+-- number of rows and the same number of columns and the same+-- elements.++sameShape+  :: (Ix col, Ix row, Eq a)+  => Array (col, row) a+  -> Array (col, row) a+  -> Bool+sameShape x y = rx == ry && cx == cy && ex == ey+  where+    ((minCx, minRx), (maxCx, maxRx)) = bounds x+    ((minCy, minRy), (maxCy, maxRy)) = bounds y+    rx = rangeSize (minRx, maxRx)+    ry = rangeSize (minRy, maxRy)+    cx = rangeSize (minCx, maxCx)+    cy = rangeSize (minCy, maxCy)+    ex = elems x+    ey = elems y++-- # mapTable properties++-- | mapTable does not change lCols+mapTableNoChangeCols+  :: (Ix col, Ix row, Eq lCol)+  => (lCol -> lRow -> col -> row -> a -> b)+  -> Table lCol lRow col row a+  -> Bool+mapTableNoChangeCols f t = lCols t == lCols t'+  where+    t' = mapTable f t++-- | mapTable does not change lRows+mapTableNoChangeRows+  :: (Ix col, Ix row, Eq lRow)+  => (lCol -> lRow -> col -> row -> a -> b)+  -> Table lCol lRow col row a+  -> Bool+mapTableNoChangeRows f t = lRows t == lRows t'+  where+    t' = mapTable f t++-- | mapTable allows rebuild of original array+mapTableRebuildNoIndices+  :: (Ix col, Ix row, Eq a)+  => Table lCol lRow col row a+  -> Bool+mapTableRebuildNoIndices tbl = cells tbl == ay'+  where+    ay' = listArray (bounds . cells $ tbl) . elems . cells+        . mapTable f $ tbl+    f _ _ _ _ a = a++mapTableRebuildWithIndices+  :: (Ix col, Ix row, Eq a)+  => Table lCol lRow col row a+  -> Bool+mapTableRebuildWithIndices tbl = cells tbl == ay'+  where+    ay' = array (bounds . cells $ tbl) . elems . cells+      . mapTable f $ tbl+    f _ _ cl rw a = ((cl, rw), a)++-- # labelRows and labelCols properties++-- | labelCols allows rebuild of original array+propLabelColsRebuild+  :: (Ix col, Ix row, Eq a)+  => Array (col, row) a+  -> Bool+propLabelColsRebuild ay = ay == ay'+  where+    ay' = array (bounds ay) . concat . elems+      . labelCols f $ ay+    f cl ls = map g ls+      where+        g (rw, a) = ((cl, rw), a)++-- | labelRows allows rebuild of original array+propLabelRowsRebuild+  :: (Ix col, Ix row, Eq a)+  => Array (col, row) a+  -> Bool+propLabelRowsRebuild ay = ay == ay'+  where+    ay' = array (bounds ay) . concat . elems+      . labelRows f $ ay+    f rw ls = map g ls+      where+        g (cl, a) = ((cl, rw), a)++-- # mapRowLabels properties++-- | mapRowLabels does not change column labels+propMapRowLabelsCols+  :: (Ix col, Ix row, Eq lCol)+  => (lRow -> row -> [(lCol, col, a)] -> lRow')+  -> Table lCol lRow col row a+  -> Bool+propMapRowLabelsCols f tb = lbls == lbls'+  where+    lbls = lCols tb+    tb' = mapRowLabels f tb+    lbls' = lCols tb'++-- | mapRowLabels does not change cells+propMapRowLabelsCells+  :: (Ix col, Ix row, Eq a, Eq lCol)+  => (lRow -> row -> [(lCol, col, a)] -> lRow')+  -> Table lCol lRow col row a+  -> Bool+propMapRowLabelsCells f tb = ay == ay'+  where+    ay = cells tb+    tb' = mapRowLabels f tb+    ay' = cells tb'++-- | mapRowLabels permits reconstruction of original array+propMapRowLabelsRebuild+  :: (Ix col, Ix row, Eq a)+  => Table lCol lRow col row a+  -> Bool+propMapRowLabelsRebuild t = ay == ay'+  where+    ay = cells t+    ay' = array (bounds ay) . concat . elems+      . lRows . mapRowLabels f $ t+    f _ rw ls = map g ls+      where+        g (_, cl, a) = ((cl, rw), a)++-- | mapRowLabels gives the original row labels+propMapRowLabelsRelabel+  :: (Ix col, Ix row, Eq a, Eq lRow, Eq lCol)+  => Table lCol lRow col row a+  -> Bool+propMapRowLabelsRelabel t = t == t'+  where+    t' = mapRowLabels (\r _ _ -> r) t++-- # mapColLabels properties++-- | mapColLabels does not change row labels+propMapColLabelsCols+  :: (Ix col, Ix row, Eq lRow)+  => (lCol -> col -> [(lRow, row, a)] -> lCol')+  -> Table lCol lRow col row a+  -> Bool+propMapColLabelsCols f tb = lbls == lbls'+  where+    lbls = lRows tb+    tb' = mapColLabels f tb+    lbls' = lRows tb'++-- | mapColLabels does not change cells+propMapColLabelsCells+  :: (Ix col, Ix row, Eq a, Eq lCol)+  => (lCol -> col -> [(lRow, row, a)] -> lCol')+  -> Table lCol lRow col row a+  -> Bool+propMapColLabelsCells f tb = ay == ay'+  where+    ay = cells tb+    tb' = mapColLabels f tb+    ay' = cells tb'++-- | mapColLabels permits reconstruction of original array+propMapColLabelsRebuild+  :: (Ix col, Ix row, Eq a)+  => Table lCol lRow col row a+  -> Bool+propMapColLabelsRebuild t = ay == ay'+  where+    ay = cells t+    ay' = array (bounds ay) . concat . elems+      . lCols . mapColLabels f $ t+    f _ cl ls = map g ls+      where+        g (_, rw, a) = ((cl, rw), a)++-- | mapColLabels gives the original row labels+propMapColLabelsRelabel+  :: (Ix col, Ix row, Eq a, Eq lRow, Eq lCol)+  => Table lCol lRow col row a+  -> Bool+propMapColLabelsRelabel t = t == t'+  where+    t' = mapColLabels (\r _ _ -> r) t++tests :: TestTree+tests = testGroup "Array2d"+  [ testProperty "bounds of columns in Table matches those of cells" $+    forAll genTable $+    propTableColsBounds++  , testProperty "bounds of rows in Table matches those of cells" $+    forAll genTable $+    propTableRowsBounds++  , testProperty "propGenRebuildByRow" $+    forAll genArray propGenRebuildByRow++  , testProperty "propGenRebuildByCol" $+    forAll genArray propGenRebuildByCol++  , testProperty "propRoundTripRows" $+    forAll genArray propRoundTripRows++  , testProperty "propRoundTripCols" $+    forAll genArray propRoundTripCols++  , testProperty "mapTableNoChangeCols" $+    forAll genLabelF $ \f ->+    forAll genTable $ \t ->+    mapTableNoChangeCols f t++  , testProperty "mapTableNoChangeRows" $+    forAll genLabelF $ \f ->+    forAll genTable $ \t ->+    mapTableNoChangeRows f t++  , testProperty "mapTableRebuildNoIndices" $+    forAll genTable mapTableRebuildNoIndices++  , testProperty "mapTableRebuildWithIndices" $+    forAll genTable mapTableRebuildWithIndices++  , testProperty "propLabelColsRebuild" $+    forAll genArray propLabelColsRebuild++  , testProperty "propLabelRowsRebuild" $+    forAll genArray propLabelRowsRebuild++  , testProperty "propMapRowLabelsCols" $+    forAll genChangeLabelF $ \f ->+    forAll genTable $ \t ->+    propMapRowLabelsCols f t++  , testProperty "propMapRowLabelsCells" $+    forAll genChangeLabelF $ \f ->+    forAll genTable $ \t ->+    propMapRowLabelsCells f t++  , testProperty "propMapRowLabelsRebuild" $+    forAll genTable propMapRowLabelsRebuild++  , testProperty "propMapRowLabelsRelabel" $+    forAll genTable propMapRowLabelsRelabel++  , testProperty "propMapColLabelsCols" $+    forAll genChangeLabelF $ \f ->+    forAll genTable $ \t ->+    propMapColLabelsCols f t++  , testProperty "propMapColLabelsCells" $+    forAll genChangeLabelF $ \f ->+    forAll genTable $ \t ->+    propMapColLabelsCells f t++  , testProperty "propMapColLabelsRebuild" $+    forAll genTable propMapColLabelsRebuild++  , testProperty "propMapColLabelsRelabel" $+    forAll genTable propMapColLabelsRelabel++  ]+

@@ -0,0 +1,222 @@+module Rainbox.Box.PrimitivesTests where++import Control.Monad+import Control.Applicative+import Test.Tasty+import Test.Tasty.QuickCheck (testProperty)+import Test.QuickCheck+import System.Console.Rainbow+import qualified Data.Text as X+import qualified Test.Rainbow.Generators as G+import Rainbox.Box.Primitives+import Rainbox.Box (backgroundToTextSpec)++genText :: Gen X.Text+genText = fmap X.pack $ listOf c+  where+    c = elements ['0'..'Z']++genChunk :: Gen Chunk+genChunk = genText >>= G.chunk++genHeight :: Gen Height+genHeight = fmap Height $ frequency [(3, nonNeg), (1, neg)]+  where+    nonNeg = fmap getNonNegative arbitrarySizedIntegral+    neg = fmap (negate . abs) arbitrarySizedIntegral++genWidth :: Gen Width+genWidth = fmap Width $ frequency [(3, nonNeg), (1, neg)]+  where+    nonNeg = fmap abs arbitrarySizedIntegral+    neg = fmap (negate . abs) arbitrarySizedIntegral++genBackground :: Gen Background+genBackground = liftM2 Background G.colors8 G.colors256++-- | Generates blank Box.+genBlankBox :: Gen Box+genBlankBox = liftM3 blank genBackground rw cl+  where+    rw = fmap (Height . abs) arbitrarySizedIntegral+    cl = fmap (Width . abs) arbitrarySizedIntegral++-- | Generates a box using chunks.+genChunkBox :: Gen Box+genChunkBox = fmap chunks $ listOf genChunk++-- | Generates a box using catH.+genCatHBox :: Gen Box+genCatHBox = sized $ \s -> do+  bk <- genBackground+  av <- genAlignVert+  bs <- listOf (resize (s `div` 2) genBox)+  return $ catH bk av bs++-- | Generates a box using catV.+genCatVBox :: Gen Box+genCatVBox = sized $ \s -> do+  bk <- genBackground+  ah <- genAlignHoriz+  bs <- listOf (resize (s `div` 2) genBox)+  return $ catV bk ah bs++-- | Generates a random box.+genBox :: Gen Box+genBox = oneof [ genBlankBox, genCatHBox, genCatVBox, genChunkBox ]++genChunkLen :: Background -> Int -> Gen Chunk+genChunkLen bk l = do+  let ts = backgroundToTextSpec bk+  txt <- fmap X.pack $ vectorOf l (elements ['0'..'Z'])+  return $ Chunk ts txt++-- | Generates a box of text; its horizontal and vertical size+-- depends on the size parameter.+genTextBox :: Gen Box+genTextBox = do+  w <- fmap abs arbitrarySizedIntegral+  h <- fmap abs arbitrarySizedIntegral+  bk <- genBackground+  cks <- vectorOf h (genChunkLen bk w)+  let bxs = map (chunks . (:[])) cks+  bk' <- genBackground+  return $ catV bk' left bxs++++-- # Alignment++genAlignVert :: Gen (Align Vert)+genAlignVert = elements+  [ center, top, bottom ]++genAlignHoriz :: Gen (Align Horiz)+genAlignHoriz = elements [ center, left, right ]++validBox :: Box -> Bool+validBox box = case unBox box of+  NoHeight i -> i > -1+  WithHeight rw -> case rw of+    [] -> False+    x:xs -> all (== width x) . map width $ xs++biggest :: Int -> Gen a -> Gen a+biggest m g = sized $ \s -> resize (min s m) g++data Inputs = Inputs+  { iChunks :: [Chunk]+  , iBackground :: Background+  , iHeight :: Height+  , iWidth :: Width+  , iVert :: Align Vert+  , iHoriz :: Align Horiz+  , iBoxes :: [Box]+  , iBox :: Box+  , iChunk :: Chunk+  } deriving Show++instance Arbitrary Inputs where+  arbitrary = Inputs+    <$> listOf genChunk+    <*> genBackground+    <*> genHeight+    <*> genWidth+    <*> genAlignVert+    <*> genAlignHoriz+    <*> listOf genBlankBox+    <*> genBlankBox+    <*> genChunk++tests :: TestTree+tests = testGroup "BoxTests"+  [ testGroup "blank"+    [ testProperty "makes valid Box" $ \i ->+      validBox $ blank (iBackground i) (iHeight i)+        (iWidth i)++    , testProperty "has right number of rows" $ \i ->+      let ht = unHeight . iHeight $ i+      in (== max 0 ht) . height $ blank (iBackground i)+            (iHeight i) (iWidth i)++    , testProperty "has right number of columns" $ \i ->+      let wt = unWidth . iWidth $ i+      in (== max 0 wt) . width $ blank (iBackground i)+            (iHeight i) (iWidth i)+    ]++  , testGroup "chunks"+    [ testProperty "makes valid Box" $+      validBox . chunks . iChunks++    , testProperty "makes Box whose height is 1" $+      (== 1) . height . chunks . iChunks++    , testProperty "makes Box with cols == number of characters" $ \i ->+      let cks = iChunks i+          nChars = sum . map X.length . map text $ cks+      in (== nChars) . width $ chunks cks+    ]++  , testGroup "catH"+    [ testProperty "makes valid Box" $ \i ->+      validBox $ catH (iBackground i) (iVert i) (iBoxes i)++    , testProperty "is as tall as tallest box" $ \i ->+      let h = maximum . (0 :) . map height $ bs+          bs = iBoxes i+      in (== h) . height $ catH (iBackground i) (iVert i) bs++    , testProperty "is as wide as sum of all widths" $ \i ->+      let s = sum . map width $ bs+          bs = iBoxes i+      in (== s) . width $ catH (iBackground i) (iVert i) bs+    ]++  , testGroup "catV"+    [ testProperty "makes a valid Box" $ \i ->+      validBox $ catV (iBackground i) (iHoriz i) (iBoxes i)++    , testProperty "is as tall as the sum of all heights" $ \i ->+      let h = sum . map height $ bs+          bs = iBoxes i+      in (== h) . height $ catV (iBackground i) (iHoriz i) bs++    , testProperty "is as wide as the widest box" $ \i ->+      let w = maximum . (0:) . map width $ bs+          bs = iBoxes i+      in (== w) . width $ catV (iBackground i) (iHoriz i) bs+    ]++  , testGroup "viewH"+    [ testProperty "makes a valid Box" $ \i ->+      validBox $ viewH (unWidth . iWidth $ i) (iHoriz i) (iBox i)++    , testProperty "number of rows does not change" $ \i ->+      let b = iBox i+      in (== height b) . height $ viewH (unWidth . iWidth $ i)+                                    (iHoriz i) b++    , testProperty "number of columns <= number requested" $ \i ->+      let c = unWidth . iWidth $ i+          tgt = max 0 c+      in (<= tgt) . width $ viewH c (iHoriz i) (iBox i)+    ]++  , testGroup "viewV"+    [ testProperty "makes a valid Box" $ \i ->+      validBox $ viewV (unHeight . iHeight $ i) (iVert i) (iBox i)++    , testProperty "width does not change" $ \i ->+      let b = iBox i+      in (== width b) . width $ viewV (unHeight . iHeight $ i)+                                    (iVert i) b++    , testProperty "number of rows <= number requested" $ \i ->+      let r = unHeight . iHeight $ i+          tgt = max 0 r+      in (<= tgt) . height $ viewV r (iVert i) (iBox i)+    ]+  ]+

@@ -0,0 +1,7 @@+module Rainbox.BoxDir where++import qualified Rainbox.Box.PrimitivesTests+import Test.Tasty++tests :: TestTree+tests = testGroup "Box" [ Rainbox.Box.PrimitivesTests.tests ]

@@ -0,0 +1,207 @@+module Rainbox.BoxTests where++import Rainbox.Box+import Rainbox.Box.PrimitivesTests+import qualified Data.Text as X+import Test.Tasty.QuickCheck (testProperty)+import Test.Tasty+import System.Console.Rainbow+import Test.QuickCheck hiding (resize)++tests :: TestTree+tests = testGroup "RainboxTests"+  [ testGroup "blankH"+    [ testProperty "makes Box with no height" $ \i ->+      (== 0) . height $ blankH (iBackground i) (unWidth . iWidth $ i)++    , testProperty "makes Box with correct width" $ \i ->+      let w = unWidth . iWidth $ i+          tgt = max 0 w+      in (== tgt) . width $ blankH (iBackground i) w+    ]++  , testGroup "blankV"+    [ testProperty "makes Box with no width" $ \i ->+      (== 0) . width $ blankV (iBackground i) (unHeight . iHeight $ i)++    , testProperty "makes Box with correct height" $ \i ->+      let h = unHeight . iHeight $ i+          tgt = max 0 h+      in (== tgt) . height $ blankV (iBackground i) h+    ]++  , testGroup "chunk"+    [ testProperty "makes Box one high" $+      (== 1) . height . chunk . iChunk++    , testProperty "makes Box as wide as characters in chunk" $ \i ->+      let cs = X.length . text . iChunk $ i+      in (== cs) . width . chunk . iChunk $ i+    ]++  , testGroup "growH"+    [ testProperty "does not change height" $ \i ->+      let bx = iBox i+      in (== height bx) . height $ growH (iBackground i)+            (unWidth . iWidth $ i) (iHoriz i) bx++    , testProperty "new Box is of correct width" $ \i ->+      let bx = iBox i+          tgt = max wdth (width bx)+          wdth = unWidth . iWidth $ i+      in (== tgt) . width $+            growH (iBackground i) wdth (iHoriz i) bx++    , testProperty "new Box is at least as wide as old Box" $ \i ->+      let bx = iBox i+      in (>= width bx) . width $ growH (iBackground i)+            (unWidth . iWidth $ i) (iHoriz i) bx+    ]++  , testGroup "growV"+    [ testProperty "does not change width" $ \i ->+      let bx = iBox i+      in (== width bx) . width $ growV (iBackground i)+            (unWidth . iWidth $ i) (iVert i) bx++    , testProperty "new Box is of correct height" $ \i ->+      let bx = iBox i+          tgt = max (height bx) hght+          hght = unHeight . iHeight $ i+      in (== tgt) . height $+            growV (iBackground i) hght (iVert i) bx++    , testProperty "new Box is at least as tall as old Box" $ \i ->+      let bx = iBox i+      in (>= height bx) . height $ growV (iBackground i)+            (unWidth . iWidth $ i) (iVert i) bx+    ]++  , testGroup "grow"+    [  testProperty "new Box is of correct width" $ \i ->+      let bx = iBox i+          tgt = unWidth . iWidth $ i+      in (\w -> w == width bx || w == tgt) . width $+            growH (iBackground i) tgt (iHoriz i) bx++    , testProperty "new Box is at least as wide as old Box" $ \i ->+      let bx = iBox i+      in (>= width bx) . width $ grow (iBackground i) (iHeight i)+            (iWidth i) (iVert i) (iHoriz i) (iBox i)++    , testProperty "new Box is of correct height" $ \i ->+      let bx = iBox i+          tgt = unHeight . iHeight $ i+      in (\h -> h == height bx || h == tgt) . height $+            grow (iBackground i) (iHeight i) (iWidth i)+                 (iVert i) (iHoriz i) (iBox i)++    , testProperty "new Box is at least as tall as old Box" $ \i ->+      let bx = iBox i+      in (>= height bx) . height $ grow (iBackground i)+            (iHeight i) (iWidth i) (iVert i) (iHoriz i) (iBox i)+    ]++  , testGroup "column"+    [ testProperty "number of inputs == number of outputs" $ \i ->+      let bs = iBoxes i+      in (== length bs) . length $ column (iBackground i) (iHoriz i) bs++    , testProperty "width of outputs is identical" $ \i ->+      case column (iBackground i) (iHoriz i) (iBoxes i) of+        [] -> True+        x:xs -> all (== width x) . map width $ xs++    , testProperty "width of output is as wide as widest input" $ \i ->+      let r = column (iBackground i) (iHoriz i) (iBoxes i)+      in case iBoxes i of+        [] -> null r+        xs -> width (head r) == (maximum . map width $ xs)+    ]++  , testGroup "resizeH"+    [ testProperty "height of resulting Box unchanged" $ \i ->+      let bx = iBox i+      in (== height bx) . height $ resizeH (iBackground i)+            (unWidth . iWidth $ i) (iHoriz i) bx++    , testProperty "result has desired width" $ \i ->+      let tgt = max 0 . unWidth . iWidth $ i+      in (== tgt) . width $ resizeH (iBackground i)+            (unWidth . iWidth $ i) (iHoriz i) (iBox i)+    ]++  , testGroup "resizeV"+    [ testProperty "width of resulting Box unchanged" $ \i ->+      let bx = iBox i+      in (== width bx) . width $ resizeV (iBackground i)+            (unHeight . iHeight $ i) (iVert i) bx++    , testProperty "result has desired height" $ \i ->+      let tgt = max 0 . unHeight . iHeight $ i+      in (== tgt) . height $ resizeV (iBackground i)+            (unHeight . iHeight $ i) (iVert i) (iBox i)+    ]++  , testGroup "resize"+    [ testProperty "result has desired height" $ \i ->+      let tgt = max 0 . unHeight . iHeight $ i+      in (== tgt) . height $ resize (iBackground i)+            (iHeight i) (iWidth i)+            (iVert i) (iHoriz i) (iBox i)++    , testProperty "result has desired width" $ \i ->+      let tgt = max 0 . unWidth . iWidth $ i+      in (== tgt) . width $ resize (iBackground i)+            (iHeight i) (iWidth i) (iVert i) (iHoriz i)+            (iBox i)+    ]++  , testGroup "punctuateH"+    [ testProperty "result has desired width" $ \i ->+      let tgt = (sum . map width $ bs)+            + width bx * (max 0 $ len - 1)+          len = length bs+          bs = iBoxes i+          bx = iBox i+      in (== tgt) . width $ punctuateH (iBackground i)+          (iVert i) bx bs+    ]++  , testGroup "punctuateV"+    [ testProperty "result has desired height" $ \i ->+      let tgt = (sum . map height $ bs)+            + height bx * (max 0 $ len - 1)+          len = length bs+          bs = iBoxes i+          bx = iBox i+      in (== tgt) . height $ punctuateV (iBackground i)+          (iHoriz i) bx bs+    ]++  -- Have to cap size on this one, which is not satisfying.  There+  -- are no apparent bugs.  Apparently what is taking so long is the+  -- Text.replicate in Box.blanks, which is applied from+  -- Box.padHoriz.+  , testGroup "sepH"+    [ testProperty "result has correct width" $+      forAll arbitrarySizedIntegral $ \len ->+      forAll arbitrary $ \i ->+      let tgt = (sum . map width $ bs)+            + max 0 len * max 0 (length bs - 1)+          bs = iBoxes i+      in (== tgt) . width $ sepH (iBackground i) len+          (iVert i) (iBoxes i)+    ]++  , testGroup "sepV"+    [ testProperty "result has correct height" $+      forAll arbitrarySizedIntegral $ \len ->+      forAll arbitrary $ \i ->+      let tgt = (sum . map height $ bs)+            + max 0 len * max 0 (length bs - 1)+          bs = iBoxes i+      in (== tgt) . height $ sepV (iBackground i) len+          (iHoriz i) (iBoxes i)+    ]+  ]

@@ -0,0 +1,133 @@+module Rainbox.ReaderTests where++import qualified Rainbox.Box as R+import Rainbox.Reader+import Rainbox.Box.PrimitivesTests+import Test.QuickCheck hiding (resize)+import Test.Tasty.QuickCheck (testProperty)+import Test.Tasty+import Data.Functor.Identity++tests :: TestTree+tests = testGroup "ReaderTests"+  [ testProperty "blankH" $ \(SpecPair i s) ->+    let p = R.blankH (iBackground i) (unWidth . iWidth $ i)+    in testEq s (blankH (unWidth . iWidth $ i)) p++  , testProperty "blankV" $ \(SpecPair i s) ->+    let p = R.blankV (iBackground i) (unHeight . iHeight $ i)+    in testEq s (blankV (unHeight . iHeight $ i)) p++  , testProperty "catH" $ \(SpecPair i s) ->+    let p = R.catH (iBackground i) (iVert i) (iBoxes i)+    in testEq s (catH (iBoxes i)) p++  , testProperty "catV" $ \(SpecPair i s) ->+    let p = R.catV (iBackground i) (iHoriz i) (iBoxes i)+    in testEq s (catV (iBoxes i)) p++  , testProperty "grow" $ \(SpecPair i s) ->+    let p = R.grow (iBackground i) (iHeight i) (iWidth i)+          (iVert i) (iHoriz i) (iBox i)+    in testEq s (grow (iHeight i) (iWidth i) (iBox i)) p++  , testProperty "growH" $ \(SpecPair i s) ->+    let p = R.growH (iBackground i) (unWidth . iWidth $ i)+          (iHoriz i) (iBox i)+    in testEq s (growH (unWidth . iWidth $ i)+        (iBox i)) p++  , testProperty "growV" $ \(SpecPair i s) ->+    let p = R.growV (iBackground i) (unHeight . iHeight $ i)+          (iVert i) (iBox i)+    in testEq s (growV (unHeight . iHeight $ i)+        (iBox i)) p++  , testProperty "column" $ \(SpecPair i s) ->+    let p = R.column (iBackground i) (iHoriz i) (iBoxes i)+    in testEq s (column (iBoxes i)) p++  , testProperty "resize" $ \(SpecPair i s) ->+    let p = R.resize (iBackground i) (iHeight i) (iWidth i)+          (iVert i) (iHoriz i) (iBox i)+    in testEq s (resize (iHeight i) (iWidth i) (iBox i)) p++  , testProperty "resizeH" $ \(SpecPair i s) ->+    let p = R.resizeH (iBackground i) (unWidth . iWidth $ i)+          (iHoriz i) (iBox i)+    in testEq s (resizeH (unWidth . iWidth $ i) (iBox i)) p++  , testProperty "resizeV" $ \(SpecPair i s) ->+    let p = R.resizeV (iBackground i) (unHeight . iHeight $ i)+          (iVert i) (iBox i)+    in testEq s (resizeV (unHeight . iHeight $ i) (iBox i)) p++  , testProperty "sepH" $ \(SpecPair i s) ->+    let p = R.sepH (iBackground i) (spaceH s) (iVert i) (iBoxes i)+    in testEq s (sepH (spaceH s) (iBoxes i)) p++  , testProperty "sepV" $ \(SpecPair i s) ->+    let p = R.sepV (iBackground i) (spaceV s) (iHoriz i) (iBoxes i)+    in testEq s (sepV (spaceV s) (iBoxes i)) p++  , testProperty "punctuateH" $ \(SpecPair i s) ->+    let p = R.punctuateH (iBackground i) (iVert i) (iBox i) (iBoxes i)+    in testEq s (punctuateH (iBox i) (iBoxes i)) p++  , testProperty "punctuateV" $ \(SpecPair i s) ->+    let p = R.punctuateV (iBackground i) (iHoriz i) (iBox i) (iBoxes i)+    in testEq s (punctuateV (iBox i) (iBoxes i)) p++  , testProperty "viewH" $ \(SpecPair i s) ->+    let p = R.viewH (unWidth . iWidth $ i) (iHoriz i) (iBox i)+    in testEq s (viewH (unWidth . iWidth $ i) (iBox i)) p++  , testProperty "viewV" $ \(SpecPair i s) ->+    let p = R.viewV (unHeight . iHeight $ i) (iVert i) (iBox i)+    in testEq s (viewV (unHeight . iHeight $ i) (iBox i)) p++  , testProperty "view" $ \(SpecPair i s) ->+    let p = R.view (iHeight i) (iWidth i) (iVert i) (iHoriz i)+          (iBox i)+    in testEq s (view (iHeight i) (iWidth i) (iBox i)) p+  ]++testEq :: Eq a => Specs -> Env Identity a -> a -> Bool+testEq s e a = r == a+  where+    r = runEnv s e++specs+  :: Int+  -- ^ Space for horizontal joins+  -> Int+  -- ^ Space for vertical joins+  -> Inputs+  -> Specs+specs h v i = Specs+  { background = iBackground i+  , alignH = iHoriz i+  , alignV = iVert i+  , spaceH = h+  , spaceV = v+  }++genSpecs :: Gen (Inputs, Specs)+genSpecs = do+  h <- frequency [(3, fmap getPositive arbitrarySizedIntegral),+                  (1, arbitrarySizedIntegral)]+  v <- frequency [(3, fmap getPositive arbitrarySizedIntegral),+                  (1, arbitrarySizedIntegral)]+  i <- arbitrary+  let ss = specs h v i+  return (i, ss)++data SpecPair = SpecPair+  { spInputs :: Inputs+  , spSpecs :: Specs+  } deriving Show++instance Arbitrary SpecPair where+  arbitrary = do+    (i, s) <- genSpecs+    return $ SpecPair i s

@@ -0,0 +1,13 @@+module RainboxDir where++import qualified Rainbox.BoxTests+import qualified Rainbox.BoxDir+import qualified Rainbox.ReaderTests+import qualified Rainbox.Array2dTests+import Test.Tasty++tests :: TestTree+tests = testGroup "RainboxDir" [ Rainbox.BoxTests.tests+                               , Rainbox.BoxDir.tests+                               , Rainbox.ReaderTests.tests+                               , Rainbox.Array2dTests.tests ]

@@ -0,0 +1,7 @@+module RainboxTests where++import Test.Tasty+-- import Rainbox++tests :: TestTree+tests = testGroup "Rainbox" []

@@ -0,0 +1,82 @@+module Test.Rainbow.Generators where++import qualified Data.Text as X+import Prelude hiding (last)+import Control.Monad+import Data.Monoid+import Test.QuickCheck+import System.Console.Rainbow.Colors+import System.Console.Rainbow hiding+  (textSpec)+import System.Console.Rainbow.Types hiding+  (style8, style256, textSpec)++-- | Generates one of the valid colors for an 8-color terminal,+-- including the default color.+colors8 :: Gen Color8+colors8 = elements $ c8_default : map snd c8_all++-- | Generates one of the valid colors for an 256-color terminal,+-- including the default color.+colors256 :: Gen Color256+colors256 = elements $ c256_default : map snd c256_all++-- | Generates a foreground color chunk for 8-color terminals.+fgColorChunk8 :: Gen Chunk+fgColorChunk8 = fmap fc8 colors8++-- | Generates a foreground color chunk for 256-color terminals.+fgColorChunk256 :: Gen Chunk+fgColorChunk256 = fmap fc256 colors256++-- | Generates a background color chunk for 8-color terminals.+bgColorChunk8 :: Gen Chunk+bgColorChunk8 = fmap bc8 colors8++-- | Generates a background color chunk for 256-color terminals.+bgColorChunk256 :: Gen Chunk+bgColorChunk256 = fmap bc256 colors256++-- | Generates a color chunk (half foreground, half background) for+-- 8-color terminals.+colorChunk8 :: Gen Chunk+colorChunk8 = oneof [ fgColorChunk8, bgColorChunk8 ]++-- | Generates a color chunk (half foreground, half background) for+-- 256-color terminals.+colorChunk256 :: Gen Chunk+colorChunk256 = oneof [ fgColorChunk256, bgColorChunk256 ]++-- | Generates a color chunk (half for 8-color, half for 256-color).+colorChunk :: Gen Chunk+colorChunk = oneof [ colorChunk8, colorChunk256 ]++last :: a -> Gen (Last a)+last a = frequency [ (3, return $ Last (Just a)),+                     (1, return $ Last Nothing)]++styleCommon :: Gen StyleCommon+styleCommon = liftM4 StyleCommon g g g g+  where+    g = arbitrary >>= last++style8 :: Gen Style8+style8 = liftM3 Style8+  (colors8 >>= last) (colors8 >>= last) styleCommon++style256 :: Gen Style256+style256 = liftM3 Style256+  (colors256 >>= last) (colors256 >>= last) styleCommon++textSpec :: Gen TextSpec+textSpec = liftM2 TextSpec style8 style256++chunk :: X.Text -> Gen Chunk+chunk x = liftM2 Chunk textSpec (return x)++-- | Generates one Chunk for each Text in the list and combines them+-- into one Chunk.+combinedChunks :: [X.Text] -> Gen Chunk+combinedChunks ls = do+  cs <- mapM chunk ls+  return $ foldl (<>) mempty cs

@@ -0,0 +1,154 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+module Visual where++import Control.Monad+import Rainbox.Box+import System.Console.Rainbow+import System.Console.Rainbow.Colors+import Data.Monoid+import System.Random+import Test.QuickCheck.Gen hiding (resize)+import Rainbox.Box.PrimitivesTests+import Data.Maybe (fromJust)+import Data.String++colors = f_yellow <> b_blue++narrow = "narrow box" <> colors++midwidth = "medium width box" <> colors++wide = "a wide box, see how wide I am?" <> colors++greenBack = same c8_green++yellowBack = same c8_yellow++all3 = [narrow, midwidth, wide]++short = chunk narrow++midheight = catV greenBack left . map chunk $ [narrow, midwidth]++tall = catV greenBack left . map chunk $ [narrow, midwidth, wide]++sizeParam = 7++putBox b = do+  term <- termFromEnv+  putChunks term . render $ b++describe s b = do+  putStrLn (s ++ ":")+  putBox b+  putStrLn ""++testCompound :: String -> (Background -> [Box] -> Box) -> IO ()+testCompound d f = do+  g <- newStdGen+  let bxs = unGen (replicateM 5 genTextBox) g sizeParam +      bk = unGen genBackground g sizeParam+  describe d $ f bk bxs++testVert+  :: String+  -> (Background -> Align Vert -> [Box] -> Box)+  -> IO ()+testVert d f = do+  testCompound (d ++ ", top align") (\bk bxs -> f bk top bxs)+  testCompound (d ++ ", center align") (\bk bxs -> f bk center bxs)+  testCompound (d ++ ", bottom align") (\bk bxs -> f bk bottom bxs)++testHoriz+  :: String+  -> (Background -> Align Horiz -> [Box] -> Box)+  -> IO ()+testHoriz d f = do+  testCompound (d ++ ", left align") (\bk bxs -> f bk left bxs)+  testCompound (d ++ ", center align") (\bk bxs -> f bk center bxs)+  testCompound (d ++ ", right align") (\bk bxs -> f bk right bxs)++-- | Makes a 10x10 test box.+testBox :: Box+testBox = catV defaultBackground left . map mkLine $ clrs+  where+    mkLine clr = chunk $ txt <> clr+    txt = fromString ['0'..'9']+    lkp k = bc256 . fromJust . lookup k $ c256_all+    clrs = map lkp . take 10 . iterate (+6) $ 160++singleH+  :: String+  -> (Align Horiz -> Box)+  -> IO ()+singleH desc f = do+  describe (desc ++ ", left") (f left)+  describe (desc ++ ", center") (f center)+  describe (desc ++ ", right") (f right)++singleV+  :: String+  -> (Align Vert -> Box)+  -> IO ()+singleV desc f = do+  describe (desc ++ ", top") (f top)+  describe (desc ++ ", center") (f center)+  describe (desc ++ ", bottom") (f bottom)++single+  :: String+  -> (Align Vert -> Align Horiz -> Box)+  -> IO ()+single desc f = do+  singleV (desc ++ ", left") (\av -> f av left)+  singleV (desc ++ ", center") (\av -> f av center)+  singleV (desc ++ ", right") (\av -> f av right)++  singleH (desc ++ ", top") (f top)+  singleH (desc ++ ", center") (f center)+  singleH (desc ++ ", bottom") (f bottom)+++tests :: IO ()+tests = do+  describe "narrow box" . chunk $ narrow+  describe "medium box" . chunk $ midwidth+  describe "wide box" . chunk $ wide++  testHoriz "catV" catV+  testVert "catH" catH++  testVert "sepH" (\bk av bxs -> sepH bk 1 av bxs)+  testHoriz "sepV" (\bk ah bxs -> sepV bk 1 ah bxs)++  testVert "punctuateH" (\bk av bxs -> punctuateH bk av " " bxs)+  testHoriz "punctuateV" (\bk ah bxs -> punctuateV bk ah " " bxs)++  let green = backgroundFromChunk b_green++  testHoriz "column" (\bk ah bxs -> catV defaultBackground left+                        (column bk ah bxs))++  describe "original box for following tests, 10x10" testBox++  single "view, 3x3"+    (\av ah -> view (Height 3) (Width 3) av ah testBox)+  singleH "viewH, 3" (\ah -> viewH 3 ah testBox)+  singleV "viewV, 3" (\av -> viewV 3 av testBox)++  single "grow, 13x13"+    (\av ah -> grow green (Height 13) (Width 13) av ah testBox)+  singleH "growH, 13" (\ah -> growH green 13 ah testBox)+  singleV "growV, 13" (\av -> growV green 13 av testBox)++  single "resize, 13x13"+    (\av ah -> resize green (Height 13) (Width 13) av ah testBox)+  singleH "resizeH, 13" (\ah -> resizeH green 13 ah testBox)+  singleV "resizeV, 13" (\av -> resizeV green 13 av testBox)++  single "resize, 7x7"+    (\av ah -> resize green (Height 7) (Width 7) av ah testBox)+  singleH "resizeH, 7" (\ah -> resizeH green 7 ah testBox)+  singleV "resizeV, 7" (\av -> resizeV green 7 av testBox)+

@@ -0,0 +1,20 @@+-- | Usage:+--+-- Input the size parameter as $1.  Will generate a random box and print+-- it out. Always uses colors.+module Main where++import Test.QuickCheck.Gen+import Rainbox.Box.PrimitivesTests+import System.Environment+import System.Random+import Rainbox.Box+import System.Console.Rainbow++main :: IO ()+main = do+  g <- newStdGen+  s:[] <- getArgs+  let bx = unGen genBox g (read s)+  e <- termFromEnv+  putChunks e . render $ bx

@@ -0,0 +1,11 @@+module Main where++import qualified RainboxDir+import qualified RainboxTests+import Test.Tasty++main :: IO ()+main = defaultMain $ testGroup "rainbox"+  [ RainboxDir.tests+  , RainboxTests.tests+  ]

@@ -0,0 +1,10 @@+-- | Rainbox visual tests.+--+-- Tests that are intended to be run and then examined visually.++module Main where++import Visual++main :: IO ()+main = Visual.tests