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

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

Apply a declarative 'Formatter' to a 'Double'. Replaces the
function-typed @LabelFormatter@ used by the legacy 'Granite.Plot'
record, so the entire chart spec can stay JSON-shaped.
-}
module Granite.Format (
    Formatter (..),
    runFormatter,
) where

import Data.Text (Text)
import Data.Text qualified as Text
import Numeric (showEFloat, showFFloat)

{- | A declarative formatter applied to numeric tick / label values.

The /Default/ behaves like the legacy formatter: scientific for
very small or very large magnitudes, fixed-point with one decimal
otherwise. The other constructors give the caller explicit control
without needing to embed a Haskell function in the spec.
-}
data Formatter
    = FormatDefault
    | -- | fixed point with the given decimals
      FormatPrecision Int
    | -- | scientific notation with the given decimals
      FormatScientific Int
    | -- | percentage (multiplies by 100), with given decimals
      FormatPercent Int
    | -- | integer with comma grouping (1,234,567)
      FormatComma
    | {- | epoch-millisecond value formatted with the given strftime-style
      pattern; unsupported in this phase, returns the raw value.
      -}
      FormatDateTime !Text
    | {- | a printf-like template with a single \"{}" placeholder.
      This phase only supports \"{}" itself.
      -}
      FormatTemplate !Text
    | -- | SI suffixes (1.2k, 3.4M)
      FormatSI
    deriving (Formatter -> Formatter -> Bool
(Formatter -> Formatter -> Bool)
-> (Formatter -> Formatter -> Bool) -> Eq Formatter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Formatter -> Formatter -> Bool
== :: Formatter -> Formatter -> Bool
$c/= :: Formatter -> Formatter -> Bool
/= :: Formatter -> Formatter -> Bool
Eq, Int -> Formatter -> ShowS
[Formatter] -> ShowS
Formatter -> String
(Int -> Formatter -> ShowS)
-> (Formatter -> String)
-> ([Formatter] -> ShowS)
-> Show Formatter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Formatter -> ShowS
showsPrec :: Int -> Formatter -> ShowS
$cshow :: Formatter -> String
show :: Formatter -> String
$cshowList :: [Formatter] -> ShowS
showList :: [Formatter] -> ShowS
Show, ReadPrec [Formatter]
ReadPrec Formatter
Int -> ReadS Formatter
ReadS [Formatter]
(Int -> ReadS Formatter)
-> ReadS [Formatter]
-> ReadPrec Formatter
-> ReadPrec [Formatter]
-> Read Formatter
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Formatter
readsPrec :: Int -> ReadS Formatter
$creadList :: ReadS [Formatter]
readList :: ReadS [Formatter]
$creadPrec :: ReadPrec Formatter
readPrec :: ReadPrec Formatter
$creadListPrec :: ReadPrec [Formatter]
readListPrec :: ReadPrec [Formatter]
Read)

runFormatter :: Formatter -> Double -> Text
runFormatter :: Formatter -> Double -> Text
runFormatter Formatter
f Double
v = case Formatter
f of
    Formatter
FormatDefault -> Double -> Text
defaultFmt Double
v
    FormatPrecision Int
n -> 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
n) Double
v String
"")
    FormatScientific Int
n -> String -> Text
Text.pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) Double
v String
"")
    FormatPercent Int
n -> 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
n) (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100) String
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"
    Formatter
FormatComma -> Integer -> Text
commaGroup (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
v :: Integer)
    FormatDateTime Text
_ -> String -> Text
Text.pack (Double -> String
forall a. Show a => a -> String
show Double
v)
    FormatTemplate Text
t -> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"{}" (Double -> Text
defaultFmt Double
v) Text
t
    Formatter
FormatSI -> Double -> Text
siSuffix Double
v

defaultFmt :: Double -> Text
defaultFmt :: Double -> Text
defaultFmt Double
v
    | Double -> Double
forall a. Num a => a -> a
abs Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
10000 Bool -> Bool -> Bool
|| Double -> Double
forall a. Num a => a -> a
abs Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.01 Bool -> Bool -> Bool
&& Double
v Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0 =
        String -> Text
Text.pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Double
v String
"")
    | 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
1) Double
v String
"")

commaGroup :: Integer -> Text
commaGroup :: Integer -> Text
commaGroup Integer
n =
    let neg :: Bool
neg = Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
        digits :: String
digits = ShowS
forall a. [a] -> [a]
reverse (Integer -> String
forall a. Show a => a -> String
show (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n))
        chunks :: [String]
chunks = Int -> String -> [String]
forall a. Int -> [a] -> [[a]]
chunkN Int
3 String
digits
        grouped :: String
grouped = ShowS
forall a. [a] -> [a]
reverse (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalateRev String
"," [String]
chunks)
     in (if Bool
neg then Text
"-" else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
grouped

chunkN :: Int -> [a] -> [[a]]
chunkN :: forall a. Int -> [a] -> [[a]]
chunkN Int
_ [] = []
chunkN Int
n [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
chunkN Int
n (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
xs)

intercalateRev :: [a] -> [[a]] -> [a]
intercalateRev :: forall a. [a] -> [[a]] -> [a]
intercalateRev [a]
sep = [[a]] -> [a]
go
  where
    go :: [[a]] -> [a]
go [] = []
    go [[a]
x] = [a]
x
    go ([a]
x : [[a]]
xs) = [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
sep [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [[a]] -> [a]
go [[a]]
xs

siSuffix :: Double -> Text
siSuffix :: Double -> Text
siSuffix Double
v
    | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e12 = Double -> Text -> Text
forall {a}. RealFloat a => a -> Text -> Text
fmt (Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e12) Text
"T"
    | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e9 = Double -> Text -> Text
forall {a}. RealFloat a => a -> Text -> Text
fmt (Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e9) Text
"G"
    | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e6 = Double -> Text -> Text
forall {a}. RealFloat a => a -> Text -> Text
fmt (Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6) Text
"M"
    | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e3 = Double -> Text -> Text
forall {a}. RealFloat a => a -> Text -> Text
fmt (Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e3) Text
"k"
    | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = 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
1) Double
v String
"")
    | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e-3 = Double -> Text -> Text
forall {a}. RealFloat a => a -> Text -> Text
fmt (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e3) Text
"m"
    | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e-6 = Double -> Text -> Text
forall {a}. RealFloat a => a -> Text -> Text
fmt (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e6) Text
"\x00b5"
    | Bool
otherwise = String -> Text
Text.pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Double
v String
"")
  where
    a :: Double
a = Double -> Double
forall a. Num a => a -> a
abs Double
v
    fmt :: a -> Text -> Text
fmt a
x Text
suf = String -> Text
Text.pack (Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) a
x String
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suf