{-# 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. module Rainbow.Types where -- # Imports import qualified Data.String as Str import Data.Monoid import Data.Text (Text) import qualified Data.Text as X import qualified Data.Text.Lazy as XL import Data.Word (Word8) import GHC.Generics import Data.Typeable -- For Background8, Background256, Foreground8, Foreground256: the -- Last wraps a Maybe (Terminfo Color). If the inner Maybe is Nothing, -- use the default color. type Background8 = Last Color8 type Background256 = Last Color256 type Foreground8 = Last Color8 type Foreground256 = Last Color256 -- -- Colors -- -- | A simple enumeration for eight values. data Enum8 = E0 | E1 | E2 | E3 | E4 | E5 | E6 | E7 deriving (Eq, Ord, Show, Bounded, Enum, Generic, Typeable) enum8toWord8 :: Enum8 -> Word8 enum8toWord8 e = case e of E0 -> 0 E1 -> 1 E2 -> 2 E3 -> 3 E4 -> 4 E5 -> 5 E6 -> 6 E7 -> 7 -- | Color for an 8-color terminal. Does not affect 256-color -- terminals. 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, Generic, Typeable) -- | Color for an 256-color terminal. Does not affect 8-color -- terminals. 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, Generic, Typeable) -- | 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 -- -- 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 , scFaint :: Last Bool , scItalic :: Last Bool , scUnderline :: Last Bool , scBlink :: Last Bool , scInverse :: Last Bool , 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) (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. data Style8 = Style8 { foreground8 :: Foreground8 , background8 :: Background8 , common8 :: StyleCommon } deriving (Show, Eq, Ord, Generic, Typeable) 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 -- | 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, Generic, Typeable) 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 -- -- TextSpec -- -- | 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, Generic, Typeable) instance Monoid TextSpec where mappend (TextSpec x1 x2) (TextSpec y1 y2) = TextSpec (x1 <> y1) (x2 <> y2) mempty = TextSpec mempty mempty -- -- Chunks -- -- | A chunk is some textual data coupled with a description of what -- color the text is, attributes like whether it is bold or -- 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. data Chunk = Chunk { 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. 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. 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) -- 8-color effects bold8 :: Chunk bold8 = x { chunkTextSpec = (chunkTextSpec x) { style8 = (style8 (chunkTextSpec x)) { common8 = (common8 (style8 (chunkTextSpec x))) { scBold = Last (Just True) }}}} where x = mempty bold8off :: Chunk bold8off = 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 { chunkTextSpec = (chunkTextSpec x) { style8 = (style8 (chunkTextSpec x)) { common8 = (common8 (style8 (chunkTextSpec x))) { scUnderline = Last (Just True) }}}} where x = mempty underline8off :: Chunk underline8off = x { chunkTextSpec = (chunkTextSpec x) { style8 = (style8 (chunkTextSpec x)) { common8 = (common8 (style8 (chunkTextSpec x))) { scUnderline = Last (Just False) }}}} where x = mempty blink8 :: Chunk blink8 = x { chunkTextSpec = (chunkTextSpec x) { style8 = (style8 (chunkTextSpec x)) { common8 = (common8 (style8 (chunkTextSpec x))) { scBlink = Last (Just True) }}}} where x = mempty 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 { chunkTextSpec = (chunkTextSpec x) { style8 = (style8 (chunkTextSpec x)) { common8 = (common8 (style8 (chunkTextSpec x))) { scInverse = Last (Just True) }}}} where x = mempty inverse8off :: Chunk inverse8off = x { chunkTextSpec = (chunkTextSpec x) { style8 = (style8 (chunkTextSpec x)) { common8 = (common8 (style8 (chunkTextSpec x))) { scInverse = Last (Just False) }}}} where x = mempty 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 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 { chunkTextSpec = (chunkTextSpec x) { style256 = (style256 (chunkTextSpec x)) { common256 = (common256 (style256 (chunkTextSpec x))) { scBold = Last (Just True) }}}} where x = mempty bold256off :: Chunk bold256off = 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 { chunkTextSpec = (chunkTextSpec x) { style256 = (style256 (chunkTextSpec x)) { common256 = (common256 (style256 (chunkTextSpec x))) { scInverse = Last (Just True) }}}} where x = mempty inverse256off :: Chunk inverse256off = x { chunkTextSpec = (chunkTextSpec x) { style256 = (style256 (chunkTextSpec x)) { common256 = (common256 (style256 (chunkTextSpec x))) { scInverse = Last (Just False) }}}} where x = mempty 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 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 -- -- | 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 faint :: Chunk faint = faint8 <> faint256 faintOff :: Chunk faintOff = faint8off <> faint256off italic :: Chunk italic = italic8 <> italic256 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