{-|
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 text using red underline.
highlightError :: (Int, Int) -- ^ Start position (line, column)
               -> (Int, Int) -- ^ End position (line, column)
               -> String     -- ^ The text content
               -> String     -- ^ The highlighted text
highlightError :: (Int, Int) -> (Int, Int) -> String -> String
highlightError (Int
startLine, Int
startCol) (Int
endLine, Int
endCol) String
content =
  (Int, Int)
-> (Int, Int) -> String -> String -> (String -> String) -> String
highlight (Int
startLine, Int
startCol) (Int
endLine, Int
endCol) String
"red" String
content String -> String
underline

-- | Highlights a portion of text with a specified color and effect.
highlight :: (Int, Int)            -- ^ Start position (line, column)
          -> (Int, Int)            -- ^ End position (line, column)
          -> String                -- ^ Color name
          -> String                -- ^ The text content
          -> (String -> String)    -- ^ Effect function
          -> String                -- ^ The highlighted text
highlight :: (Int, Int)
-> (Int, Int) -> String -> String -> (String -> String) -> String
highlight (Int
startLine, Int
startCol) (Int
endLine, Int
endCol) String
color String
content String -> String
effect =
    Bool -> String -> String -> String
forall a. Bool -> String -> a -> a
assert (Int
startLine Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
endLine Bool -> Bool -> Bool
&& (Int
startLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
endLine Bool -> Bool -> Bool
|| Int
startCol Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
endCol)) 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, Int) -> ([(Int, String)], [Int])
calculateIndicesAndLineNumbers String
content (Int
startLine, Int
startCol) (Int
endLine, Int
endCol)
        displayText :: String
displayText = [(Int, String)]
-> [Int]
-> (Int, Int)
-> (Int, Int)
-> String
-> (String -> String)
-> String
buildDisplayText [(Int, String)]
lineIndices [Int]
lineNumbers (Int
startLine, Int
startCol) (Int
endLine, Int
endCol) String
color String -> String
effect
    in String
displayText

-- | Calculates indices and line numbers for the relevant portion of text.
calculateIndicesAndLineNumbers :: String -> (Int, Int) -> (Int, Int) -> ([(Int, String)], [Int])
calculateIndicesAndLineNumbers :: String -> (Int, Int) -> (Int, Int) -> ([(Int, String)], [Int])
calculateIndicesAndLineNumbers String
content (Int
startLine, Int
startCol) (Int
endLine, Int
endCol) =
    let linesWithNumbers :: [(Int, String)]
linesWithNumbers = [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
        relevantLines :: [(Int, String)]
relevantLines = ((Int, String) -> Bool) -> [(Int, String)] -> [(Int, String)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Int
n, String
_) -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
endLine) ([(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
n, String
_) -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
startLine) [(Int, String)]
linesWithNumbers
        lineIndices :: [Int]
lineIndices = (Int -> (Int, String) -> Int) -> Int -> [(Int, String)] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Int
acc (Int
_, String
l) -> Int
acc 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
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 [(Int, String)]
relevantLines
        lineNumbers :: [Int]
lineNumbers = ((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)]
relevantLines
    in ([Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
lineIndices (((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)]
relevantLines), [Int]
lineNumbers)

-- | Builds the display text with line numbers and highlighting.
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)]
lineIndices [Int]
lineNumbers (Int
startLine, Int
startCol) (Int
endLine, Int
endCol) String
colorStr String -> String
effect =
    let maxLineNumWidth :: Int
maxLineNumWidth = 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]
lineNumbers
        formatLineNum :: a -> String
formatLineNum a
n = Int -> String -> String
pad Int
maxLineNumWidth (a -> String
forall a. Show a => a -> String
show a
n)
        
        highlightLine :: Int -> Int -> String -> String
        highlightLine :: Int -> Int -> String -> String
highlightLine Int
lineNum Int
lineStart String
line =
            let lineEnd :: Int
lineEnd = if Int
lineNum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
endLine then Int
endCol 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
                startCol' :: Int
startCol' = if Int
lineNum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
startLine then Int
startCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
0
                (String
before, String
highlight) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
startCol' String
line
                (String
toHighlight, String
after) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
lineEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startCol') String
highlight
            in Int -> String
forall a. Show a => a -> String
formatLineNum Int
lineNum 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 -> String
effect String
toHighlight) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
reset String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
after
        color :: String
color = String -> String
getColor String
colorStr
        reset :: String
reset = String
"\x1b[0m"
    in [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> String -> String)
-> [Int] -> [Int] -> [String] -> [String]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Int -> Int -> String -> String
highlightLine [Int]
lineNumbers (((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)]
lineIndices) (((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)]
lineIndices)

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

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