granite 0.3.0.5 → 0.4.0.0

raw patch · 5 files changed

+997/−27 lines, 5 filesdep ~granitePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: granite

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• app/Main.hs +2/−2
• granite.cabal +5/−4
• src/Granite.hs +78/−21
• src/Granite/Svg.hs +909/−0

@@ -1,5 +1,8 @@ # Revision history for granite +## 0.4.0.0 -- 2026-02-27+* Add Svg support.+ ## 0.3.0.5 -- 2025-11-10 * Fix x-axis label alignment for continuous histograms. 

@@ -70,7 +70,7 @@             , ("Class C", [88, 92, 95, 90, 93, 89, 91, 94, 96, 87, 90, 92])             , ("Class D", [65, 70, 72, 68, 75, 80, 73, 71, 69, 74, 77, 76])             ]-            defPlot{plotTitle = "Test Score Distribution by Class", xNumTicks = 4}+            defPlot{plotTitle = "Test Score Distribution by Class"}      -- stacked bar chart     Text.putStrLn $@@ -80,7 +80,7 @@             , ("Q3", [("Hardware", 110), ("Software", 240), ("Services", 110)])             , ("Q4", [("Hardware", 145), ("Software", 260), ("Services", 125)])             ]-            defPlot{plotTitle = "Quarterly Revenue Breakdown", xNumTicks = 4}+            defPlot{plotTitle = "Quarterly Revenue Breakdown"}      -- heatmap     let matrix =

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               granite-version:            0.3.0.5+version:            0.4.0.0 synopsis:           Easy terminal plotting. description:        A terminal plotting library for quick and easy visualisation. license:            MIT@@ -42,7 +42,8 @@ library     import:           ghc-options     exposed-modules:  Granite,-                      Granite.String+                      Granite.String,+                      Granite.Svg     build-depends:         base >=4 && <5,         text >= 1 && < 3@@ -53,7 +54,7 @@     main-is:          Main.hs     build-depends:         base >=4 && <5,-        granite ^>= 0.3,+        granite ^>= 0.4,         text >= 1 && < 3     hs-source-dirs:   app     default-language: GHC2021@@ -69,7 +70,7 @@      build-depends:         base >= 4.14 && < 5-        , granite ^>= 0.3+        , granite ^>= 0.4         , text >= 1.2 && < 3         , hspec >= 2.7 && < 2.12         , QuickCheck >= 2.14 && < 2.17

@@ -681,9 +681,6 @@                         idx' = clamp 0 (length intensityColors - 1) idx                      in intensityColors !! idx' -        plotW = widthChars cfg-        plotH = heightChars cfg-         displayGrid =             [ [ let                     matrixRow = min (rows - 1) ((plotH - 1 - i) * rows `div` plotH)@@ -696,15 +693,44 @@             | i <- [0 .. plotH - 1]             ] -        ax =-            axisifyGrid-                cfg-                displayGrid-                (0, fromIntegral cols - 1)-                (0, fromIntegral rows - 1)-                []-                (Just (plotW `div` cols))+        plotW = widthChars cfg+        plotH = heightChars cfg +        colLabels = [Text.pack (show i) | i <- [0 .. cols - 1]]+        rowLabels = [Text.pack (show i) | i <- reverse [0 .. rows - 1]]++        cellHeight = fromIntegral plotH / fromIntegral rows+        yTicks =+            [ ( round @Double @Int (fromIntegral i * cellHeight + cellHeight / 2)+              , rowLabels !! i+              )+            | i <- [0 .. rows - 1]+            ]++        left = leftMargin cfg+        baseLbl = replicate plotH (Text.replicate left " ")+        yLabels =+            List.foldl'+                ( \acc (row, lbl) ->+                    setAt acc row (justifyRight left (ellipsisize left lbl))+                )+                baseLbl+                yTicks++        renderRow cells =+            Text.concat+                (fmap (\(ch, mc) -> maybe (Text.singleton ch) (`paint` ch) mc) cells)+        attachY = zipWith (\lbl cells -> lbl <> "│" <> renderRow cells) yLabels displayGrid++        xBar = Text.replicate left " " <> "└" <> Text.replicate plotW "─"+        xLine =+            placeGridLabels+                (Text.replicate (left + 1) " ")+                (plotW `div` cols)+                colLabels++        ax = Text.unlines (attachY <> [xBar, xLine])+         gradientLegend =             Text.pack (printf "%.2f " vmin)                 <> Text.concat (fmap (`paint` '█') intensityColors)@@ -785,14 +811,41 @@          finalGrid = List.foldl' drawBox emptyGrid (zip [0 ..] stats) -        ax =-            axisifyGrid-                cfg-                finalGrid-                (0, fromIntegral nBoxes)-                (ymin, ymax)-                (map fst datasets)-                (Just (boxWidth + spacing))+        left = leftMargin cfg+        baseLbl = replicate hC (Text.replicate left " ")++        yTicks = ticks1D hC (yNumTicks cfg) (ymin, ymax) True+        yEnv n = AxisEnv (ymin, ymax) n (yNumTicks cfg)+        ySlot = max 1 left+        yLabels =+            List.foldl'+                ( \acc (row, v) ->+                    setAt acc row . ellipsisize left . justifyRight left $+                        yFormatter cfg (yEnv row) ySlot v+                )+                baseLbl+                yTicks++        renderRow cells =+            Text.concat+                (fmap (\(ch, mc) -> maybe (Text.singleton ch) (`paint` ch) mc) cells)+        attachY = zipWith (\lbl cells -> lbl <> "│" <> renderRow cells) yLabels finalGrid++        xBar = Text.replicate left " " <> "└" <> Text.replicate wC "─"++        xLine =+            List.foldl'+                ( \acc (idx, name) ->+                    let boxCenter = idx * (boxWidth + spacing) + boxWidth `div` 2+                        lblWidth = wcswidth name+                        lblStart = left + 1 + boxCenter - lblWidth `div` 2+                     in Text.take lblStart acc <> name <> Text.drop (lblStart + wcswidth name) acc+                )+                (Text.replicate (left + 1 + wC) " ")+                (zip [0 ..] (map fst datasets))++        ax = Text.unlines (attachY <> [xBar, xLine])+         legend =             legendBlock                 (legendPos cfg)@@ -1117,7 +1170,7 @@                      in placeGridLabels                             (Text.replicate (left + 1) " ")                             slotW-                            (keepPercentiles (xNumTicks cfg) (length xTicks + 1) categories)+                            (keepPercentiles (length categories) (length xTicks + 1) categories)                 else                     let xTicks = ticks1D plotW (xNumTicks cfg) (xmin, xmax) False                         xEnv i = AxisEnv (xmin, xmax) i (xNumTicks cfg)@@ -1161,7 +1214,11 @@ placeGridLabels base slotW = List.foldl' place base   where     place :: Text -> Text -> Text-    place acc s = acc <> Text.take slotW (s <> Text.replicate slotW " ")+    place acc s =+        let lblWidth = wcswidth s+            padding = max 0 ((slotW - lblWidth) `div` 2)+            centered = Text.replicate padding " " <> s+         in acc <> Text.take slotW (centered <> Text.replicate slotW " ")  legendBlock :: LegendPos -> Int -> [(Text, Pat, Color)] -> Text legendBlock LegendBottom width entries =

@@ -0,0 +1,909 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++{- |+Module      : Granite.Svg+Copyright   : (c) 2025+License     : MIT+Maintainer  : mschavinda@gmail.com+Stability   : experimental+Portability : POSIX++An SVG-based plotting backend that mirrors the API of "Granite".+Every chart function returns a self-contained SVG document as 'Text'.++= Basic Usage++@+{\-# LANGUAGE OverloadedStrings #-\}+import qualified Data.Text.IO as T+import Granite.Svg++main = do+  let chart = bars [(\"Q1\",12),(\"Q2\",18),(\"Q3\",9),(\"Q4\",15)]+                   defPlot { plotTitle = \"Sales\" }+  T.writeFile \"chart.svg\" chart+@+-}+module Granite.Svg (+    -- * Re-exports from Granite+    Plot (..),+    defPlot,+    LegendPos (..),+    Color (..),+    AxisEnv (..),+    LabelFormatter,+    Bins (..),+    bins,+    series,++    -- * Chart types (SVG output)+    scatter,+    lineGraph,+    bars,+    stackedBars,+    histogram,+    pie,+    heatmap,+    boxPlot,+) where++import Data.List qualified as List+import Data.Maybe (fromMaybe, listToMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Granite (+    AxisEnv (..),+    Bins (..),+    Color (..),+    LabelFormatter,+    LegendPos (..),+    Plot (..),+    bins,+    defPlot,+    series,+ )+import Numeric (showFFloat)++------------------------------------------------------------------------+-- Scaling constants+------------------------------------------------------------------------++-- | Pixels per terminal character width.+cW :: Double+cW = 10++-- | Pixels per terminal character height.+cH :: Double+cH = 16++-- | Font size for axis labels (px).+labelFontSize :: Double+labelFontSize = 11++-- | Font size for chart title (px).+titleFontSize :: Double+titleFontSize = 14++------------------------------------------------------------------------+-- Colour mapping  (ANSI → hex)+------------------------------------------------------------------------++colorHex :: Color -> Text+colorHex Default = "#555555"+colorHex Black = "#2c3e50"+colorHex Red = "#c0392b"+colorHex Green = "#27ae60"+colorHex Yellow = "#f39c12"+colorHex Blue = "#2980b9"+colorHex Magenta = "#8e44ad"+colorHex Cyan = "#16a085"+colorHex White = "#ecf0f1"+colorHex BrightBlack = "#7f8c8d"+colorHex BrightRed = "#e74c3c"+colorHex BrightGreen = "#2ecc71"+colorHex BrightYellow = "#f1c40f"+colorHex BrightBlue = "#3498db"+colorHex BrightMagenta = "#9b59b6"+colorHex BrightCyan = "#1abc9c"+colorHex BrightWhite = "#bdc3c7"++-- Heatmap intensity palette (low → high).+heatColors :: [Text]+heatColors =+    [ "#2980b9"+    , "#3498db"+    , "#16a085"+    , "#1abc9c"+    , "#27ae60"+    , "#2ecc71"+    , "#f1c40f"+    , "#f39c12"+    , "#9b59b6"+    , "#e74c3c"+    , "#c0392b"+    ]++------------------------------------------------------------------------+-- Helpers copied from Granite (not exported there)+------------------------------------------------------------------------++clamp :: (Ord a) => a -> a -> a -> a+clamp lo hi x = max lo (min hi x)++eps :: Double+eps = 1e-12++minimum', maximum' :: [Double] -> Double+minimum' [] = 0+minimum' xs = minimum xs+maximum' [] = 1+maximum' xs = maximum xs++boundsXY :: Plot -> [(Double, Double)] -> (Double, Double, Double, Double)+boundsXY cfg pts =+    let (xs, ys) = unzip pts+        xmin = minimum' xs+        xmax = maximum' xs+        ymin = minimum' ys+        ymax = maximum' ys+        padx = (xmax - xmin) * 0.05 + 1e-9+        pady = (ymax - ymin) * 0.05 + 1e-9+     in ( fromMaybe (xmin - padx) (fst (xBounds cfg))+        , fromMaybe (xmax + padx) (snd (xBounds cfg))+        , fromMaybe (ymin - pady) (fst (yBounds cfg))+        , fromMaybe (ymax + pady) (snd (yBounds cfg))+        )++quartiles :: [Double] -> (Double, Double, Double, Double, Double)+quartiles [] = (0, 0, 0, 0, 0)+quartiles xs =+    let sorted = List.sort xs+        n = length sorted+        q1Idx = n `div` 4+        q2Idx = n `div` 2+        q3Idx = 3 * n `div` 4+        getIdx i = if i < n then sorted !! i else last sorted+     in if n < 5+            then let m = sum xs / fromIntegral n in (m, m, m, m, m)+            else+                ( fromMaybe 0 (listToMaybe sorted)+                , getIdx q1Idx+                , getIdx q2Idx+                , getIdx q3Idx+                , last sorted+                )++normalize :: [(Text, Double)] -> [(Text, Double)]+normalize xs =+    let s = sum (map (abs . snd) xs) + 1e-12+     in [(n, max 0 (v / s)) | (n, v) <- xs]++ticks1D ::+    Int ->+    Int ->+    (Double, Double) ->+    Bool ->+    [(Int, Double)]+ticks1D screenLen want (vmin, vmax) invertY =+    let n = max 2 want+        lastIx = max 0 (screenLen - 1)+        toVal t =+            if invertY+                then vmax - t * (vmax - vmin)+                else vmin + t * (vmax - vmin)+        mk' k =+            let t = if n == 1 then 0 else fromIntegral k / fromIntegral (n - 1)+                pos = round (t * fromIntegral lastIx)+             in (pos, toVal t)+        raw = [mk' k | k <- [0 .. n - 1]]+     in List.nubBy (\a b -> fst a == fst b) raw++------------------------------------------------------------------------+-- Layout record+------------------------------------------------------------------------++data Layout = Layout+    { svgW :: !Double+    , svgH :: !Double+    , plotX :: !Double -- left edge of plot area+    , plotY :: !Double -- top edge of plot area+    , plotW :: !Double -- width of plot area+    , plotH :: !Double -- height of plot area+    }++mkLayout :: Plot -> Layout+mkLayout cfg =+    let pw = fromIntegral (widthChars cfg) * cW+        ph = fromIntegral (heightChars cfg) * cH+        lm = fromIntegral (leftMargin cfg) * cW + 10 -- extra padding+        tm =+            if T.null (plotTitle cfg)+                then 10+                else titleFontSize + 20+        bm = fromIntegral (bottomMargin cfg) * cH + 10+        rm = case legendPos cfg of+            LegendRight -> 120+            _ -> 20+        lb = case legendPos cfg of+            LegendBottom -> 30+            _ -> 0+     in Layout+            { svgW = lm + pw + rm+            , svgH = tm + ph + bm + lb+            , plotX = lm+            , plotY = tm+            , plotW = pw+            , plotH = ph+            }++------------------------------------------------------------------------+-- SVG primitives+------------------------------------------------------------------------++showD :: Double -> Text+showD d+    | d == fromIntegral (round d :: Int) = T.pack (show (round d :: Int))+    | otherwise = T.pack (showFFloat (Just 2) d "")++escXml :: Text -> Text+escXml =+    T.replace "&" "&amp;"+        . T.replace "<" "&lt;"+        . T.replace ">" "&gt;"+        . T.replace "\"" "&quot;"++attr :: Text -> Text -> Text+attr k v = " " <> k <> "=\"" <> v <> "\""++svgDoc :: Double -> Double -> Text -> Text+svgDoc w h content =+    "<svg xmlns=\"http://www.w3.org/2000/svg\""+        <> attr "viewBox" ("0 0 " <> showD w <> " " <> showD h)+        <> attr "width" (showD w)+        <> attr "height" (showD h)+        <> attr "font-family" "system-ui, -apple-system, sans-serif"+        <> ">\n"+        <> "<rect width=\"100%\" height=\"100%\" fill=\"white\"/>\n"+        <> content+        <> "</svg>\n"++svgRect :: Double -> Double -> Double -> Double -> Text -> Text -> Text+svgRect x y w h fill extra =+    "<rect"+        <> attr "x" (showD x)+        <> attr "y" (showD y)+        <> attr "width" (showD w)+        <> attr "height" (showD h)+        <> attr "fill" fill+        <> extra+        <> "/>\n"++svgCircle :: Double -> Double -> Double -> Text -> Text+svgCircle cx cy r fill =+    "<circle"+        <> attr "cx" (showD cx)+        <> attr "cy" (showD cy)+        <> attr "r" (showD r)+        <> attr "fill" fill+        <> "/>\n"++svgLine :: Double -> Double -> Double -> Double -> Text -> Double -> Text+svgLine x1 y1 x2 y2 stroke strokeW =+    "<line"+        <> attr "x1" (showD x1)+        <> attr "y1" (showD y1)+        <> attr "x2" (showD x2)+        <> attr "y2" (showD y2)+        <> attr "stroke" stroke+        <> attr "stroke-width" (showD strokeW)+        <> "/>\n"++svgPolyline :: [(Double, Double)] -> Text -> Double -> Text+svgPolyline pts stroke strokeW =+    "<polyline"+        <> attr "points" (T.intercalate " " [showD x <> "," <> showD y | (x, y) <- pts])+        <> attr "fill" "none"+        <> attr "stroke" stroke+        <> attr "stroke-width" (showD strokeW)+        <> attr "stroke-linejoin" "round"+        <> attr "stroke-linecap" "round"+        <> "/>\n"++svgText :: Double -> Double -> Text -> Text -> Double -> Text -> Text+svgText x y anchor fill size content =+    "<text"+        <> attr "x" (showD x)+        <> attr "y" (showD y)+        <> attr "text-anchor" anchor+        <> attr "fill" fill+        <> attr "font-size" (showD size)+        <> ">"+        <> escXml content+        <> "</text>\n"++svgPath :: Text -> Text -> Text -> Text+svgPath d fill extra =+    "<path"+        <> attr "d" d+        <> attr "fill" fill+        <> extra+        <> "/>\n"++------------------------------------------------------------------------+-- Shared drawing: title, axes, legend+------------------------------------------------------------------------++drawTitle :: Plot -> Layout -> Text+drawTitle cfg lay+    | T.null (plotTitle cfg) = ""+    | otherwise =+        svgText+            (plotX lay + plotW lay / 2)+            (plotY lay - 8)+            "middle"+            "#222"+            titleFontSize+            (plotTitle cfg)++drawAxes :: Plot -> Layout -> (Double, Double) -> (Double, Double) -> Text+drawAxes cfg lay (xmin, xmax) (ymin, ymax) =+    let px = plotX lay+        py = plotY lay+        pw = plotW lay+        ph = plotH lay++        -- Axis lines+        xAxis = svgLine px (py + ph) (px + pw) (py + ph) "#aaa" 1+        yAxis = svgLine px py px (py + ph) "#aaa" 1++        -- Y ticks+        yN = yNumTicks cfg+        yTks = ticks1D (round ph) yN (ymin, ymax) True+        ySlot = max 1 (leftMargin cfg)+        yEnv i = AxisEnv (ymin, ymax) i yN+        yElems =+            T.concat+                [ let frac = fromIntegral pos / max 1 (ph - 1)+                      yy = py + frac * ph+                      lbl = yFormatter cfg (yEnv i) ySlot v+                   in svgLine px yy (px - 4) yy "#aaa" 1+                        <> svgText (px - 8) (yy + 4) "end" "#555" labelFontSize lbl+                        <> svgLine px yy (px + pw) yy "#eee" 0.5 -- grid line+                | (i, (pos, v)) <- zip [0 ..] yTks+                ]++        -- X ticks+        xN = xNumTicks cfg+        xTks = ticks1D (round pw) xN (xmin, xmax) False+        xSlot = max 1 (round pw `div` max 1 xN)+        xEnv i = AxisEnv (xmin, xmax) i xN+        xElems =+            T.concat+                [ let frac = fromIntegral pos / max 1 (pw - 1)+                      xx = px + frac * pw+                      lbl = xFormatter cfg (xEnv i) xSlot v+                   in svgLine xx (py + ph) xx (py + ph + 4) "#aaa" 1+                        <> svgText xx (py + ph + 16) "middle" "#555" labelFontSize lbl+                        <> svgLine xx py xx (py + ph) "#eee" 0.5 -- grid line+                | (i, (pos, v)) <- zip [0 ..] xTks+                ]+     in xAxis <> yAxis <> yElems <> xElems++drawCatAxes :: Plot -> Layout -> (Double, Double) -> [Text] -> Text+drawCatAxes cfg lay (ymin, ymax) catNames =+    let px = plotX lay+        py = plotY lay+        pw = plotW lay+        ph = plotH lay++        xAxis = svgLine px (py + ph) (px + pw) (py + ph) "#aaa" 1+        yAxis = svgLine px py px (py + ph) "#aaa" 1++        -- Y ticks (value axis)+        yN = yNumTicks cfg+        yTks = ticks1D (round ph) yN (ymin, ymax) True+        ySlot = max 1 (leftMargin cfg)+        yEnv i = AxisEnv (ymin, ymax) i yN+        yElems =+            T.concat+                [ let frac = fromIntegral pos / max 1 (ph - 1)+                      yy = py + frac * ph+                      lbl = yFormatter cfg (yEnv i) ySlot v+                   in svgLine px yy (px - 4) yy "#aaa" 1+                        <> svgText (px - 8) (yy + 4) "end" "#555" labelFontSize lbl+                        <> svgLine px yy (px + pw) yy "#eee" 0.5+                | (i, (pos, v)) <- zip [0 ..] yTks+                ]++        -- X category labels+        n = length catNames+        catElems =+            T.concat+                [ let xx = px + (fromIntegral i + 0.5) * pw / fromIntegral n+                   in svgText xx (py + ph + 16) "middle" "#555" labelFontSize name+                | (i, name) <- zip [0 :: Int ..] catNames+                ]+     in xAxis <> yAxis <> yElems <> catElems++drawLegend :: Plot -> Layout -> [(Text, Color)] -> Text+drawLegend cfg lay entries = case legendPos cfg of+    LegendNone -> ""+    LegendRight ->+        let lx = plotX lay + plotW lay + 15+            ly = plotY lay + 5+         in T.concat+                [ svgRect lx (ly + fromIntegral i * 20) 12 12 (colorHex col) ""+                    <> svgText+                        (lx + 16)+                        (ly + fromIntegral i * 20 + 10)+                        "start"+                        "#555"+                        labelFontSize+                        name+                | (i, (name, col)) <- zip [0 :: Int ..] entries+                ]+    LegendBottom ->+        let ly = svgH lay - 18+            totalW = sum [30 + fromIntegral (T.length name) * 7 | (name, _) <- entries]+            startX = plotX lay + (plotW lay - totalW) / 2+         in snd $+                List.foldl'+                    ( \(x, acc) (name, col) ->+                        let elem' =+                                svgRect x (ly - 1) 12 12 (colorHex col) ""+                                    <> svgText (x + 16) (ly + 9) "start" "#555" labelFontSize name+                            w = 30 + fromIntegral (T.length name) * 7+                         in (x + w, acc <> elem')+                    )+                    (startX, "")+                    entries++------------------------------------------------------------------------+-- Coordinate mapping+------------------------------------------------------------------------++-- | Map data X to SVG X.+mapX :: Layout -> Double -> Double -> Double -> Double+mapX lay xmin xmax x =+    plotX lay + (x - xmin) / (xmax - xmin + eps) * plotW lay++-- | Map data Y to SVG Y (flipped: higher values → lower Y).+mapY :: Layout -> Double -> Double -> Double -> Double+mapY lay ymin ymax y =+    plotY lay + plotH lay - (y - ymin) / (ymax - ymin + eps) * plotH lay++------------------------------------------------------------------------+-- SCATTER+------------------------------------------------------------------------++scatter ::+    [(Text, [(Double, Double)])] ->+    Plot ->+    Text+scatter sers cfg =+    let lay = mkLayout cfg+        (xmin, xmax, ymin, ymax) = boundsXY cfg (concatMap snd sers)+        cols = cycle (colorPalette cfg)+        withCol = zip sers cols++        points =+            T.concat+                [ T.concat+                    [ svgCircle+                        (mapX lay xmin xmax x)+                        (mapY lay ymin ymax y)+                        3+                        (colorHex col)+                    | (x, y) <- pts+                    ]+                | ((_, pts), col) <- withCol+                ]++        axes = drawAxes cfg lay (xmin, xmax) (ymin, ymax)+        title = drawTitle cfg lay+        legend = drawLegend cfg lay [(n, col) | ((n, _), col) <- withCol]+     in svgDoc (svgW lay) (svgH lay) (title <> axes <> points <> legend)++------------------------------------------------------------------------+-- LINE GRAPH+------------------------------------------------------------------------++lineGraph ::+    [(Text, [(Double, Double)])] ->+    Plot ->+    Text+lineGraph sers cfg =+    let lay = mkLayout cfg+        (xmin, xmax, ymin, ymax) = boundsXY cfg (concatMap snd sers)+        cols = cycle (colorPalette cfg)+        withCol = zip sers cols++        lines' =+            T.concat+                [ let sortedPts = List.sortOn fst pts+                      svgPts =+                        [ (mapX lay xmin xmax x, mapY lay ymin ymax y)+                        | (x, y) <- sortedPts+                        ]+                   in svgPolyline svgPts (colorHex col) 2+                | ((_, pts), col) <- withCol+                ]++        axes = drawAxes cfg lay (xmin, xmax) (ymin, ymax)+        title = drawTitle cfg lay+        legend = drawLegend cfg lay [(n, col) | ((n, _), col) <- withCol]+     in svgDoc (svgW lay) (svgH lay) (title <> axes <> lines' <> legend)++------------------------------------------------------------------------+-- BARS+------------------------------------------------------------------------++bars ::+    [(Text, Double)] ->+    Plot ->+    Text+bars kvs cfg =+    let lay = mkLayout cfg+        (catNames, vals) = unzip kvs+        vmax = maximum' (map abs vals)+        cols = cycle (colorPalette cfg)+        n = length kvs++        barGap = 0.15 -- 15% gap on each side+        groupW = plotW lay / fromIntegral (max 1 n)++        rects =+            T.concat+                [ let barW = groupW * (1 - 2 * barGap)+                      barH = abs v / (vmax + eps) * plotH lay+                      bx = plotX lay + fromIntegral i * groupW + groupW * barGap+                      by = plotY lay + plotH lay - barH+                   in svgRect bx by barW barH (colorHex col) (attr "rx" "2")+                | (i, (_, v), col) <- zip3 [0 :: Int ..] kvs cols+                ]++        axes = drawCatAxes cfg lay (0, vmax) catNames+        title = drawTitle cfg lay+        legend = drawLegend cfg lay [(name, col) | ((name, _), col) <- zip kvs cols]+     in svgDoc (svgW lay) (svgH lay) (title <> axes <> rects <> legend)++------------------------------------------------------------------------+-- STACKED BARS+------------------------------------------------------------------------++stackedBars ::+    [(Text, [(Text, Double)])] ->+    Plot ->+    Text+stackedBars categories cfg =+    let lay = mkLayout cfg+        seriesNames = case categories of+            [] -> []+            (c : _) -> map fst (snd c)++        totals = [sum (map snd s) | (_, s) <- categories]+        maxH = maximum (1e-12 : totals)++        cols = cycle (colorPalette cfg)+        seriesColors = zip seriesNames cols++        nCats = length categories+        barGap = 0.1+        groupW = plotW lay / fromIntegral (max 1 nCats)++        rects =+            T.concat+                [ let barW = groupW * (1 - 2 * barGap)+                      bx = plotX lay + fromIntegral ci * groupW + groupW * barGap+                      cumHeights = scanl (+) 0 [v / maxH | (_, v) <- segs]+                   in T.concat+                        [ let bot = cumHeights !! si+                              top = cumHeights !! (si + 1)+                              segH = (top - bot) * plotH lay+                              segY = plotY lay + plotH lay - top * plotH lay+                              col = fromMaybe BrightBlue (lookup sn seriesColors)+                           in svgRect bx segY barW segH (colorHex col) (attr "rx" "1")+                        | (si, (sn, _)) <- zip [0 :: Int ..] segs+                        ]+                | (ci, (_, segs)) <- zip [0 :: Int ..] categories+                ]++        catNames = map fst categories+        axes = drawCatAxes cfg lay (0, maxH) catNames+        title = drawTitle cfg lay+        legend = drawLegend cfg lay [(n, col) | (n, col) <- seriesColors]+     in svgDoc (svgW lay) (svgH lay) (title <> axes <> rects <> legend)++------------------------------------------------------------------------+-- HISTOGRAM+------------------------------------------------------------------------++histogram ::+    Bins ->+    [Double] ->+    Plot ->+    Text+histogram (Bins nB a b) xs cfg =+    let lay = mkLayout cfg+        step = (b - a) / fromIntegral nB+        binIx x = clamp 0 (nB - 1) $ floor ((x - a) / step)+        counts0 :: [Int]+        counts0 =+            List.foldl'+                ( \acc x ->+                    if x < a || x > b+                        then acc+                        else addAt acc (binIx x) 1+                )+                (replicate nB 0)+                xs+        maxC = fromIntegral (maximum (1 : counts0)) :: Double++        barW = plotW lay / fromIntegral nB+        rects =+            T.concat+                [ let v = fromIntegral c+                      barH = v / (maxC + eps) * plotH lay+                      bx = plotX lay + fromIntegral i * barW+                      by = plotY lay + plotH lay - barH+                   in svgRect bx by (barW - 1) barH (colorHex BrightCyan) ""+                | (i, c) <- zip [0 :: Int ..] counts0+                ]++        axes = drawAxes cfg lay (a, b) (0, maxC)+        title = drawTitle cfg lay+        legend = drawLegend cfg lay [("count", BrightCyan)]+     in svgDoc (svgW lay) (svgH lay) (title <> axes <> rects <> legend)++------------------------------------------------------------------------+-- PIE+------------------------------------------------------------------------++pie ::+    [(Text, Double)] ->+    Plot ->+    Text+pie parts0 cfg =+    let lay = mkLayout cfg+        parts = normalize parts0++        cxP = plotX lay + plotW lay / 2+        cyP = plotY lay + plotH lay / 2+        r = min (plotW lay / 2) (plotH lay / 2) * 0.85++        toAng p = p * 2 * pi+        wedgeAngles = scanl (\acc (_, p) -> acc + toAng p) 0 parts+        angles = zip wedgeAngles (drop 1 wedgeAngles)++        cols = cycle (colorPalette cfg)+        withP = zip3 (map fst parts) angles cols++        slices =+            T.concat+                [ let (a0, a1) = ang+                      x0 = cxP + r * cos a0+                      y0 = cyP - r * sin a0+                      x1 = cxP + r * cos a1+                      y1 = cyP - r * sin a1+                      largeArc = if a1 - a0 > pi then "1" else "0"+                      d =+                        "M "+                            <> showD cxP+                            <> " "+                            <> showD cyP+                            <> " L "+                            <> showD x0+                            <> " "+                            <> showD y0+                            <> " A "+                            <> showD r+                            <> " "+                            <> showD r+                            <> " 0 "+                            <> largeArc+                            <> " 0 "+                            <> showD x1+                            <> " "+                            <> showD y1+                            <> " Z"+                   in svgPath d (colorHex col) (attr "stroke" "white" <> attr "stroke-width" "2")+                | (_, ang, col) <- withP+                ]++        title = drawTitle cfg lay+        legend = drawLegend cfg lay [(n, col) | (n, _, col) <- withP]+     in svgDoc (svgW lay) (svgH lay) (title <> slices <> legend)++------------------------------------------------------------------------+-- HEATMAP+------------------------------------------------------------------------++heatmap ::+    [[Double]] ->+    Plot ->+    Text+heatmap matrix cfg =+    let lay = mkLayout cfg+        rows = length matrix+        cols = case matrix of+            [] -> 0+            (r : _) -> length r++        allVals = concat matrix+        vmin = if null allVals then 0 else minimum' allVals+        vmax = if null allVals then 1 else maximum' allVals+        vrange = vmax - vmin++        nColors = length heatColors+        colorForVal v =+            if vrange < eps+                then heatColors !! (nColors `div` 2)+                else+                    let norm = clamp 0 1 ((v - vmin) / vrange)+                        idx = clamp 0 (nColors - 1) (floor (norm * fromIntegral (nColors - 1)))+                     in heatColors !! idx++        cellW = plotW lay / fromIntegral (max 1 cols)+        cellH = plotH lay / fromIntegral (max 1 rows)++        cells =+            T.concat+                [ T.concat+                    [ let cx = plotX lay + fromIntegral c * cellW+                          cy = plotY lay + fromIntegral r * cellH+                          dataRow = rows - 1 - r -- flip: row 0 at bottom+                          v = (matrix !! dataRow) !! c+                       in svgRect cx cy cellW cellH (colorForVal v) ""+                    | c <- [0 .. cols - 1]+                    ]+                | r <- [0 .. rows - 1]+                ]++        -- Axis labels: column indices on x, row indices on y+        colLabels =+            T.concat+                [ svgText+                    (plotX lay + (fromIntegral c + 0.5) * cellW)+                    (plotY lay + plotH lay + 16)+                    "middle"+                    "#555"+                    labelFontSize+                    (T.pack (show c))+                | c <- [0 .. cols - 1]+                ]+        rowLabels =+            T.concat+                [ svgText+                    (plotX lay - 8)+                    (plotY lay + (fromIntegral r + 0.5) * cellH + 4)+                    "end"+                    "#555"+                    labelFontSize+                    (T.pack (show (rows - 1 - r)))+                | r <- [0 .. rows - 1]+                ]++        -- Draw border+        border =+            svgRect+                (plotX lay)+                (plotY lay)+                (plotW lay)+                (plotH lay)+                "none"+                (attr "stroke" "#aaa" <> attr "stroke-width" "1")++        title = drawTitle cfg lay++        -- Gradient legend+        gradLegend =+            let gw = min 200 (plotW lay * 0.5)+                gh = 12+                gx = plotX lay + (plotW lay - gw) / 2+                gy = svgH lay - 22+                nSteps = 20 :: Int+                stepW = gw / fromIntegral nSteps+             in svgText+                    (gx - 5)+                    (gy + 10)+                    "end"+                    "#555"+                    labelFontSize+                    (T.pack (showFFloat (Just 2) vmin ""))+                    <> T.concat+                        [ let t = fromIntegral i / fromIntegral nSteps+                              v = vmin + t * vrange+                           in svgRect (gx + fromIntegral i * stepW) gy stepW gh (colorForVal v) ""+                        | i <- [0 .. nSteps - 1]+                        ]+                    <> svgText+                        (gx + gw + 5)+                        (gy + 10)+                        "start"+                        "#555"+                        labelFontSize+                        (T.pack (showFFloat (Just 2) vmax ""))+     in svgDoc+            (svgW lay)+            (svgH lay)+            (title <> cells <> colLabels <> rowLabels <> border <> gradLegend)++------------------------------------------------------------------------+-- BOX PLOT+------------------------------------------------------------------------++boxPlot ::+    [(Text, [Double])] ->+    Plot ->+    Text+boxPlot datasets cfg =+    let lay = mkLayout cfg+        stats = [(name, quartiles vals) | (name, vals) <- datasets]++        allVals = concatMap snd datasets+        ymin = if null allVals then 0 else minimum' allVals - abs (minimum' allVals) * 0.1+        ymax = if null allVals then 1 else maximum' allVals + abs (maximum' allVals) * 0.1++        nBoxes = length datasets+        cols = cycle (colorPalette cfg)++        groupW = plotW lay / fromIntegral (max 1 nBoxes)+        boxW = groupW * 0.6++        scY v = plotY lay + plotH lay - (v - ymin) / (ymax - ymin + eps) * plotH lay++        boxes =+            T.concat+                [ let bx = plotX lay + fromIntegral i * groupW + (groupW - boxW) / 2+                      midX = bx + boxW / 2+                      (minV, q1, med, q3, maxV) = qs+                      col = colorHex c++                      -- Whisker: min to Q1+                      whiskerBot = svgLine midX (scY minV) midX (scY q1) col 1.5+                      capBot = svgLine (bx + boxW * 0.25) (scY minV) (bx + boxW * 0.75) (scY minV) col 1.5++                      -- Box: Q1 to Q3+                      boxY = scY q3+                      boxH = scY q1 - scY q3+                      box =+                        svgRect+                            bx+                            boxY+                            boxW+                            boxH+                            col+                            ( attr "fill-opacity" "0.3"+                                <> attr "stroke" col+                                <> attr "stroke-width" "1.5"+                                <> attr "rx" "2"+                            )++                      -- Median line+                      medLine = svgLine bx (scY med) (bx + boxW) (scY med) col 2.5++                      -- Whisker: Q3 to max+                      whiskerTop = svgLine midX (scY q3) midX (scY maxV) col 1.5+                      capTop = svgLine (bx + boxW * 0.25) (scY maxV) (bx + boxW * 0.75) (scY maxV) col 1.5+                   in whiskerBot <> capBot <> whiskerTop <> capTop <> box <> medLine+                | (i, (_, qs), c) <- zip3 [0 :: Int ..] stats cols+                ]++        catNames = map fst datasets+        axes = drawCatAxes cfg lay (ymin, ymax) catNames+        title = drawTitle cfg lay+        legend = drawLegend cfg lay [(name, col) | ((name, _), col) <- zip stats cols]+     in svgDoc (svgW lay) (svgH lay) (title <> axes <> boxes <> legend)++addAt :: [Int] -> Int -> Int -> [Int]+addAt xs i v = updateAt xs i (+ v)++updateAt :: [a] -> Int -> (a -> a) -> [a]+updateAt xs i f+    | i < 0 = xs+    | otherwise = go xs i+  where+    go [] _ = []+    go (x : rest) 0 = f x : rest+    go (x : rest) n = x : go rest (n - 1)