    -- Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons

    -- | Colors and friends.
    module Yi.Style where

    import Data.Word (Word8)
    import Data.Char (chr, ord)
    import Data.Monoid

    -- | Visual text attributes to be applied during layout.
    data Attributes = Attributes
      { Attributes -> Color
    foreground :: !Color
      , Attributes -> Color
    background :: !Color
      , Attributes -> Bool
    reverseAttr :: !Bool
        -- ^ The text should be show as "active" or "selected".
        -- This can be implemented by reverse video on the terminal.
      , Attributes -> Bool
    bold :: !Bool
      , Attributes -> Bool
    italic :: !Bool
      , Attributes -> Bool
    underline :: !Bool
      } deriving (Attributes -> Attributes -> Bool
    (Attributes -> Attributes -> Bool)
    -> (Attributes -> Attributes -> Bool) -> Eq Attributes
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Attributes -> Attributes -> Bool
    == :: Attributes -> Attributes -> Bool
    $c/= :: Attributes -> Attributes -> Bool
    /= :: Attributes -> Attributes -> Bool
    Eq, Eq Attributes
    Eq Attributes =>
    (Attributes -> Attributes -> Ordering)
    -> (Attributes -> Attributes -> Bool)
    -> (Attributes -> Attributes -> Bool)
    -> (Attributes -> Attributes -> Bool)
    -> (Attributes -> Attributes -> Bool)
    -> (Attributes -> Attributes -> Attributes)
    -> (Attributes -> Attributes -> Attributes)
    -> Ord Attributes
    Attributes -> Attributes -> Bool
    Attributes -> Attributes -> Ordering
    Attributes -> Attributes -> Attributes
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Attributes -> Attributes -> Ordering
    compare :: Attributes -> Attributes -> Ordering
    $c< :: Attributes -> Attributes -> Bool
    < :: Attributes -> Attributes -> Bool
    $c<= :: Attributes -> Attributes -> Bool
    <= :: Attributes -> Attributes -> Bool
    $c> :: Attributes -> Attributes -> Bool
    > :: Attributes -> Attributes -> Bool
    $c>= :: Attributes -> Attributes -> Bool
    >= :: Attributes -> Attributes -> Bool
    $cmax :: Attributes -> Attributes -> Attributes
    max :: Attributes -> Attributes -> Attributes
    $cmin :: Attributes -> Attributes -> Attributes
    min :: Attributes -> Attributes -> Attributes
    Ord, Int -> Attributes -> ShowS
    [Attributes] -> ShowS
    Attributes -> String
    (Int -> Attributes -> ShowS)
    -> (Attributes -> String)
    -> ([Attributes] -> ShowS)
    -> Show Attributes
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Attributes -> ShowS
    showsPrec :: Int -> Attributes -> ShowS
    $cshow :: Attributes -> String
    show :: Attributes -> String
    $cshowList :: [Attributes] -> ShowS
    showList :: [Attributes] -> ShowS
    Show)

    emptyAttributes :: Attributes
    emptyAttributes :: Attributes
    emptyAttributes = Attributes { foreground :: Color
    foreground = Color
    Default, background :: Color
    background = Color
    Default, reverseAttr :: Bool
    reverseAttr = Bool
    False, bold :: Bool
    bold = Bool
    False, italic :: Bool
    italic = Bool
    False, underline :: Bool
    underline = Bool
    False }

    -- | The style is used to transform attributes by modifying
    --   one or more of the visual text attributes.
    type Style = Endo Attributes

    -- | The UI type
    data UIStyle = UIStyle
      { UIStyle -> Attributes
    modelineAttributes :: Attributes -- ^ ground attributes for the modeline
      , StyleName
    modelineFocusStyle :: Style      -- ^ transformation of modeline in focus

      , UIStyle -> Attributes
    tabBarAttributes   :: Attributes -- ^ ground attributes for the tabbar
      , StyleName
    tabInFocusStyle    :: Style      -- ^ a tab that currently holds the focus
      , StyleName
    tabNotFocusedStyle :: Style      -- ^ a tab that does not have the current focus

      , UIStyle -> Attributes
    baseAttributes     :: Attributes -- ^ ground attributes for the main text views

      -- General styles applied to the ground attributes above
      , StyleName
    selectedStyle      :: Style      -- ^ the selected portion
      , StyleName
    eofStyle           :: Style      -- ^ empty file marker colours

      , StyleName
    errorStyle         :: Style      -- ^ indicates errors in text
      , StyleName
    hintStyle          :: Style      -- ^ search matches/paren matches/other hints
      , StyleName
    strongHintStyle    :: Style      -- ^ current search match

      -- Syntax highlighting styles
      , StyleName
    commentStyle       :: Style      -- ^ all comments
      , StyleName
    blockCommentStyle  :: Style      -- ^ additional only for block comments
      , StyleName
    keywordStyle       :: Style      -- ^ applied to language keywords
      , StyleName
    numberStyle        :: Style      -- ^ numbers
      , StyleName
    preprocessorStyle  :: Style      -- ^ preprocessor directive (often in Haskell or C)
      , StyleName
    stringStyle        :: Style      -- ^ constant strings
      , StyleName
    longStringStyle    :: Style      -- ^ additional style for long strings
      , StyleName
    typeStyle          :: Style      -- ^ type name (such as class in an OO language)
      , StyleName
    dataConstructorStyle
                           :: Style      -- ^ data constructor
      , StyleName
    importStyle        :: Style      -- ^ style of import names
      , StyleName
    builtinStyle       :: Style      -- ^ builtin things, e.g. Array in JavaScript
      , StyleName
    regexStyle         :: Style      -- ^ regular expressions
      , StyleName
    variableStyle      :: Style      -- ^ any standard variable (identifier)
      , StyleName
    operatorStyle      :: Style      -- ^ infix operators

      , StyleName
    quoteStyle         :: Style      -- ^ Style of a quotation (e.g. in template haskell)

      , StyleName
    makeFileAction     :: Style      -- ^ stuff that's passed to the shell in a Makefile
      , StyleName
    makeFileRuleHead   :: Style      -- ^ makefile rule headers
      }

    -- | A StyleName determines what style to use, taking into account the
    -- set of rendering preferences given by a 'UIStyle'.  Typically, style
    -- names will be 'Style'-valued field names of 'UIStyle'.
    type StyleName = UIStyle -> Style

    withFg, withBg :: Color -> Style
    -- | A style that sets the foreground.
    withFg :: Color -> Endo Attributes
    withFg Color
    c = (Attributes -> Attributes) -> Endo Attributes
    forall a. (a -> a) -> Endo a
    Endo ((Attributes -> Attributes) -> Endo Attributes)
    -> (Attributes -> Attributes) -> Endo Attributes
    forall a b. (a -> b) -> a -> b
    $ \Attributes
    s -> Attributes
    s { foreground = c }
    -- | A style that sets the background.
    withBg :: Color -> Endo Attributes
    withBg Color
    c = (Attributes -> Attributes) -> Endo Attributes
    forall a. (a -> a) -> Endo a
    Endo ((Attributes -> Attributes) -> Endo Attributes)
    -> (Attributes -> Attributes) -> Endo Attributes
    forall a b. (a -> b) -> a -> b
    $ \Attributes
    s -> Attributes
    s { background = c }

    withBd, withItlc, withUnderline, withReverse :: Bool -> Style
    -- | A style that sets the font to bold
    withBd :: Bool -> Endo Attributes
    withBd Bool
    c = (Attributes -> Attributes) -> Endo Attributes
    forall a. (a -> a) -> Endo a
    Endo ((Attributes -> Attributes) -> Endo Attributes)
    -> (Attributes -> Attributes) -> Endo Attributes
    forall a b. (a -> b) -> a -> b
    $ \Attributes
    s -> Attributes
    s { bold = c }
    -- | A style that sets the style to italics
    withItlc :: Bool -> Endo Attributes
    withItlc Bool
    c = (Attributes -> Attributes) -> Endo Attributes
    forall a. (a -> a) -> Endo a
    Endo ((Attributes -> Attributes) -> Endo Attributes)
    -> (Attributes -> Attributes) -> Endo Attributes
    forall a b. (a -> b) -> a -> b
    $ \Attributes
    s -> Attributes
    s { italic = c }
    -- | A style that sets the style to underlined
    withUnderline :: Bool -> Endo Attributes
    withUnderline Bool
    c = (Attributes -> Attributes) -> Endo Attributes
    forall a. (a -> a) -> Endo a
    Endo ((Attributes -> Attributes) -> Endo Attributes)
    -> (Attributes -> Attributes) -> Endo Attributes
    forall a b. (a -> b) -> a -> b
    $ \Attributes
    s -> Attributes
    s { underline = c }
    -- | A style that sets the style to underlined
    withReverse :: Bool -> Endo Attributes
    withReverse Bool
    c = (Attributes -> Attributes) -> Endo Attributes
    forall a. (a -> a) -> Endo a
    Endo ((Attributes -> Attributes) -> Endo Attributes)
    -> (Attributes -> Attributes) -> Endo Attributes
    forall a b. (a -> b) -> a -> b
    $ \Attributes
    s -> Attributes
    s { reverseAttr = c }

    -- | The identity transform.
    defaultStyle :: StyleName
    defaultStyle :: StyleName
    defaultStyle = StyleName
    forall a. Monoid a => a
    mempty

    data Color
        = RGB {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
        | Default
        -- ^ The system-default color of the engine used.
        -- e.g. in Gtk this should pick whatever the user has chosen as default color
        -- (background or foreground depending on usage) for the text.
        deriving (Color -> Color -> Bool
    (Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Color -> Color -> Bool
    == :: Color -> Color -> Bool
    $c/= :: Color -> Color -> Bool
    /= :: Color -> Color -> Bool
    Eq,Eq Color
    Eq Color =>
    (Color -> Color -> Ordering)
    -> (Color -> Color -> Bool)
    -> (Color -> Color -> Bool)
    -> (Color -> Color -> Bool)
    -> (Color -> Color -> Bool)
    -> (Color -> Color -> Color)
    -> (Color -> Color -> Color)
    -> Ord Color
    Color -> Color -> Bool
    Color -> Color -> Ordering
    Color -> Color -> Color
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Color -> Color -> Ordering
    compare :: Color -> Color -> Ordering
    $c< :: Color -> Color -> Bool
    < :: Color -> Color -> Bool
    $c<= :: Color -> Color -> Bool
    <= :: Color -> Color -> Bool
    $c> :: Color -> Color -> Bool
    > :: Color -> Color -> Bool
    $c>= :: Color -> Color -> Bool
    >= :: Color -> Color -> Bool
    $cmax :: Color -> Color -> Color
    max :: Color -> Color -> Color
    $cmin :: Color -> Color -> Color
    min :: Color -> Color -> Color
    Ord,Int -> Color -> ShowS
    [Color] -> ShowS
    Color -> String
    (Int -> Color -> ShowS)
    -> (Color -> String) -> ([Color] -> ShowS) -> Show Color
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Color -> ShowS
    showsPrec :: Int -> Color -> ShowS
    $cshow :: Color -> String
    show :: Color -> String
    $cshowList :: [Color] -> ShowS
    showList :: [Color] -> ShowS
    Show)

    -- | Convert a color to its text specification, as to be accepted by XParseColor
    colorToText :: Color -> String
    colorToText :: Color -> String
    colorToText Color
    Default = String
    "default"
    colorToText (RGB Word8
    r Word8
    g Word8
    b) = (Char
    '#'Char -> ShowS
    forall a. a -> [a] -> [a]
    :) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> ShowS
    forall {a}. Integral a => a -> ShowS
    showsHex Word8
    r ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> ShowS
    forall {a}. Integral a => a -> ShowS
    showsHex Word8
    g ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> ShowS
    forall {a}. Integral a => a -> ShowS
    showsHex Word8
    b ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ []
        where showsHex :: a -> ShowS
    showsHex a
    x String
    s = a -> Char
    forall {a}. Integral a => a -> Char
    showHex1 (a
    x a -> a -> a
    forall a. Integral a => a -> a -> a
    `div` a
    16) Char -> ShowS
    forall a. a -> [a] -> [a]
    : a -> Char
    forall {a}. Integral a => a -> Char
    showHex1 (a
    x a -> a -> a
    forall a. Integral a => a -> a -> a
    `mod` a
    16) Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    s
              showHex1 :: a -> Char
    showHex1 a
    x | a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    10 = Int -> Char
    chr (Char -> Int
    ord Char
    '0' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x)
                         | Bool
    otherwise = Int -> Char
    chr (Char -> Int
    ord Char
    'A' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    10)

    ------------------------------------------------------------------------

    -- Some simple colours

    black, grey, lightGrey, darkred, red, darkgreen, green, brown, yellow :: Color
    darkblue, blue, purple, magenta, darkcyan, cyan, white, brightwhite   :: Color
    black :: Color
    black       = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    0 Word8
    0 Word8
    0
    grey :: Color
    grey        = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    128 Word8
    128 Word8
    128
    lightGrey :: Color
    lightGrey   = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    100 Word8
    100 Word8
    100
    darkred :: Color
    darkred     = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    139 Word8
    0 Word8
    0
    red :: Color
    red         = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    255 Word8
    0 Word8
    0
    darkgreen :: Color
    darkgreen   = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    0 Word8
    100 Word8
    0
    green :: Color
    green       = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    0 Word8
    128 Word8
    0
    brown :: Color
    brown       = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    165 Word8
    42 Word8
    42
    yellow :: Color
    yellow      = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    255 Word8
    255 Word8
    0
    darkblue :: Color
    darkblue    = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    0 Word8
    0 Word8
    139
    blue :: Color
    blue        = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    0 Word8
    0 Word8
    255
    purple :: Color
    purple      = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    128 Word8
    0 Word8
    128
    magenta :: Color
    magenta     = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    255 Word8
    0 Word8
    255
    darkcyan :: Color
    darkcyan    = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    0 Word8
    139 Word8
    139
    cyan :: Color
    cyan        = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    0 Word8
    255 Word8
    255
    white :: Color
    white       = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    165 Word8
    165 Word8
    165
    brightwhite :: Color
    brightwhite = Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    255 Word8
    255 Word8
    255