module Language.Haskell.HsColour.ColourHighlight
  ( Colour(..)
  , Highlight(..)
  , base256, unbase
  , rgb24bit_to_xterm256
  ,   projectToBasicColour8
  , hlProjectToBasicColour8
  ) where

import Data.Word

-- | Colours supported by ANSI codes.
data Colour = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White | Rgb Word8 Word8 Word8
  deriving (Colour -> Colour -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Colour -> Colour -> Bool
$c/= :: Colour -> Colour -> Bool
== :: Colour -> Colour -> Bool
$c== :: Colour -> Colour -> Bool
Eq,Int -> Colour -> ShowS
[Colour] -> ShowS
Colour -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Colour] -> ShowS
$cshowList :: [Colour] -> ShowS
show :: Colour -> String
$cshow :: Colour -> String
showsPrec :: Int -> Colour -> ShowS
$cshowsPrec :: Int -> Colour -> ShowS
Show,ReadPrec [Colour]
ReadPrec Colour
Int -> ReadS Colour
ReadS [Colour]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Colour]
$creadListPrec :: ReadPrec [Colour]
readPrec :: ReadPrec Colour
$creadPrec :: ReadPrec Colour
readList :: ReadS [Colour]
$creadList :: ReadS [Colour]
readsPrec :: Int -> ReadS Colour
$creadsPrec :: Int -> ReadS Colour
Read)

-- | Convert an integer in the range [0,2^24-1] to its base 256-triplet, passing the result to the given continuation (avoid unnecessary tupleism).
base256 :: Integral int => (Word8 -> Word8 -> Word8 -> r) -> int -> r
base256 :: forall int r.
Integral int =>
(Word8 -> Word8 -> Word8 -> r) -> int -> r
base256 Word8 -> Word8 -> Word8 -> r
kont int
x =
    let
        (int
r,int
gb) = forall a. Integral a => a -> a -> (a, a)
divMod int
x int
256
        (int
g,int
b)  = forall a. Integral a => a -> a -> (a, a)
divMod int
gb int
256
        fi :: int -> Word8
fi = forall a b. (Integral a, Num b) => a -> b
fromIntegral
    in 
        Word8 -> Word8 -> Word8 -> r
kont (int -> Word8
fi int
r) (int -> Word8
fi int
g) (int -> Word8
fi int
b)

-- | Convert a three-digit numeral in the given (as arg 1) base to its integer value.
unbase :: Integral int => int -> Word8 -> Word8 -> Word8 -> int
unbase :: forall int. Integral int => int -> Word8 -> Word8 -> Word8 -> int
unbase int
base Word8
r Word8
g Word8
b = (Word8 -> int
fi Word8
rforall a. Num a => a -> a -> a
*int
baseforall a. Num a => a -> a -> a
+Word8 -> int
fi Word8
g)forall a. Num a => a -> a -> a
*int
baseforall a. Num a => a -> a -> a
+Word8 -> int
fi Word8
b
    where fi :: Word8 -> int
fi = forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Approximate a 24-bit Rgb colour with a colour in the xterm256 6x6x6 colour cube, returning its index.
rgb24bit_to_xterm256 :: (Integral t) => Word8 -> Word8 -> Word8 -> t
rgb24bit_to_xterm256 :: forall t. Integral t => Word8 -> Word8 -> Word8 -> t
rgb24bit_to_xterm256 Word8
r Word8
g Word8
b = let f :: Word8 -> Word8
f = (forall a. Integral a => a -> a -> a
`div` Word8
43)
                          in t
16 forall a. Num a => a -> a -> a
+ forall int. Integral int => int -> Word8 -> Word8 -> Word8 -> int
unbase t
6 (Word8 -> Word8
f Word8
r) (Word8 -> Word8
f Word8
g) (Word8 -> Word8
f Word8
b)


-- | Ap\"proxi\"mate a 24-bit Rgb colour with an ANSI8 colour. Will leave other colours unchanged and will never return an 'Rgb' constructor value. 
projectToBasicColour8 ::  Colour -> Colour
projectToBasicColour8 :: Colour -> Colour
projectToBasicColour8 (Rgb Word8
r Word8
g Word8
b) = let f :: Word8 -> Word8
f = (forall a. Integral a => a -> a -> a
`div` Word8
128)
                          in  forall a. Enum a => Int -> a
toEnum ( forall int. Integral int => int -> Word8 -> Word8 -> Word8 -> int
unbase Int
2 (Word8 -> Word8
f Word8
r) (Word8 -> Word8
f Word8
g) (Word8 -> Word8
f Word8
b) )
projectToBasicColour8 Colour
x = Colour
x


-- | Lift 'projectToBasicColour8' to 'Highlight's
hlProjectToBasicColour8 ::  Highlight -> Highlight
hlProjectToBasicColour8 :: Highlight -> Highlight
hlProjectToBasicColour8 (Foreground Colour
c) = Colour -> Highlight
Foreground (Colour -> Colour
projectToBasicColour8 Colour
c)
hlProjectToBasicColour8 (Background Colour
c) = Colour -> Highlight
Background (Colour -> Colour
projectToBasicColour8 Colour
c)
hlProjectToBasicColour8 Highlight
h = Highlight
h

        

instance Enum Colour where
    toEnum :: Int -> Colour
toEnum Int
0 = Colour
Black
    toEnum Int
1 = Colour
Red 
    toEnum Int
2 = Colour
Green 
    toEnum Int
3 = Colour
Yellow 
    toEnum Int
4 = Colour
Blue 
    toEnum Int
5 = Colour
Magenta 
    toEnum Int
6 = Colour
Cyan 
    toEnum Int
7 = Colour
White 
    -- Arbitrary extension; maybe just 'error' out instead
    toEnum Int
x = forall int r.
Integral int =>
(Word8 -> Word8 -> Word8 -> r) -> int -> r
base256 Word8 -> Word8 -> Word8 -> Colour
Rgb (Int
xforall a. Num a => a -> a -> a
-Int
8)
    
    fromEnum :: Colour -> Int
fromEnum Colour
Black   = Int
0
    fromEnum Colour
Red     = Int
1
    fromEnum Colour
Green   = Int
2
    fromEnum Colour
Yellow  = Int
3
    fromEnum Colour
Blue    = Int
4
    fromEnum Colour
Magenta = Int
5
    fromEnum Colour
Cyan    = Int
6
    fromEnum Colour
White   = Int
7
    -- Arbitrary extension; maybe just 'error' out instead
    fromEnum (Rgb Word8
r Word8
g Word8
b) = Int
8 forall a. Num a => a -> a -> a
+ forall int. Integral int => int -> Word8 -> Word8 -> Word8 -> int
unbase Int
256 Word8
r Word8
g Word8
b
 

-- | Types of highlighting supported by ANSI codes (and some extra styles).
data Highlight =
    Normal
  | Bold
  | Dim
  | Underscore
  | Blink
  | ReverseVideo
  | Concealed
  | Foreground Colour
  | Background Colour
  -- The above styles are ANSI-supported, with the exception of the 'Rgb' constructor for 'Colour's.  Below are extra styles (e.g. for Html rendering).
  | Italic
  deriving (Highlight -> Highlight -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Highlight -> Highlight -> Bool
$c/= :: Highlight -> Highlight -> Bool
== :: Highlight -> Highlight -> Bool
$c== :: Highlight -> Highlight -> Bool
Eq,Int -> Highlight -> ShowS
[Highlight] -> ShowS
Highlight -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Highlight] -> ShowS
$cshowList :: [Highlight] -> ShowS
show :: Highlight -> String
$cshow :: Highlight -> String
showsPrec :: Int -> Highlight -> ShowS
$cshowsPrec :: Int -> Highlight -> ShowS
Show,ReadPrec [Highlight]
ReadPrec Highlight
Int -> ReadS Highlight
ReadS [Highlight]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Highlight]
$creadListPrec :: ReadPrec [Highlight]
readPrec :: ReadPrec Highlight
$creadPrec :: ReadPrec Highlight
readList :: ReadS [Highlight]
$creadList :: ReadS [Highlight]
readsPrec :: Int -> ReadS Highlight
$creadsPrec :: Int -> ReadS Highlight
Read)