diff --git a/current-versions.txt b/current-versions.txt deleted file mode 100644 --- a/current-versions.txt +++ /dev/null @@ -1,60 +0,0 @@ -This package was tested to work with these dependency -versions and compiler version. -These are the default versions fetched by cabal install. -Tested as of: 2014-06-14 02:31:26.107979 UTC -Path to compiler: ghc-7.8.2 -Compiler description: 7.8.2 - -/opt/ghc/7.8.2/lib/ghc-7.8.2/package.conf.d: - Cabal-1.18.1.3 - array-0.5.0.0 - base-4.7.0.0 - bin-package-db-0.0.0.0 - binary-0.7.1.0 - rts-1.0 - bytestring-0.10.4.0 - containers-0.5.5.1 - deepseq-1.3.0.2 - directory-1.2.1.0 - filepath-1.3.0.2 - (ghc-7.8.2) - ghc-prim-0.3.1.0 - (haskell2010-1.1.2.0) - (haskell98-2.0.0.3) - hoopl-3.10.0.1 - hpc-0.6.0.1 - integer-gmp-0.5.1.0 - old-locale-1.0.0.6 - old-time-1.1.0.2 - pretty-1.1.1.1 - process-1.2.0.0 - template-haskell-2.9.0.0 - time-1.4.2 - transformers-0.3.0.0 - unix-2.7.0.1 - -/home/massysett/rainbox/sunlight-8257/db: - QuickCheck-2.7.5 - ansi-terminal-0.6.1.1 - ansi-wl-pprint-0.6.7.1 - async-2.0.1.5 - mtl-2.2.1 - optparse-applicative-0.9.0 - parsec-3.1.5 - primitive-0.5.3.0 - rainbow-0.14.0.2 - rainbox-0.4.0.4 - random-1.0.1.1 - regex-base-0.93.2 - regex-tdfa-1.2.0 - stm-2.4.3 - tagged-0.7.2 - tasty-0.8.1.1 - tasty-quickcheck-0.8.1 - terminfo-0.4.0.0 - text-1.1.1.3 - tf-random-0.5 - transformers-0.4.1.0 - transformers-compat-0.3.3.4 - unbounded-delays-0.1.0.7 - diff --git a/lib/Rainbox.hs b/lib/Rainbox.hs --- a/lib/Rainbox.hs +++ b/lib/Rainbox.hs @@ -16,13 +16,9 @@ -- module together with "Rainbox.Box" to create very complex -- layouts.) module Rainbox - ( -- * Backgrounds - Background(..) - , defaultBackground - , backgroundFromChunk - - -- * Alignment - , Align + ( + -- * Alignment + Align , Horiz , Vert , top @@ -45,7 +41,6 @@ -- complex needs. , gridByRows , gridByCols - , checkGrid , boxCells , glueBoxes @@ -54,6 +49,7 @@ , printBox ) where +import Rainbow.Colors import Rainbox.Box import Rainbox.Array2d import Data.Array @@ -73,7 +69,7 @@ -- ^ How this Cell aligns compared to other Cell in its row; use -- 'top', 'center', or 'bottom'. - , background :: Background + , 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 @@ -81,10 +77,11 @@ } deriving (Eq, Show) -- | Creates a Cell with a 'left' horizontal alignment, a 'top' --- vertical alignment, and a 'defaultBackground'. The cell will be --- one 'Bar' tall and contain the text given in the string. +-- 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 defaultBackground + fromString s = Cell [(fromString s)] left top noColorRadiant -- | Returns the width of each 'Bar' in the 'Cell'. cellWidths :: Cell -> [Int] @@ -120,43 +117,31 @@ => Array (col, row) Box -> Box glueBoxes - = catH defaultBackground top - . map (catV defaultBackground left) + = 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. --- --- /This function is partial./ Each list of 'Cell' must be --- the same length; otherwise, your program will crash. Since you --- will typically generate the list of rows using 'map' or list --- comprehensions or the like, this isn't typically a problem; if it --- is a problem, then check the inputs to this function with --- 'checkGrid' before you apply it. +-- | 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 +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. --- --- /This function is partial./ Each list of 'Cell' must be --- the same length; otherwise, your program will crash. Since you --- will typically generate the list of columns using 'map' or list --- comprehensions or the like, this isn't typically a problem; if it --- is a problem, then check the inputs to this function with --- 'checkGrid' before you apply it. +-- 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. gridByCols :: [[Cell]] -> Box -gridByCols = glueBoxes . boxCells . arrayByCols +gridByCols = glueBoxes . boxCells . arrayByCols padCell --- | Checks the input to 'gridByRows' or 'gridByCols' to ensure that --- it is safe. True if the list of list of 'Cell' is safe for --- either of these functions; False if not. -checkGrid :: [[Cell]] -> Bool -checkGrid ls = case ls of - [] -> True - x:xs -> let len = length x in all ((== len) . length) xs +padCell :: Cell +padCell = Cell [] left top noColorRadiant diff --git a/lib/Rainbox/Array2d.hs b/lib/Rainbox/Array2d.hs --- a/lib/Rainbox/Array2d.hs +++ b/lib/Rainbox/Array2d.hs @@ -181,19 +181,43 @@ ixsCols = range (minCol, maxCol) getRow ixRow = map (\cl -> ay ! (cl, ixRow)) ixsCols --- | Generate a two-dimensional array from a list of rows. Each row --- must be of equal length; otherwise, the generated array will have --- undefined elements. +-- | 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]] + :: a + -- ^ Append this empty value to rows that are too short. + -> [[a]] + -- ^ One list per row -> Array (Int, Int) a -arrayByRows ls = array ((0,0), (colMax, rowMax)) $ indexRows ls +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 @@ -201,13 +225,22 @@ where g (cl, a) = ((cl, rw), a) --- | Generate a two-dimensional array from a list of columns. Each --- column must be of equal length; otherwise, the generated array --- will have undefined elements. +-- | 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]] + :: 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 ls = listArray ((0,0), (colMax, rowMax)) . concat $ ls +arrayByCols empty ls + = listArray ((0,0), (colMax, rowMax)) + . concat + . padder empty + $ ls where colMax = length ls - 1 rowMax = case ls of diff --git a/lib/Rainbox/Box.hs b/lib/Rainbox/Box.hs --- a/lib/Rainbox/Box.hs +++ b/lib/Rainbox/Box.hs @@ -31,14 +31,9 @@ -- character. When you print your 'Box', the blank characters will -- have the appropriate background color. module Rainbox.Box - ( -- * Backgrounds - Background(..) - , defaultBackground - , backgroundFromChunk - , backgroundToTextSpec - + ( -- * Height and columns - , Height(..) + Height(..) , B.height , Width(..) , B.HasWidth(..) @@ -100,8 +95,6 @@ import Data.List (intersperse) import qualified Data.Text as X import Rainbow -import Rainbow.Types -import Rainbow.Colors import qualified Rainbox.Box.Primitives as B import Rainbox.Box.Primitives ( Box @@ -110,49 +103,30 @@ , Vert , Height(..) , Width(..) - , Background , unBox ) import qualified System.IO as IO -backgroundFromChunk :: Chunk -> B.Background -backgroundFromChunk (Chunk ts _) = - B.Background $ Radiant bk8 (Just bk256) - where - bk8 = case getLast . background8 . style8 $ ts of - Nothing -> noColor8 - Just c -> c - bk256 = case getLast . background256 . style256 $ ts of - Nothing -> noColor256 - Just c -> c - -backgroundToTextSpec :: B.Background -> TextSpec -backgroundToTextSpec (B.Background (Radiant c8 may256)) = TextSpec s8 s256 - where - s8 = Style8 f8 b8 sc - s256 = Style256 f256 b256 sc - f8 = Last Nothing - f256 = Last Nothing - b8 = Last (Just c8) - b256 = case may256 of - Nothing -> Last (Just (to256 c8)) - Just c256 -> Last (Just c256) - sc = mempty - --- | Use the default background colors of the current terminal. -defaultBackground :: B.Background -defaultBackground = B.Background $ Radiant noColor8 Nothing - -- -- # Box making -- -- | A blank horizontal box with a given width and no height. -blankH :: Background -> Int -> Box +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 :: Background -> Int -> Box +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'. @@ -167,7 +141,8 @@ -- added to the right and bottom sides of the resulting 'Box'. grow - :: Background + :: Radiant + -- ^ Background colors -> Height -> Width -> Align Vert @@ -181,7 +156,8 @@ -- | Grow a 'Box' horizontally. growH - :: Background + :: Radiant + -- ^ Background colors -> Int -- ^ Resulting width -> Align Horiz @@ -201,7 +177,8 @@ -- | Grow a 'Box' vertically. growV - :: Background + :: Radiant + -- ^ Background colors -> Int -- ^ Resulting height -> Align Vert @@ -222,7 +199,8 @@ -- | Returns a list of 'Box', each being exactly as wide as the -- widest 'Box' in the input list. column - :: Background + :: Radiant + -- ^ Background colors -> Align Horiz -> [Box] -> [Box] @@ -250,7 +228,8 @@ -- 'Height' or 'Width' is less than 1. resize - :: Background + :: Radiant + -- ^ Background colors -> Height -> Width -> Align Vert @@ -263,7 +242,8 @@ -- | Resize horizontally. resizeH - :: Background + :: Radiant + -- ^ Background colors -> Int -- ^ Resulting width -> Align Horiz @@ -278,7 +258,8 @@ -- | Resize vertically. resizeV - :: Background + :: Radiant + -- ^ Background colors -> Int -- ^ Resulting height -> Align Vert @@ -297,25 +278,51 @@ -- | @sepH sep a bs@ lays out @bs@ horizontally with alignment @a@, -- with @sep@ amount of space in between each. -sepH :: Background -> Int -> Align Vert -> [Box] -> Box +sepH + :: 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 :: Background -> Int -> Align Horiz -> [Box] -> Box +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 :: Background -> Align Vert -> Box -> [Box] -> Box +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 :: Background -> Align Horiz -> Box -> [Box] -> Box +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 diff --git a/lib/Rainbox/Box/Primitives.hs b/lib/Rainbox/Box/Primitives.hs --- a/lib/Rainbox/Box/Primitives.hs +++ b/lib/Rainbox/Box/Primitives.hs @@ -25,11 +25,9 @@ -- character. When you print your 'Box', the blank characters will -- have the appropriate background color. module Rainbox.Box.Primitives - ( -- * Background - Background(..) - + ( -- * Alignment - , Align + Align , Vert , Horiz , center @@ -77,21 +75,11 @@ import qualified Data.Text as X import Data.String --- # Background - --- | Background colors to use when inserting necessary padding. -newtype Background = Background Radiant - deriving (Eq, Ord, Show) - -instance Color Background where - back (Background b) = back b - fore (Background b) = fore b - -- # Box data Spaces = Spaces { numSpaces :: Int - , spcBackground :: Background + , spcBackground :: Radiant } deriving (Eq, Show) instance HasWidth Spaces where @@ -125,7 +113,12 @@ barToBox :: Bar -> Box barToBox = chunks . unBar -barsToBox :: Background -> Align Horiz -> [Bar] -> Box +barsToBox + :: Radiant + -- ^ Background colors + -> Align Horiz + -> [Bar] + -> Box barsToBox bk ah = catV bk ah . map barToBox instance IsString Bar where @@ -217,7 +210,8 @@ -- | A blank 'Box'. Useful for aligning other 'Box'. blank - :: Background + :: Radiant + -- ^ Background colors -> Height -> Width -> Box @@ -279,7 +273,12 @@ -- > ----------.... -- > -------------- -catH :: Background -> Align Vert -> [Box] -> Box +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 @@ -319,7 +318,12 @@ -- > ...---- -- > ...---- -catV :: Background -> Align Horiz -> [Box] -> Box +catV + :: Radiant + -- ^ Background colors + -> Align Horiz + -> [Box] + -> Box catV bk al bs | null bs = Box $ NoHeight 0 | otherwise = Box . foldr f (NoHeight w) @@ -352,7 +356,13 @@ -- -- where dashes is a 'Bar' with data, and dots is a blank 'Bar'. -padHoriz :: Background -> Align Vert -> Int -> BoxP -> [Rod] +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] @@ -381,7 +391,8 @@ -- > ...------- padVert - :: Background + :: Radiant + -- ^ Background colors -> Align Horiz -> Int -> Rod @@ -544,7 +555,7 @@ -- | Generate spaces. blanks - :: Background + :: Radiant -- ^ Background colors -> Int -- ^ Number of blanks diff --git a/lib/Rainbox/Reader.hs b/lib/Rainbox/Reader.hs --- a/lib/Rainbox/Reader.hs +++ b/lib/Rainbox/Reader.hs @@ -6,12 +6,9 @@ -- operators to easily join up 'Box'. The disadvantage is that -- using the 'Reader' monad adds a layer of indirection. module Rainbox.Reader - ( -- * Backgrounds - B.Background(..) - , R.defaultBackground - + ( -- * Box properties - , B.Bar(..) + B.Bar(..) , B.Box , B.unBox @@ -89,9 +86,10 @@ , Horiz , Vert ) +import Rainbow data Specs = Specs - { background :: B.Background + { background :: Radiant , alignH :: Align Horiz , alignV :: Align Vert , spaceH :: Int diff --git a/lib/Rainbox/Tutorial.lhs b/lib/Rainbox/Tutorial.lhs --- a/lib/Rainbox/Tutorial.lhs +++ b/lib/Rainbox/Tutorial.lhs @@ -9,13 +9,12 @@ [boxes](http://hackage.haskell.org/package/boxes) is a similar package but without color support. -This file is written in literate Haskell, so it compile and run for -you. It also means that the compiler checks the examples, which +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). +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 =============== @@ -131,14 +130,14 @@ will make a function that returns a `Cell` with our desired defaults: -> cell :: [Chunk] -> Chunk -> Cell -> cell cks bck = Cell brs left top (backgroundFromChunk bck) +> cell :: [Chunk] -> Radiant -> Cell +> cell cks bck = Cell brs left top bck > where -> brs = map Bar . map ((:[]) . (<> bck)) $ cks +> brs = map Bar . map ((:[]) . (<> back bck)) $ cks -> recordToCells :: Record -> Chunk -> [Cell] -> recordToCells r ck = map ($ ck) $ +> recordToCells :: Record -> Radiant -> [Cell] +> recordToCells r rad = map ($ rad) $ > [ cell . (:[]) . fromString . firstName $ r > , cell . (:[]) $ (fromString (lastName r) <> bold) > , cell . map fromString . address $ r @@ -151,7 +150,7 @@ ============================ > cellRows :: [[Cell]] -> cellRows = zipWith recordToCells records (cycle [mempty, fore yellow]) +> cellRows = zipWith recordToCells records (cycle [noColorRadiant, yellow]) Adding white space between columns ================================== diff --git a/minimum-versions.txt b/minimum-versions.txt deleted file mode 100644 --- a/minimum-versions.txt +++ /dev/null @@ -1,60 +0,0 @@ -This package was tested to work with these dependency -versions and compiler version. -These are the minimum versions given in the .cabal file. -Tested as of: 2014-06-14 02:31:26.107979 UTC -Path to compiler: ghc-7.4.1 -Compiler description: 7.4.1 - -/opt/ghc/7.4.1/lib/ghc-7.4.1/package.conf.d: - Cabal-1.14.0 - array-0.4.0.0 - base-4.5.0.0 - bin-package-db-0.0.0.0 - binary-0.5.1.0 - bytestring-0.9.2.1 - containers-0.4.2.1 - deepseq-1.3.0.0 - directory-1.1.0.2 - extensible-exceptions-0.1.1.4 - filepath-1.3.0.0 - (ghc-7.4.1) - ghc-prim-0.2.0.0 - (haskell2010-1.1.0.1) - (haskell98-2.0.0.1) - hoopl-3.8.7.3 - hpc-0.5.1.1 - integer-gmp-0.4.0.0 - old-locale-1.0.0.4 - old-time-1.1.0.0 - pretty-1.1.1.0 - process-1.1.0.1 - rts-1.0 - template-haskell-2.7.0.0 - time-1.4 - unix-2.5.1.0 - -/home/massysett/rainbox/sunlight-8257/db: - QuickCheck-2.7 - ansi-terminal-0.6.1.1 - ansi-wl-pprint-0.6.7.1 - async-2.0.1.5 - mtl-2.1.3.1 - optparse-applicative-0.9.0 - parsec-3.1.5 - primitive-0.5.3.0 - rainbow-0.14.0.0 - rainbox-0.4.0.4 - random-1.0.0.0 - regex-base-0.93.2 - regex-tdfa-1.2.0 - stm-2.4.3 - tagged-0.7.2 - tasty-0.8 - tasty-quickcheck-0.8.1 - terminfo-0.4.0.0 - text-0.11.3.1 - tf-random-0.5 - transformers-0.3.0.0 - transformers-compat-0.3.3.3 - unbounded-delays-0.1.0.7 - diff --git a/rainbox.cabal b/rainbox.cabal --- a/rainbox.cabal +++ b/rainbox.cabal @@ -3,15 +3,16 @@ -- http://www.github.com/massysett/cartel -- -- Script name used to generate: genCabal.hs --- Generated on: 2014-11-23 09:17:19.169553 EST --- Cartel library version: 0.10.0.2 +-- Generated on: 2015-02-17 16:40:53.4642 EST +-- Cartel library version: 0.14.2.0 + name: rainbox -version: 0.8.0.0 +version: 0.10.0.0 cabal-version: >= 1.14 -build-type: Simple license: BSD3 license-file: LICENSE -copyright: Copyright 2014 Omari Norman +build-type: Simple +copyright: Copyright 2014-2015 Omari Norman author: Omari Norman maintainer: omari@smileystation.com stability: Experimental @@ -24,138 +25,182 @@ . For more information, please see the Haddock documentation and . - category: Text extra-source-files: - README.md - , sunlight-test.hs - , minimum-versions.txt - , current-versions.txt - , changelog - -source-repository head - type: git - location: git://github.com/massysett/rainbox.git - branch: master - -Flag mosaic - Description: Build the rainbox-mosaic executable - Default: False - Manual: True + README.md + changelog Library exposed-modules: - Rainbox - , Rainbox.Array2d - , Rainbox.Box - , Rainbox.Box.Primitives - , Rainbox.Reader - , Rainbox.Tutorial + Rainbox + Rainbox.Array2d + Rainbox.Box + Rainbox.Box.Primitives + Rainbox.Reader + Rainbox.Tutorial default-language: Haskell2010 ghc-options: - -Wall + -Wall hs-source-dirs: - lib + lib build-depends: - base ((> 4.5.0.0 || == 4.5.0.0) && < 4.8.0.0) - , rainbow ((> 0.20 || == 0.20) && < 0.21) - , text ((> 0.11.3.1 || == 0.11.3.1) && < 1.3.0.0) - , transformers ((> 0.3.0.0 || == 0.3.0.0) && < 0.5.0.0) - , array ((> 0.4.0.0 || == 0.4.0.0) && < 0.6.0.0) + base >= 4.5.0.0 && < 4.8.0.0 + , rainbow >= 0.20.4.0 && < 0.21 + , 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 + ghc-options: + -Wall + other-modules: + Rainbox + Rainbox.Array2d + Rainbox.Box + Rainbox.Box.Primitives + Rainbox.Reader + Rainbox.Tutorial + Rainbow.Coarbitrary + Rainbow.Colors.Coarbitrary + Rainbow.Colors.Generators + Rainbow.Colors.Shrinkers + Rainbow.Generators + Rainbow.QuickCheck + Rainbow.Shrinkers + Rainbow.Types.Coarbitrary + Rainbow.Types.Generators + Rainbow.Types.Shrinkers + Rainbox.Array2dTests + Rainbox.Box.PrimitivesTests + Rainbox.BoxDir + Rainbox.BoxTests + Rainbox.Instances + Rainbox.ReaderTests + RainboxDir + RainboxTests + 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 + , rainbow >= 0.20.4.0 && < 0.21 + , 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.5 && < 2.8 + , barecheck >= 0.2.0.6 && < 0.3 + , ChasingBottoms >= 1.3.0 && < 1.4 + Executable rainbox-mosaic main-is: rainbox-mosaic.hs if flag(mosaic) ghc-options: - -Wall + -Wall other-modules: - Rainbox - , Rainbox.Array2d - , Rainbox.Box - , Rainbox.Box.Primitives - , Rainbox.Reader - , Rainbox.Tutorial - , Rainbox.Array2dTests - , Rainbox.Box.PrimitivesTests - , Rainbox.BoxDir - , Rainbox.BoxTests - , Rainbox.ReaderTests - , RainboxDir - , RainboxTests - , Visual + Rainbox + Rainbox.Array2d + Rainbox.Box + Rainbox.Box.Primitives + Rainbox.Reader + Rainbox.Tutorial + Rainbow.Coarbitrary + Rainbow.Colors.Coarbitrary + Rainbow.Colors.Generators + Rainbow.Colors.Shrinkers + Rainbow.Generators + Rainbow.QuickCheck + Rainbow.Shrinkers + Rainbow.Types.Coarbitrary + Rainbow.Types.Generators + Rainbow.Types.Shrinkers + Rainbox.Array2dTests + Rainbox.Box.PrimitivesTests + Rainbox.BoxDir + Rainbox.BoxTests + Rainbox.Instances + Rainbox.ReaderTests + RainboxDir + RainboxTests + Visual hs-source-dirs: - test - , lib + test + lib default-language: Haskell2010 build-depends: - base ((> 4.5.0.0 || == 4.5.0.0) && < 4.8.0.0) - , rainbow ((> 0.20 || == 0.20) && < 0.21) - , text ((> 0.11.3.1 || == 0.11.3.1) && < 1.3.0.0) - , transformers ((> 0.3.0.0 || == 0.3.0.0) && < 0.5.0.0) - , array ((> 0.4.0.0 || == 0.4.0.0) && < 0.6.0.0) - build-depends: - tasty ((> 0.10.1 || == 0.10.1) && < 0.11) - , tasty-quickcheck ((> 0.8.1 || == 0.8.1) && < 0.9) - , QuickCheck ((> 2.7.5 || == 2.7.5) && < 2.8) - , random ((> 1.0.0.0 || == 1.0.0.0) && < 1.2) - , rainbow-tests ((> 0.20 || == 0.20) && < 0.21) + base >= 4.5.0.0 && < 4.8.0.0 + , rainbow >= 0.20.4.0 && < 0.21 + , 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.5 && < 2.8 + , barecheck >= 0.2.0.6 && < 0.3 + , ChasingBottoms >= 1.3.0 && < 1.4 else buildable: False Test-Suite rainbox-test ghc-options: - -Wall + -Wall type: exitcode-stdio-1.0 hs-source-dirs: - test - , lib + test + lib default-language: Haskell2010 build-depends: - base ((> 4.5.0.0 || == 4.5.0.0) && < 4.8.0.0) - , rainbow ((> 0.20 || == 0.20) && < 0.21) - , text ((> 0.11.3.1 || == 0.11.3.1) && < 1.3.0.0) - , transformers ((> 0.3.0.0 || == 0.3.0.0) && < 0.5.0.0) - , array ((> 0.4.0.0 || == 0.4.0.0) && < 0.6.0.0) + base >= 4.5.0.0 && < 4.8.0.0 + , rainbow >= 0.20.4.0 && < 0.21 + , 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.5 && < 2.8 + , barecheck >= 0.2.0.6 && < 0.3 + , ChasingBottoms >= 1.3.0 && < 1.4 main-is: rainbox-test.hs - build-depends: - tasty ((> 0.10.1 || == 0.10.1) && < 0.11) - , tasty-quickcheck ((> 0.8.1 || == 0.8.1) && < 0.9) - , QuickCheck ((> 2.7.5 || == 2.7.5) && < 2.8) - , rainbow-tests ((> 0.20 || == 0.20) && < 0.21) -Test-Suite rainbox-visual - type: exitcode-stdio-1.0 - ghc-options: +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 - other-modules: - Rainbox - , Rainbox.Array2d - , Rainbox.Box - , Rainbox.Box.Primitives - , Rainbox.Reader - , Rainbox.Tutorial - , Rainbox.Array2dTests - , Rainbox.Box.PrimitivesTests - , Rainbox.BoxDir - , Rainbox.BoxTests - , Rainbox.ReaderTests - , RainboxDir - , RainboxTests - , Visual - main-is: rainbox-visual.hs - hs-source-dirs: + hs-source-dirs: test - , lib - default-language: Haskell2010 - build-depends: - base ((> 4.5.0.0 || == 4.5.0.0) && < 4.8.0.0) - , rainbow ((> 0.20 || == 0.20) && < 0.21) - , text ((> 0.11.3.1 || == 0.11.3.1) && < 1.3.0.0) - , transformers ((> 0.3.0.0 || == 0.3.0.0) && < 0.5.0.0) - , array ((> 0.4.0.0 || == 0.4.0.0) && < 0.6.0.0) - build-depends: - tasty ((> 0.10.1 || == 0.10.1) && < 0.11) - , tasty-quickcheck ((> 0.8.1 || == 0.8.1) && < 0.9) - , QuickCheck ((> 2.7.5 || == 2.7.5) && < 2.8) - , random ((> 1.0.0.0 || == 1.0.0.0) && < 1.2) - , rainbow-tests ((> 0.20 || == 0.20) && < 0.21) + lib + default-language: Haskell2010 + build-depends: + base >= 4.5.0.0 && < 4.8.0.0 + , rainbow >= 0.20.4.0 && < 0.21 + , 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.5 && < 2.8 + , barecheck >= 0.2.0.6 && < 0.3 + , 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 diff --git a/sunlight-test.hs b/sunlight-test.hs deleted file mode 100644 --- a/sunlight-test.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Main where - -import Test.Sunlight - -inputs = TestInputs - { tiDescription = Nothing - , tiCabal = "cabal" - , tiLowest = ("7.4.1", "ghc-7.4.1", "ghc-pkg-7.4.1") - , tiDefault = [ ("7.4.1", "ghc-7.4.1", "ghc-pkg-7.4.1") - , ("7.6.3", "ghc-7.6.3", "ghc-pkg-7.6.3") - , ("7.8.3", "ghc-7.8.3", "ghc-pkg-7.8.3") ] - , tiTest = [] - } - -main = runTests inputs diff --git a/test/Rainbow/Coarbitrary.hs b/test/Rainbow/Coarbitrary.hs new file mode 100644 --- /dev/null +++ b/test/Rainbow/Coarbitrary.hs @@ -0,0 +1,7 @@ +module Rainbow.Coarbitrary + ( module Rainbow.Types.Coarbitrary + , module Rainbow.Colors.Coarbitrary + ) where + +import Rainbow.Types.Coarbitrary +import Rainbow.Colors.Coarbitrary diff --git a/test/Rainbow/Colors/Coarbitrary.hs b/test/Rainbow/Colors/Coarbitrary.hs new file mode 100644 --- /dev/null +++ b/test/Rainbow/Colors/Coarbitrary.hs @@ -0,0 +1,12 @@ +module Rainbow.Colors.Coarbitrary where + +import Test.QuickCheck +import Rainbow.Colors +import Rainbow.Types.Coarbitrary +import qualified Prelude.Coarbitrary + +radiant :: Radiant -> Gen b -> Gen b +radiant (Radiant c8 mc256) = + color8 c8 + . Prelude.Coarbitrary.maybe color256 mc256 + diff --git a/test/Rainbow/Colors/Generators.hs b/test/Rainbow/Colors/Generators.hs new file mode 100644 --- /dev/null +++ b/test/Rainbow/Colors/Generators.hs @@ -0,0 +1,11 @@ +module Rainbow.Colors.Generators where + +import qualified Rainbow.Colors as C +import Test.QuickCheck +import qualified Rainbow.Types.Generators as G +import Control.Monad +import qualified Prelude.Generators + +radiant :: Gen C.Radiant +radiant = liftM2 C.Radiant G.color8 + (Prelude.Generators.maybe G.color256) diff --git a/test/Rainbow/Colors/Shrinkers.hs b/test/Rainbow/Colors/Shrinkers.hs new file mode 100644 --- /dev/null +++ b/test/Rainbow/Colors/Shrinkers.hs @@ -0,0 +1,10 @@ +module Rainbow.Colors.Shrinkers where + +import qualified Rainbow.Colors as C +import qualified Rainbow.Types.Shrinkers as S +import qualified Prelude.Shrinkers + +radiant :: C.Radiant -> [C.Radiant] +radiant (C.Radiant c8 mc256) = + zipWith C.Radiant (S.color8 c8) + (Prelude.Shrinkers.maybe S.color256 mc256) diff --git a/test/Rainbow/Generators.hs b/test/Rainbow/Generators.hs new file mode 100644 --- /dev/null +++ b/test/Rainbow/Generators.hs @@ -0,0 +1,7 @@ +module Rainbow.Generators + ( module Rainbow.Types.Generators + , module Rainbow.Colors.Generators + ) where + +import Rainbow.Types.Generators +import Rainbow.Colors.Generators diff --git a/test/Rainbow/QuickCheck.hs b/test/Rainbow/QuickCheck.hs new file mode 100644 --- /dev/null +++ b/test/Rainbow/QuickCheck.hs @@ -0,0 +1,58 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | QuickCheck instances for all of Rainbow. Currently Rainbow does +-- not use these instances itself; they are only here for +-- cut-and-paste for other libraries that may need them. There is an +-- executable in Rainbow that is built solely to make sure this module +-- compiles without any errors. +-- +-- To use these instances, just drop them into your own project +-- somewhere. They are not packaged as a library because there are +-- orphan instances. + +module Rainbow.QuickCheck where + +import Test.QuickCheck +import Rainbow.Colors +import Rainbow.Types +import Data.Monoid +import Control.Monad +import qualified Data.Text as X + +instance Arbitrary Enum8 where + arbitrary = elements [E0, E1, E2, E3, E4, E5, E6, E7] + +instance Arbitrary Color8 where + arbitrary = fmap Color8 arbitrary + +instance Arbitrary Color256 where + arbitrary = fmap Color256 arbitrary + +instance Arbitrary (Last Color8) where + arbitrary = fmap Last arbitrary + +instance Arbitrary (Last Color256) where + arbitrary = fmap Last arbitrary + +instance Arbitrary StyleCommon where + arbitrary + = liftM4 StyleCommon g g g g + where + g = fmap Last arbitrary + +instance Arbitrary Style256 where + arbitrary = liftM3 Style256 arbitrary arbitrary arbitrary + +instance Arbitrary Style8 where + arbitrary = liftM3 Style8 arbitrary arbitrary arbitrary + +instance Arbitrary TextSpec where + arbitrary = liftM2 TextSpec arbitrary arbitrary + +instance Arbitrary Chunk where + arbitrary = liftM2 Chunk arbitrary + (listOf (fmap X.pack (listOf (elements ['a'..'z'])))) + +instance Arbitrary Radiant where + arbitrary = liftM2 Radiant arbitrary arbitrary diff --git a/test/Rainbow/Shrinkers.hs b/test/Rainbow/Shrinkers.hs new file mode 100644 --- /dev/null +++ b/test/Rainbow/Shrinkers.hs @@ -0,0 +1,7 @@ +module Rainbow.Shrinkers + ( module Rainbow.Types.Shrinkers + , module Rainbow.Colors.Shrinkers + ) where + +import Rainbow.Types.Shrinkers +import Rainbow.Colors.Shrinkers diff --git a/test/Rainbow/Types/Coarbitrary.hs b/test/Rainbow/Types/Coarbitrary.hs new file mode 100644 --- /dev/null +++ b/test/Rainbow/Types/Coarbitrary.hs @@ -0,0 +1,55 @@ +module Rainbow.Types.Coarbitrary where + +import Test.QuickCheck +import Data.Monoid.Coarbitrary +import Data.Text.Coarbitrary +import qualified Rainbow.Types as T +import Prelude hiding (last, maybe) +import Barecheck.Util +import Prelude.Coarbitrary + +enum8 :: T.Enum8 -> Gen b -> Gen b +enum8 e = case e of + T.E0 -> varInt 0 + T.E1 -> varInt 1 + T.E2 -> varInt 2 + T.E3 -> varInt 3 + T.E4 -> varInt 4 + T.E5 -> varInt 5 + T.E6 -> varInt 6 + T.E7 -> varInt 7 + +color8 :: T.Color8 -> Gen b -> Gen b +color8 (T.Color8 me) = maybe enum8 me + +color256 :: T.Color256 -> Gen b -> Gen b +color256 (T.Color256 me) = maybe variant me + +styleCommon :: T.StyleCommon -> Gen b -> Gen b +styleCommon c + = last coarbitrary (T.scBold c) + . last coarbitrary (T.scUnderline c) + . last coarbitrary (T.scFlash c) + . last coarbitrary (T.scInverse c) + +style8 :: T.Style8 -> Gen b -> Gen b +style8 c + = last color8 (T.foreground8 c) + . last color8 (T.background8 c) + . styleCommon (T.common8 c) + +style256 :: T.Style256 -> Gen b -> Gen b +style256 c + = last color256 (T.foreground256 c) + . last color256 (T.background256 c) + . styleCommon (T.common256 c) + +textSpec :: T.TextSpec -> Gen b -> Gen b +textSpec c + = style8 (T.style8 c) + . style256 (T.style256 c) + +chunk :: T.Chunk -> Gen b -> Gen b +chunk c + = textSpec (T.textSpec c) + . list text (T.text c) diff --git a/test/Rainbow/Types/Generators.hs b/test/Rainbow/Types/Generators.hs new file mode 100644 --- /dev/null +++ b/test/Rainbow/Types/Generators.hs @@ -0,0 +1,52 @@ +module Rainbow.Types.Generators where + +import Data.Monoid.Generators +import qualified Rainbow.Types as T +import Test.QuickCheck +import Control.Monad +import Data.Text.Generators +import Prelude.Generators +import Prelude hiding (last, maybe) + + +enum8 :: Gen T.Enum8 +enum8 = elements [minBound..maxBound] + +color8 :: Gen T.Color8 +color8 = fmap T.Color8 $ maybe enum8 + +color256 :: Gen T.Color256 +color256 = fmap T.Color256 $ maybe (elements [minBound..maxBound]) + +background8 :: Gen T.Background8 +background8 = last color8 + +background256 :: Gen T.Background256 +background256 = last color256 + +foreground8 :: Gen T.Foreground8 +foreground8 = last color8 + +foreground256 :: Gen T.Foreground256 +foreground256 = last color256 + +styleCommon :: Gen T.StyleCommon +styleCommon = liftM4 T.StyleCommon g g g g + where + g = last arbitrary + +style8 :: Gen T.Style8 +style8 = liftM3 T.Style8 g g styleCommon + where + g = last color8 + +style256 :: Gen T.Style256 +style256 = liftM3 T.Style256 g g styleCommon + where + g = last color256 + +textSpec :: Gen T.TextSpec +textSpec = liftM2 T.TextSpec style8 style256 + +chunk :: Gen T.Chunk +chunk = liftM2 T.Chunk textSpec (listOf (text arbitrary)) diff --git a/test/Rainbow/Types/Shrinkers.hs b/test/Rainbow/Types/Shrinkers.hs new file mode 100644 --- /dev/null +++ b/test/Rainbow/Types/Shrinkers.hs @@ -0,0 +1,64 @@ +module Rainbow.Types.Shrinkers where + +import Data.Text.Shrinkers +import Data.Monoid.Shrinkers +import Test.QuickCheck + ( shrinkIntegral, shrink ) + +-- be sure to import shrinkList from Test.QuickCheck.Arbitrary to +-- maintain compatibility between QuickCheck 2.6 and 2.7 +import Test.QuickCheck.Arbitrary ( shrinkList ) +import qualified Rainbow.Types as T +import Prelude hiding (last) +import Prelude.Shrinkers + +enum8 :: T.Enum8 -> [T.Enum8] +enum8 e = case e of + T.E0 -> [] + T.E1 -> [T.E0] + T.E2 -> [T.E0, T.E1] + T.E3 -> [T.E0, T.E1, T.E2] + T.E4 -> [T.E0, T.E1, T.E2, T.E3] + T.E5 -> [T.E0, T.E1, T.E2, T.E3, T.E4] + T.E6 -> [T.E0, T.E1, T.E2, T.E3, T.E4, T.E5] + T.E7 -> [T.E0, T.E1, T.E2, T.E3, T.E4, T.E5, T.E6] + +color8 :: T.Color8 -> [T.Color8] +color8 (T.Color8 me) = case me of + Nothing -> [] + Just e -> map T.Color8 $ Nothing : map Just (enum8 e) + +color256 :: T.Color256 -> [T.Color256] +color256 (T.Color256 me) = case me of + Nothing -> [] + Just e -> map T.Color256 $ Nothing : map Just (shrinkIntegral e) + +styleCommon :: T.StyleCommon -> [T.StyleCommon] +styleCommon (T.StyleCommon a b c d) = + [ T.StyleCommon a' b' c' d' + | (a', b', c', d') <- tuple4 s s s s (a, b, c, d) ] + where + s = last shrink + +style8 :: T.Style8 -> [T.Style8] +style8 (T.Style8 f8 b8 c) = + [ T.Style8 f8' b8' c' + | (f8', b8', c') <- tuple3 sc sc styleCommon (f8, b8, c) ] + where + sc = last color8 + +style256 :: T.Style256 -> [T.Style256] +style256 (T.Style256 f256 b256 c) = + [ T.Style256 f256' b256' c' + | (f256', b256', c') <- tuple3 sc sc styleCommon (f256, b256, c) ] + where + sc = last color256 + +textSpec :: T.TextSpec -> [T.TextSpec] +textSpec (T.TextSpec s8 s256) = + [ T.TextSpec s8' s256' + | (s8', s256') <- tuple2 style8 style256 (s8, s256) ] + +chunk :: T.Chunk -> [T.Chunk] +chunk (T.Chunk t xs) = [T.Chunk t' xs' + | (t', xs') <- tuple2 textSpec (shrinkList (text shrink)) (t, xs) ] diff --git a/test/Rainbox/Array2dTests.hs b/test/Rainbox/Array2dTests.hs --- a/test/Rainbox/Array2dTests.hs +++ b/test/Rainbox/Array2dTests.hs @@ -5,6 +5,7 @@ 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. @@ -109,7 +110,7 @@ -> Bool propRoundTripRows ay = sameShape ay ay' where - ay' = arrayByRows . rows $ ay + ay' = arrayByRows undefined . rows $ ay -- | Round-tripping through columns and arrayByCols propRoundTripCols @@ -118,7 +119,7 @@ -> Bool propRoundTripCols ay = sameShape ay ay' where - ay' = arrayByCols . cols $ ay + 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 @@ -309,6 +310,9 @@ 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" $ @@ -330,6 +334,15 @@ , 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) -> diff --git a/test/Rainbox/Box/PrimitivesTests.hs b/test/Rainbox/Box/PrimitivesTests.hs --- a/test/Rainbox/Box/PrimitivesTests.hs +++ b/test/Rainbox/Box/PrimitivesTests.hs @@ -9,7 +9,7 @@ import qualified Data.Text as X import qualified Rainbow.Generators as G import Rainbox.Box.Primitives -import Rainbox.Box (backgroundToTextSpec) +import Data.Monoid genText :: Gen X.Text genText = fmap X.pack $ listOf c @@ -31,12 +31,9 @@ nonNeg = fmap abs arbitrarySizedIntegral neg = fmap (negate . abs) arbitrarySizedIntegral -genBackground :: Gen Background -genBackground = fmap Background G.radiant - -- | Generates blank Box. genBlankBox :: Gen Box -genBlankBox = liftM3 blank genBackground rw cl +genBlankBox = liftM3 blank G.radiant rw cl where rw = fmap (Height . abs) arbitrarySizedIntegral cl = fmap (Width . abs) arbitrarySizedIntegral @@ -48,7 +45,7 @@ -- | Generates a box using catH. genCatHBox :: Gen Box genCatHBox = sized $ \s -> do - bk <- genBackground + bk <- G.radiant av <- genAlignVert bs <- listOf (resize (s `div` 2) genBox) return $ catH bk av bs @@ -56,7 +53,7 @@ -- | Generates a box using catV. genCatVBox :: Gen Box genCatVBox = sized $ \s -> do - bk <- genBackground + bk <- G.radiant ah <- genAlignHoriz bs <- listOf (resize (s `div` 2) genBox) return $ catV bk ah bs @@ -65,11 +62,10 @@ genBox :: Gen Box genBox = oneof [ genBlankBox, genCatHBox, genCatVBox, genChunkBox ] -genChunkLen :: Background -> Int -> Gen Chunk +genChunkLen :: Radiant -> Int -> Gen Chunk genChunkLen bk l = do - let ts = backgroundToTextSpec bk txt <- fmap X.pack $ vectorOf l (elements ['0'..'Z']) - return $ Chunk ts [txt] + return $ (fromText txt) <> back bk -- | Generates a box of text; its horizontal and vertical size -- depends on the size parameter. @@ -77,10 +73,10 @@ genTextBox = do w <- fmap abs arbitrarySizedIntegral h <- fmap abs arbitrarySizedIntegral - bk <- genBackground + bk <- G.radiant cks <- vectorOf h (genChunkLen bk w) let bxs = map (chunks . (:[])) cks - bk' <- genBackground + bk' <- G.radiant return $ catV bk' left bxs @@ -106,7 +102,7 @@ data Inputs = Inputs { iChunks :: [Chunk] - , iBackground :: Background + , iBackground :: Radiant , iHeight :: Height , iWidth :: Width , iVert :: Align Vert @@ -119,7 +115,7 @@ instance Arbitrary Inputs where arbitrary = Inputs <$> listOf genChunk - <*> genBackground + <*> G.radiant <*> genHeight <*> genWidth <*> genAlignVert diff --git a/test/Rainbox/Instances.hs b/test/Rainbox/Instances.hs new file mode 100644 --- /dev/null +++ b/test/Rainbox/Instances.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | QuickCheck instances for all Rainbox modules. +module Rainbox.Instances where + +import Control.Monad +import Test.QuickCheck +import Rainbow.QuickCheck () +import Rainbox +import Rainbox.Box + +instance Arbitrary Height where + arbitrary = fmap Height arbitrary + +instance Arbitrary Width where + arbitrary = fmap Width arbitrary + +instance Arbitrary (Align Vert) where + arbitrary = elements [center, top, bottom] + +instance Arbitrary (Align Horiz) where + arbitrary = elements [center, left, right] + +instance Arbitrary Bar where + arbitrary = fmap Bar arbitrary + +-- | Creates a non-nested Box. +instance Arbitrary Box where + arbitrary = liftM3 barsToBox arbitrary arbitrary arbitrary + +instance Arbitrary Cell where + arbitrary = liftM4 Cell arbitrary arbitrary arbitrary arbitrary diff --git a/test/Visual.hs b/test/Visual.hs --- a/test/Visual.hs +++ b/test/Visual.hs @@ -11,6 +11,7 @@ import Rainbox.Box.PrimitivesTests import Data.String import Data.Word (Word8) +import qualified Rainbow.Colors.Generators as RG colors = fore yellow <> back blue @@ -20,17 +21,13 @@ wide = "a wide box, see how wide I am?" <> colors -greenBack = Background (Radiant green8 Nothing) - -yellowBack = Background (Radiant yellow8 Nothing) - all3 = [narrow, midwidth, wide] short = chunk narrow -midheight = catV greenBack left . map chunk $ [narrow, midwidth] +midheight = catV green left . map chunk $ [narrow, midwidth] -tall = catV greenBack left . map chunk $ [narrow, midwidth, wide] +tall = catV green left . map chunk $ [narrow, midwidth, wide] sizeParam = 7 @@ -43,16 +40,16 @@ putBox b putStrLn "" -testCompound :: String -> (Background -> [Box] -> Box) -> IO () +testCompound :: String -> (Radiant -> [Box] -> Box) -> IO () testCompound d f = do g <- newQCGen let bxs = unGen (replicateM 5 genTextBox) g sizeParam - bk = unGen genBackground g sizeParam + bk = unGen RG.radiant g sizeParam describe d $ f bk bxs testVert :: String - -> (Background -> Align Vert -> [Box] -> Box) + -> (Radiant -> Align Vert -> [Box] -> Box) -> IO () testVert d f = do testCompound (d ++ ", top align") (\bk bxs -> f bk top bxs) @@ -61,7 +58,7 @@ testHoriz :: String - -> (Background -> Align Horiz -> [Box] -> Box) + -> (Radiant -> Align Horiz -> [Box] -> Box) -> IO () testHoriz d f = do testCompound (d ++ ", left align") (\bk bxs -> f bk left bxs) @@ -70,7 +67,7 @@ -- | Makes a 10x10 test box. testBox :: Box -testBox = catV defaultBackground left . map mkLine $ clrs +testBox = catV noColorRadiant left . map mkLine $ clrs where mkLine clr = chunk $ txt <> clr txt = fromString ['0'..'9'] @@ -123,9 +120,7 @@ testVert "punctuateH" (\bk av bxs -> punctuateH bk av " " bxs) testHoriz "punctuateV" (\bk ah bxs -> punctuateV bk ah " " bxs) - let grn = Background (Radiant green8 Nothing) - - testHoriz "column" (\bk ah bxs -> catV defaultBackground left + testHoriz "column" (\bk ah bxs -> catV noColorRadiant left (column bk ah bxs)) describe "original box for following tests, 10x10" testBox @@ -136,17 +131,17 @@ singleV "viewV, 3" (\av -> viewV 3 av testBox) single "grow, 13x13" - (\av ah -> grow grn (Height 13) (Width 13) av ah testBox) - singleH "growH, 13" (\ah -> growH grn 13 ah testBox) - singleV "growV, 13" (\av -> growV grn 13 av testBox) + (\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 grn (Height 13) (Width 13) av ah testBox) - singleH "resizeH, 13" (\ah -> resizeH grn 13 ah testBox) - singleV "resizeV, 13" (\av -> resizeV grn 13 av testBox) + (\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 grn (Height 7) (Width 7) av ah testBox) - singleH "resizeH, 7" (\ah -> resizeH grn 7 ah testBox) - singleV "resizeV, 7" (\av -> resizeV grn 7 av testBox) + (\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) diff --git a/test/rainbox-grid.hs b/test/rainbox-grid.hs new file mode 100644 --- /dev/null +++ b/test/rainbox-grid.hs @@ -0,0 +1,13 @@ +-- | 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 diff --git a/test/rainbox-mosaic.hs b/test/rainbox-mosaic.hs --- a/test/rainbox-mosaic.hs +++ b/test/rainbox-mosaic.hs @@ -4,17 +4,15 @@ -- it out. Always uses colors. module Main where -import Test.QuickCheck.Gen +import Test.QuickCheck import Rainbox.Box.PrimitivesTests import System.Environment -import System.Random import Rainbox.Box -import System.Console.Rainbow +import Rainbow main :: IO () main = do - g <- newStdGen s:[] <- getArgs - let bx = unGen genBox g (read s) + bx <- generate (Test.QuickCheck.resize (read s) genBox) e <- termFromEnv putChunks e . render $ bx