{-|
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

-- | Highlights an error in the given content between the specified start and end positions.
highlightError :: (Int, Int) -> (Int, Int) -> String -> String
highlightError :: (Int, Int) -> (Int, Int) -> String -> String
highlightError (Int
sLine, Int
sCol) (Int
eLine, Int
eCol) String
content =
  (Int, Int)
-> (Int, Int) -> String -> (String -> String) -> String -> String
highlight (Int
sLine, Int
sCol) (Int
eLine, Int
eCol) String
"red" String -> String
underline String
content

-- | Highlights a portion of the given content between the specified start and end positions with a specified color and effect.
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
effect String
content =
    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 ([(Int, String)]
lineIndices, [Int]
lineNumbers) = String -> Int -> Int -> ([(Int, String)], [Int])
targetLines String
content Int
sLine Int
eLine
        displayText :: String
displayText = [(Int, String)]
-> [Int]
-> (Int, Int)
-> (Int, Int)
-> String
-> (String -> String)
-> String
buildDisplayText [(Int, String)]
lineIndices [Int]
lineNumbers (Int, Int)
sPos (Int, Int)
ePos String
color String -> String
effect
    in String
displayText

-- | Extracts the target lines and their indices from the content based on the start and end line numbers.
targetLines :: String -> Int -> Int -> ([(Int, String)], [Int])
targetLines :: String -> Int -> Int -> ([(Int, String)], [Int])
targetLines String
content Int
sLine Int
eLine =
    let
        -- Pair each line with its line number, starting from 1
        numberedLines :: [(Int, String)]
numberedLines = [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] ([String] -> [(Int, String)]) -> [String] -> [(Int, String)]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
content
        
        -- Extract only the lines between startLine and endLine
        intervalLines :: [(Int, String)]
intervalLines = ((Int, String) -> Bool) -> [(Int, String)] -> [(Int, String)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Int
lineNum, String
_) -> Int
lineNum Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
eLine) ([(Int, String)] -> [(Int, String)])
-> [(Int, String)] -> [(Int, String)]
forall a b. (a -> b) -> a -> b
$ 
                        ((Int, String) -> Bool) -> [(Int, String)] -> [(Int, String)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Int
lineNum, String
_) -> Int
lineNum Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sLine) [(Int, String)]
numberedLines
        
        -- Calculate cumulative character indices for each target line
        -- Example: "Hello\nWorld" will return [0, 6] because 0 has 5 characters + 1 for newline
        indices :: [Int]
indices = (Int -> (Int, String) -> Int) -> Int -> [(Int, String)] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Int
accIndex (Int
_, String
line) -> Int
accIndex 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
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 [(Int, String)]
intervalLines
        -- Extract line numbers from target lines to a list
        numbers :: [Int]
numbers = ((Int, String) -> Int) -> [(Int, String)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> Int
forall a b. (a, b) -> a
fst [(Int, String)]
intervalLines
        -- Extract line contents from target lines to a list
        contents :: [String]
contents = ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> String
forall a b. (a, b) -> b
snd [(Int, String)]
intervalLines
        -- Pair each line index with its corresponding line content
        -- Example: "Hello\nWorld" would return: [(0, "Hello"), (6, "World")]
        indexedLines :: [(Int, String)]
indexedLines = [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
indices [String]
contents
      -- Returns (a list of)  a tuple containing the indexed lines above along with their respective line numbers
     in ([(Int, String)]
indexedLines, [Int]
numbers)

-- | Builds the display text with highlighting applied to the specified portion of the content.
buildDisplayText :: [(Int, String)] -> [Int] -> (Int, Int) -> (Int, Int) -> String -> (String -> String) -> String
buildDisplayText :: [(Int, String)]
-> [Int]
-> (Int, Int)
-> (Int, Int)
-> String
-> (String -> String)
-> String
buildDisplayText [(Int, String)]
indices [Int]
numbers (Int
sLine, Int
sCol) (Int
eLine, Int
eCol) String
colorStr String -> String
effect =
    -- Calculate the maximum line number to pad the pipe
    let maxNumLineWidth :: Int
maxNumLineWidth = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
numbers
        -- add padding to the number + pipe line
        formatLineNum :: a -> String
formatLineNum a
n = Int -> String -> String
pad Int
maxNumLineWidth (a -> String
forall a. Show a => a -> String
show a
n) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" | "
        color :: String
color = String -> String
getColor String
colorStr
        reset :: String
reset = String
"\x1b[0m"

        -- helper to determine start/end column index of highlighting
        col :: a -> a -> a -> a -> a
col a
num a
line a
col a
fallback = if a
num a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
line then a
col a -> a -> a
forall a. Num a => a -> a -> a
- a
1 else a
fallback 

        highlightLine :: (a, String) -> Int -> String
highlightLine (a
start, String
line) Int
num =
              -- Split the line at the starting column for highlighting (0-based index).
          let (String
before, String
rest)  = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int -> Int -> Int -> Int
forall {a} {a}. (Eq a, Num a) => a -> a -> a -> a -> a
col Int
num Int
sLine Int
sCol Int
0) String
line
              -- Split the remaining part of the line at the ending column for highlighting (0-based index), 
              -- adjusted by subtracting the length of the `before` segment to correctly identify the `target` segment.
              (String
target, String
after) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int -> Int -> Int -> Int
forall {a} {a}. (Eq a, Num a) => a -> a -> a -> a -> a
col Int
num Int
eLine Int
eCol (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
line) 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
before) String
rest
              -- apply color and effects to target text
              highlighted :: String
highlighted = String
color String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
effect String
target String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
reset
          in Int -> String
forall a. Show a => a -> String
formatLineNum Int
num String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
before String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
highlighted String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
after

    -- zipWith calls highlightLine for every element of zipped indices and numbers, resulting in a list of strings with the highlighted ones
    -- unlines concate them with newlines, returning a highlighted string
    in [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Int, String) -> Int -> String)
-> [(Int, String)] -> [Int] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, String) -> Int -> String
forall {a}. (a, String) -> Int -> String
highlightLine [(Int, String)]
indices [Int]
numbers

-- | 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
_         -> 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"