{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}

{- |
Module      : Granite.Internal.Util
Copyright   : (c) 2025
License     : MIT
Maintainer  : mschavinda@gmail.com

Internal helpers shared across backends.
-}
module Granite.Internal.Util (
    clamp,
    eps,
    minimum',
    maximum',
    mod',
    angleWithin,
    quartiles,
    normalize,
    setAt,
    updateAt,
    addAt,
    gridWidth,
    wcswidth,
    ellipsisize,
    estLabelWidthPx,
    estMaxGlyphs,
    truncatePx,
    justifyRight,
    showD,
    escXml,
    ticks1D,
) where

import Data.List qualified as List
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Text (Text)
import Data.Text qualified as Text
import Numeric (showFFloat)

clamp :: (Ord a) => a -> a -> a -> a
clamp :: forall a. Ord a => a -> a -> a -> a
clamp a
low a
high a
x = a -> a -> a
forall a. Ord a => a -> a -> a
max a
low (a -> a -> a
forall a. Ord a => a -> a -> a
min a
high a
x)

eps :: Double
eps :: Double
eps = Double
1e-12

minimum', maximum' :: [Double] -> Double
minimum' :: [Double] -> Double
minimum' [] = Double
0
minimum' [Double]
xs = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
xs
maximum' :: [Double] -> Double
maximum' [] = Double
1
maximum' [Double]
xs = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
xs

mod' :: Double -> Double -> Double
mod' :: Double -> Double -> Double
mod' Double
a Double
m = Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
m) :: Int) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m

angleWithin :: Double -> Double -> Double -> Bool
angleWithin :: Double -> Double -> Double -> Bool
angleWithin Double
ang Double
a0 Double
a1
    | Double
a1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
a0 = Double
ang Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
a0 Bool -> Bool -> Bool
&& Double
ang Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
a1
    | Bool
otherwise = Double
ang Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
a0 Bool -> Bool -> Bool
|| Double
ang Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
a1

{- | Five-number summary: @(min, Q1, median, Q3, max)@. For @n < 5@,
all five values collapse to the mean.
-}
quartiles :: [Double] -> (Double, Double, Double, Double, Double)
quartiles :: [Double] -> (Double, Double, Double, Double, Double)
quartiles [] = (Double
0, Double
0, Double
0, Double
0, Double
0)
quartiles [Double]
xs =
    let sorted :: [Double]
sorted = [Double] -> [Double]
forall a. Ord a => [a] -> [a]
List.sort [Double]
xs
        n :: Int
n = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
sorted
        q1Idx :: Int
q1Idx = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
        q2Idx :: Int
q2Idx = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        q3Idx :: Int
q3Idx = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
        getIdx :: Int -> Double
getIdx Int
i = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n then [Double]
sorted [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
i else [Double] -> Double
forall a. HasCallStack => [a] -> a
last [Double]
sorted
     in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5
            then let m :: Double
m = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
xs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n in (Double
m, Double
m, Double
m, Double
m, Double
m)
            else
                ( Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 ([Double] -> Maybe Double
forall a. [a] -> Maybe a
listToMaybe [Double]
sorted)
                , Int -> Double
getIdx Int
q1Idx
                , Int -> Double
getIdx Int
q2Idx
                , Int -> Double
getIdx Int
q3Idx
                , [Double] -> Double
forall a. HasCallStack => [a] -> a
last [Double]
sorted
                )

normalize :: [(Text, Double)] -> [(Text, Double)]
normalize :: [(Text, Double)] -> [(Text, Double)]
normalize [(Text, Double)]
xs =
    let s :: Double
s = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Text, Double) -> Double) -> [(Text, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double
forall a. Num a => a -> a
abs (Double -> Double)
-> ((Text, Double) -> Double) -> (Text, Double) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Double) -> Double
forall a b. (a, b) -> b
snd) [(Text, Double)]
xs) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1e-12
     in [(Text
n, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
s)) | (Text
n, Double
v) <- [(Text, Double)]
xs]

setAt :: [a] -> Int -> a -> [a]
setAt :: forall a. [a] -> Int -> a -> [a]
setAt [a]
xs Int
i a
v = [a] -> Int -> (a -> a) -> [a]
forall a. [a] -> Int -> (a -> a) -> [a]
updateAt [a]
xs Int
i (a -> a -> a
forall a b. a -> b -> a
const a
v)

updateAt :: [a] -> Int -> (a -> a) -> [a]
updateAt :: forall a. [a] -> Int -> (a -> a) -> [a]
updateAt [a]
xs Int
i a -> a
f
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [a]
xs
    | Bool
otherwise = [a] -> Int -> [a]
forall {t}. (Eq t, Num t) => [a] -> t -> [a]
go [a]
xs Int
i
  where
    go :: [a] -> t -> [a]
go [] t
_ = []
    go (a
x : [a]
rest) t
0 = a -> a
f a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rest
    go (a
x : [a]
rest) t
n = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> t -> [a]
go [a]
rest (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)

addAt :: [Int] -> Int -> Int -> [Int]
addAt :: [Int] -> Int -> Int -> [Int]
addAt [Int]
xs Int
i Int
v = [Int] -> Int -> (Int -> Int) -> [Int]
forall a. [a] -> Int -> (a -> a) -> [a]
updateAt [Int]
xs Int
i (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
v)

gridWidth :: [[a]] -> Int
gridWidth :: forall a. [[a]] -> Int
gridWidth [] = Int
0
gridWidth ([a]
x : [[a]]
_) = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x

-- | Visible width of text, skipping ANSI escape sequences.
wcswidth :: Text -> Int
wcswidth :: Text -> Int
wcswidth = Int -> Text -> Int
forall {t}. Num t => t -> Text -> t
go Int
0
  where
    go :: t -> Text -> t
go t
acc Text
xs
        | Text -> Bool
Text.null Text
xs = t
acc
        | Text -> Text -> Bool
Text.isPrefixOf Text
"\ESC[" Text
xs =
            let rest' :: Text
rest' = (Char -> Bool) -> Text -> Text
Text.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'm') Text
xs
             in if Text -> Bool
Text.null Text
rest' then t
acc else t -> Text -> t
go t
acc (HasCallStack => Text -> Text
Text -> Text
Text.tail Text
rest')
        | Bool
otherwise = t -> Text -> t
go (t
acc t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) (HasCallStack => Text -> Text
Text -> Text
Text.tail Text
xs)

{- | Ensure the text fits within maxWidth. If it doesn't, truncate and append an ellipsis.
>>> ellipsisize 5 "Hello, World!"
"Hell\8230"
>>> ellipsisize 1 "Hi"
"\8230"
>>> ellipsisize 0 "Hello, World!"
""
>>> ellipsisize 20 "Hello, World!"
"Hello, World!"
-}
ellipsisize :: Int -> Text -> Text
ellipsisize :: Int -> Text -> Text
ellipsisize Int
maxWidth Text
lbl
    | Int
maxWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text
""
    | Text -> Int
wcswidth Text
lbl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxWidth = Int -> Text -> Text
Text.take (Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"…"
    | Bool
otherwise = Text
lbl

-- | Average glyph advance as a fraction of the em, for proportional fonts.
glyphAspectEm :: Double
glyphAspectEm :: Double
glyphAspectEm = Double
0.6

{- | Rough rendered pixel width of a label at a given font size: visible
glyph count times 'glyphAspectEm'. Good enough to decide when axis labels
would collide.
-}
estLabelWidthPx :: Double -> Text -> Double
estLabelWidthPx :: Double -> Text -> Double
estLabelWidthPx Double
fontSize Text
t = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
wcswidth Text
t) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fontSize Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
glyphAspectEm

{- | Inverse of 'estLabelWidthPx': the most glyphs that fit within @limitPx@
at the given font size. Pair with 'ellipsisize' to truncate to a pixel budget.
-}
estMaxGlyphs :: Double -> Double -> Int
estMaxGlyphs :: Double -> Double -> Int
estMaxGlyphs Double
fontSize Double
limitPx = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
limitPx Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
fontSize Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
glyphAspectEm))

{- | Fit @full@ within @limitPx@ at the given font size: returns the
(possibly ellipsised) label and, when it was shortened, the full text for a
tooltip. Used wherever a label must not overrun its slot (axis ticks, facet
strips).
-}
truncatePx :: Double -> Double -> Text -> (Text, Maybe Text)
truncatePx :: Double -> Double -> Text -> (Text, Maybe Text)
truncatePx Double
fontSize Double
limitPx Text
full
    | Double -> Text -> Double
estLabelWidthPx Double
fontSize Text
full Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
limitPx = (Text
full, Maybe Text
forall a. Maybe a
Nothing)
    | Bool
otherwise =
        (Int -> Text -> Text
ellipsisize (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Double -> Double -> Int
estMaxGlyphs Double
fontSize Double
limitPx)) Text
full, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
full)

justifyRight :: Int -> Text -> Text
justifyRight :: Int -> Text -> Text
justifyRight Int
n Text
s = Int -> Text -> Text
Text.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
wcswidth Text
s)) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s

showD :: Double -> Text
showD :: Double -> Text
showD Double
d
    | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
d :: Int) = String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
d :: Int))
    | Bool
otherwise = String -> Text
Text.pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Double
d String
"")

escXml :: Text -> Text
escXml :: Text -> Text
escXml =
    HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"&" Text
"&amp;"
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"<" Text
"&lt;"
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
">" Text
"&gt;"
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"\"" Text
"&quot;"

{- | Evenly spaced tick positions in screen space paired with data values.
With @invertY = True@, position 0 maps to @vmax@ (top row).
-}
ticks1D :: Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D :: Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D Int
screenLen Int
want (Double
vmin, Double
vmax) Bool
invertY =
    let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2 Int
want
        lastIx :: Int
lastIx = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
screenLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        toVal :: Double -> Double
toVal Double
t =
            if Bool
invertY
                then Double
vmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
vmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vmin)
                else Double
vmin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
vmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vmin)
        mk' :: p -> (a, Double)
mk' p
k =
            let t :: Double
t = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Double
0 else p -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
k Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                pos :: a
pos = Double -> a
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lastIx)
             in (a
pos, Double -> Double
toVal Double
t)
        raw :: [(Int, Double)]
raw = [Int -> (Int, Double)
forall {p} {a}. (Integral p, Integral a) => p -> (a, Double)
mk' Int
k | Int
k <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
     in ((Int, Double) -> (Int, Double) -> Bool)
-> [(Int, Double)] -> [(Int, Double)]
forall a. (a -> a -> Bool) -> [a] -> [a]
List.nubBy (\(Int, Double)
a (Int, Double)
b -> (Int, Double) -> Int
forall a b. (a, b) -> a
fst (Int, Double)
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Double) -> Int
forall a b. (a, b) -> a
fst (Int, Double)
b) [(Int, Double)]
raw