rainbow 0.20.4.0 → 0.34.2.2
raw patch · 11 files changed
Files
- LICENSE +1/−1
- README.md +20/−0
- lib/Rainbow.hs +303/−164
- lib/Rainbow/Colors.hs +0/−187
- lib/Rainbow/Translate.hs +355/−0
- lib/Rainbow/Types.hs +154/−453
- rainbow.cabal +88/−48
- stack.yaml +32/−0
- tests/Rainbow/QuickCheck.hs +106/−0
- tests/rainbow-instances.hs +10/−0
- tests/rainbow-visual.hs +18/−0
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2013-2014, Omari Norman+Copyright (c) 2013-2019 Omari Norman All rights reserved.
+ README.md view
@@ -0,0 +1,20 @@+# rainbow++rainbow helps you build colorful output for both 8- and 256-color+terminals. It works only on Unix-like operating systems. For more+information, please see the documentation in the main Rainbow+module.++rainbow is on Github:++http://www.github.com/massysett/rainbow++and Hackage:++http://hackage.haskell.org/package/rainbow++and Stackage:++https://www.stackage.org/package/rainbow++rainbow is licensed under the BSD license; see the LICENSE file.
lib/Rainbow.hs view
@@ -1,178 +1,107 @@--- | 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.------ The building block of Rainbow is the 'Chunk'. Each 'Chunk' comes with--- a 'TextSpec', which specifies how the text should look on 8-color--- and on 256-color terminals. The 'Chunk' is a full specification; that--- is, although 'Chunk's are typically printed one after the other, the--- appearance of one 'Chunk' does not affect the appearance of the next--- 'Chunk'.------ You have full freedom to specify different attributes and colors--- 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--- 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 #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++-- | Rainbow handles colors and special effects for text. The basic+-- building block of Rainbow is the 'Y.Chunk'. The 'Y.Chunk' contains+-- both text and formatting information such as colors, bold,+-- underlining, etc. 'Y.Chunk' is an instance of+-- 'Data.String.IsString' so you can create a 'Y.Chunk' using the+-- @OverloadedStrings@ extension. Such a chunk has the given text+-- and has no formatting. ----- and all future examples assume you have enabled OverloadedStrings.--- You will also want the Monoid module in scope:+-- When printed, each 'Y.Chunk' starts off with a clean slate, so if+-- you want special formatting such as any color, bold, etc, then you+-- must specify it for every 'Y.Chunk'. The appearance of one+-- 'Y.Chunk' does not affect the appearance of the next 'Y.Chunk'.+-- This makes it easy to reason about how a particular 'Y.Chunk' will+-- look. ----- > import Data.Monoid+-- Rainbow supports 256-color terminals. You have full freedom to+-- specify different attributes and colors 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. -- -- Here are some basic examples: -- -- @--- 'putChunkLn' $ \"Some blue text\" \<> 'fore' 'blue'--- 'putChunkLn' $ \"Blue on red background\"--- \<> 'fore' 'blue' \<> 'back' 'red'--- 'putChunkLn' $ \"Blue on red, foreground bold\"--- \<> 'fore' 'blue' \<> 'back' 'red' \<> 'bold'--- @------ 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:------ @--- 'putChunkLn' $ \"Blue on 8-color terminal, red on 256-color terminal\"--- \<> 'fore' 'blue8' \<> 'fore' ('to256' 'red8')+-- ghci> import Rainbow+-- ghci> import Data.Function ((&))+-- ghci> :set -XOverloadedStrings+-- ghci> 'T.putChunkLn' $ \"Some blue text\" '&' 'fore' 'blue'+-- ghci> 'T.putChunkLn' $ \"Blue on red background\"+-- '&' 'fore' 'blue' '&' 'back' 'red'+-- ghci> 'T.putChunkLn' $ \"Blue on red, foreground bold\"+-- '&' 'fore' 'blue' '&' 'back' 'red' '&' 'bold' -- @ ----- To get a 'Color256', which affects only 256-color terminals, there--- are some definitions in the module such as 'brightRed'. You may--- also use 'Word8' literals, like this. You need to specify the type--- as it can't be inferred:+-- 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. -- -- @--- import Data.Word ('Data.Word.Word8')--- 'putChunkLn' $ \"Pink on 256-color terminal only\"--- \<> 'fore' (201 :: 'Data.Word.Word8')--- @------ If 'mappend' multiple chunks that change the same property, the--- rightmost one \"wins\":+-- ghci> 'T.putChunkLn' $ \"Blue on 8, bright green on 256\" '&'+-- 'fore' ('blue' '<>' 'brightGreen') ----- @--- 'putChunkLn' $ \"This will be blue\" \<> 'fore' 'red' \<> 'fore' 'blue'+-- ghci> 'T.putChunkLn' $ \"Blue on 8, red on 256" '&'+-- 'fore' ('blue' '<>' 'only256' 'red') -- @ ----- This property comes in handy if you want to specify a default color--- for 8- and 256-color terminals, then a more specific shade for a--- 256-color terminal:+-- Each 'Y.Chunk' affects the formatting only of that 'Y.Chunk'. So+-- to print things in different colors, make more than one 'Y.Chunk': -- -- @--- 'putChunkLn' $ \"Red on 8-color, pink on 256-color\"--- \<> 'fore' 'red' \<> 'fore' (201 :: 'Data.Word.Word8')+-- ghci> 'T.putChunksLn'+-- [ \"Roses\" '&' 'fore' 'red'+-- , \"Violets\" '&' 'fore' 'blue' ] -- @ ----- However, if you use 'mappend' to add additional 'Chunk's that have--- text, the text will be appended:------ @--- 'putChunkLn' $ 'fore' 'green' \<> \"You will see this text \"--- \<> \"and this text too, but it will all be blue\"--- \<> 'fore' 'blue'--- @+-- Most of the above examples use 'T.putChunkLn', but that function+-- may be inefficient if you are printing many 'Y.Chunk's. For+-- greater efficiency use functions under the heading \"Converting+-- multiple Chunk to ByteString\", including 'T.putChunksLn' and+-- 'T.putChunks'. ----- Although one chunk can have different colors on 8- and 256-color--- terminals, it cannot have different colors on the same--- terminal. That is, if you want to print some text in one color and--- some text in another color, make two chunks.+-- The functions in this module, "Rainbow", will likely be enough for+-- most uses, but for more flexibility you can use "Rainbow.Types".+-- Use of "Rainbow.Types" will require some familiarity with the+-- @lens@ library. + 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-- -- * Effects for both 8 and 256 color terminals+ -- * Chunk+ Y.Chunk+ , Y.chunk - -- | These 'Chunk's affect both 8 and 256 color terminals:- --- -- @- -- 'putChunkLn' $ \"bold on 8 and 256 color terminals\" \<> 'bold'- -- @+ -- * Formatting, all terminals + -- | These combinators affect the way a 'Y.Chunk' is displayed on+ -- both 8- and 256-color terminals. , bold+ , faint+ , italic , underline- , flash+ , blink , inverse-- -- * Effects for 8-color terminals only-- -- | These 'Chunk's affect 8-color terminals only.- --- -- @- -- 'putChunkLn' $ \"Bold on 8 color terminal only\" \<> 'bold8'- -- @-- , bold8- , underline8- , flash8- , inverse8-- -- * Effects for 256-color terminals only-- -- | These 'Chunk's affect 256-color terminals only.- --- -- @- -- 'putChunkLn' $ \"Underlined on 256-color terminal, \"- -- \<> \"bold on 8-color terminal\"- -- \<> 'underline256' \<> 'bold8'- -- @-- , bold256- , underline256- , flash256- , inverse256+ , invisible+ , strikeout -- * Colors+ , Y.Radiant+ , fore+ , back - -- ** Changing the foreground and background color- , Color(..)+ -- * Colors, all terminals - -- ** Colors for both 8- and 256-color terminals- , Radiant(..)- , noColorRadiant- , both+ -- | These 'Y.Radiant' affect the way a 'Y.Chunk' is displayed on+ -- both 8- and 256-color terminals. , black , red , green@@ -182,23 +111,9 @@ , cyan , white -- -- ** Colors for 8-color terminals only- , Enum8(..)- , Color8(..)- , noColor8- , black8- , red8- , green8- , yellow8- , blue8- , magenta8- , cyan8- , white8+ -- * Colors, 256-color terminals only - -- ** Colors for 256-color terminals only- , Color256(..)- , noColor256+ -- | These 'Y.Radiant' affect 256-color terminals only. , grey , brightRed , brightGreen@@ -207,9 +122,233 @@ , brightMagenta , brightCyan , brightWhite- , to256+ , color256+ , only256 + -- * Converting multiple 'Y.Chunk' to 'Data.ByteString.ByteString'++ -- | To print a 'Y.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 'T.chunksToByteStrings' and use+ -- 'T.byteStringMakerFromEnvironment' if you want to use the highest+ -- number of colors possible, or, to manually specify the number of+ -- colors, use 'T.chunksToByteStrings' with 'T.toByteStringsColors0',+ -- 'T.toByteStringsColors8', or 'T.toByteStringsColors256' as the first+ -- argument. 'T.chunksToByteStrings' has an example.+ --+ -- For output to handles or to standard output, just use+ -- 'T.hPutChunks' or 'T.putChunks'.+ , T.toByteStringsColors0+ , T.toByteStringsColors8+ , T.toByteStringsColors256+ , T.byteStringMakerFromEnvironment+ , T.byteStringMakerFromHandle+ , T.chunksToByteStrings++ -- * Writing multiple 'Y.Chunk' to a handle or to standard output+ , T.putChunks+ , T.hPutChunks+ , T.putChunksLn+ , T.hPutChunksLn++ -- * Quick and dirty functions for IO++ -- | For efficiency reasons you probably don't want to use these+ -- when printing large numbers of 'Y.Chunk', but they are handy for+ -- throwaway uses like experimenting in GHCi.+ , T.putChunk+ , T.putChunkLn++ -- * Notes on terminals+ -- $termNotes+ ) where -import Rainbow.Types-import Rainbow.Colors+import qualified Rainbow.Translate as T+import qualified Rainbow.Types as Y+import Data.Word (Word8)+import Data.Function ((&))+import qualified Control.Lens as Lens+import Control.Lens ((.~))+import Data.Monoid (Monoid(mempty))++formatBoth :: Lens.Setter' Y.Format Bool -> Y.Chunk -> Y.Chunk+formatBoth get c = c & Y.scheme . Y.style8 . Y.format . get .~ True+ & Y.scheme . Y.style256 . Y.format . get .~ True++-- | Bold. What actually happens when you use Bold is going to depend+-- on your terminal. For example, xterm allows you actually use a bold+-- font for bold, if you have one. Otherwise, it might simulate bold+-- by using overstriking. Another possibility is that your terminal+-- might use a different color to indicate bold. For more details (at+-- least for xterm), look at xterm (1) and search for @boldColors@.+--+-- If your terminal uses a different color for bold, this allows an+-- 8-color terminal to really have 16 colors.+bold :: Y.Chunk -> Y.Chunk+bold = formatBoth Y.bold++faint :: Y.Chunk -> Y.Chunk+faint = formatBoth Y.faint++italic :: Y.Chunk -> Y.Chunk+italic = formatBoth Y.italic++underline :: Y.Chunk -> Y.Chunk+underline = formatBoth Y.underline++blink :: Y.Chunk -> Y.Chunk+blink = formatBoth Y.blink++inverse :: Y.Chunk -> Y.Chunk+inverse = formatBoth Y.inverse++invisible :: Y.Chunk -> Y.Chunk+invisible = formatBoth Y.invisible++strikeout :: Y.Chunk -> Y.Chunk+strikeout = formatBoth Y.strikeout++-- | Change the foreground color. Whether this affects 8-color+-- terminals, 256-color terminals, or both depends on the 'Y.Radiant'.+fore :: Y.Radiant -> Y.Chunk -> Y.Chunk+fore (Y.Radiant c8 c256) c = c & Y.scheme . Y.style8 . Y.fore .~ c8+ & Y.scheme . Y.style256 . Y.fore .~ c256++-- | Change the background color. Whether this affects 8-color+-- terminals, 256-color terminals, or both depends on the 'Y.Radiant'.+back :: Y.Radiant -> Y.Chunk -> Y.Chunk+back (Y.Radiant c8 c256) c = c & Y.scheme . Y.style8 . Y.back .~ c8+ & Y.scheme . Y.style256 . Y.back .~ c256++-- | Ensures that a 'Y.Radiant' affects only a 256-color terminal.+-- For instance, to make text that is blue on an 8-color terminal but+-- red on a 256-color terminal:+--+-- @+-- 'T.putChunkLn' $ \"Blue on 8, red on 256\" &+-- 'fore' ('blue' <> 'only256' 'red')+-- @+only256 :: Y.Radiant -> Y.Radiant+only256 (Y.Radiant _ c256) = Y.Radiant mempty c256++black :: Y.Radiant+black = Y.Radiant (Y.Color (Just Y.E0)) (Y.Color (Just 0))++red :: Y.Radiant+red = Y.Radiant (Y.Color (Just Y.E1)) (Y.Color (Just 1))++green :: Y.Radiant+green = Y.Radiant (Y.Color (Just Y.E2)) (Y.Color (Just 2))++yellow :: Y.Radiant+yellow = Y.Radiant (Y.Color (Just Y.E3)) (Y.Color (Just 3))++blue :: Y.Radiant+blue = Y.Radiant (Y.Color (Just Y.E4)) (Y.Color (Just 4))++magenta :: Y.Radiant+magenta = Y.Radiant (Y.Color (Just Y.E5)) (Y.Color (Just 5))++cyan :: Y.Radiant+cyan = Y.Radiant (Y.Color (Just Y.E6)) (Y.Color (Just 6))++white :: Y.Radiant+white = Y.Radiant (Y.Color (Just Y.E7)) (Y.Color (Just 7))++grey :: Y.Radiant+grey = color256 8++brightRed :: Y.Radiant+brightRed = color256 9++brightGreen :: Y.Radiant+brightGreen = color256 10++brightYellow :: Y.Radiant+brightYellow = color256 11++brightBlue :: Y.Radiant+brightBlue = color256 12++brightMagenta :: Y.Radiant+brightMagenta = color256 13++brightCyan :: Y.Radiant+brightCyan = color256 14++brightWhite :: Y.Radiant+brightWhite = color256 15++-- | A 'Y.Radiant' for any of the 256 colors available. Supply the+-- color number. Exactly which color you'll get for a given number+-- is dependent on the terminal; though there seem to be common+-- defaults, often the user can configure this however she likes.+-- The resulting 'Y.Radiant' will affect 256-color terminals only.+color256 :: Word8 -> Y.Radiant+color256 x = Y.Radiant (Y.Color Nothing) (Y.Color (Just x))+++{- $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 'T.toByteStringsColors0'.++I also decided to standardize on UTF-8 for the 'Data.Text.Text'+output. These days that seems reasonable.++Apparently it's difficult to get ISO 6429 support on Microsoft+Windows. Oh well.++-}
− lib/Rainbow/Colors.hs
@@ -1,187 +0,0 @@--- | 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--- "Rainbow" does not re-export.-module Rainbow.Colors where--import Data.Maybe (fromMaybe)-import Rainbow.Types-import Data.Monoid-import Data.Word (Word8)---- * 8 color---- | Resets the color (foreground or background, as appropriate) to--- the default for your terminal. Usually you will not need this, as--- each 'Chunk' starts out with the terminal's default colors.-noColor8 :: Color8-noColor8 = Color8 Nothing--black8 :: Color8-black8 = Color8 (Just E0)--red8 :: Color8-red8 = Color8 (Just E1)--green8 :: Color8-green8 = Color8 (Just E2)--yellow8 :: Color8-yellow8 = Color8 (Just E3)--blue8 :: Color8-blue8 = Color8 (Just E4)--magenta8 :: Color8-magenta8 = Color8 (Just E5)--cyan8 :: Color8-cyan8 = Color8 (Just E6)--white8 :: Color8-white8 = Color8 (Just E7)---- * 256 color---- | Resets the color (foreground or background, as appropriate) to--- the default for your terminal. Usually you will not need this, as--- each 'Chunk' starts out with the terminal's default colors.-noColor256 :: Color256-noColor256 = Color256 Nothing--grey :: Color256-grey = Color256 (Just 8)--brightRed :: Color256-brightRed = Color256 (Just 9)--brightGreen :: Color256-brightGreen = Color256 (Just 10)--brightYellow :: Color256-brightYellow = Color256 (Just 11)--brightBlue :: Color256-brightBlue = Color256 (Just 12)--brightMagenta :: Color256-brightMagenta = Color256 (Just 13)--brightCyan :: Color256-brightCyan = Color256 (Just 14)--brightWhite :: Color256-brightWhite = Color256 (Just 15)---- * Both 8- and 256-color terminals---- | A 'Radiant' affects both 8- and 256-color terminals. (It does--- /not/ necessarily affect both the foreground and background;--- whether it affects the foreground, background, or both depends upon--- the context in which it is used.)-data Radiant = Radiant- { rad8 :: Color8- , rad256 :: Maybe Color256- -- ^ If 'Nothing', use the 'rad8' color on 256-color terminals.- } deriving (Eq, Ord, Show)---- | A Radiant with the same color for both 8- and 256-color--- terminals.-both :: Color8 -> Radiant-both c8 = Radiant c8 Nothing---- | A Radiant that uses the terminal's default colors for both 8- and--- 256-color terminals.-noColorRadiant :: Radiant-noColorRadiant = both noColor8--black :: Radiant-black = both black8--red :: Radiant-red = both red8--green :: Radiant-green = both green8--yellow :: Radiant-yellow = both yellow8--blue :: Radiant-blue = both blue8--magenta :: Radiant-magenta = both magenta8--cyan :: Radiant-cyan = both cyan8--white :: Radiant-white = both white8---- | Changing colors. Instances of this class affect the background--- or the foreground color. For example, to get a 'Chunk' that--- changes the background to red, use @'back' 'red'@; for the--- foreground, use @'fore' 'red'@. Whether 8-color or 256-color--- terminals (or both) are affected depends on the particular--- instance.------ Because 'Word8' is an instance of 'Color', you can use literals to--- affect the color of 256-color terminals. For example, if you have--- a 256 color terminal:------ > putChunkLn $ "muddy yellow background" <> back (100 :: Word8)------ This example would not affect an 8-color terminal, as the 'Word8'--- instance affects 256-color terminals only.--class Color a where- -- | Create a 'Chunk' that affects the background color only.- back :: a -> Chunk-- -- | Create a 'Chunk' that affects the foreground color only.- fore :: a -> Chunk--instance Color Color8 where- back c = Chunk ts []- where- ts = TextSpec s8 mempty- s8 = Style8 mempty b8 mempty- b8 = Last (Just c)-- fore c = Chunk ts []- where- ts = TextSpec s8 mempty- s8 = Style8 f8 mempty mempty- f8 = Last (Just c)--instance Color Color256 where- back c = Chunk ts []- where- ts = TextSpec mempty s256- s256 = Style256 mempty b256 mempty- b256 = Last (Just c)-- fore c = Chunk ts []- where- ts = TextSpec mempty s256- s256 = Style256 f256 mempty mempty- f256 = Last (Just c)---- | Affects the foreground and background of both 8- and 256-color--- terminals.-instance Color Radiant where- fore (Radiant c8 mc256) = fore c8- <> fore (fromMaybe (to256 c8) mc256)- back (Radiant c8 mc256) = back c8- <> back (fromMaybe (to256 c8) mc256)---- | Affects the foreground and background of 8-color terminals.-instance Color Enum8 where- back = back . Color8 . Just- fore = fore . Color8 . Just---- | Affects the foreground and background of 256-color terminals.-instance Color Word8 where- back = back . Color256 . Just- fore = fore . Color256 . Just
+ lib/Rainbow/Translate.hs view
@@ -0,0 +1,355 @@+{-# LANGUAGE FlexibleInstances #-}++-- | This module contains functions that convert a 'T.Chunk' into+-- 'ByteString's. Ordinarily everything you need from this module is+-- exported from "Rainbow".+module Rainbow.Translate where++import Control.Exception (try)+import Data.ByteString (ByteString)+import Data.List (intersperse)+import Data.Text (Text)+import Data.Word (Word8)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.Text.Encoding as X+import qualified Rainbow.Types as T+import qualified System.Console.Terminfo as Terminfo+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 semi . map (BS8.pack . show) $ cs) ++)+ where+ semi = BS8.singleton ';'++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 :: T.Enum8 -> [ByteString] -> [ByteString]+foreColor8 e8 = case e8 of+ T.E0 -> foreBlack+ T.E1 -> foreRed+ T.E2 -> foreGreen+ T.E3 -> foreYellow+ T.E4 -> foreBlue+ T.E5 -> foreMagenta+ T.E6 -> foreCyan+ T.E7 -> foreWhite++backColor8 :: T.Enum8 -> [ByteString] -> [ByteString]+backColor8 e8 = case e8 of+ T.E0 -> backBlack+ T.E1 -> backRed+ T.E2 -> backGreen+ T.E3 -> backYellow+ T.E4 -> backBlue+ T.E5 -> backMagenta+ T.E6 -> backCyan+ T.E7 -> backWhite++renderFormat :: T.Format -> [ByteString] -> [ByteString]+renderFormat (T.Format 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 x = if x then on else id++renderStyle8 :: T.Style T.Enum8 -> [ByteString] -> [ByteString]+renderStyle8 (T.Style fore back format)+ = effect foreColor8 fore+ . effect backColor8 back+ . renderFormat format+ where+ effect on (T.Color may) = maybe id on may++renderStyle256 :: T.Style Word8 -> [ByteString] -> [ByteString]+renderStyle256 (T.Style fore back format)+ = effect fore256 fore+ . effect back256 back+ . renderFormat format+ where+ effect on (T.Color may) = maybe id on may++render :: Text -> [ByteString] -> [ByteString]+render x = (X.encodeUtf8 x :)++toByteStringsColors0+ :: T.Chunk+ -> [ByteString]+ -> [ByteString]+toByteStringsColors0 (T.Chunk _ yn) = render yn++toByteStringsColors8+ :: T.Chunk+ -> [ByteString]+ -> [ByteString]+toByteStringsColors8 (T.Chunk (T.Scheme s8 _) yn)+ = normalDefault+ . renderStyle8 s8+ . render yn+ . normalDefault++toByteStringsColors256+ :: T.Chunk+ -> [ByteString]+ -> [ByteString]+toByteStringsColors256 (T.Chunk (T.Scheme _ s256) yn)+ = normalDefault+ . renderStyle256 s256+ . render yn+ . normalDefault+++-- | Uses 'Terminfo.setupTermFromEnv' to obtain the terminal's color+-- capability. 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 the terminfo database could not be read (that is, if+-- 'System.Console.Terminfo.Base.SetupTermError' is returned), then return+-- 'toByteStringsColors0'.+byteStringMakerFromEnvironment+ :: IO (T.Chunk -> [ByteString] -> [ByteString])+byteStringMakerFromEnvironment = fmap g (try Terminfo.setupTermFromEnv)+ where+ g (Left e) = toByteStringsColors0+ where+ -- Previously this caught all IOException. Now it catches only SetupTermError.+ -- See+ -- https://github.com/commercialhaskell/stackage/issues/4994+ -- Hopefully this will fix this Stackage bug.+ _types = e :: Terminfo.SetupTermError+ g (Right terminal) =+ case Terminfo.getCapability terminal (Terminfo.tiGetNum "colors") of+ Nothing -> toByteStringsColors0+ Just c+ | c >= 256 -> toByteStringsColors256+ | c >= 8 -> toByteStringsColors8+ | otherwise -> toByteStringsColors0++-- | Like 'byteStringMakerFromEnvironment' but also consults a+-- provided 'IO.Handle'. If the 'IO.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:+--+-- > module PrintMyChunks where+-- >+-- > import qualified Data.ByteString as BS+-- > import Rainbow+-- >+-- > myChunks :: [Chunk String]+-- > myChunks = [ chunk "Roses" & fore red, chunk "\n",+-- > chunk "Violets" & fore blue, chunk "\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++-- | Writes a list of chunks to the given 'IO.Handle'.+--+-- First uses 'byteStringMakerFromEnvironment' to determine how many+-- colors to use. Then creates a list of 'ByteString' using+-- 'chunksToByteStrings' and then writes them to the given 'IO.Handle'.+hPutChunks :: IO.Handle -> [T.Chunk] -> IO ()+hPutChunks h cks = do+ maker <- byteStringMakerFromEnvironment+ let bsList = chunksToByteStrings maker cks+ mapM_ (BS.hPut h) bsList++-- | Writes a list of chunks to the given 'IO.Handle', followed by a+-- newline character.+--+-- First uses 'byteStringMakerFromEnvironment' to determine how many+-- colors to use. Then creates a list of 'ByteString' using+-- 'chunksToByteStrings' and then writes them to the given 'IO.Handle'.+hPutChunksLn :: IO.Handle -> [T.Chunk] -> IO ()+hPutChunksLn h cks = do+ hPutChunks h cks+ IO.hPutStr h "\n"++-- | Writes a list of chunks to standard output.+--+-- First uses 'byteStringMakerFromEnvironment' to determine how many+-- colors to use. Then creates a list of 'ByteString' using+-- 'chunksToByteStrings' and then writes them to standard output.+putChunks :: [T.Chunk] -> IO ()+putChunks = hPutChunks IO.stdout++-- | Writes a list of chunks to standard output, followed by a+-- newline.+--+-- First uses 'byteStringMakerFromEnvironment' to determine how many+-- colors to use. Then creates a list of 'ByteString' using+-- 'chunksToByteStrings' and then writes them to standard output.+putChunksLn :: [T.Chunk] -> IO ()+putChunksLn cks = do+ putChunks cks+ IO.putStr "\n"++-- | Writes a 'T.Chunk' to standard output. Uses+-- 'byteStringMakerFromEnvironment' each time you apply it, so this+-- might be inefficient. You are better off using+-- 'chunksToByteStrings' and the functions in "Data.ByteString" to+-- print your 'T.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 'T.Chunk' to standard output, and appends a newline.+-- Uses 'byteStringMakerFromEnvironment' each time you apply it, so+-- this might be inefficient. You are better off using+-- 'chunksToByteStrings' and the functions in "Data.ByteString" to+-- print your 'T.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,78 +1,46 @@--- | 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.+{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DeriveFunctor,+ DeriveTraversable, DeriveFoldable, TemplateHaskell #-} +-- | All the main types in Rainbow. Using this module you can specify+-- that you want different formatting for 8- and 256-color terminals.+-- Many of the names in this module conflict with the names in+-- "Rainbow", so it's probably best to @import@ this module+-- @qualified@. module Rainbow.Types where -- # Imports -import qualified Data.String as Str-import Data.Monoid+import Control.Lens (makeLenses)+import Data.String (IsString(..)) 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.Traversable ()+import Data.Typeable (Typeable) import Data.Word (Word8)+import GHC.Generics (Generic) ----- Terminal definitions+-- Colors -- --- | 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---- For Background8, Background256, Foreground8, Foreground256: the--- Last wraps a Maybe (Terminfo Color). If the inner Maybe is Nothing,--- use the default color.+-- | A color; a 'Nothing' value means that the terminal's default+-- color is used. The type of the 'Maybe' generally will be an+-- 'Enum8' to represent one of 8 colors, or a 'Word8' to represent one+-- of 256 colors.+newtype Color a = Color (Maybe a)+ deriving (Eq, Show, Ord, Generic, Typeable, Functor, Foldable,+ Traversable) -type Background8 = Last Color8-type Background256 = Last Color256-type Foreground8 = Last Color8-type Foreground256 = Last Color256+instance Semigroup (Color a) where+ Color x <> Color y = case y of+ Just a -> Color (Just a)+ _ -> Color x ------ Colors---+-- | Takes the last non-Nothing Color. 'mempty' is no color.+instance Monoid (Color a) where+ mempty = Color Nothing --- | A simple enumeration for eight values.+-- | A simple enumeration for eight values. Represents eight colors. data Enum8 = E0 | E1@@ -82,7 +50,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@@ -95,104 +63,120 @@ E6 -> 6 E7 -> 7 --- | Color for an 8-color terminal. Does not affect 256-color--- terminals.+black :: Enum8+black = E0 -newtype Color8 = Color8- { unColor8 :: Maybe Enum8- -- ^ Nothing indicates to use the default color for the terminal;- -- otherwise, use the corresponding Terminfo 'T.Color'.- } deriving (Eq, Ord, Show)+red :: Enum8+red = E1 -color8toTerminfo :: Color8 -> Maybe T.Color-color8toTerminfo = fmap (T.ColorNumber . fromIntegral . enum8toWord8)- . unColor8+green :: Enum8+green = E2 --- | Color for an 256-color terminal. Does not affect 8-color--- terminals.+yellow :: Enum8+yellow = E3 -newtype Color256 = Color256- { unColor256 :: Maybe Word8- -- ^ Nothing indicates to use the default color for the terminal;- -- otherwise, use the corresponding Terminfo 'T.Color'.- } deriving (Eq, Ord, Show)+blue :: Enum8+blue = E4 -color256toTerminfo :: Color256 -> Maybe T.Color-color256toTerminfo = fmap (T.ColorNumber . fromIntegral)- . unColor256+magenta :: Enum8+magenta = E5 --- | Any color for an 8-color terminal can also be used in a--- 256-color terminal.-to256 :: Color8 -> Color256-to256 (Color8 mayE) = Color256 $ fmap enum8toWord8 mayE+cyan :: Enum8+cyan = E6 +white :: Enum8+white = E7++grey :: Word8+grey = 8++brightRed :: Word8+brightRed = 9++brightGreen :: Word8+brightGreen = 10++brightYellow :: Word8+brightYellow = 11++brightBlue :: Word8+brightBlue = 12++brightMagenta :: Word8+brightMagenta = 13++brightCyan :: Word8+brightCyan = 14++brightWhite :: Word8+brightWhite = 15+ -- -- Styles -- --- | Style elements that apply in both 8 and 256 color--- terminals. However, the elements are described separately for 8 and--- 256 color terminals, so that the text appearance can change--- depending on how many colors a terminal has.-data StyleCommon = StyleCommon- { scBold :: Last Bool- , scUnderline :: Last Bool- , scFlash :: Last Bool- , scInverse :: Last Bool- } deriving (Show, Eq, Ord)-+-- | Text formatting such as bold, italic, etc.+data Format = Format+ { _bold :: Bool+ , _faint :: Bool+ , _italic :: Bool+ , _underline :: Bool+ , _blink :: Bool+ , _inverse :: Bool+ , _invisible :: Bool+ , _strikeout :: 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)+makeLenses ''Format --- | Describes text appearance (foreground and background colors, as--- well as other attributes such as bold) for an 8 color terminal.-data Style8 = Style8- { foreground8 :: Foreground8- , background8 :: Background8- , common8 :: StyleCommon- } deriving (Show, Eq, Ord)+instance Semigroup Format where+ (Format x0 x1 x2 x3 x4 x5 x6 x7) <> (Format y0 y1 y2 y3 y4 y5 y6 y7)+ = Format (x0 || y0) (x1 || y1) (x2 || y2) (x3 || y3) (x4 || y4)+ (x5 || y5) (x6 || y6) (x7 || y7) +-- | For each field, the resulting field is True if either field is+-- True. For 'mempty', every field is False.+instance Monoid Format where+ mempty = Format False False False False False False False False -instance Monoid Style8 where- mappend (Style8 fx bx cx) (Style8 fy by cy)- = Style8 (fx <> fy) (bx <> by) (cx <> cy)- mempty = Style8 mempty mempty mempty+-- | The foreground and background color, and the 'Format'. This+-- represents all colors and formatting attributes for either an 8- or+-- 256-color terminal.+data Style a = Style+ { _fore :: Color a+ , _back :: Color a+ , _format :: Format+ } deriving (Show, Eq, Ord, Generic, Typeable, Functor, Foldable,+ Traversable) --- | Describes text appearance (foreground and background colors, as--- well as other attributes such as bold) for a 256 color terminal.-data Style256 = Style256- { foreground256 :: Foreground256- , background256 :: Background256- , common256 :: StyleCommon- } deriving (Show, Eq, Ord)+makeLenses ''Style +instance Semigroup (Style a) where+ (Style x0 x1 x2) <> (Style y0 y1 y2)+ = Style (x0 <> y0) (x1 <> y1) (x2 <> y2) -instance Monoid Style256 where- mappend (Style256 fx bx cx) (Style256 fy by cy)- = Style256 (fx <> fy) (bx <> by) (cx <> cy)- mempty = Style256 mempty mempty mempty+-- | Uses the underlying 'Monoid' instances for 'Color' and 'Format'.+instance Monoid (Style a) where+ mempty = Style mempty mempty mempty ----- TextSpec+-- Scheme -- --- | The TextSpec bundles together the styles for the 8 and 256 color--- terminals, so that the text can be portrayed on any terminal.-data TextSpec = TextSpec- { style8 :: Style8- , style256 :: Style256- } deriving (Show, Eq, Ord)+-- | Holds the 'Style' for both 8- and 256-color terminals.+data Scheme = Scheme+ { _style8 :: Style Enum8+ , _style256 :: Style Word8+ } deriving (Eq, Ord, Show, Generic, Typeable) +makeLenses ''Scheme -instance Monoid TextSpec where- mappend (TextSpec x1 x2) (TextSpec y1 y2)- = TextSpec (x1 <> y1) (x2 <> y2)- mempty = TextSpec mempty mempty+instance Semigroup Scheme where+ (Scheme x0 x1) <> (Scheme y0 y1) = Scheme (x0 <> y0) (x1 <> y1) +instance Monoid Scheme where+ mempty = Scheme mempty mempty+ -- -- Chunks --@@ -202,337 +186,54 @@ -- 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)---instance Str.IsString Chunk where- fromString s = Chunk mempty [(X.pack s)]+ { _scheme :: Scheme+ , _yarn :: Text+ } deriving (Eq, Show, Ord, Generic, Typeable) --- | Creates a 'Chunk' from a strict 'X.Text' with default colors--- and no special effects.-fromText :: Text -> Chunk-fromText = Chunk mempty . (:[])+-- | Uses the underlying 'Semigroup' instances for both the+-- underlying 'Scheme' and the underlying 'Text'.+instance Semigroup Chunk where+ (Chunk x0 x1) <> (Chunk y0 y1)+ = Chunk (x0 <> y0) (x1 <> y1) --- | Creates a 'Chunk' from a lazy 'XL.Text' with default colors and--- no special effects.-fromLazyText :: XL.Text -> Chunk-fromLazyText = Chunk mempty . XL.toChunks+-- | Creates a 'Chunk' with no formatting and with the given text.+instance IsString Chunk where+ fromString = chunk . X.pack +-- | Uses the underlying 'Monoid' instances for the 'Scheme' and for+-- the underlying 'Text'. Therefore 'mempty' will have no+-- formatting, no colors, and no text. 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"--bold8 :: Chunk-bold8 = x {- textSpec = (textSpec x) {- style8 = (style8 (textSpec x)) {- common8 = (common8 (style8 (textSpec x))) {- scBold = Last (Just True) }}}}- where- x = mempty--bold8off :: Chunk-bold8off = x {- textSpec = (textSpec x) {- style8 = (style8 (textSpec x)) {- common8 = (common8 (style8 (textSpec x))) {- scBold = Last (Just False) }}}}- where- x = mempty---underline8 :: Chunk-underline8 = x {- textSpec = (textSpec x) {- style8 = (style8 (textSpec x)) {- common8 = (common8 (style8 (textSpec x))) {- scUnderline = Last (Just True) }}}}- where- x = mempty---underline8off :: Chunk-underline8off = x {- textSpec = (textSpec x) {- style8 = (style8 (textSpec x)) {- common8 = (common8 (style8 (textSpec 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) }}}}- where- x = mempty--flash8off :: Chunk-flash8off = x {- textSpec = (textSpec x) {- style8 = (style8 (textSpec x)) {- common8 = (common8 (style8 (textSpec x))) {- scFlash = Last (Just False) }}}}- where- x = mempty---inverse8 :: Chunk-inverse8 = x {- textSpec = (textSpec x) {- style8 = (style8 (textSpec x)) {- common8 = (common8 (style8 (textSpec x))) {- scInverse = Last (Just True) }}}}- where- x = mempty--inverse8off :: Chunk-inverse8off = x {- textSpec = (textSpec x) {- style8 = (style8 (textSpec x)) {- common8 = (common8 (style8 (textSpec 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) }}}}- where- x = mempty---underline256off :: Chunk-underline256off = x {- textSpec = (textSpec x) {- style256 = (style256 (textSpec x)) {- common256 = (common256 (style256 (textSpec x))) {- scUnderline = Last (Just False) }}}}- where- x = mempty--bold256 :: Chunk-bold256 = x {- textSpec = (textSpec x) {- style256 = (style256 (textSpec x)) {- common256 = (common256 (style256 (textSpec x))) {- scBold = Last (Just True) }}}}- where- x = mempty--bold256off :: Chunk-bold256off = x {- textSpec = (textSpec x) {- style256 = (style256 (textSpec x)) {- common256 = (common256 (style256 (textSpec x))) {- scBold = Last (Just False) }}}}- where- x = mempty---inverse256 :: Chunk-inverse256 = x {- textSpec = (textSpec x) {- style256 = (style256 (textSpec x)) {- common256 = (common256 (style256 (textSpec x))) {- scInverse = Last (Just True) }}}}- where- x = mempty--inverse256off :: Chunk-inverse256off = x {- textSpec = (textSpec x) {- style256 = (style256 (textSpec x)) {- common256 = (common256 (style256 (textSpec 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) }}}}- where- x = mempty---flash256off :: Chunk-flash256off = x {- textSpec = (textSpec x) {- style256 = (style256 (textSpec x)) {- common256 = (common256 (style256 (textSpec x))) {- scFlash = Last (Just False) }}}}- where- x = mempty-+-- | Creates a 'Chunk' with no formatting and with the given text.+-- A 'Chunk' is also an instance of 'Data.String.IsString' so you+-- can create them with the @OverloadedStrings@ extension. Such a+-- 'Chunk' has the text of the string and no formatting.+chunk :: Text -> Chunk+chunk = Chunk mempty ------ All---+makeLenses ''Chunk --- | Bold. What actually happens when you use Bold is going to depend--- on your terminal. For example, xterm allows you actually use a bold--- font for bold, if you have one. Otherwise, it might simulate bold--- by using overstriking. Another possibility is that your terminal--- might use a different color to indicate bold. For more details (at--- least for xterm), look at xterm (1) and search for @boldColors@.------ If your terminal uses a different color for bold, this allows an--- 8-color terminal to really have 16 colors.-bold :: Chunk-bold = bold8 <> bold256--boldOff :: Chunk-boldOff = bold8off <> bold256off--inverse :: Chunk-inverse = inverse8 <> inverse256--inverseOff :: Chunk-inverseOff = inverse8off <> inverse256off--flash :: Chunk-flash = flash8 <> flash256+-- | Stores colors that may affect 8-color terminals, 256-color+-- terminals, both, or neither.+data Radiant = Radiant+ { _color8 :: Color Enum8+ , _color256 :: Color Word8+ } deriving (Eq, Ord, Show, Typeable, Generic) -flashOff :: Chunk-flashOff = flash8off <> flash256off+instance Semigroup Radiant where+ (Radiant x0 x1) <> (Radiant y0 y1) = Radiant (x0 <> y0) (x1 <> y1) -underline :: Chunk-underline = underline8 <> underline256+-- | Uses the underlying 'Monoid' instance for the 'Color's. Thus the+-- last non-'Nothing' 'Color' is used. This can be useful to specify+-- one color for 8-color terminals and a different color for 256-color+-- terminals.+instance Monoid Radiant where+ mempty = Radiant mempty mempty -underlineOff :: Chunk-underlineOff = underline8off <> underline256off+makeLenses ''Radiant
rainbow.cabal view
@@ -1,55 +1,95 @@--- This Cabal file generated using the Cartel library.--- Cartel is available at:--- http://www.github.com/massysett/cartel+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2. ----- Script name used to generate: genCabal.hs--- Generated on: 2015-02-17 14:13:13.981663 EST--- Cartel library version: 0.14.2.0+-- see: https://github.com/sol/hpack+--+-- hash: 837a60ee2540f28dc14f871885d041b7f60038586de137f1f3e495154992b4fe -name: rainbow-version: 0.20.4.0-cabal-version: >= 1.16-license: BSD3-license-file: LICENSE-build-type: Simple-copyright: Copyright 2013-2015 Omari Norman-author: Omari Norman-maintainer: omari@smileystation.com-stability: Experimental-homepage: https://www.github.com/massysett/rainbow-bug-reports: https://www.github.com/massysett/rainbow/issues-synopsis: Print text to terminal with colors and effects-description:- rainbow helps you print Text chunks to a terminal with colors and effects- 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- GHC == 7.8.2+name: rainbow+version: 0.34.2.2+synopsis: Print text to terminal with colors and effects+description: Please see README.md+category: System+stability: Experimental+homepage: https://www.github.com/massysett/rainbow+bug-reports: https://www.github.com/massysett/rainbow/issues+author: Omari Norman+maintainer: omari@smileystation.com+copyright: Copyright 2013-2019 Omari Norman+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ stack.yaml+x-curation: uncurated -Library+source-repository head+ type: git+ location: https://github.com/massysett/rainbow++library exposed-modules:- Rainbow- Rainbow.Colors- Rainbow.Types- default-language: Haskell2010- ghc-options:- -Wall+ Rainbow+ Rainbow.Translate+ Rainbow.Types+ other-modules:+ Paths_rainbow+ hs-source-dirs:+ lib+ other-extensions: TemplateHaskell+ 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+ base >=4.11 && <5+ , bytestring+ , lens+ , terminfo+ , text+ default-language: Haskell2010++test-suite rainbow-instances+ type: exitcode-stdio-1.0+ main-is: rainbow-instances.hs+ other-modules:+ Rainbow+ Rainbow.Translate+ Rainbow.Types+ Rainbow.QuickCheck+ Paths_rainbow hs-source-dirs:- lib+ lib+ tests+ other-extensions: TemplateHaskell+ ghc-options: -Wall+ build-depends:+ QuickCheck+ , base >=4.11 && <5+ , bytestring+ , lens+ , terminfo+ , text+ default-language: Haskell2010 -source-repository head- type: git- location: https://github.com/massysett/rainbow.git+test-suite rainbow-visual+ type: exitcode-stdio-1.0+ main-is: rainbow-visual.hs+ other-modules:+ Rainbow+ Rainbow.Translate+ Rainbow.Types+ Rainbow.QuickCheck+ Paths_rainbow+ hs-source-dirs:+ lib+ tests+ other-extensions: TemplateHaskell+ ghc-options: -Wall+ build-depends:+ QuickCheck+ , base >=4.11 && <5+ , bytestring+ , lens+ , terminfo+ , text+ default-language: Haskell2010
+ stack.yaml view
@@ -0,0 +1,32 @@+# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md++# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)+resolver: lts-14.14++# Local packages, usually specified by relative directory name+packages:+- '.'++# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)+extra-deps: []++# Override default flag values for local packages and extra-deps+flags: {}++# Extra package databases containing global packages+extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true++# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: >= 0.1.4.0++# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64++# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]
+ tests/Rainbow/QuickCheck.hs view
@@ -0,0 +1,106 @@+{-# 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 qualified Data.Text as X+import Data.Typeable+import Rainbow.Types+import Test.QuickCheck++instance Arbitrary X.Text where+ arbitrary = fmap X.pack $ listOf genChar+ where+ genChar = elements ['a'..'z']+ shrink = fmap X.pack . shrink . X.unpack++instance CoArbitrary X.Text where+ coarbitrary = coarbitrary . X.unpack++instance (Typeable a, Arbitrary a) => Arbitrary (Color a) where+ arbitrary = Color <$> arbitrary+ shrink = genericShrink++instance CoArbitrary a => CoArbitrary (Color a) where+ coarbitrary (Color a) = coarbitrary a++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 Format where+ arbitrary+ = Format <$> g <*> g <*> g <*> g <*> g <*> g <*> g <*> g+ where+ g = arbitrary+ shrink = genericShrink++instance CoArbitrary Format where+ coarbitrary (Format 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 a, Typeable a) => Arbitrary (Style a) where+ arbitrary = Style <$> arbitrary <*> arbitrary <*> arbitrary+ shrink = genericShrink++instance CoArbitrary a => CoArbitrary (Style a) where+ coarbitrary (Style a b c)+ = coarbitrary a+ . coarbitrary b+ . coarbitrary c++instance Arbitrary Scheme where+ arbitrary = Scheme <$> arbitrary <*> arbitrary+ shrink = genericShrink++instance CoArbitrary Scheme where+ coarbitrary (Scheme a b) = coarbitrary a . coarbitrary b+++instance Arbitrary Chunk where+ arbitrary = Chunk <$> arbitrary <*> arbitrary+ shrink = genericShrink++instance CoArbitrary Chunk where+ coarbitrary (Chunk a b)+ = coarbitrary a+ . coarbitrary b++instance Arbitrary Radiant where+ arbitrary = Radiant <$> arbitrary <*> arbitrary+ shrink = genericShrink++instance CoArbitrary Radiant where+ coarbitrary (Radiant a b) = coarbitrary a . coarbitrary b+
+ 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/rainbow-visual.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Rainbow+import Data.Function ((&))++main :: IO ()+main = do+ putChunksLn+ [ "Red fore, green back " & fore red & back green+ , "Blue fore, magenta back" & fore blue & back magenta ]+ putChunksLn+ [ "Red, bold fore " & fore red & bold+ , "Red, underlined fore " & fore red & underline+ , "Cyan, italic fore" & fore cyan & italic+ ]+ putChunksLn+ [ "Light grey background on 256-color" & back (color256 254) ]