{-# OPTIONS_GHC -Wall -Werror #-}

{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
{-# LANGUAGE Safe                         #-}

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

-- |
-- Copyright  : (c) 2026 SPISE MISU ApS
-- License    : SSPL-1.0 OR AGPL-3.0-only
-- Maintainer : SPISE MISU <mail+hackage@spisemisu.com>
-- Stability  : experimental

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

module Agent.Data.ANSI.EscapeCode
  ( -- * Type signatures
    SelectGraphicRendition
  , Blink
  , Bright
  , Background
  , Foreground
    -- * Enums
  , Colour
    ( Black
    , Red
    , Green
    , Yellow
    , Blue
    , Magenta
    , Cyan
    , White
    )
  , Frequency
    ( Slow
    , Fast
    )
    -- * Methods
  , sgr
  , foreground
  , background
  , bold
  , faint
  , italic
  , underline
  , blink
  )
where

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

data Colour
  = Black
  | Red
  | Green
  | Yellow
  | Blue
  | Magenta
  | Cyan
  | White
  deriving (Colour -> Colour -> Bool
(Colour -> Colour -> Bool)
-> (Colour -> Colour -> Bool) -> Eq Colour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Colour -> Colour -> Bool
== :: Colour -> Colour -> Bool
$c/= :: Colour -> Colour -> Bool
/= :: Colour -> Colour -> Bool
Eq)

instance Enum Colour where
  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

  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
  toEnum Int
_ = [Char] -> Colour
forall a. HasCallStack => [Char] -> a
error [Char]
"Colour code not supported"

type Bright = Bool

data Background = BG !Bool Bright Colour
data Foreground = FG !Bool Bright Colour

data Frequency
  = Slow
  | Fast

data Blink = B !Bool Frequency

data SelectGraphicRendition
  = SGR !Background !Foreground !Bool !Bool !Bool !Bool !Blink String

instance Show SelectGraphicRendition where
  show :: SelectGraphicRendition -> [Char]
show (SGR Background
bg Foreground
fg Bool
bo Bool
fa Bool
it Bool
un Blink
bl [Char]
text) =
    [Char]
"\ESC[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
    [Char]
"0"     [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Background -> [Char]
cb Background
bg) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Foreground -> [Char]
cf Foreground
fg) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Bool -> [Char]
fb Bool
bo) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Bool -> [Char]
ff Bool
fa) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Bool -> [Char]
fi Bool
it) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Bool -> [Char]
fu Bool
un) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Blink -> [Char]
bf Blink
bl) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
    [Char]
"m"     [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
    [Char]
text    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
    [Char]
"\ESC[00m"
    where
      cb :: Background -> [Char]
cb (BG Bool
True  Bool
True  Colour
c) = [Char]
";" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
40 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Colour -> Int
forall a. Enum a => a -> Int
fromEnum Colour
c)
      cb (BG Bool
True  Bool
False Colour
c) = [Char]
";" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$      Int
40 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Colour -> Int
forall a. Enum a => a -> Int
fromEnum Colour
c)
      cb (BG Bool
False Bool
_____ Colour
_) = [                                  ]
      cf :: Foreground -> [Char]
cf (FG Bool
True  Bool
True  Colour
c) = [Char]
";" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Colour -> Int
forall a. Enum a => a -> Int
fromEnum Colour
c)
      cf (FG Bool
True  Bool
False Colour
c) = [Char]
";" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$      Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Colour -> Int
forall a. Enum a => a -> Int
fromEnum Colour
c)
      cf (FG Bool
False Bool
_____ Colour
_) = [                                  ]
      fb :: Bool -> [Char]
fb     Bool
True  = [Char]
";01"
      fb     Bool
False = [   ]
      ff :: Bool -> [Char]
ff     Bool
True  = [Char]
";02"
      ff     Bool
False = [   ]
      fi :: Bool -> [Char]
fi     Bool
True  = [Char]
";03"
      fi     Bool
False = [   ]
      fu :: Bool -> [Char]
fu     Bool
True  = [Char]
";04"
      fu     Bool
False = [   ]
      bf :: Blink -> [Char]
bf (B  Bool
True  Frequency
Slow) = [Char]
";05"
      bf (B  Bool
True  Frequency
Fast) = [Char]
";06"
      bf (B  Bool
False Frequency
____) = [   ]

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

sgr
  :: String
  -> SelectGraphicRendition

foreground
  :: Bright
  -> Colour
  -> SelectGraphicRendition
  -> SelectGraphicRendition

background
  :: Bright
  -> Colour
  -> SelectGraphicRendition
  -> SelectGraphicRendition

bold
  :: SelectGraphicRendition
  -> SelectGraphicRendition

faint
  :: SelectGraphicRendition
  -> SelectGraphicRendition

italic
  :: SelectGraphicRendition
  -> SelectGraphicRendition

underline
  :: SelectGraphicRendition
  -> SelectGraphicRendition

blink
  :: Frequency
  -> SelectGraphicRendition
  -> SelectGraphicRendition

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

sgr :: [Char] -> SelectGraphicRendition
sgr =
  Background
-> Foreground
-> Bool
-> Bool
-> Bool
-> Bool
-> Blink
-> [Char]
-> SelectGraphicRendition
SGR Background
bg Foreground
fg Bool
bo Bool
fa Bool
it Bool
un Blink
bl
  where
    fg :: Foreground
fg = Bool -> Bool -> Colour -> Foreground
FG Bool
False Bool
forall a. HasCallStack => a
undefined Colour
forall a. HasCallStack => a
undefined
    bg :: Background
bg = Bool -> Bool -> Colour -> Background
BG Bool
False Bool
forall a. HasCallStack => a
undefined Colour
forall a. HasCallStack => a
undefined
    bo :: Bool
bo = Bool
False
    fa :: Bool
fa = Bool
False
    it :: Bool
it = Bool
False
    un :: Bool
un = Bool
False
    bl :: Blink
bl = Bool -> Frequency -> Blink
B Bool
False Frequency
forall a. HasCallStack => a
undefined

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

foreground :: Bool -> Colour -> SelectGraphicRendition -> SelectGraphicRendition
foreground Bool
b Colour
c (SGR Background
bg Foreground
__ Bool
bo Bool
fa Bool
it Bool
un Blink
bl [Char]
txt) =
  Background
-> Foreground
-> Bool
-> Bool
-> Bool
-> Bool
-> Blink
-> [Char]
-> SelectGraphicRendition
SGR Background
bg Foreground
fg Bool
bo Bool
fa Bool
it Bool
un Blink
bl [Char]
txt
  where
    fg :: Foreground
fg = Bool -> Bool -> Colour -> Foreground
FG Bool
True Bool
b Colour
c

background :: Bool -> Colour -> SelectGraphicRendition -> SelectGraphicRendition
background Bool
b Colour
c (SGR Background
__ Foreground
fg Bool
bo Bool
fa Bool
it Bool
un Blink
bl [Char]
txt) =
  Background
-> Foreground
-> Bool
-> Bool
-> Bool
-> Bool
-> Blink
-> [Char]
-> SelectGraphicRendition
SGR Background
bg Foreground
fg Bool
bo Bool
fa Bool
it Bool
un Blink
bl [Char]
txt
  where
    bg :: Background
bg = Bool -> Bool -> Colour -> Background
BG Bool
True Bool
b Colour
c

bold :: SelectGraphicRendition -> SelectGraphicRendition
bold (SGR Background
bg Foreground
fg Bool
__ Bool
fa Bool
it Bool
un Blink
bl [Char]
txt) =
  Background
-> Foreground
-> Bool
-> Bool
-> Bool
-> Bool
-> Blink
-> [Char]
-> SelectGraphicRendition
SGR Background
bg Foreground
fg Bool
bo Bool
fa Bool
it Bool
un Blink
bl [Char]
txt
  where
    bo :: Bool
bo = Bool
True

faint :: SelectGraphicRendition -> SelectGraphicRendition
faint (SGR Background
bg Foreground
fg Bool
bo Bool
__ Bool
it Bool
un Blink
bl [Char]
txt) =
  Background
-> Foreground
-> Bool
-> Bool
-> Bool
-> Bool
-> Blink
-> [Char]
-> SelectGraphicRendition
SGR Background
bg Foreground
fg Bool
bo Bool
fa Bool
it Bool
un Blink
bl [Char]
txt
  where
    fa :: Bool
fa = Bool
True

italic :: SelectGraphicRendition -> SelectGraphicRendition
italic (SGR Background
bg Foreground
fg Bool
bo Bool
fa Bool
__ Bool
un Blink
bl [Char]
txt) =
  Background
-> Foreground
-> Bool
-> Bool
-> Bool
-> Bool
-> Blink
-> [Char]
-> SelectGraphicRendition
SGR Background
bg Foreground
fg Bool
bo Bool
fa Bool
it Bool
un Blink
bl [Char]
txt
  where
    it :: Bool
it = Bool
True

underline :: SelectGraphicRendition -> SelectGraphicRendition
underline (SGR Background
bg Foreground
fg Bool
bo Bool
fa Bool
it Bool
__ Blink
bl [Char]
txt) =
  Background
-> Foreground
-> Bool
-> Bool
-> Bool
-> Bool
-> Blink
-> [Char]
-> SelectGraphicRendition
SGR Background
bg Foreground
fg Bool
bo Bool
fa Bool
it Bool
un Blink
bl [Char]
txt
  where
    un :: Bool
un = Bool
True

blink :: Frequency -> SelectGraphicRendition -> SelectGraphicRendition
blink Frequency
f (SGR Background
bg Foreground
fg Bool
bo Bool
fa Bool
it Bool
un Blink
__ [Char]
txt) =
  Background
-> Foreground
-> Bool
-> Bool
-> Bool
-> Bool
-> Blink
-> [Char]
-> SelectGraphicRendition
SGR Background
bg Foreground
fg Bool
bo Bool
fa Bool
it Bool
un Blink
bl [Char]
txt
  where
    bl :: Blink
bl = Bool -> Frequency -> Blink
B Bool
True Frequency
f

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

-- References
--
-- ANSI escape code:
-- * https://en.wikipedia.org/wiki/ANSI_escape_code#SGR_parameters