{- |
Module      : Granite.String
Copyright   : (c) 2024
License     : BSD3
Maintainer  : your-email@example.com
Stability   : experimental
Portability : POSIX

A String-based interface to the Granite plotting library. This module provides
the same functionality as "Granite" but uses 'String' instead of 'Text' for
easier use in simple scripts and educational contexts.

= Basic Usage

Create a simple scatter plot:

@
import Granite.String

main = do
  let points = [(x, sin x) | x <- [0, 0.1 .. 6.28]]
      chart = scatter [series "sin(x)" points] defPlot
  putStrLn chart
@

= Note on Performance

This module internally converts between 'String' and 'Text'. For performance-critical
applications with large datasets, consider using the "Granite" module directly which
works with 'Text' natively.

= Terminal Requirements

This library requires a terminal that supports:

  * Unicode (specifically Braille patterns U+2800-U+28FF)
  * ANSI color codes
  * Monospace font with proper Braille character rendering
-}
module Granite.String (
    -- * Plot Configuration
    Plot (..),
    defPlot,

    -- * Data Preparation
    series,
    module RE,
    bins,

    -- * Formatting
    LabelFormatter,

    -- * Chart Types
    scatter,
    lineGraph,
    bars,
    stackedBars,
    histogram,
    pie,
    heatmap,
    boxPlot,
) where

import Data.Text (Text)

import Data.Bifunctor
import Data.Text qualified as Text
import Granite qualified as G

import Granite as RE (AxisEnv (..), Bins, Color (..), LegendPos (..))

{- | Plot configuration parameters.

Controls the appearance and layout of generated charts.
-}
data Plot = Plot
    { Plot -> Int
widthChars :: Int
    -- ^ Width of the plot area in terminal characters (default: 60)
    , Plot -> Int
heightChars :: Int
    -- ^ Height of the plot area in terminal characters (default: 20)
    , Plot -> Int
leftMargin :: Int
    -- ^ Space reserved for y-axis labels (default: 6)
    , Plot -> Int
bottomMargin :: Int
    -- ^ Space reserved for x-axis labels (default: 2)
    , Plot -> Int
titleMargin :: Int
    -- ^ Space above the plot for the title (default: 1)
    , Plot -> (Maybe Double, Maybe Double)
xBounds :: (Maybe Double, Maybe Double)
    {- ^ Optional manual x-axis bounds (min, max).
    'Nothing' uses automatic bounds with 5% padding.
    -}
    , Plot -> (Maybe Double, Maybe Double)
yBounds :: (Maybe Double, Maybe Double)
    {- ^ Optional manual y-axis bounds (min, max).
    'Nothing' uses automatic bounds with 5% padding.
    -}
    , Plot -> String
plotTitle :: String
    -- ^ Title displayed above the plot (default: empty)
    , Plot -> LegendPos
legendPos :: G.LegendPos
    -- ^ Position of the legend (default: 'LegendRight')
    , Plot -> [Color]
colorPalette :: [G.Color]
    -- ^ Color palette that'll be used by the plot.
    , Plot -> LabelFormatter
xFormatter :: LabelFormatter
    -- ^ Formatter for x-axis labels.
    , Plot -> LabelFormatter
yFormatter :: LabelFormatter
    -- ^ Formatter for y-axis labels.
    , Plot -> Int
xNumTicks :: Int
    -- ^ Number of ticks on the x axis.
    , Plot -> Int
yNumTicks :: Int
    -- ^ Number of ticks on the y axis.
    }

{- | Axis-aware, width-limited, tick-label formatter.

Given:
   * axis context
   * a per-tick width budget (in terminal cells)
   * and the raw tick value.
returns the label to render.
-}
type LabelFormatter =
    -- | Axis context (domain, tick index/count, etc)
    G.AxisEnv ->
    -- | Slot width budget in characters for this tick.
    Int ->
    -- | Raw data value for the tick
    Double ->
    -- | Rendered label (if it doesn't fit in the slot it will be truncated)
    String

{- | Default plot configuration.

Creates a 60×20 character plot with reasonable defaults:

@
defPlot = Plot
  { widthChars   = 60
  , heightChars  = 20
  , leftMargin   = 6
  , bottomMargin = 2
  , titleMargin  = 1
  , xBounds      = (Nothing, Nothing)
  , yBounds      = (Nothing, Nothing)
  , plotTitle    = ""
  , legendPos    = LegendRight
  , colorPalette = [BrightBlue, BrightMagenta, BrightCyan, BrightGreen, BrightYellow, BrightRed, BrightWhite, BrightBlack]
  , xFormatter   = \_ d -> show d
  , yFormatter   = \_ d -> show d
  , xNumTicks    = 2
  , yNumTicks    = 2
  }
@
-}
defPlot :: Plot
defPlot :: Plot
defPlot = Plot -> Plot
fromGranitePlot Plot
G.defPlot

{- | Create a bin configuration for histograms.

@
bins 10 0 100  -- 10 bins from 0 to 100
bins 20 (-5) 5 -- 20 bins from -5 to 5
@
-}
bins ::
    -- | Number of bins (will be clamped to minimum 1)
    Int ->
    -- | Lower bound
    Double ->
    -- | Upper bound
    Double ->
    G.Bins
bins :: Int -> Double -> Double -> Bins
bins = Int -> Double -> Double -> Bins
G.bins

{- | Create a named data series for multi-series plots.

@
let s1 = series "Dataset A" [(1,2), (2,4), (3,6)]
    s2 = series "Dataset B" [(1,3), (2,5), (3,7)]
    chart = scatter [s1, s2] defPlot
@
-}
series ::
    -- | Name of the series (appears in legend)
    String ->
    -- | List of (x, y) data points
    [(Double, Double)] ->
    (String, [(Double, Double)])
series :: String -> [(Double, Double)] -> (String, [(Double, Double)])
series String
name [(Double, Double)]
points = (String
name, [(Double, Double)]
points)

{- | Create a scatter plot from multiple data series.

Each series is rendered with a different color and pattern.
Points are plotted using Braille characters for sub-character resolution.

==== __Example__

@
let points1 = [(x, x^2) | x <- [-3, -2.5 .. 3]]
    points2 = [(x, 2*x + 1) | x <- [-3, -2.5 .. 3]]
    chart = scatter [series "y = x²" points1,
                     series "y = 2x + 1" points2] defPlot
@
-}
scatter ::
    -- | List of named data series
    [(String, [(Double, Double)])] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as String
    String
scatter :: [(String, [(Double, Double)])] -> Plot -> String
scatter [(String, [(Double, Double)])]
seriesList Plot
plot =
    Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
        [(Text, [(Double, Double)])] -> Plot -> Text
G.scatter (((String, [(Double, Double)]) -> (Text, [(Double, Double)]))
-> [(String, [(Double, Double)])] -> [(Text, [(Double, Double)])]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Text)
-> (String, [(Double, Double)]) -> (Text, [(Double, Double)])
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFirst String -> Text
Text.pack) [(String, [(Double, Double)])]
seriesList) (Plot -> Plot
toGranitePlot Plot
plot)

{- | Create a line graph connecting data points.

Similar to 'scatter' but connects consecutive points with lines.
Points are automatically sorted by x-coordinate before connecting.

==== __Example__

@
let sine = [(x, sin x) | x <- [0, 0.1 .. 2*pi]]
    cosine = [(x, cos x) | x <- [0, 0.1 .. 2*pi]]
    chart = lineGraph [series "sin" sine, series "cos" cosine] defPlot
@
-}
lineGraph ::
    -- | List of named data series
    [(String, [(Double, Double)])] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as String
    String
lineGraph :: [(String, [(Double, Double)])] -> Plot -> String
lineGraph [(String, [(Double, Double)])]
seriesList Plot
plot =
    Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
        [(Text, [(Double, Double)])] -> Plot -> Text
G.lineGraph (((String, [(Double, Double)]) -> (Text, [(Double, Double)]))
-> [(String, [(Double, Double)])] -> [(Text, [(Double, Double)])]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Text)
-> (String, [(Double, Double)]) -> (Text, [(Double, Double)])
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFirst String -> Text
Text.pack) [(String, [(Double, Double)])]
seriesList) (Plot -> Plot
toGranitePlot Plot
plot)

{- | Create a bar chart from categorical data.

Each bar is colored differently and labeled with its category name.

==== __Example__

@
let data = [("Apple", 45.2), ("Banana", 38.1), ("Orange", 52.7)]
    chart = bars data defPlot { plotTitle = "Fruit Sales" }
@
-}
bars ::
    -- | List of (category, value) pairs
    [(String, Double)] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as String
    String
bars :: [(String, Double)] -> Plot -> String
bars [(String, Double)]
categories Plot
plot =
    Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [(Text, Double)] -> Plot -> Text
G.bars (((String, Double) -> (Text, Double))
-> [(String, Double)] -> [(Text, Double)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Text) -> (String, Double) -> (Text, Double)
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFirst String -> Text
Text.pack) [(String, Double)]
categories) (Plot -> Plot
toGranitePlot Plot
plot)

{- | Create a stacked bar chart.

Each category can have multiple stacked components.

==== __Example__

@
let data = [("Q1", [("Product A", 100), ("Product B", 150)]),
            ("Q2", [("Product A", 120), ("Product B", 180)])]
    chart = stackedBars data defPlot
@
-}
stackedBars ::
    -- | Categories with stacked components
    [(String, [(String, Double)])] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as String
    String
stackedBars :: [(String, [(String, Double)])] -> Plot -> String
stackedBars [(String, [(String, Double)])]
categories Plot
plot =
    Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
        [(Text, [(Text, Double)])] -> Plot -> Text
G.stackedBars
            (((String, [(String, Double)]) -> (Text, [(Text, Double)]))
-> [(String, [(String, Double)])] -> [(Text, [(Text, Double)])]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Text)
-> ([(String, Double)] -> [(Text, Double)])
-> (String, [(String, Double)])
-> (Text, [(Text, Double)])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
Data.Bifunctor.bimap String -> Text
Text.pack (((String, Double) -> (Text, Double))
-> [(String, Double)] -> [(Text, Double)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Text) -> (String, Double) -> (Text, Double)
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFirst String -> Text
Text.pack))) [(String, [(String, Double)])]
categories)
            (Plot -> Plot
toGranitePlot Plot
plot)

{- | Create a histogram from numerical data.

Data is binned according to the provided 'Bins' configuration.

==== __Example__

@
import System.Random

-- Generate random normal-like distribution
let values = take 1000 $ randomRs (0, 100) gen
    chart = histogram (bins 20 0 100) values defPlot
@
-}
histogram ::
    -- | Binning configuration
    G.Bins ->
    -- | Raw data values to bin
    [Double] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as String
    String
histogram :: Bins -> [Double] -> Plot -> String
histogram Bins
binConfig [Double]
values Plot
plot =
    Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Bins -> [Double] -> Plot -> Text
G.histogram Bins
binConfig [Double]
values (Plot -> Plot
toGranitePlot Plot
plot)

{- | Create a pie chart showing proportions.

Values are normalized to sum to 100%. Negative values are treated as zero.

==== __Example__

@
let data = [("Chrome", 65), ("Firefox", 20), ("Safari", 10), ("Other", 5)]
    chart = pie data defPlot { plotTitle = "Browser Market Share" }
@
-}
pie ::
    -- | List of (category, value) pairs
    [(String, Double)] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as String
    String
pie :: [(String, Double)] -> Plot -> String
pie [(String, Double)]
slices Plot
plot =
    Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [(Text, Double)] -> Plot -> Text
G.pie (((String, Double) -> (Text, Double))
-> [(String, Double)] -> [(Text, Double)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Text) -> (String, Double) -> (Text, Double)
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFirst String -> Text
Text.pack) [(String, Double)]
slices) (Plot -> Plot
toGranitePlot Plot
plot)

{- | Create a heatmap visualization of a 2D matrix.

Values are mapped to a color gradient from blue (low) to red (high).

==== __Example__

@
let matrix = [[x * y | x <- [1..10]] | y <- [1..10]]
    chart = heatmap matrix defPlot { plotTitle = "Multiplication Table" }
@
-}
heatmap ::
    -- | 2D matrix of values (rows × columns)
    [[Double]] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as String
    String
heatmap :: [[Double]] -> Plot -> String
heatmap [[Double]]
matrix Plot
plot =
    Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [[Double]] -> Plot -> Text
G.heatmap [[Double]]
matrix (Plot -> Plot
toGranitePlot Plot
plot)

{- | Create a box plot showing statistical distributions.

Displays quartiles, median, and min/max values for each dataset.

==== __Example__

@
let data1 = [1.2, 2.3, 2.1, 3.4, 2.8, 4.1, 3.9]
    data2 = [5.1, 4.8, 6.2, 5.9, 7.1, 6.5, 5.5]
    chart = boxPlot [("Group A", data1), ("Group B", data2)] defPlot
@

The box plot displays:

  * Box: First quartile (Q1) to third quartile (Q3)
  * Line inside box: Median (Q2)
  * Whiskers: Minimum and maximum values
-}
boxPlot ::
    -- | Named datasets
    [(String, [Double])] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as String
    String
boxPlot :: [(String, [Double])] -> Plot -> String
boxPlot [(String, [Double])]
datasets Plot
plot =
    Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [(Text, [Double])] -> Plot -> Text
G.boxPlot (((String, [Double]) -> (Text, [Double]))
-> [(String, [Double])] -> [(Text, [Double])]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Text) -> (String, [Double]) -> (Text, [Double])
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFirst String -> Text
Text.pack) [(String, [Double])]
datasets) (Plot -> Plot
toGranitePlot Plot
plot)

-- | Convert our String-based Plot to Granite's Text-based Plot
toGranitePlot :: Plot -> G.Plot
toGranitePlot :: Plot -> Plot
toGranitePlot Plot
p =
    G.Plot
        { widthChars :: Int
G.widthChars = Plot -> Int
widthChars Plot
p
        , heightChars :: Int
G.heightChars = Plot -> Int
heightChars Plot
p
        , leftMargin :: Int
G.leftMargin = Plot -> Int
leftMargin Plot
p
        , bottomMargin :: Int
G.bottomMargin = Plot -> Int
bottomMargin Plot
p
        , titleMargin :: Int
G.titleMargin = Plot -> Int
titleMargin Plot
p
        , xBounds :: (Maybe Double, Maybe Double)
G.xBounds = Plot -> (Maybe Double, Maybe Double)
xBounds Plot
p
        , yBounds :: (Maybe Double, Maybe Double)
G.yBounds = Plot -> (Maybe Double, Maybe Double)
yBounds Plot
p
        , plotTitle :: Text
G.plotTitle = String -> Text
Text.pack (Plot -> String
plotTitle Plot
p)
        , legendPos :: LegendPos
G.legendPos = Plot -> LegendPos
legendPos Plot
p
        , colorPalette :: [Color]
G.colorPalette = Plot -> [Color]
colorPalette Plot
p
        , xFormatter :: LabelFormatter
G.xFormatter = LabelFormatter -> LabelFormatter
formatWithText (Plot -> LabelFormatter
xFormatter Plot
p)
        , yFormatter :: LabelFormatter
G.yFormatter = LabelFormatter -> LabelFormatter
formatWithText (Plot -> LabelFormatter
yFormatter Plot
p)
        , xNumTicks :: Int
G.xNumTicks = Plot -> Int
xNumTicks Plot
p
        , yNumTicks :: Int
G.yNumTicks = Plot -> Int
yNumTicks Plot
p
        }

-- | Convert Granite's Text-based Plot to our String-based Plot
fromGranitePlot :: G.Plot -> Plot
fromGranitePlot :: Plot -> Plot
fromGranitePlot Plot
p =
    Plot
        { widthChars :: Int
widthChars = Plot -> Int
G.widthChars Plot
p
        , heightChars :: Int
heightChars = Plot -> Int
G.heightChars Plot
p
        , leftMargin :: Int
leftMargin = Plot -> Int
G.leftMargin Plot
p
        , bottomMargin :: Int
bottomMargin = Plot -> Int
G.bottomMargin Plot
p
        , titleMargin :: Int
titleMargin = Plot -> Int
G.titleMargin Plot
p
        , xBounds :: (Maybe Double, Maybe Double)
xBounds = Plot -> (Maybe Double, Maybe Double)
G.xBounds Plot
p
        , yBounds :: (Maybe Double, Maybe Double)
yBounds = Plot -> (Maybe Double, Maybe Double)
G.yBounds Plot
p
        , plotTitle :: String
plotTitle = Text -> String
Text.unpack (Plot -> Text
G.plotTitle Plot
p)
        , legendPos :: LegendPos
legendPos = Plot -> LegendPos
G.legendPos Plot
p
        , colorPalette :: [Color]
colorPalette = Plot -> [Color]
G.colorPalette Plot
p
        , xFormatter :: LabelFormatter
xFormatter = LabelFormatter -> LabelFormatter
formatWithString (Plot -> LabelFormatter
G.xFormatter Plot
p)
        , yFormatter :: LabelFormatter
yFormatter = LabelFormatter -> LabelFormatter
formatWithString (Plot -> LabelFormatter
G.yFormatter Plot
p)
        , xNumTicks :: Int
xNumTicks = Plot -> Int
G.xNumTicks Plot
p
        , yNumTicks :: Int
yNumTicks = Plot -> Int
G.yNumTicks Plot
p
        }

mapFirst :: (a -> b) -> (a, c) -> (b, c)
mapFirst :: forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFirst a -> b
f (a
a, c
c) = (a -> b
f a
a, c
c)

formatWithText ::
    (G.AxisEnv -> Int -> Double -> String) -> G.AxisEnv -> Int -> Double -> Text
formatWithText :: LabelFormatter -> LabelFormatter
formatWithText LabelFormatter
f AxisEnv
env Int
i Double
d = String -> Text
Text.pack (LabelFormatter
f AxisEnv
env Int
i Double
d)

formatWithString ::
    (G.AxisEnv -> Int -> Double -> Text) -> G.AxisEnv -> Int -> Double -> String
formatWithString :: LabelFormatter -> LabelFormatter
formatWithString LabelFormatter
f AxisEnv
env Int
i Double
d = Text -> String
Text.unpack (LabelFormatter
f AxisEnv
env Int
i Double
d)