{-|
Module      : Highlight
Description : A module for highlighting and formatting text in terminal output
Copyright   : (c) Lorenzobattistela, 2024
License     : MIT
Maintainer  : lorenzobattistela@gmail.com
Stability   : experimental

This module provides functions to highlight and format text in terminal output,
particularly useful for displaying code snippets with error highlighting.
-}
module Highlight 
    ( highlightError
    , highlight
    , underline
    , bold
    , italic
    , parenthesize
    , strikethrough
    , inverse
    , getColor
    ) where

-- | Highlight errors with red color and underline.
-- 
-- This function highlights text in the specified range with red color and underline.
-- 
-- * `sLine`, `sCol`: Starting line and column position.
-- * `eLine`, `eCol`: Ending line and column position.
-- * `file`: The text content to process.
-- 
-- Returns the highlighted text.
highlightError :: (Int, Int) -> (Int, Int) -> String -> String
highlightError :: (Int, Int) -> (Int, Int) -> String -> String
highlightError (Int
sLine, Int
sCol) (Int
eLine, Int
eCol) String
file =
    let color :: String
color = String -> String
getColor String
"red"
    in (Int, Int)
-> (Int, Int) -> String -> (String -> String) -> String -> String
highlight (Int
sLine, Int
sCol) (Int
eLine, Int
eCol) String
color String -> String
underline String
file

-- | Highlight text in the given range.
-- 
-- This function highlights text within the specified range with the provided color and formatting function.
-- 
-- * `sPos`: Starting position as a tuple (line, column).
-- * `ePos`: Ending position as a tuple (line, column).
-- * `color`: The color code to apply for highlighting.
-- * `format`: A function to format the highlighted text.
-- * `file`: The text content to process.
-- 
-- Returns the highlighted text.
highlight :: (Int, Int) -> (Int, Int) -> String -> (String -> String) -> String -> String
highlight :: (Int, Int)
-> (Int, Int) -> String -> (String -> String) -> String -> String
highlight sPos :: (Int, Int)
sPos@(Int
sLine, Int
sCol) ePos :: (Int, Int)
ePos@(Int
eLine, Int
eCol) String
color String -> String
format String
file =
    -- Assert that the range is valid
    Bool -> String -> String -> String
forall a. Bool -> String -> a -> a
assert ((Int, Int) -> (Int, Int) -> Bool
isInBounds (Int, Int)
sPos (Int, Int)
ePos)
           String
"Start position must be before or equal to end position" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
    
    let -- Split file into lines
        linesList :: [String]
linesList = String -> [String]
lines String
file
        
        -- Length of the number of lines for padding
        numLen :: Int
numLen = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
eLine)  

        -- Recursive function to process each line
        highlightLines :: [String] -> Int -> String
        highlightLines :: [String] -> Int -> String
highlightLines [] Int
_ = String
""  -- Base case: no more lines to process
        highlightLines (String
line : [String]
rest) Int
num
            | Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sLine = [String] -> Int -> String
highlightLines [String]
rest (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)  -- Skip lines before the start line
            | Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
eLine = String
""  -- Stop processing if past the end line
            | Bool
otherwise =
                let -- Determine the start and end columns for highlighting
                    targetStartCol :: Int
targetStartCol = if Int
num Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sLine then Int
sCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
0
                    adjustedCol :: Int
adjustedCol = if Int
num Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
eLine then Int
eCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
line
                    targetEndCol :: Int
targetEndCol = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
adjustedCol (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
line)

                    reset :: String
reset = String -> String
getColor String
"reset"
                    
                    -- Split the line into before, highlight, and after parts
                    (String
before, String
restLine) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
targetStartCol String
line
                    (String
target, String
after) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
targetEndCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
targetStartCol) String
restLine

                    -- Apply formatting function to the highlighted part
                    formattedTarget :: String
formattedTarget = String -> String
format String
target

                    -- Format the line with number, highlighted part, and color codes
                    numStr :: String
numStr = Int -> String -> String
pad Int
numLen (Int -> String
forall a. Show a => a -> String
show Int
num)
                    highlightedLine :: String
highlightedLine =
                      if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
target
                      then String
numStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" | " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
before String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
after String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"                     
                      else String
numStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" | " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
before String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
color String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
formattedTarget String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
reset String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
after String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
                in String
highlightedLine String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> Int -> String
highlightLines [String]
rest (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)  -- Recursively process the remaining lines

    -- Start highlighting from line number 1
    in [String] -> Int -> String
highlightLines [String]
linesList Int
1

-- | Pads a string with spaces to the left.
pad :: Int    -- ^ Desired length
    -> String -- ^ String to pad
    -> String -- ^ Padded string
pad :: Int -> String -> String
pad Int
len String
txt = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt) Int
0) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
txt

-- | Checks if the start position is before or equal to the end position.
isInBounds :: (Int, Int) -> (Int, Int) -> Bool
isInBounds :: (Int, Int) -> (Int, Int) -> Bool
isInBounds (Int
sLine, Int
sCol) (Int
eLine, Int
eCol) =
    Int
sLine Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
eLine Bool -> Bool -> Bool
|| (Int
sLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
eLine Bool -> Bool -> Bool
&& Int
sCol Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
eCol)

-- | Simple assertion function.
assert :: Bool   -- ^ Condition to assert
       -> String -- ^ Error message if assertion fails
       -> a      -- ^ Value to return if assertion passes
       -> a
assert :: forall a. Bool -> String -> a -> a
assert Bool
True String
_ a
x = a
x
assert Bool
False String
msg a
_ = String -> a
forall a. HasCallStack => String -> a
error String
msg

-- | Gets the ANSI color code for a given color name.
getColor :: String -- ^ Color name
         -> String -- ^ ANSI color code
getColor :: String -> String
getColor String
color = case String
color of
    String
"red"     -> String
"\x1b[31m"
    String
"green"   -> String
"\x1b[32m"
    String
"yellow"  -> String
"\x1b[33m"
    String
"blue"    -> String
"\x1b[34m"
    String
"magenta" -> String
"\x1b[35m"
    String
"cyan"    -> String
"\x1b[36m"
    String
"white"   -> String
"\x1b[37m"
    String
"reset"   -> String
"\x1b[0m"
    String
_         -> String
"\x1b[0m"  -- defaults to reset

-- | Applies underline formatting to text using ANSI escape codes.
underline :: String -- ^ Text to underline
          -> String -- ^ Underlined text
underline :: String -> String
underline String
text = String
"\x1b[4m" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
text String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\x1b[24m"

-- | Applies bold formatting to text using ANSI escape codes.
bold :: String -- ^ Text to make bold
     -> String -- ^ Bold text
bold :: String -> String
bold String
text = String
"\x1b[1m" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
text String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\x1b[22m"

-- | Applies italic formatting to text using ANSI escape codes.
italic :: String -- ^ Text to italicize
       -> String -- ^ Italicized text
italic :: String -> String
italic String
text = String
"\x1b[3m" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
text String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\x1b[23m"

-- | Wraps text in parentheses.
parenthesize :: String -- ^ Text to parenthesize
             -> String -- ^ Parenthesized text
parenthesize :: String -> String
parenthesize String
text = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
text String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

-- | Applies strikethrough formatting to text using ANSI escape codes.
strikethrough :: String -- ^ Text to strikethrough
              -> String -- ^ Strikethrough text
strikethrough :: String -> String
strikethrough String
text = String
"\x1b[9m" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
text String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\x1b[29m"

-- | Applies inverse (reverse video) formatting to text using ANSI escape codes.
inverse :: String -- ^ Text to inverse
        -> String -- ^ Inversed text
inverse :: String -> String
inverse String
text = String
"\x1b[7m" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
text String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\x1b[27m"