rainbox 0.16.0.0 → 0.18.0.0
raw patch · 6 files changed
+92/−49 lines, 6 filesdep +lens
Dependencies added: lens
Files
- lib/Rainbox.hs +4/−0
- lib/Rainbox/Core.hs +73/−42
- lib/Rainbox/Tutorial.hs +1/−1
- rainbox.cabal +12/−3
- test/Rainbow/Instances.hs +0/−1
- test/Rainbox/Instances.hs +2/−2
lib/Rainbox.hs view
@@ -42,6 +42,10 @@ -- * Tables , Cell(..)+ , rows+ , horizontal+ , vertical+ , background , tableByRows , tableByColumns , separator
lib/Rainbox/Core.hs view
@@ -1,6 +1,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE TemplateHaskell #-} {-# 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@@ -9,11 +13,12 @@ import Rainbow import Control.Monad (join)-import Data.Monoid+import Control.Lens hiding (below) import Rainbow.Types (Chunk(..))-import Data.Sequence (Seq, ViewL(..), viewl, (|>), (<|))-import qualified Data.Foldable as F+import Data.Sequence (Seq, ViewL(..), viewl) import qualified Data.Sequence as Seq+import qualified Data.Foldable as F+import qualified Data.Traversable as T import Data.Text (Text) import qualified Data.Text as X import qualified Data.Map as M@@ -23,16 +28,27 @@ -- | 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)+ deriving (Eq, Ord, Show, Functor, F.Foldable, T.Traversable) +-- | 'mempty' is 'center'. 'mappend' takes the rightmost non-'center'+-- value.++instance Monoid (Alignment a) where+ mempty = Center+ mappend x y = case x of+ Center -> y+ NonCenter a -> case y of+ Center -> NonCenter a+ NonCenter b -> NonCenter b+ -- # Horizontal and vertical -- | Determines how a payload aligns with a horizontal axis.-data Horizontal = ATop | ABottom+data Horizontal = Top | Bottom deriving (Eq, Ord, Show) -- | Determines how a payload aligns with a vertical axis.-data Vertical = ALeft | ARight+data Vertical = Port | Starboard deriving (Eq, Ord, Show) -- | Place this payload so that it is centered on the vertical axis or@@ -50,19 +66,19 @@ -- | Place this payload's left edge on the vertical axis. left :: Alignment Vertical-left = NonCenter ALeft+left = NonCenter Port -- | Place this payload's right edge on the vertical axis. right :: Alignment Vertical-right = NonCenter ARight+right = NonCenter Starboard -- | Place this payload's top edge on the horizontal axis. top :: Alignment Horizontal-top = NonCenter ATop+top = NonCenter Top -- | Place this payload's bottom edge on the horizontal axis. bottom :: Alignment Horizontal-bottom = NonCenter ABottom+bottom = NonCenter Bottom -- # Width and height@@ -247,6 +263,13 @@ RodRowsWithHeight sq' -> Seq.zipWith (<>) acc sq' RodRowsNoHeight _ -> error "horizontalMerge: error 2" +-- | 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+ -- | 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@@ -273,12 +296,12 @@ lenLin = F.sum . fmap width $ lin lenLft = case a of Center -> maxLeft - (fst . split $ lenLin)- NonCenter ALeft -> maxLeft- NonCenter ARight -> maxLeft - lenLin+ NonCenter Port -> maxLeft+ NonCenter Starboard -> maxLeft - lenLin lenRgt = case a of Center -> maxRight - (snd . split $ lenLin)- NonCenter ALeft -> maxRight - lenLin- NonCenter ARight -> maxRight+ NonCenter Port -> maxRight - lenLin+ NonCenter Starboard -> maxRight padder len | len < 1 = Seq.empty | otherwise = Seq.singleton . Rod . Left $ (len, rd)@@ -343,7 +366,7 @@ rodRows = verticalMerge . addHorizontalPadding spacer r i = Box . Seq.singleton $- Payload (NonCenter ALeft) r (Right . Core . Right $+ Payload (NonCenter Port) r (Right . Core . Right $ (Height (max 0 i), Width 0)) spreader a i = Box . Seq.singleton $ Payload a mempty (Right . Core . Right $@@ -353,7 +376,7 @@ rodRows = horizontalMerge . addVerticalPadding spacer r i = Box . Seq.singleton $- Payload (NonCenter ATop) r (Right . Core . Right $+ Payload (NonCenter Top) r (Right . Core . Right $ (Height 0, Width (max 0 i))) spreader a i = Box . Seq.singleton $ Payload a mempty (Right . Core . Right $@@ -380,24 +403,24 @@ instance LeftRight (Payload Vertical) where port (Payload a _ ei) = case a of- NonCenter ALeft -> 0- NonCenter ARight -> width ei+ NonCenter Port -> 0+ NonCenter Starboard -> width ei Center -> fst . split . width $ ei starboard (Payload a _ s3) = case a of- NonCenter ALeft -> width s3- NonCenter ARight -> 0+ NonCenter Port -> width s3+ NonCenter Starboard -> 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+ NonCenter Top -> 0+ NonCenter Bottom -> height s3 Center -> fst . split . height $ s3 below (Payload a _ s3) = case a of- NonCenter ATop -> height s3- NonCenter ABottom -> 0+ NonCenter Top -> height s3+ NonCenter Bottom -> 0 Center -> snd . split . height $ s3 instance LeftRight (Box Vertical) where@@ -473,22 +496,41 @@ -- | A single cell in a spreadsheet-like grid. data Cell = Cell- { cellRows :: Seq (Seq (Chunk Text))+ { _rows :: Seq (Seq (Chunk Text)) -- ^ The cell can have multiple rows of text; there is one 'Seq' for -- each row of text.- , cellHoriz :: Alignment Horizontal+ , _horizontal :: Alignment Horizontal -- ^ How this 'Cell' should align compared to other 'Cell' in its -- row.- , cellVert :: Alignment Vertical+ , _vertical :: Alignment Vertical -- ^ How this 'Cell' should align compared to other 'Cell' in its column.- , cellBackground :: Radiant+ , _background :: 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.- }+ } deriving (Eq, Ord, Show) +makeLenses ''Cell++-- | 'mappend' combines two 'Cell' horizontally so they are+-- side-by-side, left-to-right. The '_horizontal', '_vertical', and+-- '_background' fields are combined using their respective 'Monoid'+-- instances. 'mempty' uses the respective 'mempty' value for each+-- field.+instance Monoid Cell where+ mempty = Cell mempty mempty mempty mempty+ mappend (Cell rx hx vx bx) (Cell ry hy vy by)+ = Cell (zipSeqs rx ry) (hx <> hy) (vx <> vy) (bx <> by)+ where+ zipSeqs x y = Seq.zipWith (<>) x' y'+ where+ x' = x <> Seq.replicate+ (max 0 (Seq.length y - Seq.length x)) Seq.empty+ y' = y <> Seq.replicate+ (max 0 (Seq.length x - Seq.length y)) Seq.empty+ -- | Creates a blank 'Cell' with the given background color and width; -- useful for adding separators between columns. separator :: Radiant -> Int -> Cell@@ -496,10 +538,6 @@ where ck = (chunk $ X.replicate (max 0 i) " ") & back rd -emptyCell :: Cell-emptyCell = Cell Seq.empty center center mempty-- -- Cells by row: -- 0. Ensure each row is equal length -- 1. Create one BoxV for each cell@@ -524,7 +562,7 @@ . uncurry padBoxV . addWidthMap . fmap (fmap cellToBoxV)- . equalize emptyCell+ . equalize mempty rowToBoxV :: Box Horizontal -> Box Vertical rowToBoxV = wrap center mempty@@ -596,7 +634,7 @@ . uncurry padBoxH . addHeightMap . fmap (fmap cellToBoxH)- . equalize emptyCell+ . equalize mempty rowToBoxH :: Box Vertical -> Box Horizontal@@ -674,11 +712,4 @@ 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
lib/Rainbox/Tutorial.hs view
@@ -39,7 +39,7 @@ 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+The vertical payload also has a background color, which has 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'
rainbox.cabal view
@@ -3,11 +3,11 @@ -- http://www.github.com/massysett/cartel -- -- Script name used to generate: genCabal.hs--- Generated on: 2015-04-26 13:36:49.036797 EDT+-- Generated on: 2015-07-14 18:32:37.563738 EDT -- Cartel library version: 0.14.2.6 name: rainbox-version: 0.16.0.0+version: 0.18.0.0 cabal-version: >= 1.18 license: BSD3 license-file: LICENSE@@ -17,7 +17,7 @@ maintainer: omari@smileystation.com stability: Experimental homepage: http://www.github.com/massysett/rainbox-bug-reports: http://www.github.com/massyett/rainbox/issues+bug-reports: http://www.github.com/massysett/rainbox/issues synopsis: Two-dimensional box pretty printing, with colors description: Prints boxes in two dimensions, with colors. Boxes are@@ -47,6 +47,9 @@ , bytestring >= 0.10 && < 0.11 , containers >= 0.5.5 && < 0.6 , text >= 0.11.3.1 && < 1.3.0.0+ , lens >= 4.9+ other-extensions:+ TemplateHaskell source-repository head type: git@@ -60,6 +63,7 @@ , bytestring >= 0.10 && < 0.11 , containers >= 0.5.5 && < 0.6 , text >= 0.11.3.1 && < 1.3.0.0+ , lens >= 4.9 , tasty >= 0.10.1 && < 0.11 , tasty-quickcheck >= 0.8.1 && < 0.9 , QuickCheck >= 2.7 && < 2.9@@ -76,6 +80,8 @@ Rainbow.Instances Rainbox.Instances type: exitcode-stdio-1.0+ other-extensions:+ TemplateHaskell Test-Suite rainbox-visual main-is: rainbox-visual.hs@@ -85,6 +91,7 @@ , bytestring >= 0.10 && < 0.11 , containers >= 0.5.5 && < 0.6 , text >= 0.11.3.1 && < 1.3.0.0+ , lens >= 4.9 , tasty >= 0.10.1 && < 0.11 , tasty-quickcheck >= 0.8.1 && < 0.9 , QuickCheck >= 2.7 && < 2.9@@ -101,3 +108,5 @@ Rainbow.Instances Rainbox.Instances type: exitcode-stdio-1.0+ other-extensions:+ TemplateHaskell
test/Rainbow/Instances.hs view
@@ -13,7 +13,6 @@ module Rainbow.Instances where -import Control.Applicative import Test.QuickCheck import Rainbow.Types import qualified Data.Text as X
test/Rainbox/Instances.hs view
@@ -12,10 +12,10 @@ arbitrary = oneof [ return Center, fmap NonCenter arbitrary ] instance Arbitrary Horizontal where- arbitrary = elements [ ATop, ABottom ]+ arbitrary = elements [ Top, Bottom ] instance Arbitrary Vertical where- arbitrary = elements [ ALeft, ARight ]+ arbitrary = elements [ Port, Starboard ] instance Arbitrary Height where arbitrary = fmap Height $ frequency