packages feed

rainbow 0.20.4.0 → 0.22.0.0

raw patch · 10 files changed

+1269/−320 lines, 10 filesdep +QuickCheckdep +bytestringdep +processdep −terminfodep ~basenew-component:exe:colorTestnew-component:exe:test256colornew-component:exe:test8color

Dependencies added: QuickCheck, bytestring, process

Dependencies removed: terminfo

Dependency ranges changed: base

Files

lib/Rainbow.hs view
@@ -1,7 +1,4 @@--- | Handles colors and special effects for text. Internally this--- module uses the Haskell terminfo library, which links against the--- UNIX library of the same name, so it should work with a wide--- variety of UNIX terminals.+-- | Rainbow handles colors and special effects for text. -- -- The building block of Rainbow is the 'Chunk'. Each 'Chunk' comes with -- a 'TextSpec', which specifies how the text should look on 8-color@@ -14,19 +11,20 @@ -- for 8 and 256 color terminals; for instance, you can have text -- appear red on an 8-color terminal but blue on a 256-color terminal. ----- A 'Chunk' is a 'Data.Monoid.Monoid', so you can combine them using--- the usual monoid functions, including 'Data.Monoid.<>'. You can+-- A 'Chunk' is a 'Monoid', so you can combine them using+-- the usual monoid functions, including '<>'. You can -- create a 'Chunk' with text using 'Data.String.fromString', but this -- library is much more usable if you enable the OverloadedStrings GHC -- extension: -- -- > {-# LANGUAGE OverloadedStrings #-} ----- and all future examples assume you have enabled OverloadedStrings.--- You will also want the Monoid module in scope:+-- or, in GHCi: ----- > import Data.Monoid+-- >>> :set -XOverloadedStrings --+-- and all future examples assume you have enabled OverloadedStrings.+-- -- Here are some basic examples: -- -- @@@ -40,7 +38,7 @@ -- But what makes Rainbow a little more interesting is that you can -- also specify output for 256-color terminals. To use these examples, -- be sure your TERM environment variable is set to something that--- supports 256 colors (like @xterm-256color@) before you start GHCi:+-- supports 256 colors (like @xterm-256color@) before you start GHCi. -- -- @ -- 'putChunkLn' $ \"Blue on 8-color terminal, red on 256-color terminal\"@@ -53,12 +51,11 @@ -- as it can't be inferred: -- -- @--- import Data.Word ('Data.Word.Word8') -- 'putChunkLn' $ \"Pink on 256-color terminal only\"---                \<> 'fore' (201 :: 'Data.Word.Word8')+--                \<> 'fore' (201 :: 'Word8') -- @ ----- If 'mappend' multiple chunks that change the same property, the+-- If you 'mappend' multiple chunks that change the same property, the -- rightmost one \"wins\": -- -- @@@ -71,7 +68,7 @@ -- -- @ -- 'putChunkLn' $ \"Red on 8-color, pink on 256-color\"---                \<> 'fore' 'red' \<> 'fore' (201 :: 'Data.Word.Word8')+--                \<> 'fore' 'red' \<> 'fore' (201 :: 'Word8') -- @ -- -- However, if you use 'mappend' to add additional 'Chunk's that have@@ -91,37 +88,12 @@ module Rainbow   ( -  -- * Terminal definitions-    Term(..)-  , termFromEnv-  , smartTermFromEnv-   -- * Chunks-  , Chunk(..)-  , fromText-  , fromLazyText--  -- * Printing chunks-  , putChunks-  , hPutChunks--  -- ** Printing one chunk at a time--  -- | These functions make it easy to print one chunk at a time. Each-  -- function initializes the terminal once for each chunk, unlike the-  -- list-oriented functions, which only initialize the terminal-  -- once. (Initialization does not clear the screen; rather, it is a-  -- process that the terminfo library requires.) Thus there might be-  -- a performance penalty for using these functions to print large-  -- numbers of chunks. Or, there might not be--I have not benchmarked-  -- them.-  ---  -- These functions use the default terminal, obtained using-  -- 'termFromEnv'.-  , putChunk-  , putChunkLn-  , hPutChunk-  , hPutChunkLn+    Chunk+  , chunkFromText+  , chunkFromTexts+  , chunkFromLazyText+  , chunkFromLazyTexts    -- * Effects for both 8 and 256 color terminals @@ -132,9 +104,13 @@   -- @    , bold+  , faint+  , italic   , underline-  , flash+  , blink   , inverse+  , invisible+  , strikeout    -- * Effects for 8-color terminals only @@ -145,9 +121,13 @@   -- @    , bold8+  , faint8+  , italic8   , underline8-  , flash8+  , blink8   , inverse8+  , invisible8+  , strikeout8    -- * Effects for 256-color terminals only @@ -160,9 +140,13 @@   -- @    , bold256+  , faint256+  , italic256   , underline256-  , flash256+  , blink256   , inverse256+  , invisible256+  , strikeout256    -- * Colors @@ -209,7 +193,138 @@   , brightWhite   , to256 +  -- * Converting 'Chunk' to 'Data.ByteString.ByteString'++  -- | To print a 'Chunk', you need to convert it to some+  -- 'Data.ByteString.ByteString's.+  --+  -- All these functions convert the 'Data.Text' to UTF-8+  -- 'Data.ByteString.ByteString's.  Many of these functions return a+  -- difference list.  Learn You a Haskell for Great Good has a great+  -- explanation of difference lists:+  --+  -- http://learnyouahaskell.com/for-a-few-monads-more+  --+  -- If you don't want to learn about difference lists, just stick+  -- with using 'chunksToByteStrings' and use+  -- 'byteStringMakerFromEnvironment' if you want to use the highest+  -- number of colors possible, or, to manually specify the number of+  -- colors, use 'chunksToByteStrings' with 'toByteStringsColors0',+  -- 'toByteStringsColors8', or 'toByteStringsColors256' as the first+  -- argument.  'chunksToByteStrings' has an example.+  , byteStringMakerFromEnvironment+  , byteStringMakerFromHandle+  , toByteStringsColors0+  , toByteStringsColors8+  , toByteStringsColors256+  , chunksToByteStrings++  -- * Quick and dirty functions for IO++  -- | For efficiency reasons you probably don't want to use these+  -- when printing large numbers of 'Chunk', but they are handy for+  -- throwaway uses like experimenting in GHCi.+  , putChunk+  , putChunkLn++  -- * Re-exports+  -- $reexports+  -- | * "Data.Monoid" re-exports '<>' and 'mempty'+  --+  -- +  , module Data.Monoid+  , module Data.ByteString+  , module Data.Text+  , module Data.Word++  -- * Notes on terminals+  -- $termNotes+   ) where  import Rainbow.Types import Rainbow.Colors+import Rainbow.Translate+  ( byteStringMakerFromEnvironment+  , byteStringMakerFromHandle+  , toByteStringsColors0+  , toByteStringsColors8+  , toByteStringsColors256+  , chunksToByteStrings+  , putChunk+  , putChunkLn+  )+import Data.Monoid (Monoid, (<>), mempty)+import Data.Text (Text)+import Data.ByteString (ByteString)+import Data.Word (Word8)++{- $reexports++   * "Data.Monoid" re-exports 'Monoid', '<>' and 'mempty'++   * "Data.ByteString" re-exports 'ByteString'++   * "Data.Text" re-exports 'Text'++   * "Data.Word" re-exports 'Word8'+-}++{- $termNotes++Earlier versions of Rainbow used the Haskell terminfo library for+dealing with the terminal.  Terminfo is available at++<https://hackage.haskell.org/package/terminfo>++Terminfo, in turn, uses the UNIX terminfo library.  The biggest+advantage of using Terminfo is that it is compatible with a huge+variety of terminals.  Many of these terminals are hardware models+that are gathering dust in an IBM warehouse somewhere, but even modern+software terminals might have quirks.  Terminfo covers all those.++The disadvantage is that using Terminfo requires you to perform IO+whenever you need to format output for the terminal.  Your only choice+when using Terminfo is to send output directly to the terminal, or to+a handle.  This goes against typical Haskell practice, where we try to+write pure code whenever possible.++Perhaps surprisingly, there are times where you may want to format+output, but not immediately send it to the terminal.  Maybe you want+to send it to a file instead, or maybe you want to use a Haskell+library like Pipes and stream it somewhere.  Terminfo is a binding to+a Unix library that is not designed for this sort of thing.  The+closest you could get using Terminfo would be to make a Handle that is+backed by a in-memory buffer.  There is a package for that sort of+thing:++<http://hackage.haskell.org/package/knob>++but it seems like a nasty workaround.  Or you can hijack stdout and+send that somewhere--again, nasty workaround.++So I decided to stop using Terminfo.  That means Rainbow no longer+supports a menagerie of bizarre terminals.  It instead just uses the+standard ISO 6429 / ECMA 48 terminal codes.  These are the same codes+that are used by xterm, the OS X Terminal, the Linux console, or any+other reasonably modern software terminal.  Realistically they are the+only terminals Rainbow would be used for.++The 256 color capability is not in ISO 6429, but it is widely supported.++Probably the most common so-called terminals in use today that do NOT+support the ISO 6429 codes are those that are not really terminals.+For instance, you might use an Emacs shell buffer.  For those+situations just use 'toByteStringsColors0'.++I also decided to standardize on UTF-8 for the 'Text' output..  These+days that seems reasonable.++Now, to figure out how many colors the terminal supports, Rainbow+simply uses the @tput@ program.  This removes the dependency on+Terminfo altogether.++Apparently it's difficult to get ISO 6429 support on Microsoft+Windows.  Oh well.++-}
lib/Rainbow/Colors.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-} -- | Ordinarily you should not need this module; typically you will -- just import "Rainbow", which re-exports the most useful things from -- this module.  This module also contains data constructors that@@ -8,6 +9,8 @@ import Rainbow.Types import Data.Monoid import Data.Word (Word8)+import GHC.Generics+import Data.Typeable  -- * 8 color @@ -83,7 +86,7 @@   { rad8 :: Color8   , rad256 :: Maybe Color256   -- ^ If 'Nothing', use the 'rad8' color on 256-color terminals.-  } deriving (Eq, Ord, Show)+  } deriving (Eq, Ord, Show, Generic, Typeable)  -- | A Radiant with the same color for both 8- and 256-color -- terminals.
+ lib/Rainbow/Translate.hs view
@@ -0,0 +1,338 @@+{-# LANGUAGE OverloadedStrings #-}+module Rainbow.Translate where++import Data.Monoid+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString as BS+import Data.ByteString (ByteString)+import Data.Word+import Data.List (intersperse)+import Rainbow.Types+  ( Color8(..), Enum8(..), Color256(..),+    StyleCommon(..), Style8(..), Style256(..), TextSpec)+import qualified Rainbow.Types as T+import Data.Text.Encoding+import System.Process+import Text.Read+import System.Exit+import Control.Monad+import Control.Exception+import qualified System.IO as IO++single :: Char -> [ByteString] -> [ByteString]+single c = ((BS8.singleton c):)++escape :: [ByteString] -> [ByteString]+escape = single '\x1B'++csi :: [ByteString] -> [ByteString]+csi = escape . single '['++sgr :: ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]+sgr sq = csi . sq . single 'm'++params :: Show a => [a] -> [ByteString] -> [ByteString]+params cs = ((intersperse ";" . map (BS8.pack . show) $ cs) ++)++sgrSingle :: Word -> [ByteString] -> [ByteString]+sgrSingle w = sgr $ params [w]++sgrDouble :: Word -> Word -> [ByteString] -> [ByteString]+sgrDouble x y = sgr $ params [x, y]++normalDefault :: [ByteString] -> [ByteString]+normalDefault = sgrSingle 0++bold :: [ByteString] -> [ByteString]+bold = sgrSingle 1++faint :: [ByteString] -> [ByteString]+faint = sgrSingle 2++italic :: [ByteString] -> [ByteString]+italic = sgrSingle 3++underline :: [ByteString] -> [ByteString]+underline = sgrSingle 4++blink :: [ByteString] -> [ByteString]+blink = sgrSingle 5++-- Yes, blink is 5, inverse is 7; 6 is skipped.  In ISO 6429 6 blinks+-- at a different rate.++inverse :: [ByteString] -> [ByteString]+inverse = sgrSingle 7++invisible :: [ByteString] -> [ByteString]+invisible = sgrSingle 8++strikeout :: [ByteString] -> [ByteString]+strikeout = sgrSingle 9++foreBlack :: [ByteString] -> [ByteString]+foreBlack = sgrSingle 30++foreRed :: [ByteString] -> [ByteString]+foreRed = sgrSingle 31++foreGreen :: [ByteString] -> [ByteString]+foreGreen = sgrSingle 32++foreYellow :: [ByteString] -> [ByteString]+foreYellow = sgrSingle 33++foreBlue :: [ByteString] -> [ByteString]+foreBlue = sgrSingle 34++foreMagenta :: [ByteString] -> [ByteString]+foreMagenta = sgrSingle 35++foreCyan :: [ByteString] -> [ByteString]+foreCyan = sgrSingle 36++foreWhite :: [ByteString] -> [ByteString]+foreWhite = sgrSingle 37++-- code 3 8 is skipped++foreDefault :: [ByteString] -> [ByteString]+foreDefault = sgrSingle 39++backBlack :: [ByteString] -> [ByteString]+backBlack = sgrSingle 40++backRed :: [ByteString] -> [ByteString]+backRed = sgrSingle 41++backGreen :: [ByteString] -> [ByteString]+backGreen = sgrSingle 42++backYellow :: [ByteString] -> [ByteString]+backYellow = sgrSingle 43++backBlue :: [ByteString] -> [ByteString]+backBlue = sgrSingle 44++backMagenta :: [ByteString] -> [ByteString]+backMagenta = sgrSingle 45++backCyan :: [ByteString] -> [ByteString]+backCyan = sgrSingle 46++backWhite :: [ByteString] -> [ByteString]+backWhite = sgrSingle 47++-- code 4 8 is skipped++backDefault :: [ByteString] -> [ByteString]+backDefault = sgrSingle 49++fore256 :: Word8 -> [ByteString] -> [ByteString]+fore256 c = sgr $ params [38,5,c]++back256 :: Word8 -> [ByteString] -> [ByteString]+back256 c = sgr $ params [48,5,c]++foreColor8 :: Color8 -> [ByteString] -> [ByteString]+foreColor8 (Color8 maym8) = case maym8 of+  Nothing -> id+  Just m8 -> case m8 of+    E0 -> foreBlack+    E1 -> foreRed+    E2 -> foreGreen+    E3 -> foreYellow+    E4 -> foreBlue+    E5 -> foreMagenta+    E6 -> foreCyan+    E7 -> foreWhite++backColor8 :: Color8 -> [ByteString] -> [ByteString]+backColor8 (Color8 maym8) = case maym8 of+  Nothing -> id+  Just m8 -> case m8 of+    E0 -> backBlack+    E1 -> backRed+    E2 -> backGreen+    E3 -> backYellow+    E4 -> backBlue+    E5 -> backMagenta+    E6 -> backCyan+    E7 -> backWhite++foreColor256 :: Color256 -> [ByteString] -> [ByteString]+foreColor256 (Color256 mayW8) = case mayW8 of+  Nothing -> id+  Just w8 -> fore256 w8++backColor256 :: Color256 -> [ByteString] -> [ByteString]+backColor256 (Color256 mayW8) = case mayW8 of+  Nothing -> id+  Just w8 -> back256 w8++styleCommon :: StyleCommon -> [ByteString] -> [ByteString]+styleCommon (StyleCommon bld fnt ita und bli ivr isb stk)+  = effect bold bld+  . effect faint fnt+  . effect italic ita+  . effect underline und+  . effect blink bli+  . effect inverse ivr+  . effect invisible isb+  . effect strikeout stk+  where+    effect on = maybe id (\x -> if x then on else id)+      . getLast++style8 :: Style8 -> [ByteString] -> [ByteString]+style8 (Style8 f8 b8 sc)+  = effect foreColor8 f8+  . effect backColor8 b8+  . styleCommon sc+  where+    effect on = maybe id on . getLast++style256 :: Style256 -> [ByteString] -> [ByteString]+style256 (Style256 f256 b256 sc)+  = effect foreColor256 f256+  . effect backColor256 b256+  . styleCommon sc+  where+    effect on = maybe id on . getLast++textSpec8 :: TextSpec -> [ByteString] -> [ByteString]+textSpec8 = style8 . T.style8++textSpec256 :: TextSpec -> [ByteString] -> [ByteString]+textSpec256 = style256 . T.style256++-- | Convert a 'T.Chunk' to a list of 'ByteString'; do not show any+-- colors.  When applied to a 'T.Chunk', this function returns a+-- difference list.+toByteStringsColors0 :: T.Chunk -> [ByteString] -> [ByteString]+toByteStringsColors0 c = ((map encodeUtf8 . T.chunkTexts $ c) ++)++-- | Convert a 'T.Chunk' to a list of 'ByteString'; show eight+-- colors.  When applied to a 'T.Chunk', this function returns a+-- difference list.+toByteStringsColors8 :: T.Chunk -> [ByteString] -> [ByteString]+toByteStringsColors8 c+  = normalDefault+  . textSpec8 (T.chunkTextSpec c)+  . ((map encodeUtf8 . T.chunkTexts $ c) ++)+  . normalDefault++-- | Convert a 'T.Chunk' to a list of 'ByteString'; show 256+-- colors.  When applied to a 'T.Chunk', this function returns a+-- difference list.+toByteStringsColors256 :: T.Chunk -> [ByteString] -> [ByteString]+toByteStringsColors256 c+  = normalDefault+  . textSpec256 (T.chunkTextSpec c)+  . ((map encodeUtf8 . T.chunkTexts $ c) ++)+  . normalDefault+++-- | Spawns a subprocess to read the output of @tput colors@.  If this+-- says there are at least 256 colors are available, returns+-- 'toByteStringsColors256'.  Otherwise, if there are at least 8+-- colors available, returns 'toByteStringsColors8'.  Otherwise,+-- returns 'toByteStringsColors0'.+--+-- If any IO exceptions arise during this process, they are discarded+-- and 'toByteStringsColors0' is returned.+byteStringMakerFromEnvironment+  :: IO (T.Chunk -> [ByteString] -> [ByteString])+byteStringMakerFromEnvironment+  = catcher (fmap f $ readProcessWithExitCode "tput" ["colors"] "")+  where+    f (code, stdOut, _) = maybe toByteStringsColors0 id $ do+      case code of+        ExitFailure _ -> mzero+        _ -> return ()+      numColors <- readMaybe stdOut+      return $ numColorsToFunc numColors+    numColorsToFunc i+      | i >= (256 :: Int) = toByteStringsColors256+      | i >= 8 = toByteStringsColors8+      | otherwise = toByteStringsColors0++    catcher act = fmap g (try act)+      where+        g (Left e) = toByteStringsColors0+          where _types = e :: IOException+        g (Right good) = good++-- | Like 'byteStringMakerFromEnvironment' but also consults a+-- provided 'Handle'.  If the 'Handle' is not a terminal,+-- 'toByteStringsColors0' is returned.  Otherwise, the value of+-- 'byteStringMakerFromEnvironment' is returned.+byteStringMakerFromHandle+  :: IO.Handle+  -> IO (T.Chunk -> [ByteString] -> [ByteString])+byteStringMakerFromHandle h = IO.hIsTerminalDevice h >>= f+  where+    f isTerm | isTerm = byteStringMakerFromEnvironment+             | otherwise = return toByteStringsColors0+          ++-- | Convert a list of 'T.Chunk' to a list of 'ByteString'.  The+-- length of the returned list may be longer than the length of the+-- input list.+--+-- So, for example, to print a bunch of chunks to standard output+-- using 256 colors:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > module PrintMyChunks where+-- >+-- > import qualified Data.ByteString as BS+-- > import Rainbow+-- >+-- > myChunks :: [Chunk]+-- > myChunks = [ "Roses" <> fore red, "\n", "Violets" <> fore blue, "\n" ]+-- >+-- > myPrintedChunks :: IO ()+-- > myPrintedChunks = mapM_ BS.putStr+-- >                 . chunksToByteStrings toByteStringsColors256+-- >                 $ myChunks+--+-- To use the highest number of colors that this terminal supports:+--+-- > myPrintedChunks' :: IO ()+-- > myPrintedChunks' = do+-- >   printer <- byteStringMakerFromEnvironment+-- >   mapM_ BS.putStr+-- >     . chunksToByteStrings printer+-- >     $ myChunks++chunksToByteStrings+  :: (T.Chunk -> [ByteString] -> [ByteString])+  -- ^ Function that converts 'T.Chunk' to 'ByteString'.  This+  -- function, when applied to a 'T.Chunk', returns a difference list.+  -> [T.Chunk]+  -> [ByteString]+chunksToByteStrings mk = ($ []) . foldr (.) id . map mk++-- Quick and dirty I/O functions++-- | Writes a 'Chunk' to standard output.  Spawns a child process to+-- read the output of @tput colors@ to determine how many colors to+-- use, for every single chunk.  Therefore, this is not going to win+-- any speed awards.  You are better off using 'chunksToByteStrings'+-- and the functions in "Data.ByteString" to print your 'Chunk's if+-- you are printing a lot of them.+putChunk :: T.Chunk -> IO ()+putChunk ck = do+  mkr <- byteStringMakerFromEnvironment+  mapM_ BS.putStr . chunksToByteStrings mkr $ [ck]++-- | Writes a 'Chunk' to standard output, and appends a newline.+-- Spawns a child process to read the output of @tput colors@ to+-- determine how many colors to use, for every single chunk.+-- Therefore, this is not going to win any speed awards.  You are+-- better off using 'chunksToByteStrings' and the functions in+-- "Data.ByteString" to print your 'Chunk's if you are printing a lot+-- of them.+putChunkLn :: T.Chunk -> IO ()+putChunkLn ck = putChunk ck >> putStrLn ""
lib/Rainbow/Types.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}+ -- | The innards of Rainbow.  Ordinarily you should not need this -- module; instead, just import "Rainbow", which -- re-exports the most useful names from this module.@@ -9,55 +11,11 @@ import qualified Data.String as Str import Data.Monoid import Data.Text (Text)-import Data.Maybe (fromMaybe) import qualified Data.Text as X import qualified Data.Text.Lazy as XL-import qualified System.Console.Terminfo as T-import System.IO as IO-import System.Environment as Env import Data.Word (Word8)------- Terminal definitions------- | Which terminal definition to use.-data Term-  = Dumb-  -- ^ Using this terminal should always succeed. This suppresses all-  -- colors. Uesful if output is not going to a TTY, or if you just do-  -- not like colors.--  | TermName String-  -- ^ Use the terminal with this given name. You might get this from-  -- the TERM environment variable, or set it explicitly. A runtime-  -- error will result if the terminfo database does not have a-  -- definition for this terminal. If this terminal supports 256-  -- colors, then 256 colors are used. If this terminal supports less-  -- than 256 colors, but at least 8 colors, then 8 colors are-  -- used. Otherwise, no colors are used.-  deriving (Eq, Show)---- | Gets the terminal definition from the environment. If the--- environment does not have a TERM veriable, use 'Dumb'.-termFromEnv :: IO Term-termFromEnv = do-  t <- fmap (lookup "TERM") Env.getEnvironment-  return $ maybe Dumb TermName t---- | Gets the terminal definition from the environment and a handle.--- If the handle is not a terminal, 'Dumb' is returned.  Otherwise,--- the terminal is obtained from the environment.-smartTermFromEnv-  :: IO.Handle-  -- ^ Check this handle to see if it is a terminal (typically you-  -- will use stdout).--  -> IO Term-smartTermFromEnv h = IO.hIsTerminalDevice h >>= f-  where-    f isTerm | isTerm = termFromEnv-             | otherwise = return Dumb+import GHC.Generics+import Data.Typeable  -- For Background8, Background256, Foreground8, Foreground256: the -- Last wraps a Maybe (Terminfo Color). If the inner Maybe is Nothing,@@ -82,7 +40,7 @@   | E5   | E6   | E7-  deriving (Eq, Ord, Show, Bounded, Enum)+  deriving (Eq, Ord, Show, Bounded, Enum, Generic, Typeable)  enum8toWord8 :: Enum8 -> Word8 enum8toWord8 e = case e of@@ -102,11 +60,7 @@   { unColor8 :: Maybe Enum8   -- ^ Nothing indicates to use the default color for the terminal;   -- otherwise, use the corresponding Terminfo 'T.Color'.-  } deriving (Eq, Ord, Show)--color8toTerminfo :: Color8 -> Maybe T.Color-color8toTerminfo = fmap (T.ColorNumber . fromIntegral . enum8toWord8)-  . unColor8+  } deriving (Eq, Ord, Show, Generic, Typeable)  -- | Color for an 256-color terminal.  Does not affect 8-color -- terminals.@@ -115,11 +69,7 @@   { unColor256 :: Maybe Word8   -- ^ Nothing indicates to use the default color for the terminal;   -- otherwise, use the corresponding Terminfo 'T.Color'.-  } deriving (Eq, Ord, Show)--color256toTerminfo :: Color256 -> Maybe T.Color-color256toTerminfo = fmap (T.ColorNumber . fromIntegral)-  . unColor256+  } deriving (Eq, Ord, Show, Generic, Typeable)  -- | Any color for an 8-color terminal can also be used in a -- 256-color terminal.@@ -136,17 +86,25 @@ -- depending on how many colors a terminal has. data StyleCommon = StyleCommon   { scBold :: Last Bool+  , scFaint :: Last Bool+  , scItalic :: Last Bool   , scUnderline :: Last Bool-  , scFlash :: Last Bool+  , scBlink :: Last Bool   , scInverse :: Last Bool-  } deriving (Show, Eq, Ord)+  , scInvisible :: Last Bool+  , scStrikeout :: Last Bool+  } deriving (Show, Eq, Ord, Generic, Typeable)   instance Monoid StyleCommon where   mempty = StyleCommon (Last Nothing) (Last Nothing)                        (Last Nothing) (Last Nothing)-  mappend (StyleCommon b1 u1 f1 i1) (StyleCommon b2 u2 f2 i2)-    = StyleCommon (b1 <> b2) (u1 <> u2) (f1 <> f2) (i1 <> i2)+                       (Last Nothing) (Last Nothing)+                       (Last Nothing) (Last Nothing)+  mappend (StyleCommon x1 x2 x3 x4 x5 x6 x7 x8)+          (StyleCommon y1 y2 y3 y4 y5 y6 y7 y8)+    = StyleCommon (x1 <> y1) (x2 <> y2) (x3 <> y3) (x4 <> y4)+                  (x5 <> y5) (x6 <> y6) (x7 <> y7) (x8 <> y8)  -- | Describes text appearance (foreground and background colors, as -- well as other attributes such as bold) for an 8 color terminal.@@ -154,7 +112,7 @@   { foreground8 :: Foreground8   , background8 :: Background8   , common8 :: StyleCommon-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic, Typeable)   instance Monoid Style8 where@@ -168,7 +126,7 @@   { foreground256 :: Foreground256   , background256 :: Background256   , common256 :: StyleCommon-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic, Typeable)   instance Monoid Style256 where@@ -185,7 +143,7 @@ data TextSpec = TextSpec   { style8 :: Style8   , style256 :: Style256-  } deriving (Show, Eq, Ord)+  } deriving (Show, Eq, Ord, Generic, Typeable)   instance Monoid TextSpec where@@ -202,173 +160,118 @@ -- underlined, etc. The chunk knows what foreground and background -- colors and what attributes to use for both an 8 color terminal and -- a 256 color terminal.------ The text is held as a list of strict 'Text'.  data Chunk = Chunk-  { textSpec :: TextSpec-  , text :: [Text]-  } deriving (Eq, Show, Ord)-+  { chunkTextSpec :: TextSpec+    -- ^ Specifies all the effects (such as bold, underlining,+    -- colors, etc) that apply to this chunk, with different effects for+    -- 8 and 256 color terminals; and+    --+  , chunkTexts :: [Text]+    -- The text that is in this chunk.  When printing the+    -- 'Chunk', first all colors and effects on the terminal are reset.+    -- Then, the effects in the 'TextSpec' are applied, and then the+    -- 'Text's are printed by encoding them to UTF-8.  Then, all the+    -- colors and effects on the terminal are again reset.+    --+    -- Each text in this list is a strict 'X.Text'; though there is no+    -- provision for lazy 'X.Text', you can get the same effect as a lazy+    -- 'X.Text' by using a list of strict 'X.Text'.  'chunkFromLazyText'+    -- 'Text' by using a list of strict 'and 'chunkFromLazyTexts' do+    -- 'Text' by using a list of strict 'this for you.+  } deriving (Eq, Show, Ord, Generic, Typeable)+    instance Str.IsString Chunk where   fromString s = Chunk mempty [(X.pack s)]  -- | Creates a 'Chunk' from a strict 'X.Text' with default colors -- and no special effects.-fromText :: Text -> Chunk-fromText = Chunk mempty . (:[])+chunkFromText :: X.Text -> Chunk+chunkFromText = Chunk mempty . (:[]) +-- | Creates a 'Chunk' from a list of strict 'X.Text' with default+-- colors and no special effects.+chunkFromTexts :: [X.Text] -> Chunk+chunkFromTexts = Chunk mempty+ -- | Creates a 'Chunk' from a lazy 'XL.Text' with default colors and -- no special effects.-fromLazyText :: XL.Text -> Chunk-fromLazyText = Chunk mempty . XL.toChunks+chunkFromLazyText :: XL.Text -> Chunk+chunkFromLazyText = Chunk mempty . XL.toChunks +-- | Creates a 'Chunk' from a list of lazy 'XL.Text' with default+-- colors and no special effects.+chunkFromLazyTexts :: [XL.Text] -> Chunk+chunkFromLazyTexts = Chunk mempty . concatMap XL.toChunks+ instance Monoid Chunk where   mempty = Chunk mempty mempty   mappend (Chunk s1 t1) (Chunk s2 t2) = Chunk (s1 <> s2) (t1 <> t2)  -defaultColors :: T.Terminal -> T.TermOutput-defaultColors term =-  fromMaybe mempty (T.getCapability term T.restoreDefaultColors)---commonAttrs :: T.Terminal -> StyleCommon -> T.TermOutput-commonAttrs t s =-  let a = T.Attributes-        { T.standoutAttr = False-        , T.underlineAttr = fromMaybe False-          . getLast . scUnderline $ s-        , T.reverseAttr = fromMaybe False-          . getLast . scInverse $ s-        , T.blinkAttr = fromMaybe False-          . getLast . scFlash $ s-        , T.dimAttr = False-        , T.boldAttr = fromMaybe False-          . getLast . scBold $ s-        , T.invisibleAttr = False-        , T.protectedAttr = False-        }-  in case T.getCapability t (T.setAttributes) of-      Nothing -> error $ "Rainbow: commonAttrs: "-                 ++ "capability failed; should never happen"-      Just f -> f a----- | Gets the right set of terminal codes to apply the desired--- highlighting, bold, underlining, etc. Be sure to apply the--- attributes first (bold, underlining, etc) and then the--- colors. Setting the colors first and then the attributes seems to--- reset the colors, giving blank output.-getTermCodes-  :: T.Terminal-  -> TextSpec-  -> T.TermOutput-getTermCodes t ts = fromMaybe mempty $ do-  cols <- T.getCapability t T.termColors-  let TextSpec s8 s256 = ts-      Style8 f8 b8 c8 = s8-      Style256 f256 b256 c256 = s256-  setFg <- T.getCapability t T.setForegroundColor-  setBg <- T.getCapability t T.setBackgroundColor-  (fg, bg, cm) <- case () of-    _ | cols >= 256 -> Just $ ( fmap color256toTerminfo $ getLast f256-                              , fmap color256toTerminfo $ getLast b256-                              , c256)-      | cols >= 8 -> Just ( fmap color8toTerminfo $ getLast f8-                          , fmap color8toTerminfo $ getLast b8-                          , c8)-      | otherwise -> Nothing-  let oFg = maybe mempty (maybe mempty setFg) fg-      oBg = maybe mempty (maybe mempty setBg) bg-      oCm = commonAttrs t cm-  return $ mconcat [oCm, oFg, oBg]---hPrintChunk :: IO.Handle -> T.Terminal -> Chunk -> IO ()-hPrintChunk h t (Chunk ts xs) =-  T.hRunTermOutput h t-  . mconcat-  $ defaultColors t : codes : (map (T.termText . X.unpack) $ xs)-  where-    codes = getTermCodes t ts---- | Sends a list of chunks to the given handle for printing. Sets up--- the terminal (this only needs to be done once.) Lazily processes--- the list of Chunk. See 'putChunks' for notes on how many colors--- are used.-hPutChunks :: IO.Handle -> Term -> [Chunk] -> IO ()-hPutChunks h t cs = do-  let setup = case t of-        Dumb -> T.setupTerm "dumb"-        TermName s -> T.setupTerm s-  term <- setup-  mapM_ (hPrintChunk h term) cs-  T.hRunTermOutput h term (defaultColors term)-  T.hRunTermOutput h term-    $ case T.getCapability term T.allAttributesOff of-        Nothing -> error $ "Rainbow.putChunks: error: "-                   ++ "allAttributesOff failed"-        Just s -> s---- | Sends a list of chunks to standard output for printing. Sets up--- the terminal (this only needs to be done once.) Lazily processes--- the list of Chunk.------ Which colors are used depends upon the 'Term'. If it is 'Dumb',--- then no colors are used on output. If the 'Term' is specified with--- 'TermName', the UNIX terminfo library is used to determine how many--- colors the terminal supports. If it supports at least 256 colors,--- then 256 colors are used. If it supports at least 8 colors but less--- than 256 colors, then 8 colors are used. Otherwise, no colors are--- used. A runtime error will occur if the 'TermName' is not found in--- the system terminal database.-putChunks :: Term -> [Chunk] -> IO ()-putChunks = hPutChunks IO.stdout---- | Print one chunk at a time, to a handle-hPutChunk :: IO.Handle -> Chunk -> IO ()-hPutChunk h c = do-  t <- termFromEnv-  hPutChunks h t [c]---- | Print one chunk at a time, to standard output-putChunk :: Chunk -> IO ()-putChunk = hPutChunk IO.stdout---- | Print one chunk at a time, to a handle, append a newline-hPutChunkLn :: IO.Handle -> Chunk -> IO ()-hPutChunkLn h c = hPutChunk h c >> IO.hPutStr h "\n"---- | Print one chunk at a time, to standard output, append a newline-putChunkLn :: Chunk -> IO ()-putChunkLn c = putChunk c >> putStr "\n"+-- 8-color effects  bold8 :: Chunk bold8 = x {-  textSpec = (textSpec x) {-    style8 = (style8 (textSpec x)) {-      common8 = (common8 (style8 (textSpec x))) {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {         scBold = Last (Just True) }}}}   where     x = mempty  bold8off :: Chunk bold8off = x {-  textSpec = (textSpec x) {-    style8 = (style8 (textSpec x)) {-      common8 = (common8 (style8 (textSpec x))) {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {         scBold = Last (Just False) }}}}   where     x = mempty +faint8 :: Chunk+faint8 = x {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {+        scFaint = Last (Just True) }}}}+  where+    x = mempty +faint8off :: Chunk+faint8off = x {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {+        scFaint = Last (Just False) }}}}+  where+    x = mempty++italic8 :: Chunk+italic8 = x {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {+        scItalic = Last (Just True) }}}}+  where+    x = mempty++italic8off :: Chunk+italic8off = x {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {+        scItalic = Last (Just False) }}}}+  where+    x = mempty++ underline8 :: Chunk underline8 = x {-  textSpec = (textSpec x) {-    style8 = (style8 (textSpec x)) {-      common8 = (common8 (style8 (textSpec x))) {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {         scUnderline = Last (Just True) }}}}   where     x = mempty@@ -376,128 +279,245 @@  underline8off :: Chunk underline8off = x {-  textSpec = (textSpec x) {-    style8 = (style8 (textSpec x)) {-      common8 = (common8 (style8 (textSpec x))) {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {         scUnderline = Last (Just False) }}}}   where     x = mempty -flash8 :: Chunk-flash8 = x {-  textSpec = (textSpec x) {-    style8 = (style8 (textSpec x)) {-      common8 = (common8 (style8 (textSpec x))) {-        scFlash = Last (Just True) }}}}+blink8 :: Chunk+blink8 = x {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {+        scBlink = Last (Just True) }}}}   where     x = mempty -flash8off :: Chunk-flash8off = x {-  textSpec = (textSpec x) {-    style8 = (style8 (textSpec x)) {-      common8 = (common8 (style8 (textSpec x))) {-        scFlash = Last (Just False) }}}}+blink8off :: Chunk+blink8off = x {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {+        scBlink = Last (Just False) }}}}   where     x = mempty   inverse8 :: Chunk inverse8 = x {-  textSpec = (textSpec x) {-    style8 = (style8 (textSpec x)) {-      common8 = (common8 (style8 (textSpec x))) {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {         scInverse = Last (Just True) }}}}   where     x = mempty  inverse8off :: Chunk inverse8off = x {-  textSpec = (textSpec x) {-    style8 = (style8 (textSpec x)) {-      common8 = (common8 (style8 (textSpec x))) {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {         scInverse = Last (Just False) }}}}   where     x = mempty  -underline256 :: Chunk-underline256 = x {-  textSpec = (textSpec x) {-    style256 = (style256 (textSpec x)) {-      common256 = (common256 (style256 (textSpec x))) {-        scUnderline = Last (Just True) }}}}+invisible8 :: Chunk+invisible8 = x {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {+        scInvisible = Last (Just True) }}}}   where     x = mempty +invisible8off :: Chunk+invisible8off = x {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {+        scInvisible = Last (Just False) }}}}+  where+    x = mempty -underline256off :: Chunk-underline256off = x {-  textSpec = (textSpec x) {-    style256 = (style256 (textSpec x)) {-      common256 = (common256 (style256 (textSpec x))) {-        scUnderline = Last (Just False) }}}}++strikeout8 :: Chunk+strikeout8 = x {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {+        scStrikeout = Last (Just True) }}}}   where     x = mempty +strikeout8off :: Chunk+strikeout8off = x {+  chunkTextSpec = (chunkTextSpec x) {+    style8 = (style8 (chunkTextSpec x)) {+      common8 = (common8 (style8 (chunkTextSpec x))) {+        scStrikeout = Last (Just False) }}}}+  where+    x = mempty+++-- 256 color effects+ bold256 :: Chunk bold256 = x {-  textSpec = (textSpec x) {-    style256 = (style256 (textSpec x)) {-      common256 = (common256 (style256 (textSpec x))) {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {         scBold = Last (Just True) }}}}   where     x = mempty  bold256off :: Chunk bold256off = x {-  textSpec = (textSpec x) {-    style256 = (style256 (textSpec x)) {-      common256 = (common256 (style256 (textSpec x))) {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {         scBold = Last (Just False) }}}}   where     x = mempty  +faint256 :: Chunk+faint256 = x {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {+        scFaint = Last (Just True) }}}}+  where+    x = mempty++faint256off :: Chunk+faint256off = x {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {+        scFaint = Last (Just False) }}}}+  where+    x = mempty+++italic256 :: Chunk+italic256 = x {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {+        scItalic = Last (Just True) }}}}+  where+    x = mempty++italic256off :: Chunk+italic256off = x {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {+        scItalic = Last (Just False) }}}}+  where+    x = mempty+++underline256 :: Chunk+underline256 = x {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {+        scUnderline = Last (Just True) }}}}+  where+    x = mempty+++underline256off :: Chunk+underline256off = x {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {+        scUnderline = Last (Just False) }}}}+  where+    x = mempty++blink256 :: Chunk+blink256 = x {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {+        scBlink = Last (Just True) }}}}+  where+    x = mempty+++blink256off :: Chunk+blink256off = x {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {+        scBlink = Last (Just False) }}}}+  where+    x = mempty++ inverse256 :: Chunk inverse256 = x {-  textSpec = (textSpec x) {-    style256 = (style256 (textSpec x)) {-      common256 = (common256 (style256 (textSpec x))) {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {         scInverse = Last (Just True) }}}}   where     x = mempty  inverse256off :: Chunk inverse256off = x {-  textSpec = (textSpec x) {-    style256 = (style256 (textSpec x)) {-      common256 = (common256 (style256 (textSpec x))) {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {         scInverse = Last (Just False) }}}}   where     x = mempty  -flash256 :: Chunk-flash256 = x {-  textSpec = (textSpec x) {-    style256 = (style256 (textSpec x)) {-      common256 = (common256 (style256 (textSpec x))) {-        scFlash = Last (Just True) }}}}+invisible256 :: Chunk+invisible256 = x {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {+        scInvisible = Last (Just True) }}}}   where     x = mempty +invisible256off :: Chunk+invisible256off = x {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {+        scInvisible = Last (Just False) }}}}+  where+    x = mempty -flash256off :: Chunk-flash256off = x {-  textSpec = (textSpec x) {-    style256 = (style256 (textSpec x)) {-      common256 = (common256 (style256 (textSpec x))) {-        scFlash = Last (Just False) }}}}++strikeout256 :: Chunk+strikeout256 = x {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {+        scStrikeout = Last (Just True) }}}}   where     x = mempty +strikeout256off :: Chunk+strikeout256off = x {+  chunkTextSpec = (chunkTextSpec x) {+    style256 = (style256 (chunkTextSpec x)) {+      common256 = (common256 (style256 (chunkTextSpec x))) {+        scStrikeout = Last (Just False) }}}}+  where+    x = mempty ++ -- -- All --@@ -518,21 +538,45 @@ boldOff :: Chunk boldOff = bold8off <> bold256off -inverse :: Chunk-inverse = inverse8 <> inverse256+faint :: Chunk+faint = faint8 <> faint256 -inverseOff :: Chunk-inverseOff = inverse8off <> inverse256off+faintOff :: Chunk+faintOff = faint8off <> faint256off -flash :: Chunk-flash = flash8 <> flash256+italic :: Chunk+italic = italic8 <> italic256 -flashOff :: Chunk-flashOff = flash8off <> flash256off+italicOff :: Chunk+italicOff = italic8off <> italic256off  underline :: Chunk underline = underline8 <> underline256  underlineOff :: Chunk underlineOff = underline8off <> underline256off++blink :: Chunk+blink = blink8 <> blink256++blinkOff :: Chunk+blinkOff = blink8off <> blink256off++inverse :: Chunk+inverse = inverse8 <> inverse256++inverseOff :: Chunk+inverseOff = inverse8off <> inverse256off++invisible :: Chunk+invisible = invisible8 <> invisible256++invisibleOff :: Chunk+invisibleOff = invisible8off <> invisible256off++strikeout :: Chunk+strikeout = strikeout8 <> strikeout256++strikeoutOff :: Chunk+strikeoutOff = strikeout8off <> strikeout256off
rainbow.cabal view
@@ -3,11 +3,11 @@ -- http://www.github.com/massysett/cartel -- -- Script name used to generate: genCabal.hs--- Generated on: 2015-02-17 14:13:13.981663 EST+-- Generated on: 2015-03-22 11:22:55.854238 EDT -- Cartel library version: 0.14.2.0  name: rainbow-version: 0.20.4.0+version: 0.22.0.0 cabal-version: >= 1.16 license: BSD3 license-file: LICENSE@@ -24,12 +24,6 @@   such as bold, underlining, etc. You pair each Text with a description   of how it should appear. Rainbow works with both 8-color and 256-color   terminals.-  .-  rainbow uses the terminfo package which, in turn, needs the full C-  library for ncurses installed, including the development-  headers. Before installing terminfo, you may need to install the-  ncurses headers (for instance, on Debian systems, install the-  libncurses5-dev package.) category: System tested-with:   GHC == 7.6.3@@ -39,17 +33,120 @@   exposed-modules:     Rainbow     Rainbow.Colors+    Rainbow.Translate     Rainbow.Types   default-language: Haskell2010   ghc-options:     -Wall   build-depends:       base >= 4.5.0.0 && < 4.8.0.0-    , terminfo >= 0.3.2 && < 0.5.0.0     , text >= 0.11.2.0 && < 1.3.0.0+    , bytestring >= 0.10 && < 0.11+    , process >= 1.2 && < 1.3   hs-source-dirs:     lib  source-repository head   type: git   location: https://github.com/massysett/rainbow.git++Test-Suite rainbow-instances+  type: exitcode-stdio-1.0+  main-is: rainbow-instances.hs+  other-modules:+    Rainbow.QuickCheck+    Rainbow+    Rainbow.Colors+    Rainbow.Translate+    Rainbow.Types+  hs-source-dirs:+    tests+  build-depends:+      QuickCheck >= 2.7 && < 2.9+  default-language: Haskell2010+  ghc-options:+    -Wall+  build-depends:+      base >= 4.5.0.0 && < 4.8.0.0+    , text >= 0.11.2.0 && < 1.3.0.0+    , bytestring >= 0.10 && < 0.11+    , process >= 1.2 && < 1.3+  hs-source-dirs:+    lib++Executable test8color+  main-is: test8color.hs+  if flag(visual)+    buildable: True+    other-modules:+      Rainbow+      Rainbow.Colors+      Rainbow.Translate+      Rainbow.Types+    hs-source-dirs:+      tests+    default-language: Haskell2010+    ghc-options:+      -Wall+    build-depends:+        base >= 4.5.0.0 && < 4.8.0.0+      , text >= 0.11.2.0 && < 1.3.0.0+      , bytestring >= 0.10 && < 0.11+      , process >= 1.2 && < 1.3+    hs-source-dirs:+      lib+  else+    buildable: False++Executable test256color+  main-is: test256color.hs+  if flag(visual)+    buildable: True+    other-modules:+      Rainbow+      Rainbow.Colors+      Rainbow.Translate+      Rainbow.Types+    hs-source-dirs:+      tests+    default-language: Haskell2010+    ghc-options:+      -Wall+    build-depends:+        base >= 4.5.0.0 && < 4.8.0.0+      , text >= 0.11.2.0 && < 1.3.0.0+      , bytestring >= 0.10 && < 0.11+      , process >= 1.2 && < 1.3+    hs-source-dirs:+      lib+  else+    buildable: False++Executable colorTest+  main-is: colorTest.hs+  if flag(visual)+    buildable: True+    other-modules:+      Rainbow+      Rainbow.Colors+      Rainbow.Translate+      Rainbow.Types+    hs-source-dirs:+      tests+    default-language: Haskell2010+    ghc-options:+      -Wall+    build-depends:+        base >= 4.5.0.0 && < 4.8.0.0+      , text >= 0.11.2.0 && < 1.3.0.0+      , bytestring >= 0.10 && < 0.11+      , process >= 1.2 && < 1.3+    hs-source-dirs:+      lib+  else+    buildable: False++Flag visual+  description: builds visual tests+  default: False+  manual: True
+ tests/Rainbow/QuickCheck.hs view
@@ -0,0 +1,144 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances, DeriveGeneric, StandaloneDeriving #-}++-- | 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 Control.Applicative+import Test.QuickCheck+import Rainbow.Colors+import Rainbow.Types+import Data.Monoid+import Control.Monad+import qualified Data.Text as X++varInt :: Int -> Gen b -> Gen b+varInt = variant++instance Arbitrary Enum8 where+  arbitrary = elements [E0, E1, E2, E3, E4, E5, E6, E7]+  shrink = genericShrink++instance CoArbitrary Enum8 where+  coarbitrary x = case x of+    E0 -> varInt 0+    E1 -> varInt 1+    E2 -> varInt 2+    E3 -> varInt 3+    E4 -> varInt 4+    E5 -> varInt 5+    E6 -> varInt 6+    E7 -> varInt 7++instance Arbitrary Color8 where+  arbitrary = fmap Color8 arbitrary+  shrink = genericShrink++instance CoArbitrary Color8 where+  coarbitrary (Color8 Nothing) = varInt 0+  coarbitrary (Color8 (Just e)) = varInt 1 . coarbitrary e++instance Arbitrary Color256 where+  arbitrary = fmap Color256 arbitrary+  shrink = genericShrink++instance CoArbitrary Color256 where+  coarbitrary (Color256 Nothing) = varInt 0+  coarbitrary (Color256 (Just w)) = varInt 1 . coarbitrary w++instance Arbitrary (Last Color8) where+  arbitrary = fmap Last arbitrary++instance CoArbitrary (Last Color8) where+  coarbitrary (Last Nothing) = varInt 0+  coarbitrary (Last (Just c)) = varInt 1 . coarbitrary c++instance Arbitrary (Last Color256) where+  arbitrary = fmap Last arbitrary++instance CoArbitrary (Last Color256) where+  coarbitrary (Last Nothing) = varInt 0+  coarbitrary (Last (Just c)) = varInt 1 . coarbitrary c++instance Arbitrary (Last Bool) where+  arbitrary = fmap Last arbitrary++instance CoArbitrary (Last Bool) where+  coarbitrary (Last Nothing) = varInt 0+  coarbitrary (Last (Just b)) = varInt 1 . coarbitrary b++instance Arbitrary StyleCommon where+  arbitrary+    = StyleCommon <$> g <*> g <*> g <*> g <*> g <*> g <*> g <*> g+    where+      g = fmap Last arbitrary++instance CoArbitrary StyleCommon where+  coarbitrary (StyleCommon x0 x1 x2 x3 x4 x5 x6 x7)+    = coarbitrary x0+    . coarbitrary x1+    . coarbitrary x2+    . coarbitrary x3+    . coarbitrary x4+    . coarbitrary x5+    . coarbitrary x6+    . coarbitrary x7+    ++instance Arbitrary Style256 where+  arbitrary = liftM3 Style256 arbitrary arbitrary arbitrary++instance CoArbitrary Style256 where+  coarbitrary (Style256 x0 x1 x2)+    = coarbitrary x0+    . coarbitrary x1+    . coarbitrary x2++instance Arbitrary Style8 where+  arbitrary = liftM3 Style8 arbitrary arbitrary arbitrary++instance CoArbitrary Style8 where+  coarbitrary (Style8 x0 x1 x2)+    = coarbitrary x0+    . coarbitrary x1+    . coarbitrary x2++instance Arbitrary TextSpec where+  arbitrary = liftM2 TextSpec arbitrary arbitrary+  shrink = genericShrink++instance CoArbitrary TextSpec where+  coarbitrary (TextSpec x0 x1)+    = coarbitrary x0+    . coarbitrary x1++instance Arbitrary X.Text where+  arbitrary = fmap X.pack arbitrary+  shrink = map X.pack . shrink . X.unpack++instance Arbitrary Chunk where+  arbitrary = liftM2 Chunk arbitrary+    (listOf (fmap X.pack (listOf (elements ['a'..'z']))))+  shrink = genericShrink++instance CoArbitrary Chunk where+  coarbitrary (Chunk ts txts) = coarbitrary ts+    . coarbitrary (map X.unpack txts)++instance Arbitrary Radiant where+  arbitrary = liftM2 Radiant arbitrary arbitrary+  shrink = genericShrink++instance CoArbitrary Radiant where+  coarbitrary (Radiant x0 x1)+    = coarbitrary x0+    . coarbitrary x1
+ tests/colorTest.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Rainbow+import qualified Data.Text as X+import qualified Data.ByteString as BS++colors8 :: [(Text, Color8)]+colors8 =+  [ ("(no color)", noColor8)+  , ("black", black8)+  , ("red", red8)+  , ("green", green8)+  , ("yellow", yellow8)+  , ("blue", blue8)+  , ("magenta", magenta8)+  , ("cyan", cyan8)+  , ("white", white8)+  ]++colors256 :: [(Text, Color256)]+colors256+  = ("(no color)", Color256 Nothing) : map mkColor [minBound..maxBound]+  where+    mkColor w = (X.pack . show $ w, Color256 . Just $ w)++colorChunks8ByForeground :: [Chunk]+colorChunks8ByForeground = do+  (fgColorName, fgColor) <- colors8+  (bgColorName, bgColor) <- colors8+  let lbl = "foreground " <> fgColorName <> " background " <> bgColorName+  return $ chunkFromText lbl <> fore fgColor <> back bgColor <> "\n"++colorChunks8ByBackground :: [Chunk]+colorChunks8ByBackground = do+  (bgColorName, bgColor) <- colors8+  (fgColorName, fgColor) <- colors8+  let lbl = "background " <> bgColorName <> " foreground " <> fgColorName+  return $ chunkFromText lbl <> fore fgColor <> back bgColor <> "\n"++colorChunks256ByForeground :: [Chunk]+colorChunks256ByForeground = do+  (fgColorName, fgColor) <- colors256+  (bgColorName, bgColor) <- colors256+  let lbl = "foreground " <> fgColorName <> " background " <> bgColorName+  return $ chunkFromText lbl <> fore fgColor <> back bgColor <> "\n"++colorChunks256ByBackground :: [Chunk]+colorChunks256ByBackground = do+  (bgColorName, bgColor) <- colors256+  (fgColorName, fgColor) <- colors256+  let lbl = "background " <> bgColorName <> " foreground " <> fgColorName+  return $ chunkFromText lbl <> fore fgColor <> back bgColor <> "\n"++sep :: String -> IO ()+sep s = do+  putStrLn ""+  putStrLn ""+  putStrLn $ replicate 40 '='+  putStrLn s++main :: IO ()+main = do+  sep "8 Colors - sorted by foreground color"+  mapM_ BS.putStr . chunksToByteStrings toByteStringsColors8+    $ colorChunks8ByForeground+  sep "8 Colors - sorted by background color"+  mapM_ BS.putStr . chunksToByteStrings toByteStringsColors8+    $ colorChunks8ByBackground+  sep "256 Colors - sorted by foreground color"+  mapM_ BS.putStr . chunksToByteStrings toByteStringsColors256+    $ colorChunks256ByForeground+  sep "256 Colors - sorted by background color"+  mapM_ BS.putStr . chunksToByteStrings toByteStringsColors256+    $ colorChunks256ByBackground
+ tests/rainbow-instances.hs view
@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}++-- | This program exists solely to import Rainbow.QuickCheck to make+-- sure it compiles.+module Main where++import Rainbow.QuickCheck++main :: IO ()+main = return ()
+ tests/test256color.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Arrow (second)+import Rainbow+import qualified Data.Text as X+import qualified Data.ByteString as BS++effects :: [(Text, Chunk)]+effects =+  [ ("bold", bold256)+  , ("faint", faint256)+  , ("italic", italic256)+  , ("underline", underline256)+  , ("blink", blink256)+  , ("inverse", inverse256)+  , ("invisible", invisible256)+  , ("strikeout", strikeout256)+  ]++colors :: [(Text, Color256)]+colors = ("(no color)", Color256 Nothing) : map mkColor [minBound..maxBound]+  where+    mkColor w = (X.pack . show $ w, Color256 . Just $ w)++maybeEffects :: [(Text, Maybe Chunk)]+maybeEffects = ("(no effect)", Nothing)+  : map (second Just) effects++{-+-- From+-- http://stackoverflow.com/a/22577148/1017252+combinations :: Int -> [a] -> [[a]]+combinations k xs = combinations' (length xs) k xs+  where combinations' n k' l@(y:ys)+          | k' == 0   = [[]]+          | k' >= n   = [l]+          | null l    = []+          | otherwise = map (y :) (combinations' (n - 1) (k' - 1) ys)+                            ++ combinations' (n - 1) k' ys +-}++colorsAndEffects :: [Chunk]+colorsAndEffects = do+  (fgColorName, fgColor) <- colors+  (bgColorName, bgColor) <- colors+  (effectName, mayEffect) <- maybeEffects+  let lbl = "foreground " <> fgColorName <> " background " <> bgColorName+          <> " effect " <> effectName+  return $ chunkFromText lbl <>  fore fgColor+         <>  back bgColor+         <> maybe mempty id mayEffect+         <> "\n"++main :: IO ()+main = do+  mapM_ BS.putStr . chunksToByteStrings toByteStringsColors256+    $ colorsAndEffects
+ tests/test8color.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Arrow (second)+import Rainbow+import qualified Data.ByteString as BS++effects :: [(Text, Chunk)]+effects =+  [ ("bold", bold8)+  , ("faint", faint8)+  , ("italic", italic8)+  , ("underline", underline8)+  , ("blink", blink8)+  , ("inverse", inverse8)+  , ("invisible", invisible8)+  , ("strikeout", strikeout8)+  ]++colors :: [(Text, Color8)]+colors =+  [ ("(no color)", noColor8)+  , ("black", black8)+  , ("red", red8)+  , ("green", green8)+  , ("yellow", yellow8)+  , ("blue", blue8)+  , ("magenta", magenta8)+  , ("cyan", cyan8)+  , ("white", white8)+  ]++maybeEffects :: [(Text, Maybe Chunk)]+maybeEffects = ("(no effect)", Nothing)+  : map (second Just) effects++{-+-- From+-- http://stackoverflow.com/a/22577148/1017252+combinations :: Int -> [a] -> [[a]]+combinations k xs = combinations' (length xs) k xs+  where combinations' n k' l@(y:ys)+          | k' == 0   = [[]]+          | k' >= n   = [l]+          | null l    = []+          | otherwise = map (y :) (combinations' (n - 1) (k' - 1) ys)+                            ++ combinations' (n - 1) k' ys +-}++colorsAndEffects :: [Chunk]+colorsAndEffects = do+  (fgColorName, fgColor) <- colors+  (bgColorName, bgColor) <- colors+  (effectName, mayEffect) <- maybeEffects+  let lbl = "foreground " <> fgColorName <> " background " <> bgColorName+          <> " effect " <> effectName+  return $ chunkFromText lbl <> fore fgColor+         <> back bgColor+         <> maybe mempty id mayEffect+         <> chunkFromText "\n"++main :: IO ()+main = do+  mapM_ BS.putStr . chunksToByteStrings toByteStringsColors8+    $ colorsAndEffects