rainbox 0.10.0.2 → 0.12.0.0

raw patch · 26 files changed

+1518/−3103 lines, 26 filesdep +containersdep −ChasingBottomsdep −arraydep −transformersdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: containers

Dependencies removed: ChasingBottoms, array, transformers

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• README.md +11/−11
• changelog +4/−0
• lib/Rainbox.hs +39/−133
• lib/Rainbox/Array2d.hs +0/−249
• lib/Rainbox/Box.hs +0/−351
• lib/Rainbox/Box/Primitives.hs +0/−572
• lib/Rainbox/Core.hs +683/−0
• lib/Rainbox/Reader.hs +0/−290
• lib/Rainbox/Tutorial.hs +521/−0
• lib/Rainbox/Tutorial.lhs +0/−173
• rainbox.cabal +41/−129
• test/Rainbox/Array2dTests.hs +0/−402
• test/Rainbox/Box/Instances.hs +0/−5
• test/Rainbox/Box/PrimitivesTests.hs +0/−218
• test/Rainbox/BoxDir.hs +0/−7
• test/Rainbox/BoxTests.hs +0/−207
• test/Rainbox/Instances.hs +47/−16
• test/Rainbox/ReaderTests.hs +0/−133
• test/RainboxDir.hs +0/−13
• test/RainboxTests.hs +0/−7
• test/Visual.hs +0/−142
• test/rainbox-grid.hs +0/−13
• test/rainbox-mosaic.hs +0/−16
• test/rainbox-properties.hs +153/−0
• test/rainbox-test.hs +0/−11
• test/rainbox-visual.hs +19/−5

@@ -4,23 +4,23 @@ Provides pretty printing of boxes in two dimensions.  Rainbox is useful for console programs that need to format tabular data. +On Hackage+==========++https://hackage.haskell.org/package/rainbox+ 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.+[the Rainbox.Tutorial module](lib/Rainbox/Tutorial.lhs).  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.+[Rainbow](http://hackage.haskell.org/package/rainbow) which is only+tested on UNIX-like systems.  Tests =====@@ -29,7 +29,7 @@      cabal configure --enable-tests     cabal build-    dist/build/rainbox-test/rainbox-test+    dist/build/rainbox-properties/rainbox-properties     dist/build/rainbox-visual/rainbox-visual  The last test, `rainbox-visual`, relies on you to examine the output@@ -42,8 +42,8 @@ and although you can see the output of `rainbox-visual` there, it's not formatted quite right on Travis. -At this time, Rainbox is verified to work with GHC versions 7.4.1,-7.6.3, and 7.8.2.+At this time, Rainbox is verified to work with GHC versions in the 7.8 series+and the 7.10 series.  License =======

@@ -1,3 +1,7 @@+0.12.0.0++  * rewrote API to use monoids+ 0.6.0.0    * update to work with newer version of Rainbow

@@ -1,147 +1,53 @@--- | Create grids of (possibly) colorful boxes.+-- | Typically to use Rainbox you will want these @import@s: ----- 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:+-- @+-- import qualified Data.Sequence as Seq+-- import Rainbow+-- import Rainbox ----- <https://github.com/massysett/rainbox/blob/master/lib/Rainbox/Tutorial.lhs>+-- -- and, for GHC before 7.10:+-- import Data.Monoid+-- @ ----- 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.)+-- Rainbox does not re-export anything from "Data.Sequence" or+-- "Rainbow" because I don't know if you want all those things dumped+-- into the same namespace.+--+-- "Rainbox.Tutorial" wil get you started.  "Rainbox.Core" contains+-- the implementation details, which you should not need to pay+-- attention to (if you do need to use "Rainbox.Core" for ordinary+-- usage of the library, that's a bug; please report it.) module Rainbox-  (-    -- * Alignment-    Align-  , Horiz-  , Vert-  , top-  , bottom+  ( -- * Alignment and Boxes+    Alignment+  , Horizontal+  , Vertical+  , center   , left   , right-  , center--  -- * Bar-  , Bar(..)--  -- * Cell and Box-  , Cell(..)+  , top+  , bottom+  , centerH+  , centerV   , Box--  -- * Creating Box and gluing them together+  , Orientation ( spacer, spreader ) -  -- | For simple needs you will only need 'gridByRows' or-  -- 'gridByCols'; 'boxCells' and 'glueBoxes' are provided for more-  -- complex needs.-  , gridByRows-  , gridByCols-  , boxCells-  , glueBoxes+  -- * Box construction+  , fromChunk+  , blank+  , wrap    -- * Rendering   , render-  , printBox-  ) where -import Rainbow.Colors-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 :: Radiant-  -- ^ 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 background of 'noColorRadianat'.  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 noColorRadiant---- | 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 noColorRadiant top-  . map (catV noColorRadiant 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.  All rows will be--- the same length as the first row.  Any row that is longer than the--- first row will have cells lopped off of the end, and any row that--- is shorter than the first row will be padded with empty cells on--- the end.--gridByRows :: [[Cell]] -> Box-gridByRows = glueBoxes . boxCells . arrayByRows padCell---- | 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.--- All columns will be the same height as the first column.  Any--- column that is longer than the first column will have cells lopped--- off the bottom, and any column that is shorter than the first--- column will be padded on the bottom with blank cells.+  -- * Tables+  , Cell(..)+  , tableByRows+  , tableByColumns+  , separator -gridByCols :: [[Cell]] -> Box-gridByCols = glueBoxes . boxCells . arrayByCols padCell+  -- * Utilities+  , intersperse+  ) where -padCell :: Cell-padCell = Cell [] left top noColorRadiant+import Rainbox.Core

@@ -1,249 +0,0 @@--- | 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.  Every--- row's length will be equal to the length of the first row; any rows--- after the first row that are shorter than the first row will have--- extra columns appended to the end.  Therefore, the resulting--- 'Array' will have no undefined values.-arrayByRows-  :: a-  -- ^ Append this empty value to rows that are too short.-  -> [[a]]-  -- ^ One list per row-  -> Array (Int, Int) a-arrayByRows empty ls-  = array ((0,0), (colMax, rowMax))-  . indexRows-  . padder empty-  $ ls-  where-    rowMax = length ls - 1-    colMax = case ls of-      [] -> -1-      x:_ -> length x - 1---- | Returns a list where every row is the same length as the first--- row.  Subsequent rows are padded on the end or have elements--- removed from the end, as needed.-padder-  :: a-  -- ^ Empty element-  -> [[a]]-  -> [[a]]-padder emp input = case input of-  [] -> []-  x:xs -> x : map adjust xs-    where-      len = length x-      adjust ls = take len $ ls ++ repeat emp--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.  Every--- column will be the same height as the first column; subsequent--- colums will be padded or truncated on the bottom, as needed.--- Therefore the resulting 'Array' will have no undefined elements.-arrayByCols-  :: a-  -- ^ Append this value to columns that are too short.-  -> [[a]]-  -- ^ One list per column; the head of each list is the top of the-  -- column.-  -> Array (Int, Int) a-arrayByCols empty ls-  = listArray ((0,0), (colMax, rowMax))-  . concat-  . padder empty-  $ ls-  where-    colMax = length ls - 1-    rowMax = case ls of-      [] -> -1-      x:_ -> length x - 1-

@@ -1,351 +0,0 @@-{-# 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-  (-  -- * 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 Rainbow-import qualified Rainbox.Box.Primitives as B-import Rainbox.Box.Primitives-  ( Box-  , Align-  , Horiz-  , Vert-  , Height(..)-  , Width(..)-  , unBox-  )-import qualified Data.ByteString as BS------- # Box making------- | A blank horizontal box with a given width and no height.-blankH-  :: Radiant-  -- ^ Background colors-  -> Int-  -- ^ Box width-  -> Box-blankH bk i = B.blank bk (Height 0) (Width i)---- | A blank vertical box with a given length.-blankV-  :: Radiant-  -- ^ Background colors-  -> Int-  -- ^ Box height-  -> 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-  :: Radiant-  -- ^ Background colors-  -> 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-  :: Radiant-  -- ^ Background colors-  -> 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-  :: Radiant-  -- ^ Background colors-  -> 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-  :: Radiant-  -- ^ Background colors-  -> 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-  :: Radiant-  -- ^ Background colors-  -> 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-  :: Radiant-  -- ^ Background colors-  -> 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-  :: Radiant-  -- ^ Background colors-  -> 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-  :: Radiant-  -- ^ Background colors-  -> Int-  -- ^ Number of separating spaces-  -> 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-  :: Radiant-  -- ^ Background colors-  -> Int-  -- ^ Number of separating spaces-  -> 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-  :: Radiant-  -- ^ Background colors-  -> Align Vert-  -> Box-  -> [Box]-  -> Box-punctuateH bk a sep = B.catH bk a . intersperse sep---- | A vertical version of 'punctuateH'.-punctuateV-  :: Radiant-  -- ^ Background colors-  -> 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, as--- described in "Rainbow".-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 =-      chunkFromText (X.replicate (B.numSpaces ss) (X.singleton ' '))-      <> back (B.spcBackground ss)---- | Prints a Box to standard output.  The highest number of available--- colors are used, using 'byteStringMakerFromEnvironment' from--- "Rainbow".-printBox :: Box -> IO ()-printBox b = do-  mkr <- byteStringMakerFromEnvironment-  mapM_ BS.putStr . chunksToByteStrings mkr . render $ b

@@ -1,572 +0,0 @@--- | 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-  (-  -- * 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 Rainbow-import Rainbow.Types-import Data.Monoid-import qualified Data.Text as X-import Data.String---- # Box--data Spaces = Spaces-  { numSpaces :: Int-  , spcBackground :: Radiant-  } 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's 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-  :: Radiant-  -- ^ Background colors-  -> 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 (sum . map X.length . chunkTexts) . 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 = sum . map X.length . chunkTexts---- # Making Boxes---- | A blank 'Box'.  Useful for aligning other 'Box'.-blank-  :: Radiant-  -- ^ Background colors-  -> 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-  :: Radiant-  -- ^ Background colors-  -> 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-  :: Radiant-  -- ^ Background colors-  -> 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-  :: Radiant-  -- ^ Background colors-  -> 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-  :: Radiant-  -- ^ Background colors-  -> 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 -> width chk-             x' = case unNibble x of-              Left blnk -> Nibble . Left $-                blnk { numSpaces = numSpaces blnk - n }-              Right chk -> Nibble . Right . dropChunkChars n $ chk---- | Drops the given number of characters from a Chunk.-dropChunkChars :: Int -> Chunk -> Chunk-dropChunkChars n c = c { chunkTexts = go n (chunkTexts c) }-  where-    go nLeft ls = case ls of-      [] -> []-      t:ts-        | len < nLeft -> go (nLeft - len) ts-        | len == nLeft -> ts-        | otherwise -> X.drop nLeft t : ts-        where-          len = X.length t--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 ->-                  ( width chk,-                    Nibble . Right . takeChunkChars n $ chk)--takeChunkChars :: Int -> Chunk -> Chunk-takeChunkChars n c = c { chunkTexts = go n (chunkTexts c) }-  where-    go nLeft ls = case ls of-      [] -> []-      t:ts-        | len < nLeft -> t : go (nLeft - len) ts-        | len == nLeft -> [t]-        | otherwise -> [X.take nLeft t]-        where-          len = X.length t------- # Helpers------- | Generate spaces.-blanks-  :: Radiant-  -- ^ 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,683 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_HADDOCK not-home #-}+-- | Contains the innards of 'Rainbox'.  You shouldn't need anything+-- in here.  Some functions here are partial or have undefined results+-- if their inputs don't respect particular invariants.+module Rainbox.Core where++import Rainbow+import Control.Monad (join)+import Data.Monoid+import Rainbow.Types (Chunk(..))+import Data.Sequence (Seq, ViewL(..), viewl, (|>), (<|))+import qualified Data.Foldable as F+import qualified Data.Sequence as Seq+import qualified Data.Text as X+import qualified Data.Map as M++-- # Alignment++-- | Alignment.  Used in conjunction with 'Horizontal' and 'Vertical',+-- this determines how a payload aligns with the axis of a 'Box'.+data Alignment a = Center | NonCenter a+  deriving (Eq, Ord, Show)++-- # Horizontal and vertical++-- | Determines how a payload aligns with a horizontal axis.+data Horizontal = ATop | ABottom+  deriving (Eq, Ord, Show)++-- | Determines how a payload aligns with a vertical axis.+data Vertical = ALeft | ARight+  deriving (Eq, Ord, Show)++-- | Place this payload so that it is centered on the vertical axis or+-- horizontal axis.+center :: Alignment a+center = Center++-- | Center horizontally; like 'center', but monomorphic.+centerH :: Alignment Horizontal+centerH = center++-- | Center vertically; like 'center', but monomorphic.+centerV :: Alignment Vertical+centerV = center++-- | Place this payload's left edge on the vertical axis.+left :: Alignment Vertical+left = NonCenter ALeft++-- | Place this payload's right edge on the vertical axis.+right :: Alignment Vertical+right = NonCenter ARight++-- | Place this payload's top edge on the horizontal axis.+top :: Alignment Horizontal+top = NonCenter ATop++-- | Place this payload's bottom edge on the horizontal axis.+bottom :: Alignment Horizontal+bottom = NonCenter ABottom+++-- # Width and height++-- | A count of rows.+newtype Height = Height Int+  deriving (Eq, Ord, Show)++-- | A count of columns.+newtype Width = Width Int+  deriving (Eq, Ord, Show)++class HasHeight a where+  height :: a -> Int++instance HasHeight Height where+  height (Height a) = max 0 a++instance HasHeight Chunk where+  height _ = 1++instance (HasHeight a, HasHeight b) => HasHeight (Either a b) where+  height = either height height++class HasWidth a where+  width :: a -> Int++instance HasWidth Width where+  width (Width a) = max 0 a++instance HasWidth Chunk where+  width (Chunk _ ts) = F.sum . fmap X.length $ ts++instance (HasWidth a, HasWidth b) => HasWidth (Either a b) where+  width = either width width++-- # Core++-- | A 'Core' is either a single 'Chunk' or, if the box is blank, is+-- merely a height and a width.+newtype Core = Core (Either Chunk (Height, Width))+  deriving (Eq, Ord, Show)++instance HasWidth Core where+  width (Core ei) = either width (width . snd) ei++instance HasHeight Core where+  height (Core ei) = either height (height . fst) ei++-- # Rods++-- | An intermediate type used in rendering; it consists either of+-- text 'Chunk' or of a number of spaces coupled with a background color.+newtype Rod = Rod (Either (Int, Radiant) Chunk)+  deriving (Eq, Ord, Show)++instance HasWidth Rod where+  width (Rod ei) = case ei of+    Left (i, _) -> max 0 i+    Right c -> width c++-- # RodRows++-- | A list of screen rows; each screen row is a 'Seq' of 'Rod'.+--+-- A 'RodRows' with width but no height does nothing if rendered+-- alone, but it can affect the width of other 'RodRows' if combined+-- with them.+data RodRows+  = RodRowsWithHeight (Seq (Seq Rod))+  -- ^ Each outer 'Seq' represents a single screen row.  Each 'Seq'+  -- has a height of 1.+  --+  -- The outer 'Seq' must have a length of at least 1, even if the+  -- inner 'Seq' is empty.  If the outer 'Seq' has a length of zero,+  -- undefined behavior occurs.  For a 'RodRows' with no height and no+  -- width, use 'RodRowsNoHeight'.++  | RodRowsNoHeight Int+  -- ^ A 'RodRows' that has no height.  If the 'Int' is less than 1,+  -- the 'RodRows' has no width and no height.  Otherwise, the+  -- 'RodRows' has no height but has the given width.+  deriving (Eq, Ord, Show)++instance HasHeight RodRows where+  height (RodRowsWithHeight sq) = Seq.length sq+  height (RodRowsNoHeight _) = 0++instance HasWidth RodRows where+  width (RodRowsWithHeight sq) = F.foldl' max 0 . fmap (F.sum . fmap width) $ sq+  width (RodRowsNoHeight i) = max 0 i++-- | Convert a 'Core' to a 'Seq' of 'Rod' for rendering.+rodRowsFromCore :: Radiant -> Core -> RodRows+rodRowsFromCore bk (Core ei) = case ei of+  Left ck -> RodRowsWithHeight . Seq.singleton+    . Seq.singleton . Rod . Right $ ck+  Right (Height h, Width w)+    | h < 1  -> RodRowsNoHeight w+    | otherwise -> RodRowsWithHeight . Seq.replicate h . Seq.singleton+        . Rod . Left $ (w, bk)++-- | Converts a 'RodRows' to a nested 'Seq' of 'Chunk' in+-- preparation for rendering.  Newlines are added to the end of each+-- line.+chunksFromRodRows :: RodRows -> Seq (Seq Chunk)+chunksFromRodRows rr = case rr of+  RodRowsWithHeight sq -> fmap (|> "\n") . fmap (fmap chunkFromRod) $ sq+    where+      chunkFromRod (Rod ei) = case ei of+        Left (i, r) -> (chunkFromText . X.replicate i $ " ") <> back r+        Right c -> c+  RodRowsNoHeight _ -> Seq.empty+++-- # Payload++-- | A 'Payload' holds a 'RodRows', which determines the number+-- and content of the screen rows.  The 'Payload' also has an+-- 'Alignment', which specifies how the payload aligns with the axis.+-- Whether the 'Alignment' is 'Horizontal' or 'Vertical' determines+-- the orientation of the 'Payload'.  The 'Payload' also contains a+-- background color, which is type 'Radiant'.  The background color+-- extends continuously from the 'Payload' in both directions that are+-- perpendicular to the axis.++data Payload a = Payload (Alignment a) Radiant (Either RodRows Core)+  deriving (Eq, Ord, Show)++instance HasWidth (Payload a) where+  width (Payload _ _ ei) = width ei++instance HasHeight (Payload a) where+  height (Payload _ _ ei) = height ei++-- # Padding and merging++-- | Adds padding to the top and bottom of each Payload.  A Payload+-- with a Core is converted to a RodRows and has padding added; a+-- Payload with a RodRows has necessary padding added to the top and+-- bottom.  The number of elements in the resulting Seq is the same as+-- the number of elements in the input Seq; no merging is performed.++addVerticalPadding+  :: Box Horizontal+  -> Seq RodRows+addVerticalPadding bx@(Box sqnce) = fmap eqlize sqnce+  where+    maxTop = above bx+    maxBot = below bx+    eqlize bhp@(Payload _ rd ei) = case ei of+      Left rr -> eqlzeRodRows rr+      Right cre -> eqlzeRodRows (rodRowsFromCore rd cre)+      where+        eqlzeRodRows rr = case rr of+          RodRowsWithHeight sq -> RodRowsWithHeight $ tp w <> sq <> bot w+          RodRowsNoHeight i+            | maxTop + maxBot == 0 -> RodRowsNoHeight i+            | otherwise -> RodRowsWithHeight $ tp w <> bot w+          where+            w = width rr+        tp w = Seq.replicate (max 0 (maxTop - above bhp)) (pad w)+        bot w = Seq.replicate (max 0 (maxBot - below bhp)) (pad w)+        pad w = Seq.singleton . Rod . Left $ (w, rd)++-- | Merges multiple horizontal RodRows into a single RodRows.  All+-- RodRows must already have been the same height; if they are not the+-- same height, undefined behavior occurs.++horizontalMerge :: Seq RodRows -> RodRows+horizontalMerge sqn = case viewl sqn of+  EmptyL -> RodRowsNoHeight 0+  x :< xs -> case x of+    RodRowsNoHeight i -> RodRowsNoHeight $ F.foldl' comb i xs+      where+        comb acc x' = case x' of+          RodRowsNoHeight i' -> acc + i'+          RodRowsWithHeight _ -> error "horizontalMerge: error 1"+    RodRowsWithHeight sq -> RodRowsWithHeight $ F.foldl' comb sq xs+      where+        comb acc rr = case rr of+          RodRowsWithHeight sq' -> Seq.zipWith (<>) acc sq'+          RodRowsNoHeight _ -> error "horizontalMerge: error 2"++-- | Adds padding to the left and right of each Payload.+-- A Payload with a Core is converted to a RodRows and has padding+-- added; a Payload with a RodRows has necessary padding added to the+-- left and right.  The number of elements in the resulting Seq is+-- the same as the number of elements in the input Seq; no merging is+-- performed.++addHorizontalPadding+  :: Box Vertical+  -> Seq RodRows+addHorizontalPadding bx@(Box sqnce) = fmap eqlize sqnce+  where+    maxLeft = port bx+    maxRight = starboard bx+    eqlize (Payload a rd ei) = case ei of+      Left rr -> addLeftRight rr+      Right cre -> addLeftRight $ rodRowsFromCore rd cre+      where+        addLeftRight (RodRowsNoHeight _) = RodRowsNoHeight $ maxLeft + maxRight+        addLeftRight (RodRowsWithHeight sq) = RodRowsWithHeight $+          fmap addLeftRightToLine sq+        addLeftRightToLine lin = padder lenLft <> lin <> padder lenRgt+          where+            lenLin = F.sum . fmap width $ lin+            lenLft = case a of+              Center -> maxLeft - (fst . split $ lenLin)+              NonCenter ALeft -> maxLeft+              NonCenter ARight -> maxLeft - lenLin+            lenRgt = case a of+              Center -> maxRight - (snd . split $ lenLin)+              NonCenter ALeft -> maxRight - lenLin+              NonCenter ARight -> maxRight+            padder len+              | len < 1 = Seq.empty+              | otherwise = Seq.singleton . Rod . Left $ (len, rd)+++-- | Merge multiple vertical RodRows into a single RodRows.  Each+-- RodRows should already be the same width.++verticalMerge :: Seq RodRows -> RodRows+verticalMerge sqnce = case viewl sqnce of+  EmptyL -> RodRowsNoHeight 0+  x :< xs -> F.foldl' comb x xs+    where+      comb acc rr = case (acc, rr) of+        (RodRowsNoHeight w, RodRowsNoHeight _) -> RodRowsNoHeight w+        (RodRowsNoHeight _, RodRowsWithHeight sq) -> RodRowsWithHeight sq+        (RodRowsWithHeight sq, RodRowsNoHeight _) -> RodRowsWithHeight sq+        (RodRowsWithHeight sq1, RodRowsWithHeight sq2) ->+          RodRowsWithHeight $ sq1 <> sq2++-- # Box++-- | A 'Box' is the central building block.  It consists of zero or+-- more payloads; each payload has the same orientation, which is either+-- 'Horizontal' or 'Vertical'.  This orientation also determines+-- the orientation of the entire 'Box'.+--+-- A 'Box' is a 'Monoid' so you can combine them using the usual+-- monoid functions.  For a 'Box' 'Vertical', the leftmost values+-- added with 'mappend' are at the top of the 'Box'; for a 'Box'+-- 'Horizontal', the leftmost values added with 'mappend' are on the+-- left side of the 'Box'.+newtype Box a = Box (Seq (Payload a))+  deriving (Eq, Ord, Show)++instance Monoid (Box a) where+  mempty = Box Seq.empty+  mappend (Box x) (Box y) = Box (x <> y)++-- # Orientation++-- | This typeclass is responsible for transforming a 'Box' into+-- Rainbow 'Chunk' so they can be printed to your screen.  This+-- requires adding appropriate whitespace with the right colors, as+-- well as adding newlines in the right places.+class Orientation a where+  rodRows :: Box a -> RodRows++  spacer :: Radiant -> Int -> Box a+  -- ^ Builds a one-dimensional box of the given size; its single+  -- dimension is parallel to the axis.  When added to a+  -- box, it will insert blank space of the given length.  For a 'Box'+  -- 'Horizontal', this produces a horizontal line; for a 'Box'+  -- 'Vertical', a vertical line.++  spreader :: Alignment a -> Int -> Box a+  -- ^ Builds a one-dimensional box of the given size; its single+  -- dimension is perpendicular to the axis.  This can be used to make+  -- a 'Box' 'Vertical' wider or a 'Box' 'Horizontal' taller.++instance Orientation Vertical where+  rodRows = verticalMerge . addHorizontalPadding++  spacer r i = Box . Seq.singleton $+    Payload (NonCenter ALeft) r (Right . Core . Right $+      (Height (max 0 i), Width 0))+  spreader a i = Box . Seq.singleton $+    Payload a noColorRadiant (Right . Core . Right $+      (Height 0, Width (max 0 i)))++instance Orientation Horizontal where+  rodRows = horizontalMerge . addVerticalPadding++  spacer r i = Box . Seq.singleton $+    Payload (NonCenter ATop) r (Right . Core . Right $+      (Height 0, Width (max 0 i)))+  spreader a i = Box . Seq.singleton $+    Payload a noColorRadiant (Right . Core . Right $+      (Height (max 0 i), Width 0))++-- # port, starboard, above, below+++-- | Things that are oriented around a vertical axis.+class LeftRight a where+  -- | Length to the left of the vertical axis.+  port :: a -> Int++  -- | Length to the right of the vertical axis.+  starboard :: a -> Int++-- | Things that are oriented around a horizontal axis.+class UpDown a where+  -- | Number of lines above the horizontal axis.+  above :: a -> Int+  -- | Number of lines below the horizontal axis.+  below :: a -> Int+++instance LeftRight (Payload Vertical) where+  port (Payload a _ ei) = case a of+    NonCenter ALeft -> 0+    NonCenter ARight -> width ei+    Center -> fst . split . width $ ei++  starboard (Payload a _ s3) = case a of+    NonCenter ALeft -> width s3+    NonCenter ARight -> 0+    Center -> snd . split . width $ s3++instance UpDown (Payload Horizontal) where+  above (Payload a _ s3) = case a of+    NonCenter ATop -> 0+    NonCenter ABottom -> height s3+    Center -> fst . split . height $ s3++  below (Payload a _ s3) = case a of+    NonCenter ATop -> height s3+    NonCenter ABottom -> 0+    Center -> snd . split . height $ s3++instance LeftRight (Box Vertical) where+  port (Box sq) = F.foldl' max 0 . fmap port $ sq+  starboard (Box sq) = F.foldl' max 0 . fmap starboard $ sq++instance HasWidth (Box Vertical) where+  width b = port b + starboard b++instance HasHeight (Box Vertical) where+  height (Box sq) = F.sum . fmap height $ sq++instance UpDown (Box Horizontal) where+  above (Box sq) = F.foldl' max 0 . fmap above $ sq+  below (Box sq) = F.foldl' max 0 . fmap below $ sq++instance HasHeight (Box Horizontal) where+  height b = above b + below b++instance HasWidth (Box Horizontal) where+  width (Box sq) = F.sum . fmap width $ sq++-- # Box construction++-- | Construct a box from a single 'Chunk'.+fromChunk+  :: Alignment a+  -> Radiant+  -- ^ Background color.  The background color in the 'Chunk' is not+  -- changed; this background is used if the 'Payload' must be padded+  -- later on.+  -> Chunk+  -> Box a+fromChunk a r = Box . Seq.singleton . Payload a r  . Right . Core . Left++-- | Construct a blank box.  Useful for adding in background spacers.+-- For functions that build one-dimensional boxes, see 'spacer' and+-- 'spreader'.+blank+  :: Alignment a+  -> Radiant+  -- ^ Color for the blank area.+  -> Height+  -> Width+  -> Box a+blank a r h w =+  Box . Seq.singleton . Payload a r . Right . Core . Right $ (h, w)++-- | Wrap a 'Box' in another 'Box'.  Useful for changing a+-- 'Horizontal' 'Box' to a 'Vertical' one, or simply for putting a+-- 'Box' inside another one to control size and background color.+wrap+  :: Orientation a+  => Alignment b+  -- ^ Alignment for new 'Box'.  This also determines whether the new+  -- 'Box' is 'Horizontal' or 'Vertical'.+  -> Radiant+  -- ^ Background color for new box+  -> Box a+  -> Box b+wrap a r = Box . Seq.singleton . Payload a r . Left . rodRows++-- # Box rendering++-- | Convert a box to a 'Seq' of 'Chunk' in preparation for rendering.+-- Use 'F.toList' to convert the 'Seq' of 'Chunk' to a list so that+-- you can print it using the functions in "Rainbow".+render :: Orientation a => Box a -> Seq Chunk+render = join . chunksFromRodRows . rodRows+++-- # Tables++-- | A single cell in a spreadsheet-like grid.+data Cell = Cell+  { cellRows :: Seq (Seq Chunk)+  -- ^ The cell can have multiple rows of text; there is one 'Seq' for+  -- each row of text.+  , cellHoriz :: Alignment Horizontal+  -- ^ How this 'Cell' should align compared to other 'Cell' in its+  -- row.+  , cellVert :: Alignment Vertical+  -- ^ How this 'Cell' should align compared to other 'Cell' in its column.+  , cellBackground :: Radiant+  -- ^ Background color for this cell.  The background in the+  -- individual 'Chunk' in the 'cellRows' are not affected by+  -- 'cellBackground'; instead, 'cellBackground' determines the color+  -- of necessary padding that will be added so that the cells make a+  -- uniform table.+  }++-- | Creates a blank 'Cell' with the given background color and width;+-- useful for adding separators between columns.+separator :: Radiant -> Int -> Cell+separator rd i = Cell (Seq.singleton (Seq.singleton ck)) top left rd+  where+    ck = (chunkFromText $ X.replicate (max 0 i) " ") <> back rd++emptyCell :: Cell+emptyCell = Cell Seq.empty center center noColorRadiant+++-- Cells by row:+-- 0. Ensure each row is equal length+-- 1. Create one BoxV for each cell+-- 2. Create widest cell map+-- 3. Pad each BoxV to appropriate width, using cellVert alignment+-- 4. Convert each BoxV to BoxH, using cellHoriz and cellBackground+-- 5. mconcatSeq each row+-- 6. Convert each row to BoxV; use default background+--    and center alignment+-- 7. mconcatSeq the rows++-- | Create a table where each inner 'Seq' is a row of cells,+-- from left to right.  If necessary, blank cells are added to the end+-- of a row to ensure that each row has the same number of cells as+-- the longest row.+tableByRows :: Seq (Seq Cell) -> Box Vertical+tableByRows+  = mconcatSeq+  . fmap rowToBoxV+  . fmap mconcatSeq+  . fmap (fmap toBoxH)+  . uncurry padBoxV+  . addWidthMap+  . fmap (fmap cellToBoxV)+  . equalize emptyCell++rowToBoxV :: Box Horizontal -> Box Vertical+rowToBoxV = wrap center noColorRadiant++cellToBoxV :: Cell -> (Box Vertical, Alignment Horizontal, Radiant)+cellToBoxV (Cell rs ah av rd) = (bx, ah, rd)+  where+    bx = mconcatSeq+       . fmap (wrap av rd)+       . fmap (mconcatSeq . fmap (fromChunk top rd))+       $ rs++toBoxH+  :: (Box Vertical, Alignment Horizontal, Radiant)+  -> Box Horizontal+toBoxH (bv, ah, rd) = wrap ah rd bv++addWidthMap+  :: Seq (Seq (Box Vertical, b, c))+  -> (M.Map Int (Int, Int), Seq (Seq (Box Vertical, b, c)))+addWidthMap sqnce = (m, sqnce)+  where+    m = widestCellMap . fmap (fmap (\(a, _, _) -> a)) $ sqnce++padBoxV+  :: M.Map Int (Int, Int)+  -> Seq (Seq (Box Vertical, a, b))+  -> Seq (Seq (Box Vertical, a, b))+padBoxV mp = fmap (Seq.mapWithIndex f)+  where+    f idx (bx, a, b) = (bx <> padLeft <> padRight, a, b)+      where+        (lenL, lenR) = mp M.! idx+        padLeft = spreader right lenL+        padRight = spreader left lenR+++widestCellMap :: Seq (Seq (Box Vertical)) -> M.Map Int (Int, Int)+widestCellMap = F.foldl' outer M.empty+  where+    outer mpOuter = Seq.foldlWithIndex inner mpOuter+      where+        inner mpInner idx bx = case M.lookup idx mpInner of+          Nothing -> M.insert idx (port bx, starboard bx) mpInner+          Just (pOld, sOld) -> M.insert idx+            (max pOld (port bx), max sOld (starboard bx)) mpInner++-- Table by columns:+--+-- 0.  Equalize columns+-- 1.  Create one BoxH for each cell+-- 2.  Create tallest cell map+-- 3.  Pad each BoxH to appropriate height, using cellHeight alignment+-- 4.  Convert each BoxH to BoxV, using cellVert and cellBackground+-- 5.  mconcatSeq each column+-- 6.  Convert each column to BoxH+-- 7.  mconcatSeq the columns++-- | Create a table where each inner 'Seq' is a column of cells,+-- from top to bottom.  If necessary, blank cells are added to the end+-- of a column to ensure that each column has the same number of cells+-- as the longest column.+tableByColumns :: Seq (Seq Cell) -> Box Horizontal+tableByColumns+  = mconcatSeq+  . fmap rowToBoxH+  . fmap mconcatSeq+  . fmap (fmap toBoxV)+  . uncurry padBoxH+  . addHeightMap+  . fmap (fmap cellToBoxH)+  . equalize emptyCell+++rowToBoxH :: Box Vertical -> Box Horizontal+rowToBoxH = wrap top noColorRadiant+++cellToBoxH :: Cell -> (Box Horizontal, Alignment Vertical, Radiant)+cellToBoxH (Cell rs ah av rd) = (bx, av, rd)+  where+    bx = wrap ah rd+       . mconcatSeq+       . fmap (wrap av rd)+       . fmap (mconcatSeq . fmap (fromChunk top rd))+       $ rs++addHeightMap+  :: Seq (Seq (Box Horizontal, b, c))+  -> (M.Map Int (Int, Int), Seq (Seq (Box Horizontal, b, c)))+addHeightMap sqnce = (m, sqnce)+  where+    m = tallestCellMap . fmap (fmap (\(a, _, _) -> a)) $ sqnce++tallestCellMap :: Seq (Seq (Box Horizontal)) -> M.Map Int (Int, Int)+tallestCellMap = F.foldl' outer M.empty+  where+    outer mpOuter = Seq.foldlWithIndex inner mpOuter+      where+        inner mpInner idx bx = case M.lookup idx mpInner of+          Nothing -> M.insert idx (above bx, below bx) mpInner+          Just (aOld, bOld) -> M.insert idx+            (max aOld (above bx), max bOld (below bx)) mpInner+++padBoxH+  :: M.Map Int (Int, Int)+  -> Seq (Seq (Box Horizontal, a, b))+  -> Seq (Seq (Box Horizontal, a, b))+padBoxH mp = fmap (Seq.mapWithIndex f)+  where+    f idx (bx, a, b) = (bx <> padTop <> padBot, a, b)+      where+        (lenT, lenB) = mp M.! idx+        padTop = spreader bottom lenT+        padBot = spreader top lenB+++toBoxV+  :: (Box Horizontal, Alignment Vertical, Radiant)+  -> Box Vertical+toBoxV (bh, av, rd) = wrap av rd bh+++-- | Ensures that each inner 'Seq' is the same length by adding the+-- given empty element where needed.+equalize :: a -> Seq (Seq a) -> Seq (Seq a)+equalize emp sqnce = fmap adder sqnce+  where+    maxLen = F.foldl' max 0 . fmap Seq.length $ sqnce+    adder sq = sq <> pad+      where+        pad = Seq.replicate (max 0 (maxLen - Seq.length sq)) emp++mconcatSeq :: Monoid a => Seq a -> a+mconcatSeq = F.foldl' (<>) mempty+++-- # Utilities++-- | Like 'Data.List.intersperse' in "Data.List", but works on 'Seq'.+intersperse :: a -> Seq a -> Seq a+intersperse new sq = case viewl sq of+  EmptyL -> Seq.empty+  x :< xs -> x <| go xs+    where+      go sqnce = case viewl sqnce of+        EmptyL -> Seq.empty+        a :< as -> new <| a <| go as++-- | 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+

@@ -1,290 +0,0 @@--- | '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-  (-  -- * 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-  )-import Rainbow--data Specs = Specs-  { background :: Radiant-  , 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,521 @@+-- Modules might be imported solely so Haddock can hyperlink the+-- identifiers++{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# LANGUAGE OverloadedStrings #-}++{-| The Rainbox tutorial++Rainbox helps you create arrangements of (possibly) colorful text+boxes. This module contains a tutorial.  Typically the "Rainbox"+module contains all you need.  There is also a "Rainbox.Core" module+which contains all the innards of Rainbox, but ordinarily you won't+need it.++The basic building block of Rainbox is known as a @core@.  A core is+either a single 'Chunk' or a blank box of arbitrary size.  A core made+of a single 'Chunk' should not contain any newlines.  Leave newline+handling up to Rainbox.  However, Rainbox will not check to ensure+that your 'Chunk' does not contain any newline characters.  If it does+contain newlines, your boxes will not look right.  Also, Rainbox needs+to know how wide your 'Chunk' are, in columns.  To measure width,+Rainbox simply counts the number of characters in the 'Chunk'.+Therefore, if you need accented characters, be sure to use a single+character, not composed characters.  That is, to get á, use U+00E1,+not U+00B4 and U+0061.++Many things in Rainbox have height and width.  Both the height and+width of an object can be zero, but never less than zero.  A @core@+made from a 'Chunk' always has a height of 1, and its width is equal+to the number of characters in the 'Text's that make up the 'Chunk'.+A @core@ made from a blank box has the height and width that you give+it, though neither its height nor its width is ever smaller than zero.++The next biggest building block after the @core@ is @payload@.  There+are two different types of payloads: vertical payloads and horizontal+ones.  A vertical payload aligns itself next to other vertical+payloads on a vertical axis, creating a chain of payloads.  The+vertical payload also has an alignment.  The alignment determines+whether the payload lines up along the axis on its left side, right+side, or in the center of the payload.++The vertical payload also has a background color, which as type+'Radiant'.  Think of the background color as extending infinitely from+both the left and right side of the vertical payload.  When the+vertical payload is combined with other vertical payloads into a 'Box'+'Vertical', this background color is used as necessary so that the+'Box' 'Vertical' forms a rectangle.++The horizontal payload is similar to the vertical payload, but the+axis is horizontal rather than vertical.  The alignment determines+whether the payload aligns the axis along the top, center, or bottom+of the payload.  A horizontal payload also contains a background+color; it extends infinitely from both the top and bottom of the+horizontal payload.++Finally, the biggest building block of Rainbox is the box.  There are+two types of boxes: a 'Box' 'Horizontal', which holds zero or more horizontal+payloads, and a 'Box' 'Vertical', which holds zero or more vertical payloads.+Each kind of box is a 'Monoid', so you can combine it using the usual+monoid functions.  So, to give a visual, a 'Box' 'Vertical' with five payloads+might look like this:++@++-- function: 'box1'++           V Vertical axis++           +----++           | v1 |+           |    |+           +----+--------++           |     v2      |+           |             |+  +--------+-------------++  |        |+  |  v3    |+  |        |+  |        |+  +--------+----------++           |    v4    |+      +----+----+-----++      | v5      |+      |         |+      +---------+++@++Each payload is marked in the middle with @v1@, @v2@, etc.  Note how+each payload has a different size.  @v1@ and @v2@, and @v4@ have a+'left' alignment, as their left edge is lined up with the vertical+axis.  @v3@ has a 'right' alignment.  @v5@ has a 'center' alignment.+Think of each payload has having a background color extending+infinitely off of its left and right sides.  These five payloads put+together make a 'Box' 'Vertical'.  Since 'Box' 'Vertical' is a monoid,+you can combine various 'Box' 'Vertical'.  Indeed, the pictured 'Box'+'Vertical' can be built only by combining smaller 'Box' 'Vertical', as+when you create payloads they are always given to you as a single+payload wrapped in a 'Box' 'Vertical'.++Now, you want to render your 'Box' 'Vertical'.  You use the 'render' function,+which makes a sequence of Rainbow 'Chunk'.  This turns your 'Box' 'Vertical'+into a nice rectangle for on-screen rendering:++@++-- function: 'renderBox1'++  +--------+----+--------++  |        | v1 |        |+  |        |    |        |+  +--------+----+--------++  |        |     v2      |+  |        |             |+  +--------+-------------++  |        |             |+  |  v3    |             |+  |        |             |+  |        |             |+  +--------+----------+--++  |        |    v4    |  |+  +---+----+----+-----+--++  |   | v5      |        |+  |   |         |        |+  +---+---------+--------+++@++The spaces to the left and right of each payload are filled in with+the appropriate background color, which is the background+color of the adjoining payload.+++What if you want to place the 'Box' 'Vertical' alongside another box?  If you+want to put it next to another 'Box' 'Vertical', just use 'mappend' or '<>'. But+what if you want to put it next to a 'Box' 'Horizontal'?  Let's suppose you have a+'Box' 'Horizontal' that looks like this:++@++-- function: 'box2'++                        +----++                        | h1 |+                        |    |+Horizontal Axis >       +----+----------++                             |          |+                             |   h2     |+                             |          |+                             +----------+++@++The @h1@ payload has alignment 'bottom', because its bottom edge is+lined up along the horizontal axis.  The @h2@ payload has alignment+'top'.  You want to connect this 'Box' 'Horizontal' with the 'Box'+'Vertical' made above.  You can't connect them directly because they+are different types.  You can, however, take a complete 'Box' and wrap+it inside another 'Box'.  This allows you to wrap a 'Box' 'Vertical'+inside of a 'Box' 'Horizontal', and vice versa, or even wrap a 'Box'+'Horizontal' inside of another 'Box' 'Horizontal'.  You do this with+the 'wrap' function, which is applied to the alignment for the new+box, its background color, and the box you want to wrap.  ao, let's+say you take the 'Box' 'Vertical' created above and wrap it inside a+'Box' 'Horizontal' with 'top' alignment and a background color, and+then you combine it with the 'Box' 'Horizontal' created above.  The+result:++@++-- function: 'box3'++                         +----++                         | h1 |+                         |    |+  +--------+----+--------+----+----------++  |        | v1 |        |    |          |+  |        |    |        |    |    h2    |+  +--------+----+--------+    |          |+  |        |     v2      |    +----------++  |        |             |+  +--------+-------------++  |        |             |+  |  v3    |             |+  |        |             |+  |        |             |+  +--------+----------+--++  |        |    v4    |  |+  +---+----+----+-----+--++  |   | v5      |        |+  |   |         |        |+  +---+---------+--------+++@++The old 'Box' 'Vertical', which is now wrapped in a 'Box'+'Horizontal', now has a background color which extends infinitely from+the top and bottom of the box.  It is now just a payload inside of the+'Box' 'Horizontal'.  The other two payloads in the 'Box' 'Horizontal',+@h1@ and @h2@, also have background colors extending from their tops+and bottoms.++So, when you render this 'Box' 'Horizontal' with 'render', you get this:+++@++-- function: 'renderBox3'++  +----------------------+----+----------++  |                      | h1 |          |+  |                      |    |          |+  +--------+----+--------+----+----------++  |        | v1 |        |    |          |+  |        |    |        |    |    h2    |+  +--------+----+--------+    |          |+  |        |     v2      |    +----------++  |        |             |    |          |+  +--------+-------------+    |          |+  |        |             |    |          |+  |  v3    |             |    |          |+  |        |             |    |          |+  |        |             |    |          |+  +--------+----------+--+    |          |+  |        |    v4    |  |    |          |+  +---+----+----+-----+--+    |          |+  |   | v5      |        |    |          |+  |   |         |        |    |          |+  +---+---------+--------+----+----------+++@++The area above the old 'Box' 'Vertical' has the background color that we used in+the application of 'convert'.  The area below the @h1@ payload has its+background color, and the area above and below the @h2@ payload has+its background color.++What if you just want to create an empty space?  You can create entire+blank boxes with 'blank', but often it is enough to use 'spacer',+which gives you a one-dimensional 'Box' 'Horizontal' or 'Box'+'Vertical'.  If you are creating a 'Box' 'Horizontal', 'spacer' gives+you a box with width, but no height; for a 'Box' 'Vertical', you get a+box with height, but no width.  So, to return to the example 'Box'+'Horizontal', let's say you want to add a blank space a few columns+wide on the right side.  You 'mappend' a 'Box' 'Horizontal' created+with 'spacer' to get this:++@++-- function: 'box4'++                        +----++                        | h1 |+                        |    |+Horizontal Axis >       +----+----------+--++                             |          |+                             |   h2     |+                             |          |+                             +----------++@++On the right side you now have a payload with width, but no height.+But it does have a background color.  So when you 'render' the box, you+get this:+++@++-- function: 'renderBox4'++                        +----+----------+--++                        | h1 |          |  |+                        |    |          |  |+                        +----+----------+  |+                        |    |          |  |+                        |    |   h2     |  |+                        |    |          |  |+                        +----+----------+--+++@++You can also use 'spreader' to make a 'Box' 'Horizontal' taller or a+'Box' 'Vertical' wider.  'spreader' creates a one-dimensional 'Box'+that is perpendicular to the axis.  Pay attention to the alignment of+the 'spreader' as this will determine how your box expands.  Let's say+I want to take the 'Box' that contains the @h1@ and @h2@ payloads as+created above, but I also want to make sure the box is at least 12+rows tall.  To do this, 'mappend' a 'spreader' that is 12 rows tall.+The result upon 'render'ing is:++@+                        +-- functions: 'box5' 'renderBox5'++                        +----+----------+--++                        |    |          |  |+                        +----+          |  |+                        | h1 |          |  |+                        |    |          |  |+                        +----+----------+  |+                        |    |          |  |+                        |    |   h2     |  |+                        |    |          |  |+                        |    +----------+  |+                        |    |          |  |+                        +----+----------+--++@++Those are the basics of the Rainbox model, which should be enough to+get you started.  Also helpful are the 'tableByRows' and+'tableByColumns' functions, which will help you build a simple grid+that resembles a spreadsheet; see its documentation for hints to get+started with that.  You will also find an example using the+'tableByRows', as well as code to produce all of the examples shown+above, in the source code below.++== Why the use of 'Seq' everywhere, rather than lists?++Rainbox uses 'Seq' from "Data.Sequence" because lists can be+infinite.  Practically every function in Rainbox will not accept+infinite inputs, because Rainbox needs to know exactly how long and+wide various payloads and boxes are in order to line them up+correctly.  Use of the 'Seq' most accurately reflects the fact that+Rainbox does not work on infinite inputs.++-}+module Rainbox.Tutorial where++import Data.Foldable (toList)+import Data.Monoid+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Data.Text (Text)+import qualified Data.Text as X+import Rainbow+import Rainbox++-- | Create a 'Box' for the given text.  The default foreground and+-- background colors of the terminal are used for the 'Text'; the+-- given background is used as the background color for any added+-- padding.+textBox :: Radiant -> Text -> Box a+textBox r = fromChunk center r . chunkFromText++-- | Centers the given 'Box' within a larger 'Box' that has the given+-- height and width and background color.  The larger 'Box' has the+-- given 'Alignment'.+within+  :: Orientation a+  => Alignment a+  -> Int+  -- ^ Number of rows+  -> Int+  -- ^ Number of columns+  -> Radiant+  -- ^ Background color+  -> Box a+  -> Box a+within a r c b+  = wrap a b+  . mappend (spreader center r)+  . wrap centerH b+  . mappend (spreader center c)+  . wrap centerV b++-- | Puts the given text in the center of a box.  The resulting box is+-- center aligned.+textWithin+  :: Orientation a+  => Alignment a+  -> Int+  -- ^ Number of rows+  -> Int+  -- ^ Number of columns+  -> Radiant+  -- ^ Background color for smaller box+  -> Radiant+  -- ^ Background color for larger box+  -> Text+  -> Box a+textWithin a r c bs bl = wrap a bl . within a r c bs . textBox bs++box1 :: Box Vertical+box1 = mconcat+  [ textWithin left   4 6  blue      green   "v1"+  , textWithin left   4 15 red       magenta "v2"+  , textWithin right  6 10 yellow    blue    "v3"+  , textWithin left   3 12 green     red     "v4"+  , textWithin center 4 11 magenta   blue    "v5"+  ]++renderBox1 :: IO ()+renderBox1 = mapM_ putChunk . toList . render $ box1++box2 :: Box Horizontal+box2 = mconcat+  [ textWithin bottom 4 6  magenta green "h1"+  , textWithin top    5 12 blue    yellow "h2"+  ]++renderBox2 :: IO ()+renderBox2 = mapM_ putChunk . toList . render $ box2++box3 :: Box Horizontal+box3 = mconcat+  [ wrap top yellow box1+  , box2+  ]++renderBox3 :: IO ()+renderBox3 = mapM_ putChunk . toList . render $ box3++box4 :: Box Horizontal+box4 = box2 <> spacer cyan 3++renderBox4 :: IO ()+renderBox4 = mapM_ putChunk . toList . render $ box4++box5 :: Box Horizontal+box5 = box4 <> spreader center 12++renderBox5 :: IO ()+renderBox5 = mapM_ putChunk . toList . render $ box5++-- Sample code for 'tableByRows'+--+-- Here is a simple data type representing stations in the+-- Washington DC Metrorail system.++data Line+  = Red+  | Blue+  | Orange+  | Green+  | Yellow+  | Silver+  deriving (Eq, Ord, Show, Enum)++data Station = Station+  { name :: Text+  , metroLines :: [Line]+  , address :: [Text]+  , underground :: Bool+  }++nameCell :: Radiant -> Text -> Cell+nameCell bk nm+  = Cell (Seq.singleton . Seq.singleton $ (chunkFromText nm <> back bk))+         top left bk++linesCell :: Radiant -> [Line] -> Cell+linesCell bk lns = Cell (Seq.fromList . fmap (lineRow bk) $ lns)+                        top right bk++lineRow :: Radiant -> Line -> Seq Chunk+lineRow bk li = Seq.singleton ck+  where+    ck = chunkFromText (X.pack . show $ li) <> fore clr <> back bk+    clr = case li of+      Red -> red+      Blue -> blue+      Orange -> Radiant yellow8 (Just . Color256 . Just $ 220)+      Green -> green+      Yellow -> yellow+      Silver -> Radiant white8 (Just grey)+++addressCell :: Radiant -> [Text] -> Cell+addressCell bk lns = Cell (Seq.fromList . fmap addrRow $ lns) top center bk+  where+    addrRow txt = Seq.singleton $ chunkFromText txt <> back bk++undergroundCell :: Radiant -> Bool -> Cell+undergroundCell bk bl+  = Cell (Seq.singleton . Seq.singleton $ ck) top left bk+  where+    ck = (if bl then "Yes" else "No") <> back bk++-- | Converts a 'Station' to a list of 'Cell'.++stationCells :: Radiant -> Station -> [Cell]+stationCells b st =+  [ nameCell b . name $ st+  , linesCell b . metroLines $ st+  , addressCell b . address $ st+  , undergroundCell b . underground $ st+  ]++stationTable :: Box Vertical+stationTable+  = tableByRows+  . Seq.fromList+  . zipWith stationRow (cycle [coloredBack, noColorRadiant])+  $ stations+  where+    coloredBack = Radiant noColor8 (Just . Color256 . Just $ 195)+    stationRow bk+      = intersperse (separator bk 1)+      . Seq.fromList+      . stationCells bk++renderStationTable :: IO ()+renderStationTable = mapM_ putChunk . toList . render $ stationTable++stations :: [Station]+stations =+  [ Station "Metro Center" [Red, Orange, Silver, Blue]+            ["607 13th St NW", "Washington, DC 20005"] True++  , Station "L'Enfant Plaza" [Orange, Silver, Blue, Green, Yellow]+            ["600 Maryland Ave SW", "Washington, DC 20024"] True++  , Station "Silver Spring" [Red]+            ["8400 Colesville Rd", "Silver Spring, MD 20910"] False++  , Station "Court House" [Silver, Orange]+            ["2100 Wilson Blvd", "Arlington, VA 22201"] True++  , Station "Prince George's Plaza" [Green, Yellow]+            ["3575 East-West Hwy", "Hyattsville, MD 20782"] True+  ]

@@ -1,173 +0,0 @@-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 you can compile and run-it.  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 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] -> Radiant -> Cell-> cell cks bck = Cell brs left top bck->   where->     brs = map Bar . map ((:[]) . (<> back bck)) $ cks---> recordToCells :: Record -> Radiant -> [Cell]-> recordToCells r rad = map ($ rad) $->   [ 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 [noColorRadiant, 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

@@ -3,12 +3,12 @@ -- http://www.github.com/massysett/cartel -- -- Script name used to generate: genCabal.hs--- Generated on: 2015-03-22 11:44:44.05559 EDT--- Cartel library version: 0.14.2.0+-- Generated on: 2015-04-14 07:08:21.967655 EDT+-- Cartel library version: 0.14.2.6  name: rainbox-version: 0.10.0.2-cabal-version: >= 1.14+version: 0.12.0.0+cabal-version: >= 1.18 license: BSD3 license-file: LICENSE build-type: Simple@@ -34,10 +34,7 @@ Library   exposed-modules:     Rainbox-    Rainbox.Array2d-    Rainbox.Box-    Rainbox.Box.Primitives-    Rainbox.Reader+    Rainbox.Core     Rainbox.Tutorial   default-language: Haskell2010   ghc-options:@@ -45,147 +42,62 @@   hs-source-dirs:     lib   build-depends:-      base >= 4.5.0.0 && < 4.8.0.0+      base >= 4.5.0.0 && < 4.9.0.0     , rainbow >= 0.22 && < 0.23     , bytestring >= 0.10 && < 0.11+    , containers >= 0.5.5 && < 0.6     , text >= 0.11.3.1 && < 1.3.0.0-    , transformers >= 0.3.0.0 && < 0.5.0.0-    , array >= 0.4.0.0 && < 0.6.0.0 -Test-Suite rainbox-visual-  type: exitcode-stdio-1.0+source-repository head+  type: git+  location: https://github.com/massysett/rainbox.git++Test-Suite rainbox-properties+  main-is: rainbox-properties.hs+  build-depends:+      base >= 4.5.0.0 && < 4.9.0.0+    , rainbow >= 0.22 && < 0.23+    , bytestring >= 0.10 && < 0.11+    , containers >= 0.5.5 && < 0.6+    , text >= 0.11.3.1 && < 1.3.0.0+    , tasty >= 0.10.1 && < 0.11+    , tasty-quickcheck >= 0.8.1 && < 0.9+    , QuickCheck >= 2.7 && < 2.9   ghc-options:     -Wall+  default-language: Haskell2010+  hs-source-dirs:+    lib+    test   other-modules:     Rainbox-    Rainbox.Array2d-    Rainbox.Box-    Rainbox.Box.Primitives-    Rainbox.Reader+    Rainbox.Core     Rainbox.Tutorial     Rainbow.Instances-    Rainbox.Array2dTests-    Rainbox.Box.Instances-    Rainbox.Box.PrimitivesTests-    Rainbox.BoxDir-    Rainbox.BoxTests     Rainbox.Instances-    Rainbox.ReaderTests-    RainboxDir-    RainboxTests-    Visual+  type: exitcode-stdio-1.0++Test-Suite rainbox-visual   main-is: rainbox-visual.hs-  hs-source-dirs:-    test-    lib-  default-language: Haskell2010   build-depends:-      base >= 4.5.0.0 && < 4.8.0.0+      base >= 4.5.0.0 && < 4.9.0.0     , rainbow >= 0.22 && < 0.23     , bytestring >= 0.10 && < 0.11+    , containers >= 0.5.5 && < 0.6     , text >= 0.11.3.1 && < 1.3.0.0-    , transformers >= 0.3.0.0 && < 0.5.0.0-    , array >= 0.4.0.0 && < 0.6.0.0     , tasty >= 0.10.1 && < 0.11     , tasty-quickcheck >= 0.8.1 && < 0.9     , QuickCheck >= 2.7 && < 2.9-    , ChasingBottoms >= 1.3.0 && < 1.4--Executable rainbox-mosaic-  main-is: rainbox-mosaic.hs-  if flag(mosaic)-    ghc-options:-      -Wall-    other-modules:-      Rainbox-      Rainbox.Array2d-      Rainbox.Box-      Rainbox.Box.Primitives-      Rainbox.Reader-      Rainbox.Tutorial-      Rainbow.Instances-      Rainbox.Array2dTests-      Rainbox.Box.Instances-      Rainbox.Box.PrimitivesTests-      Rainbox.BoxDir-      Rainbox.BoxTests-      Rainbox.Instances-      Rainbox.ReaderTests-      RainboxDir-      RainboxTests-      Visual-    hs-source-dirs:-      test-      lib-    default-language: Haskell2010-    build-depends:-        base >= 4.5.0.0 && < 4.8.0.0-      , rainbow >= 0.22 && < 0.23-      , bytestring >= 0.10 && < 0.11-      , text >= 0.11.3.1 && < 1.3.0.0-      , transformers >= 0.3.0.0 && < 0.5.0.0-      , array >= 0.4.0.0 && < 0.6.0.0-      , tasty >= 0.10.1 && < 0.11-      , tasty-quickcheck >= 0.8.1 && < 0.9-      , QuickCheck >= 2.7 && < 2.9-      , ChasingBottoms >= 1.3.0 && < 1.4-  else-    buildable: False--Test-Suite rainbox-test   ghc-options:     -Wall-  type: exitcode-stdio-1.0+  default-language: Haskell2010   hs-source-dirs:-    test     lib-  default-language: Haskell2010-  build-depends:-      base >= 4.5.0.0 && < 4.8.0.0-    , rainbow >= 0.22 && < 0.23-    , bytestring >= 0.10 && < 0.11-    , text >= 0.11.3.1 && < 1.3.0.0-    , transformers >= 0.3.0.0 && < 0.5.0.0-    , array >= 0.4.0.0 && < 0.6.0.0-    , tasty >= 0.10.1 && < 0.11-    , tasty-quickcheck >= 0.8.1 && < 0.9-    , QuickCheck >= 2.7 && < 2.9-    , ChasingBottoms >= 1.3.0 && < 1.4-  main-is: rainbox-test.hs--source-repository head-  type: git-  location: https://github.com/massysett/rainbox.git--Executable rainbox-grid-  main-is: rainbox-grid.hs-  if flag(grid)-    ghc-options:-      -Wall-    hs-source-dirs:-      test-      lib-    default-language: Haskell2010-    build-depends:-        base >= 4.5.0.0 && < 4.8.0.0-      , rainbow >= 0.22 && < 0.23-      , bytestring >= 0.10 && < 0.11-      , text >= 0.11.3.1 && < 1.3.0.0-      , transformers >= 0.3.0.0 && < 0.5.0.0-      , array >= 0.4.0.0 && < 0.6.0.0-      , tasty >= 0.10.1 && < 0.11-      , tasty-quickcheck >= 0.8.1 && < 0.9-      , QuickCheck >= 2.7 && < 2.9-      , ChasingBottoms >= 1.3.0 && < 1.4-  else-    buildable: False--Flag grid-  description: Build the rainbox-grid executable-  default: False-  manual: True--Flag mosaic-  description: Build the rainbox-mosaic executable-  default: False-  manual: True+    test+  other-modules:+    Rainbox+    Rainbox.Core+    Rainbox.Tutorial+    Rainbow.Instances+    Rainbox.Instances+  type: exitcode-stdio-1.0

@@ -1,402 +0,0 @@-module Rainbox.Array2dTests where--import Test.Tasty-import Test.QuickCheck-import Test.Tasty.QuickCheck (testProperty)-import Data.Array-import Rainbox.Array2d-import Test.ChasingBottoms---- | 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 undefined . 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 undefined . 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--arrayHasNoBottoms :: Ix i => Array i e -> Bool-arrayHasNoBottoms = all (not . isBottom) . elems--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 "arrayHasNoBottoms fails on arrays with a bottom" $-    expectFailure $ arrayHasNoBottoms (listArray (0 :: Int, 0) [])--  , testProperty "arrayByRows returns arrays with no bottoms" $-    \ls -> arrayHasNoBottoms (arrayByRows () ls)--  , testProperty "arrayByCols returns arrays with no bottoms" $-    \ls -> arrayHasNoBottoms (arrayByCols () ls)--  , testProperty "mapTableNoChangeCols" $-    forAll (fmap Blind genLabelF) $ \(Blind f) ->-    forAll genTable $ \t ->-    mapTableNoChangeCols f t--  , testProperty "mapTableNoChangeRows" $-    forAll (fmap Blind genLabelF) $ \(Blind 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 (fmap Blind genChangeLabelF) $ \(Blind f) ->-    forAll genTable $ \t ->-    propMapRowLabelsCols f t--  , testProperty "propMapRowLabelsCells" $-    forAll (fmap Blind genChangeLabelF) $ \(Blind f) ->-    forAll genTable $ \t ->-    propMapRowLabelsCells f t--  , testProperty "propMapRowLabelsRebuild" $-    forAll genTable propMapRowLabelsRebuild--  , testProperty "propMapRowLabelsRelabel" $-    forAll genTable propMapRowLabelsRelabel--  , testProperty "propMapColLabelsCols" $-    forAll (fmap Blind genChangeLabelF) $ \(Blind f) ->-    forAll genTable $ \t ->-    propMapColLabelsCols f t--  , testProperty "propMapColLabelsCells" $-    forAll (fmap Blind genChangeLabelF) $ \(Blind f) ->-    forAll genTable $ \t ->-    propMapColLabelsCells f t--  , testProperty "propMapColLabelsRebuild" $-    forAll genTable propMapColLabelsRebuild--  , testProperty "propMapColLabelsRelabel" $-    forAll genTable propMapColLabelsRelabel--  ]-

@@ -1,5 +0,0 @@-module Rainbox.Box.Instances where--import Rainbow.Instances ()-import Test.QuickCheck-

@@ -1,218 +0,0 @@-module Rainbox.Box.PrimitivesTests where--import Control.Monad-import Control.Applicative-import Test.Tasty-import Test.Tasty.QuickCheck (testProperty)-import Test.QuickCheck-import Rainbow-import Rainbow.Instances ()-import Rainbow.Types-import qualified Data.Text as X-import Rainbox.Box.Primitives--genText :: Gen X.Text-genText = fmap X.pack $ listOf c-  where-    c = elements ['0'..'Z']--genChunk :: Gen Chunk-genChunk = arbitrary--genHeight :: Gen Height-genHeight = fmap Height $ frequency [(3, nonNeg), (1, neg)]-  where-    nonNeg = fmap abs 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---- | Generates blank Box.-genBlankBox :: Gen Box-genBlankBox = liftM3 blank arbitrary 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 <- arbitrary-  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 <- arbitrary-  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 :: Radiant -> Int -> Gen Chunk-genChunkLen bk l = do-  txt <- fmap X.pack $ vectorOf l (elements ['0'..'Z'])-  return $ (chunkFromText txt) <> back bk---- | 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 <- arbitrary-  cks <- vectorOf h (genChunkLen bk w)-  let bxs = map (chunks . (:[])) cks-  bk' <- arbitrary-  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 :: Radiant-  , 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-    <*> arbitrary-    <*> 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 . concat . map chunkTexts $ 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)-    ]-  ]-

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

@@ -1,207 +0,0 @@-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 Rainbow.Types-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 = sum . map X.length . chunkTexts . 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)-    ]-  ]

@@ -1,33 +1,64 @@-{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}---- | QuickCheck instances for all Rainbox modules. module Rainbox.Instances where  import Control.Monad import Test.QuickCheck+import Rainbox.Core import Rainbow.Instances ()-import Rainbox-import Rainbox.Box+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq +instance Arbitrary a => Arbitrary (Alignment a) where+  arbitrary = oneof [ return Center, fmap NonCenter arbitrary ]++instance Arbitrary Horizontal where+  arbitrary = elements [ ATop, ABottom ]++instance Arbitrary Vertical where+  arbitrary = elements [ ALeft, ARight ]+ instance Arbitrary Height where-  arbitrary = fmap Height arbitrary+  arbitrary = fmap Height $ frequency+    [ (3, fmap getNonNegative arbitrary)+    , (1, arbitrary)+    ]  instance Arbitrary Width where-  arbitrary = fmap Width arbitrary+  arbitrary = fmap Width $ frequency+    [ (3, fmap getNonNegative arbitrary)+    , (1, arbitrary)+    ] -instance Arbitrary (Align Vert) where-  arbitrary = elements [center, top, bottom]+instance Arbitrary Core where+  arbitrary = fmap Core arbitrary -instance Arbitrary (Align Horiz) where-  arbitrary = elements [center, left, right]+instance Arbitrary Rod where+  arbitrary = fmap Rod arbitrary -instance Arbitrary Bar where-  arbitrary = fmap Bar arbitrary+instance Arbitrary a => Arbitrary (Seq a) where+  arbitrary = fmap Seq.fromList arbitrary --- | Creates a non-nested Box.-instance Arbitrary Box where-  arbitrary = liftM3 barsToBox arbitrary arbitrary arbitrary+newtype NonEmptySeq a = NonEmptySeq { getNonEmptySeq :: Seq a }+  deriving Show++instance Arbitrary a => Arbitrary (NonEmptySeq a) where+  arbitrary = do+    NonEmpty xs <- arbitrary+    return . NonEmptySeq . Seq.fromList $ xs++instance Arbitrary RodRows where+  arbitrary = sized $ \s -> resize (s `div` 10) $ oneof+    [ fmap (RodRowsWithHeight . getNonEmptySeq) arbitrary+    , frequency [ (1, fmap RodRowsNoHeight arbitrary)+                , (3, fmap (RodRowsNoHeight . getNonNegative) arbitrary)+                ]+    ]++instance Arbitrary a => Arbitrary (Payload a) where+  arbitrary = liftM3 Payload arbitrary arbitrary arbitrary++instance Arbitrary a => Arbitrary (Box a) where+  arbitrary = fmap Box arbitrary  instance Arbitrary Cell where   arbitrary = liftM4 Cell arbitrary arbitrary arbitrary arbitrary

@@ -1,133 +0,0 @@-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 abs arbitrarySizedIntegral),-                  (1, arbitrarySizedIntegral)]-  v <- frequency [(3, fmap abs 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

@@ -1,13 +0,0 @@-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 ]

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

@@ -1,142 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}-module Visual where--import Control.Monad-import Rainbox.Box-import Rainbow-import Test.QuickCheck hiding (resize)-import Test.QuickCheck.Gen hiding (resize)-import Test.QuickCheck.Random-import Rainbox.Box.PrimitivesTests-import Rainbow.Instances ()-import Data.String--colors = fore yellow <> back blue--narrow = "narrow box" <> colors--midwidth = "medium width box" <> colors--wide = "a wide box, see how wide I am?" <> colors--all3 = [narrow, midwidth, wide]--short = chunk narrow--midheight = catV green left . map chunk $ [narrow, midwidth]--tall = catV green left . map chunk $ [narrow, midwidth, wide]--sizeParam = 7--describe s b = do-  putStrLn (s ++ ":")-  printBox b-  putStrLn ""--testCompound :: String -> (Radiant -> [Box] -> Box) -> IO ()-testCompound d f = do-  g <- newQCGen-  let bxs = unGen (replicateM 5 genTextBox) g sizeParam -      bk = unGen arbitrary g sizeParam-  describe d $ f bk bxs--testVert-  :: String-  -> (Radiant -> 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-  -> (Radiant -> 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 noColorRadiant left . map mkLine $ clrs-  where-    mkLine clr = chunk $ txt <> clr-    txt = fromString ['0'..'9']-    clrs = map back . take 10 . iterate (+6) $ (160 :: Word8)--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)--  testHoriz "column" (\bk ah bxs -> catV noColorRadiant 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)-

@@ -1,13 +0,0 @@--- | Prints a random grid using the main Rainbox module.  Ignores all--- command line arguments.--module Main where--import Test.QuickCheck-import Rainbox.Instances ()-import Rainbox--main :: IO ()-main = do-  rows <- generate (resize 5 arbitrary)-  printBox $ gridByRows rows

@@ -1,16 +0,0 @@--- | 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-import Rainbox.Box.PrimitivesTests-import System.Environment-import Rainbox.Box--main :: IO ()-main = do-  s:[] <- getArgs-  bx <- generate (Test.QuickCheck.resize (read s) genBox)-  printBox bx

@@ -0,0 +1,153 @@+module Main where++import Rainbox.Core+import Rainbox.Instances ()+import Rainbow.Types+import Test.Tasty+import Test.Tasty.QuickCheck+import Data.Sequence (Seq, viewl, ViewL(..))+import qualified Data.Sequence as Seq+import qualified Data.Foldable as F+import qualified Data.Text as X+import Control.Monad++main :: IO ()+main = defaultMain . testGroup "Rainbox tests" $+  [ testGroup "split" $+    [ testProperty "sum is equal to original number" $ \a ->+      let (x, y) = split a+      in x + y == a+    ]++  , testGroup "intersperse" $+    [ testProperty "makes no change to empty Seq" $+      intersperse undefined Seq.empty == (Seq.empty :: Seq ())++    , testProperty "makes no change to singleton Seq" $+      intersperse undefined (Seq.singleton ()) == Seq.singleton ()++    , testProperty "lengthens other Seq by length - 1" $ \i ->+      i > 1 ==>+      Seq.length (intersperse undefined (Seq.replicate i ())) ==+      i + (i - 1)+    ]++  , testGroup "HasHeight" $+    [ testGroup "never returns less than zero" $+      let go a = let h = height a in classify (h > 2) "h > 2" (h >= 0) in+      [ testProperty "RodRows" $+          \a -> go (a `asTypeOf` (undefined :: RodRows))+      , testProperty "Core" $+          \a -> go (a `asTypeOf` (undefined :: Core))+      , testProperty "Box Vertical" $+          \a -> go (a `asTypeOf` (undefined :: Box Vertical))+      , testProperty "Box Horizontal" $+          \a -> go (a `asTypeOf` (undefined :: Box Horizontal))+      , testProperty "Payload Vertical" $+          \a -> go (a `asTypeOf` (undefined :: Payload Vertical))+      , testProperty "Payload Horizontal" $+          \a -> go (a `asTypeOf` (undefined :: Payload Horizontal))+      ]+    ]++  , testGroup "HasWidth" $+    [ testGroup "never returns less than zero" $+      let go a = let w = width a in classify (w > 2) "w > 2" (w >= 0) in+      [ testProperty "Chunk" $+          \a -> go (a `asTypeOf` (undefined :: Chunk))+      , testProperty "RodRows" $+          \a -> go (a `asTypeOf` (undefined :: RodRows))+      , testProperty "Rod" $+          \a -> go (a `asTypeOf` (undefined :: Rod))+      , testProperty "Core" $+          \a -> go (a `asTypeOf` (undefined :: Core))+      , testProperty "Box Vertical" $+          \a -> go (a `asTypeOf` (undefined :: Box Vertical))+      , testProperty "Box Horizontal" $+          \a -> go (a `asTypeOf` (undefined :: Box Horizontal))+      , testProperty "Payload Vertical" $+          \a -> go (a `asTypeOf` (undefined :: Payload Vertical))+      , testProperty "Payload Horizontal" $+          \a -> go (a `asTypeOf` (undefined :: Payload Horizontal))+      ]+    ]++  , testGroup "chunk" $+    [ testProperty "height is always 1" $ \c ->+      let _types = c :: Chunk in height c == 1+    , testProperty "width is sum of number of characters" $ \c@(Chunk _ t) ->+      width c == F.sum (fmap X.length t)+    ]++  , testGroup "addVerticalPadding"+    [ testProperty "all RodRows same height" $+      allRodRowsSameHeight . addVerticalPadding+    ]++  , testGroup "UpDown"+    [ testGroup "above + below is same as height" $+      let sameAsHeight a = above a + below a == height a in+      [ testProperty "Box Horizontal"+          (\a -> sameAsHeight (a `asTypeOf` (undefined :: Box Horizontal)))+      , testProperty "Payload Horizontal"+          (\a -> sameAsHeight (a `asTypeOf` (undefined :: Payload Horizontal)))+      ]+    ]++  , testGroup "horizontalMerge"+    [ testProperty "Resulting RodRows has same height as inputs" $+      \rr i ->+      let lenR = case rr of+            RodRowsNoHeight _ -> 0+            RodRowsWithHeight sq -> Seq.length sq+      in height (horizontalMerge (Seq.replicate (getPositive i) rr)) == lenR+    ]++  , testGroup "addHorizontalPadding"+    [ testProperty "all RodRows same width" $+      allRodRowsSameWidth . addHorizontalPadding+    ]++  , testGroup "verticalMerge"+    [ testProperty "resulting RodRows same width as inputs" $ \rr i ->+      let lenR = width rr+          mrge = verticalMerge (Seq.replicate (getPositive i) rr)+          wdth = width mrge+      in counterexample (show (mrge, wdth, lenR)) $ wdth == lenR+    ]+++  ]++allRodRowsSameHeight :: Seq RodRows -> Bool+allRodRowsSameHeight sqnce = case viewl sqnce of+  EmptyL -> True+  x :< xs -> F.all (== height x) . fmap height $ xs++allRodRowsSameWidth :: Seq RodRows -> Property+allRodRowsSameWidth sqnce = +  case viewl sqnce of+    EmptyL -> property True+    x :< _ -> counterexample (show (sqnce, lengths, height1))+      $ F.all (== height1) lengths+      where+        lengths = join . fmap toLengths $ sqnce+        height1 = case x of+          RodRowsNoHeight w -> w+          RodRowsWithHeight sqn -> case viewl sqn of+            EmptyL -> 0+            y :< _ -> F.sum . fmap width $ y+        toLengths (RodRowsNoHeight w) = Seq.singleton w+        toLengths (RodRowsWithHeight sq) = fmap (F.sum . fmap width) sq++rodsLength :: Seq Rod -> Int+rodsLength = F.sum . fmap width++rodRowsLengths :: Seq (Seq Rod) -> Seq Int+rodRowsLengths = fmap rodsLength++seqRodsRowsLengths :: Seq RodRows -> Seq (Seq Int)+seqRodsRowsLengths sq = fmap calc sq+  where+    calc (RodRowsNoHeight w) = Seq.singleton (max 0 w)+    calc (RodRowsWithHeight sqn) = rodRowsLengths sqn

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

@@ -1,10 +1,24 @@--- | Rainbox visual tests.------ Tests that are intended to be run and then examined visually.+-- | Prints all the boxes in the tutorial.  The output must be+-- visually inspected.  module Main where -import Visual+import Rainbox.Tutorial +printBox :: String -> IO () -> IO ()+printBox lbl act = do+  putStrLn $ replicate 50 '='+  putStrLn ""+  putStrLn $ lbl ++ ":"+  putStrLn ""+  act+  putStrLn ""+ main :: IO ()-main = Visual.tests+main = do+  printBox "box1" renderBox1+  printBox "box2" renderBox2+  printBox "box3" renderBox3+  printBox "box4" renderBox4+  printBox "box5" renderBox5+  printBox "stationTable" renderStationTable