{-# LANGUAGE OverloadedStrings #-}

module Highlight.Common.Color where

import Prelude ()
import Prelude.Compat

import Data.ByteString.Char8 (ByteString, empty, pack)
import Data.IntMap.Strict (IntMap, (!), fromList)
import System.Console.ANSI
       (Color(..), ColorIntensity(..), ConsoleIntensity(..),
        ConsoleLayer(..), SGR(..), setSGRCode)

------------------------
-- Application Colors --
------------------------

-- | Find the corresponding color for the number in 'allColorsList', taking the
-- mod of the 'Int'.
--
-- >>> colorForFileNumber 0
-- "\ESC[1m\ESC[94m"
-- >>> colorForFileNumber 1
-- "\ESC[1m\ESC[92m"
-- >>> colorForFileNumber 4
-- "\ESC[1m\ESC[94m"
colorForFileNumber :: Int -> ByteString
colorForFileNumber :: Int -> ByteString
colorForFileNumber Int
num = IntMap ByteString
allColorsMap IntMap ByteString -> Int -> ByteString
forall a. IntMap a -> Int -> a
! (Int
num Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
allColorsLength)

-- | 'allColorsList' turned into an 'IntMap' for faster lookup.
allColorsMap :: IntMap ByteString
allColorsMap :: IntMap ByteString
allColorsMap = [(Int, ByteString)] -> IntMap ByteString
forall a. [(Int, a)] -> IntMap a
fromList ([(Int, ByteString)] -> IntMap ByteString)
-> [(Int, ByteString)] -> IntMap ByteString
forall a b. (a -> b) -> a -> b
$ [Int] -> [ByteString] -> [(Int, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ByteString]
allColorsList

-- | 'length' of 'allColorsList'.
allColorsLength :: Int
allColorsLength :: Int
allColorsLength = [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
allColorsList

-- | List of all the colors that are used for highlighting filenames.
allColorsList :: [ByteString]
allColorsList :: [ByteString]
allColorsList =
  [ ByteString
colorVividBlueBold
  , ByteString
colorVividGreenBold
  , ByteString
colorVividCyanBold
  , ByteString
colorVividMagentaBold
  ]

-----------------------
-- Vivid Bold Colors --
-----------------------

colorVividBlackBold :: ByteString
colorVividBlackBold :: ByteString
colorVividBlackBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorVividBlack

colorVividBlueBold :: ByteString
colorVividBlueBold :: ByteString
colorVividBlueBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorVividBlue

colorVividCyanBold :: ByteString
colorVividCyanBold :: ByteString
colorVividCyanBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorVividCyan

colorVividGreenBold :: ByteString
colorVividGreenBold :: ByteString
colorVividGreenBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorVividGreen

colorVividMagentaBold :: ByteString
colorVividMagentaBold :: ByteString
colorVividMagentaBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorVividMagenta

colorVividRedBold :: ByteString
colorVividRedBold :: ByteString
colorVividRedBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorVividRed

colorVividWhiteBold :: ByteString
colorVividWhiteBold :: ByteString
colorVividWhiteBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorVividWhite

colorVividYellowBold :: ByteString
colorVividYellowBold :: ByteString
colorVividYellowBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorVividYellow

-----------------------
-- Dull Bold Colors --
-----------------------

colorDullBlackBold :: ByteString
colorDullBlackBold :: ByteString
colorDullBlackBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorDullBlack

colorDullBlueBold :: ByteString
colorDullBlueBold :: ByteString
colorDullBlueBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorDullBlue

colorDullCyanBold :: ByteString
colorDullCyanBold :: ByteString
colorDullCyanBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorDullCyan

colorDullGreenBold :: ByteString
colorDullGreenBold :: ByteString
colorDullGreenBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorDullGreen

colorDullMagentaBold :: ByteString
colorDullMagentaBold :: ByteString
colorDullMagentaBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorDullMagenta

colorDullRedBold :: ByteString
colorDullRedBold :: ByteString
colorDullRedBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorDullRed

colorDullWhiteBold :: ByteString
colorDullWhiteBold :: ByteString
colorDullWhiteBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorDullWhite

colorDullYellowBold :: ByteString
colorDullYellowBold :: ByteString
colorDullYellowBold = ByteString
colorBold ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
colorDullYellow

------------------
-- Vivid Colors --
------------------

colorVividBlack :: ByteString
colorVividBlack :: ByteString
colorVividBlack = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Vivid Color
Black

colorVividBlue :: ByteString
colorVividBlue :: ByteString
colorVividBlue = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Vivid Color
Blue

colorVividCyan :: ByteString
colorVividCyan :: ByteString
colorVividCyan = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Vivid Color
Cyan

colorVividGreen :: ByteString
colorVividGreen :: ByteString
colorVividGreen = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Vivid Color
Green

colorVividMagenta :: ByteString
colorVividMagenta :: ByteString
colorVividMagenta = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Vivid Color
Magenta

colorVividRed :: ByteString
colorVividRed :: ByteString
colorVividRed = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Vivid Color
Red

colorVividWhite :: ByteString
colorVividWhite :: ByteString
colorVividWhite = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Vivid Color
White

colorVividYellow :: ByteString
colorVividYellow :: ByteString
colorVividYellow = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Vivid Color
Yellow

------------------
-- Dull Colors --
------------------

colorDullBlack :: ByteString
colorDullBlack :: ByteString
colorDullBlack = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Dull Color
Black

colorDullBlue :: ByteString
colorDullBlue :: ByteString
colorDullBlue = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Dull Color
Blue

colorDullCyan :: ByteString
colorDullCyan :: ByteString
colorDullCyan = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Dull Color
Cyan

colorDullGreen :: ByteString
colorDullGreen :: ByteString
colorDullGreen = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Dull Color
Green

colorDullMagenta :: ByteString
colorDullMagenta :: ByteString
colorDullMagenta = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Dull Color
Magenta

colorDullRed :: ByteString
colorDullRed :: ByteString
colorDullRed = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Dull Color
Red

colorDullWhite :: ByteString
colorDullWhite :: ByteString
colorDullWhite = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Dull Color
White

colorDullYellow :: ByteString
colorDullYellow :: ByteString
colorDullYellow = ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
Dull Color
Yellow

--------------------
-- Special Colors --
--------------------

-- | Change the intensity to 'BoldIntensity'.
colorBold :: ByteString
colorBold :: ByteString
colorBold = [SGR] -> ByteString
setSGRCodeBuilder [ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity]

-- | 'Reset' the console color back to normal.
colorReset :: ByteString
colorReset :: ByteString
colorReset = [SGR] -> ByteString
setSGRCodeBuilder [SGR
Reset]

-- | Empty string.
colorNull :: ByteString
colorNull :: ByteString
colorNull = ByteString
empty

-------------
-- Helpers --
-------------

-- | Helper for creating a 'ByteString' for an ANSI escape sequence color based on
-- a 'ColorIntensity' and a 'Color'.
colorHelper :: ColorIntensity -> Color -> ByteString
colorHelper :: ColorIntensity -> Color -> ByteString
colorHelper ColorIntensity
colorIntensity Color
color =
  [SGR] -> ByteString
setSGRCodeBuilder [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
colorIntensity Color
color]

-- | Convert a list of 'SGR' to a 'ByteString'.
setSGRCodeBuilder :: [SGR] -> ByteString
setSGRCodeBuilder :: [SGR] -> ByteString
setSGRCodeBuilder = String -> ByteString
pack (String -> ByteString) -> ([SGR] -> String) -> [SGR] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> String
setSGRCode