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

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

Chart → Scene pipeline. 'chartToScene' compiles a 'Chart' spec into
a backend-agnostic 'Scene'; 'renderChartTerminal' and
'renderChartSvg' pair it with the matching backend.
-}
module Granite.Render.Pipeline (
    renderChart,
    renderChartTerminal,
    renderChartSvg,
    chartToScene,
) where

import Control.Applicative ((<|>))
import Data.List qualified as List
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as Text

import Granite.Color (Color (..), parseHex)
import Granite.Data.Frame (
    Column (..),
    DataFrame (..),
    columnAsNum,
    columnAsText,
    filterByRows,
    lookupColumn,
 )
import Granite.Internal.Util (truncatePx)
import Granite.Position (applyPosition)
import Granite.Render.Chrome (
    AxisLayout (..),
    Margins (..),
    PlotBox (..),
    XLabelMode,
    axesMarks,
    axisLayout,
    computePlotBox,
    domainLabels,
    legendMarks,
    titleMarks,
    xModeNoRotate,
 )
import Granite.Render.Scene (
    Mark (..),
    Point (..),
    Rect (..),
    Scene (..),
    Style (..),
    TextAnchor (..),
    TextStyle (..),
    defaultStyle,
    defaultTextStyle,
 )
import Granite.Render.Svg qualified as Svg
import Granite.Render.Terminal qualified as Terminal
import Granite.Scale (TrainedScale (..), train)
import Granite.Spec (
    AesDefaults (..),
    Chart (..),
    ColorSpec (..),
    ColumnRef (..),
    Coord (..),
    Facet (..),
    FacetScales (..),
    Geom (..),
    Layer (..),
    Mapping (..),
    PolarAes (..),
    PolarDir (..),
    Scale (..),
    Scales (..),
    Size (..),
    Theme (..),
    aesX,
    aesY,
 )
import Granite.Stat (applyStat)

type Projector = Double -> Double -> Point

buildProjector :: Coord -> PlotBox -> TrainedScale -> TrainedScale -> Projector
buildProjector :: Coord -> PlotBox -> TrainedScale -> TrainedScale -> Projector
buildProjector Coord
c PlotBox
box TrainedScale
xs TrainedScale
ys = case Coord
c of
    Coord
CoordCartesian -> PlotBox -> TrainedScale -> TrainedScale -> Projector
cartesianProjector PlotBox
box TrainedScale
xs TrainedScale
ys
    Coord
CoordFlip -> PlotBox -> TrainedScale -> TrainedScale -> Projector
flipProjector PlotBox
box TrainedScale
xs TrainedScale
ys
    CoordPolar PolarAes
aes Double
a0 PolarDir
dir -> PolarAes
-> Double
-> PolarDir
-> PlotBox
-> TrainedScale
-> TrainedScale
-> Projector
polarProjector PolarAes
aes Double
a0 PolarDir
dir PlotBox
box TrainedScale
xs TrainedScale
ys

cartesianProjector :: PlotBox -> TrainedScale -> TrainedScale -> Projector
cartesianProjector :: PlotBox -> TrainedScale -> TrainedScale -> Projector
cartesianProjector PlotBox
box TrainedScale
xs TrainedScale
ys Double
x Double
y =
    Projector
Point
        (PlotBox -> Double
boxX PlotBox
box Double -> Double -> Double
forall a. Num a => a -> a -> a
+ TrainedScale -> Double -> Double
tsProject TrainedScale
xs Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* PlotBox -> Double
boxW PlotBox
box)
        (PlotBox -> Double
boxY PlotBox
box Double -> Double -> Double
forall a. Num a => a -> a -> a
+ PlotBox -> Double
boxH PlotBox
box Double -> Double -> Double
forall a. Num a => a -> a -> a
- TrainedScale -> Double -> Double
tsProject TrainedScale
ys Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* PlotBox -> Double
boxH PlotBox
box)

{- | 'CoordFlip' rotates the chart 90° clockwise: the X aesthetic
projects top-down (data x=0 → top), matching ggplot @coord_flip()@
and Plotly's horizontal-bar / funnel convention.
-}
flipProjector :: PlotBox -> TrainedScale -> TrainedScale -> Projector
flipProjector :: PlotBox -> TrainedScale -> TrainedScale -> Projector
flipProjector PlotBox
box TrainedScale
xs TrainedScale
ys Double
x Double
y =
    Projector
Point
        (PlotBox -> Double
boxX PlotBox
box Double -> Double -> Double
forall a. Num a => a -> a -> a
+ TrainedScale -> Double -> Double
tsProject TrainedScale
ys Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* PlotBox -> Double
boxW PlotBox
box)
        (PlotBox -> Double
boxY PlotBox
box Double -> Double -> Double
forall a. Num a => a -> a -> a
+ TrainedScale -> Double -> Double
tsProject TrainedScale
xs Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* PlotBox -> Double
boxH PlotBox
box)

polarProjector ::
    PolarAes ->
    Double ->
    PolarDir ->
    PlotBox ->
    TrainedScale ->
    TrainedScale ->
    Projector
polarProjector :: PolarAes
-> Double
-> PolarDir
-> PlotBox
-> TrainedScale
-> TrainedScale
-> Projector
polarProjector PolarAes
aes Double
a0 PolarDir
dir PlotBox
box TrainedScale
xs TrainedScale
ys =
    let cx :: Double
cx = PlotBox -> Double
boxX PlotBox
box Double -> Double -> Double
forall a. Num a => a -> a -> a
+ PlotBox -> Double
boxW PlotBox
box Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
        cy :: Double
cy = PlotBox -> Double
boxY PlotBox
box Double -> Double -> Double
forall a. Num a => a -> a -> a
+ PlotBox -> Double
boxH PlotBox
box Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
        maxR :: Double
maxR = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (PlotBox -> Double
boxW PlotBox
box) (PlotBox -> Double
boxH PlotBox
box) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
        sign :: Double
sign = case PolarDir
dir of
            PolarDir
PolarCW -> Double
1
            PolarDir
PolarCCW -> -Double
1
     in \Double
x Double
y ->
            let (Double
tVal, Double
rVal) = case PolarAes
aes of
                    PolarAes
ThetaX -> (TrainedScale -> Double -> Double
tsProject TrainedScale
xs Double
x, TrainedScale -> Double -> Double
tsProject TrainedScale
ys Double
y)
                    PolarAes
ThetaY -> (TrainedScale -> Double -> Double
tsProject TrainedScale
ys Double
y, TrainedScale -> Double -> Double
tsProject TrainedScale
xs Double
x)
                theta :: Double
theta = Double
a0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
sign Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
tVal Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi
                r :: Double
r = Double
rVal Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
maxR
             in Projector
Point (Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
theta) (Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
theta)

renderChartTerminal :: Chart -> Text
renderChartTerminal :: Chart -> Text
renderChartTerminal = Scene -> Text
Terminal.renderScene (Scene -> Text) -> (Chart -> Scene) -> Chart -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chart -> Scene
chartToScene

{- | SVG render; uses responsive sizing when 'chartSize' is
'SizeResponsive', explicit pixel dimensions otherwise.
-}
renderChartSvg :: Chart -> Text
renderChartSvg :: Chart -> Text
renderChartSvg Chart
chart =
    let render :: Scene -> Text
render = case Chart -> Size
chartSize Chart
chart of
            SizeResponsive Double
_ -> Scene -> Text
Svg.renderSceneResponsive
            Size
_ -> Scene -> Text
Svg.renderScene
     in Scene -> Text
render (Chart -> Scene
chartToScene Chart
chart)

renderChart :: Chart -> (Text, Text)
renderChart :: Chart -> (Text, Text)
renderChart Chart
c = (Chart -> Text
renderChartTerminal Chart
c, Chart -> Text
renderChartSvg Chart
c)

chartToScene :: Chart -> Scene
chartToScene :: Chart -> Scene
chartToScene Chart
chart =
    let theme :: Theme
theme = Chart -> Theme
chartTheme Chart
chart
        palette :: [ColorSpec]
palette = Theme -> [ColorSpec]
themePalette Theme
theme
        coord :: Coord
coord = Chart -> Coord
chartCoord Chart
chart
        hasTitle :: Bool
hasTitle = case Chart -> Maybe Text
chartTitle Chart
chart of
            Just Text
t -> Bool -> Bool
not (Text -> Bool
Text.null Text
t)
            Maybe Text
Nothing -> Bool
False
        fillCols :: Maybe [ColorSpec]
fillCols = case Scales -> Maybe Scale
scaleFill (Chart -> Scales
chartScales Chart
chart) of
            Just (SColorContinuous [ColorSpec]
cs) -> [ColorSpec] -> Maybe [ColorSpec]
forall a. a -> Maybe a
Just [ColorSpec]
cs
            Maybe Scale
_ -> Maybe [ColorSpec]
forall a. Maybe a
Nothing
        fillManual :: Maybe [(Text, ColorSpec)]
fillManual = case Scales -> Maybe Scale
scaleFill (Chart -> Scales
chartScales Chart
chart) of
            Just (SColorManual [(Text, ColorSpec)]
pairs) -> [(Text, ColorSpec)] -> Maybe [(Text, ColorSpec)]
forall a. a -> Maybe a
Just [(Text, ColorSpec)]
pairs
            Just (SColorDiscrete [ColorSpec]
cs) -> [(Text, ColorSpec)] -> Maybe [(Text, ColorSpec)]
forall a. a -> Maybe a
Just (Chart -> [ColorSpec] -> [(Text, ColorSpec)]
discreteFillMap Chart
chart [ColorSpec]
cs)
            Maybe Scale
_ -> Maybe [(Text, ColorSpec)]
forall a. Maybe a
Nothing
        -- The fill scale is folded into 'colorMaps' here so a single
        -- category→colour map drives both the bars and the legend swatches.
        colorMaps :: [Maybe [(Text, ColorSpec)]]
colorMaps =
            (Layer -> Maybe [(Text, ColorSpec)])
-> [Layer] -> [Maybe [(Text, ColorSpec)]]
forall a b. (a -> b) -> [a] -> [b]
map ([ColorSpec]
-> Maybe [(Text, ColorSpec)]
-> DataFrame
-> Layer
-> Maybe [(Text, ColorSpec)]
layerColorMap [ColorSpec]
palette Maybe [(Text, ColorSpec)]
fillManual (Chart -> DataFrame
chartData Chart
chart)) (Chart -> [Layer]
chartLayers Chart
chart)
        legendEntries :: [(Text, ColorSpec)]
legendEntries = [Layer]
-> [ColorSpec]
-> [Maybe [(Text, ColorSpec)]]
-> [(Text, ColorSpec)]
collectLegend (Chart -> [Layer]
chartLayers Chart
chart) [ColorSpec]
palette [Maybe [(Text, ColorSpec)]]
colorMaps
        hasRightLegend :: Bool
hasRightLegend = Bool -> Bool
not ([(Text, ColorSpec)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, ColorSpec)]
legendEntries)
        -- Size margins to the actual labels so long words never clip, and decide
        -- the bottom-axis label policy once (threaded as 'XLabelMode') so margin
        -- sizing and rendering agree. The on-screen bottom\/left axes swap under
        -- CoordFlip; polar has no rectangular axes; faceting forbids rotation.
        ([Text]
xLbls, [Text]
yLbls) = Chart -> ([Text], [Text])
globalAxisLabels Chart
chart
        ([Text]
bottomLbls, [Text]
leftLbls) = case Coord
coord of
            Coord
CoordFlip -> ([Text]
yLbls, [Text]
xLbls)
            Coord
_ -> ([Text]
xLbls, [Text]
yLbls)
        faceted :: Bool
faceted = case Chart -> Facet
chartFacet Chart
chart of Facet
FacetNull -> Bool
False; Facet
_ -> Bool
True
        layout :: AxisLayout
layout = case Coord
coord of
            CoordPolar{} -> XLabelMode -> Double -> Double -> AxisLayout
AxisLayout XLabelMode
xModeNoRotate Double
0 Double
0
            Coord
_ ->
                Theme -> Size -> Bool -> Bool -> [Text] -> [Text] -> AxisLayout
axisLayout Theme
theme (Chart -> Size
chartSize Chart
chart) Bool
hasRightLegend Bool
faceted [Text]
bottomLbls [Text]
leftLbls
        box :: PlotBox
box =
            Size -> Theme -> Margins -> PlotBox
computePlotBox (Chart -> Size
chartSize Chart
chart) Theme
theme (Margins -> PlotBox) -> Margins -> PlotBox
forall a b. (a -> b) -> a -> b
$
                Margins
                    { marHasTitle :: Bool
marHasTitle = Bool
hasTitle
                    , marHasRightLegend :: Bool
marHasRightLegend = Bool
hasRightLegend
                    , marHasBottomLegend :: Bool
marHasBottomLegend = Bool
False
                    , marExtraBottom :: Double
marExtraBottom = AxisLayout -> Double
alExtraBottom AxisLayout
layout
                    , marLeftWanted :: Double
marLeftWanted = AxisLayout -> Double
alLeftWanted AxisLayout
layout
                    }

        panels :: [PanelSpec]
panels = Theme -> PlotBox -> Chart -> [PanelSpec]
layoutPanels Theme
theme PlotBox
box Chart
chart
        panelMarks :: [Mark]
panelMarks =
            (PanelSpec -> [Mark]) -> [PanelSpec] -> [Mark]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                ( Theme
-> [ColorSpec]
-> Coord
-> XLabelMode
-> [Maybe [(Text, ColorSpec)]]
-> Maybe [ColorSpec]
-> PanelSpec
-> [Mark]
renderPanel
                    Theme
theme
                    [ColorSpec]
palette
                    Coord
coord
                    (AxisLayout -> XLabelMode
alMode AxisLayout
layout)
                    [Maybe [(Text, ColorSpec)]]
colorMaps
                    Maybe [ColorSpec]
fillCols
                )
                [PanelSpec]
panels

        legend :: [Mark]
legend = Theme -> PlotBox -> [(Text, ColorSpec)] -> [Mark]
legendMarks Theme
theme PlotBox
box [(Text, ColorSpec)]
legendEntries
        title :: [Mark]
title = Theme -> PlotBox -> Maybe Text -> [Mark]
titleMarks Theme
theme PlotBox
box (Chart -> Maybe Text
chartTitle Chart
chart)

        marks :: [Mark]
marks = [Mark]
panelMarks [Mark] -> [Mark] -> [Mark]
forall a. Semigroup a => a -> a -> a
<> [Mark]
title [Mark] -> [Mark] -> [Mark]
forall a. Semigroup a => a -> a -> a
<> [Mark]
legend
     in Double -> Double -> [Mark] -> Scene
Scene (PlotBox -> Double
boxSceneW PlotBox
box) (PlotBox -> Double
boxSceneH PlotBox
box) [Mark]
marks

data PanelSpec = PanelSpec
    { PanelSpec -> PlotBox
panelBox :: PlotBox
    , PanelSpec -> Text
panelLabel :: Text
    , PanelSpec -> DataFrame
panelData :: DataFrame
    , PanelSpec -> [Layer]
panelLayers :: [Layer]
    , PanelSpec -> TrainedScale
panelXScale :: TrainedScale
    , PanelSpec -> TrainedScale
panelYScale :: TrainedScale
    }

renderPanel ::
    Theme ->
    [ColorSpec] ->
    Coord ->
    XLabelMode ->
    [Maybe [(Text, ColorSpec)]] ->
    Maybe [ColorSpec] ->
    PanelSpec ->
    [Mark]
renderPanel :: Theme
-> [ColorSpec]
-> Coord
-> XLabelMode
-> [Maybe [(Text, ColorSpec)]]
-> Maybe [ColorSpec]
-> PanelSpec
-> [Mark]
renderPanel Theme
theme [ColorSpec]
palette Coord
coord XLabelMode
xmode [Maybe [(Text, ColorSpec)]]
colorMaps Maybe [ColorSpec]
fillCols PanelSpec
ps =
    let proj :: Projector
proj = Coord -> PlotBox -> TrainedScale -> TrainedScale -> Projector
buildProjector Coord
coord (PanelSpec -> PlotBox
panelBox PanelSpec
ps) (PanelSpec -> TrainedScale
panelXScale PanelSpec
ps) (PanelSpec -> TrainedScale
panelYScale PanelSpec
ps)
        cmap :: Int -> Maybe [(Text, ColorSpec)]
cmap Int
i = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Maybe [(Text, ColorSpec)]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe [(Text, ColorSpec)]]
colorMaps then [Maybe [(Text, ColorSpec)]]
colorMaps [Maybe [(Text, ColorSpec)]] -> Int -> Maybe [(Text, ColorSpec)]
forall a. HasCallStack => [a] -> Int -> a
!! Int
i else Maybe [(Text, ColorSpec)]
forall a. Maybe a
Nothing
        layerMarks :: [Mark]
layerMarks =
            [[Mark]] -> [Mark]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ Theme
-> PlotBox
-> Projector
-> [ColorSpec]
-> Maybe [(Text, ColorSpec)]
-> Maybe [ColorSpec]
-> Int
-> DataFrame
-> Layer
-> [Mark]
runLayer
                    Theme
theme
                    (PanelSpec -> PlotBox
panelBox PanelSpec
ps)
                    Projector
proj
                    [ColorSpec]
palette
                    (Int -> Maybe [(Text, ColorSpec)]
cmap Int
i)
                    Maybe [ColorSpec]
fillCols
                    Int
i
                    (PanelSpec -> DataFrame
panelData PanelSpec
ps)
                    Layer
layer
                | (Int
i, Layer
layer) <- [Int] -> [Layer] -> [(Int, Layer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] (PanelSpec -> [Layer]
panelLayers PanelSpec
ps)
                ]
        axes :: [Mark]
axes = Theme
-> PlotBox
-> Coord
-> XLabelMode
-> TrainedScale
-> TrainedScale
-> [Mark]
axesMarks Theme
theme (PanelSpec -> PlotBox
panelBox PanelSpec
ps) Coord
coord XLabelMode
xmode (PanelSpec -> TrainedScale
panelXScale PanelSpec
ps) (PanelSpec -> TrainedScale
panelYScale PanelSpec
ps)
        strip :: [Mark]
strip = Theme -> PlotBox -> Text -> [Mark]
stripMark Theme
theme (PanelSpec -> PlotBox
panelBox PanelSpec
ps) (PanelSpec -> Text
panelLabel PanelSpec
ps)
     in [Mark]
axes [Mark] -> [Mark] -> [Mark]
forall a. Semigroup a => a -> a -> a
<> [Mark]
layerMarks [Mark] -> [Mark] -> [Mark]
forall a. Semigroup a => a -> a -> a
<> [Mark]
strip

stripMark :: Theme -> PlotBox -> Text -> [Mark]
stripMark :: Theme -> PlotBox -> Text -> [Mark]
stripMark Theme
theme PlotBox
box Text
label
    | Text -> Bool
Text.null Text
label = []
    | Bool
otherwise =
        let (Text
lbl, Maybe Text
title) = Double -> Double -> Text -> (Text, Maybe Text)
truncatePx (Theme -> Double
themeFontSize Theme
theme) (PlotBox -> Double
boxW PlotBox
box) Text
label
         in [ Point -> Text -> TextStyle -> Mark
MText
                (Projector
Point (PlotBox -> Double
boxX PlotBox
box Double -> Double -> Double
forall a. Num a => a -> a -> a
+ PlotBox -> Double
boxW PlotBox
box Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) (PlotBox -> Double
boxY PlotBox
box Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
4))
                Text
lbl
                TextStyle
defaultTextStyle
                    { textFill = colorOfSpec (themeTextColor theme)
                    , textSize = themeFontSize theme
                    , textAnchor = AnchorMiddle
                    , textTitle = title
                    }
            ]
  where
    colorOfSpec :: ColorSpec -> Color
colorOfSpec ColorSpec
spec = case ColorSpec
spec of
        NamedColor Color
c -> Color
c
        ColorSpec
_ -> Color
Default

layoutPanels :: Theme -> PlotBox -> Chart -> [PanelSpec]
layoutPanels :: Theme -> PlotBox -> Chart -> [PanelSpec]
layoutPanels Theme
theme PlotBox
box Chart
chart = case Chart -> Facet
chartFacet Chart
chart of
    Facet
FacetNull ->
        [Chart -> PlotBox -> Text -> PanelSpec
singlePanel Chart
chart PlotBox
box Text
""]
    FacetWrap ColumnRef
colRef Maybe Int
mNcol Maybe Int
mNrow FacetScales
scalesMode ->
        let keys :: [Text]
keys = ColumnRef -> DataFrame -> [Layer] -> [Text]
facetKeys ColumnRef
colRef (Chart -> DataFrame
chartData Chart
chart) (Chart -> [Layer]
chartLayers Chart
chart)
         in case [Text]
keys of
                [] -> [Chart -> PlotBox -> Text -> PanelSpec
singlePanel Chart
chart PlotBox
box Text
""]
                [Text]
_ ->
                    let n :: Int
n = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
keys
                        (Int
nrow, Int
ncol) = Int -> Maybe Int -> Maybe Int -> (Int, Int)
wrapDims Int
n Maybe Int
mNcol Maybe Int
mNrow
                        cells :: [PlotBox]
cells = Theme -> PlotBox -> Int -> Int -> [PlotBox]
gridCells Theme
theme PlotBox
box Int
nrow Int
ncol
                     in [ Chart -> ColumnRef -> Text -> FacetScales -> PlotBox -> PanelSpec
panelFor Chart
chart ColumnRef
colRef Text
key FacetScales
scalesMode PlotBox
cellBox
                        | (Text
key, PlotBox
cellBox) <- [Text] -> [PlotBox] -> [(Text, PlotBox)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
keys [PlotBox]
cells
                        ]
    FacetGrid [ColumnRef]
rowRefs [ColumnRef]
colRefs FacetScales
scalesMode ->
        let ([Text]
rowKeys, [Text]
colKeys) = [ColumnRef]
-> [ColumnRef] -> DataFrame -> [Layer] -> ([Text], [Text])
gridKeys [ColumnRef]
rowRefs [ColumnRef]
colRefs (Chart -> DataFrame
chartData Chart
chart) (Chart -> [Layer]
chartLayers Chart
chart)
            rowKeys' :: [Text]
rowKeys' = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
rowKeys then [Text
""] else [Text]
rowKeys
            colKeys' :: [Text]
colKeys' = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
colKeys then [Text
""] else [Text]
colKeys
            nrow :: Int
nrow = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
rowKeys'
            ncol :: Int
ncol = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
colKeys'
            cells :: [PlotBox]
cells = Theme -> PlotBox -> Int -> Int -> [PlotBox]
gridCells Theme
theme PlotBox
box Int
nrow Int
ncol
         in [ Chart
-> [ColumnRef]
-> [ColumnRef]
-> Text
-> Text
-> FacetScales
-> PlotBox
-> PanelSpec
gridPanel Chart
chart [ColumnRef]
rowRefs [ColumnRef]
colRefs Text
rowKey Text
colKey FacetScales
scalesMode PlotBox
cellBox
            | (Text
rowKey, Int
rowIx) <- [Text] -> [Int] -> [(Text, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
rowKeys' [Int
0 :: Int ..]
            , (Text
colKey, Int
colIx) <- [Text] -> [Int] -> [(Text, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
colKeys' [Int
0 :: Int ..]
            , let cellBox :: PlotBox
cellBox = [PlotBox]
cells [PlotBox] -> Int -> PlotBox
forall a. HasCallStack => [a] -> Int -> a
!! (Int
rowIx Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ncol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
colIx)
            ]

{- | The whole-chart x and y trained scales (no faceting/filtering). Shared by
'singlePanel' and 'globalAxisLabels' so the labels that size the margins match
the scales the single panel renders.
-}
trainGlobalScales :: Chart -> (TrainedScale, TrainedScale)
trainGlobalScales :: Chart -> (TrainedScale, TrainedScale)
trainGlobalScales Chart
chart =
    let xRange :: (Double, Double)
xRange = [Layer]
-> DataFrame
-> [Mapping -> Maybe ColumnRef]
-> Bool
-> (Double, Double)
paddedRange (Chart -> [Layer]
chartLayers Chart
chart) (Chart -> DataFrame
chartData Chart
chart) [Mapping -> Maybe ColumnRef]
xRangeRefs Bool
True
        yRange :: (Double, Double)
yRange = [Layer]
-> DataFrame
-> [Mapping -> Maybe ColumnRef]
-> Bool
-> (Double, Double)
paddedRange (Chart -> [Layer]
chartLayers Chart
chart) (Chart -> DataFrame
chartData Chart
chart) [Mapping -> Maybe ColumnRef]
yRangeRefs Bool
False
        xs :: TrainedScale
xs =
            (Mapping -> Maybe ColumnRef)
-> [Layer] -> DataFrame -> TrainedScale -> TrainedScale
applyCategorical
                Mapping -> Maybe ColumnRef
aesX
                (Chart -> [Layer]
chartLayers Chart
chart)
                (Chart -> DataFrame
chartData Chart
chart)
                (Scale -> (Double, Double) -> TrainedScale
train (Scales -> Scale
scaleX (Chart -> Scales
chartScales Chart
chart)) (Double, Double)
xRange)
        ys :: TrainedScale
ys =
            (Mapping -> Maybe ColumnRef)
-> [Layer] -> DataFrame -> TrainedScale -> TrainedScale
applyCategorical
                Mapping -> Maybe ColumnRef
aesY
                (Chart -> [Layer]
chartLayers Chart
chart)
                (Chart -> DataFrame
chartData Chart
chart)
                (Scale -> (Double, Double) -> TrainedScale
train (Scales -> Scale
scaleY (Chart -> Scales
chartScales Chart
chart)) (Double, Double)
yRange)
     in (TrainedScale
xs, TrainedScale
ys)

{- | The on-render x and y tick labels (domain-filtered), independent of the
plot box, so margins can be sized to fit them before the box is computed.
-}
globalAxisLabels :: Chart -> ([Text], [Text])
globalAxisLabels :: Chart -> ([Text], [Text])
globalAxisLabels Chart
chart =
    let (TrainedScale
xs, TrainedScale
ys) = Chart -> (TrainedScale, TrainedScale)
trainGlobalScales Chart
chart
     in (TrainedScale -> [Text]
domainLabels TrainedScale
xs, TrainedScale -> [Text]
domainLabels TrainedScale
ys)

singlePanel :: Chart -> PlotBox -> Text -> PanelSpec
singlePanel :: Chart -> PlotBox -> Text -> PanelSpec
singlePanel Chart
chart PlotBox
box Text
label =
    let (TrainedScale
xs, TrainedScale
ys) = Chart -> (TrainedScale, TrainedScale)
trainGlobalScales Chart
chart
     in PanelSpec
            { panelBox :: PlotBox
panelBox = PlotBox
box
            , panelLabel :: Text
panelLabel = Text
label
            , panelData :: DataFrame
panelData = Chart -> DataFrame
chartData Chart
chart
            , panelLayers :: [Layer]
panelLayers = Chart -> [Layer]
chartLayers Chart
chart
            , panelXScale :: TrainedScale
panelXScale = TrainedScale
xs
            , panelYScale :: TrainedScale
panelYScale = TrainedScale
ys
            }

panelFor :: Chart -> ColumnRef -> Text -> FacetScales -> PlotBox -> PanelSpec
panelFor :: Chart -> ColumnRef -> Text -> FacetScales -> PlotBox -> PanelSpec
panelFor Chart
chart ColumnRef
colRef Text
key FacetScales
scalesMode PlotBox
box =
    let (DataFrame
frame, [Layer]
layers) = Chart -> ColumnRef -> Text -> (DataFrame, [Layer])
filterChartByKey Chart
chart ColumnRef
colRef Text
key
        chart' :: Chart
chart' = Chart
chart{chartData = frame, chartLayers = layers}
        (TrainedScale
xs, TrainedScale
ys) = Chart -> Chart -> FacetScales -> (TrainedScale, TrainedScale)
trainPanelScales Chart
chart Chart
chart' FacetScales
scalesMode
     in PanelSpec
            { panelBox :: PlotBox
panelBox = PlotBox
box
            , panelLabel :: Text
panelLabel = Text
key
            , panelData :: DataFrame
panelData = DataFrame
frame
            , panelLayers :: [Layer]
panelLayers = [Layer]
layers
            , panelXScale :: TrainedScale
panelXScale = TrainedScale
xs
            , panelYScale :: TrainedScale
panelYScale = TrainedScale
ys
            }

gridPanel ::
    Chart ->
    [ColumnRef] ->
    [ColumnRef] ->
    Text ->
    Text ->
    FacetScales ->
    PlotBox ->
    PanelSpec
gridPanel :: Chart
-> [ColumnRef]
-> [ColumnRef]
-> Text
-> Text
-> FacetScales
-> PlotBox
-> PanelSpec
gridPanel Chart
chart [ColumnRef]
rowRefs [ColumnRef]
colRefs Text
rowKey Text
colKey FacetScales
scalesMode PlotBox
box =
    let frame0 :: DataFrame
frame0 = Chart -> DataFrame
chartData Chart
chart
        frame1 :: DataFrame
frame1 = (DataFrame -> ColumnRef -> DataFrame)
-> DataFrame -> [ColumnRef] -> DataFrame
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\DataFrame
f ColumnRef
c -> ColumnRef -> Text -> DataFrame -> DataFrame
filterFrameByKey ColumnRef
c Text
rowKey DataFrame
f) DataFrame
frame0 [ColumnRef]
rowRefs
        frame2 :: DataFrame
frame2 = (DataFrame -> ColumnRef -> DataFrame)
-> DataFrame -> [ColumnRef] -> DataFrame
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\DataFrame
f ColumnRef
c -> ColumnRef -> Text -> DataFrame -> DataFrame
filterFrameByKey ColumnRef
c Text
colKey DataFrame
f) DataFrame
frame1 [ColumnRef]
colRefs
        filterLayer :: Layer -> Layer
filterLayer Layer
l =
            Layer
l
                { layerData =
                    fmap
                        ( \DataFrame
df ->
                            let g0 :: DataFrame
g0 = (DataFrame -> ColumnRef -> DataFrame)
-> DataFrame -> [ColumnRef] -> DataFrame
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\DataFrame
f ColumnRef
c -> ColumnRef -> Text -> DataFrame -> DataFrame
filterFrameByKey ColumnRef
c Text
rowKey DataFrame
f) DataFrame
df [ColumnRef]
rowRefs
                             in (DataFrame -> ColumnRef -> DataFrame)
-> DataFrame -> [ColumnRef] -> DataFrame
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\DataFrame
f ColumnRef
c -> ColumnRef -> Text -> DataFrame -> DataFrame
filterFrameByKey ColumnRef
c Text
colKey DataFrame
f) DataFrame
g0 [ColumnRef]
colRefs
                        )
                        (layerData l)
                }
        layers :: [Layer]
layers = (Layer -> Layer) -> [Layer] -> [Layer]
forall a b. (a -> b) -> [a] -> [b]
map Layer -> Layer
filterLayer (Chart -> [Layer]
chartLayers Chart
chart)
        chart' :: Chart
chart' = Chart
chart{chartData = frame2, chartLayers = layers}
        label :: Text
label = case (Text -> Bool
Text.null Text
rowKey, Text -> Bool
Text.null Text
colKey) of
            (Bool
True, Bool
True) -> Text
""
            (Bool
True, Bool
False) -> Text
colKey
            (Bool
False, Bool
True) -> Text
rowKey
            (Bool
False, Bool
False) -> Text
rowKey Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
colKey
        (TrainedScale
xs, TrainedScale
ys) = Chart -> Chart -> FacetScales -> (TrainedScale, TrainedScale)
trainPanelScales Chart
chart Chart
chart' FacetScales
scalesMode
     in PanelSpec
            { panelBox :: PlotBox
panelBox = PlotBox
box
            , panelLabel :: Text
panelLabel = Text
label
            , panelData :: DataFrame
panelData = DataFrame
frame2
            , panelLayers :: [Layer]
panelLayers = [Layer]
layers
            , panelXScale :: TrainedScale
panelXScale = TrainedScale
xs
            , panelYScale :: TrainedScale
panelYScale = TrainedScale
ys
            }

trainPanelScales ::
    Chart -> Chart -> FacetScales -> (TrainedScale, TrainedScale)
trainPanelScales :: Chart -> Chart -> FacetScales -> (TrainedScale, TrainedScale)
trainPanelScales Chart
whole Chart
panel FacetScales
mode =
    let xS :: Scale
xS = Scales -> Scale
scaleX (Chart -> Scales
chartScales Chart
whole)
        yS :: Scale
yS = Scales -> Scale
scaleY (Chart -> Scales
chartScales Chart
whole)
        wholeXRange :: (Double, Double)
wholeXRange = [Layer]
-> DataFrame
-> [Mapping -> Maybe ColumnRef]
-> Bool
-> (Double, Double)
paddedRange (Chart -> [Layer]
chartLayers Chart
whole) (Chart -> DataFrame
chartData Chart
whole) [Mapping -> Maybe ColumnRef]
xRangeRefs Bool
True
        wholeYRange :: (Double, Double)
wholeYRange = [Layer]
-> DataFrame
-> [Mapping -> Maybe ColumnRef]
-> Bool
-> (Double, Double)
paddedRange (Chart -> [Layer]
chartLayers Chart
whole) (Chart -> DataFrame
chartData Chart
whole) [Mapping -> Maybe ColumnRef]
yRangeRefs Bool
False
        panelXRange :: (Double, Double)
panelXRange = [Layer]
-> DataFrame
-> [Mapping -> Maybe ColumnRef]
-> Bool
-> (Double, Double)
paddedRange (Chart -> [Layer]
chartLayers Chart
panel) (Chart -> DataFrame
chartData Chart
panel) [Mapping -> Maybe ColumnRef]
xRangeRefs Bool
True
        panelYRange :: (Double, Double)
panelYRange = [Layer]
-> DataFrame
-> [Mapping -> Maybe ColumnRef]
-> Bool
-> (Double, Double)
paddedRange (Chart -> [Layer]
chartLayers Chart
panel) (Chart -> DataFrame
chartData Chart
panel) [Mapping -> Maybe ColumnRef]
yRangeRefs Bool
False
        ((Double, Double)
xRange, (Double, Double)
yRange) = case FacetScales
mode of
            FacetScales
ScalesFixed -> ((Double, Double)
wholeXRange, (Double, Double)
wholeYRange)
            FacetScales
ScalesFreeX -> ((Double, Double)
panelXRange, (Double, Double)
wholeYRange)
            FacetScales
ScalesFreeY -> ((Double, Double)
wholeXRange, (Double, Double)
panelYRange)
            FacetScales
ScalesFree -> ((Double, Double)
panelXRange, (Double, Double)
panelYRange)
        xs :: TrainedScale
xs = (Mapping -> Maybe ColumnRef)
-> [Layer] -> DataFrame -> TrainedScale -> TrainedScale
applyCategorical Mapping -> Maybe ColumnRef
aesX (Chart -> [Layer]
chartLayers Chart
panel) (Chart -> DataFrame
chartData Chart
panel) (Scale -> (Double, Double) -> TrainedScale
train Scale
xS (Double, Double)
xRange)
        ys :: TrainedScale
ys = (Mapping -> Maybe ColumnRef)
-> [Layer] -> DataFrame -> TrainedScale -> TrainedScale
applyCategorical Mapping -> Maybe ColumnRef
aesY (Chart -> [Layer]
chartLayers Chart
panel) (Chart -> DataFrame
chartData Chart
panel) (Scale -> (Double, Double) -> TrainedScale
train Scale
yS (Double, Double)
yRange)
     in (TrainedScale
xs, TrainedScale
ys)

{- | Strip height of 32 px = two terminal lines, so panel data never
shares a character row with its facet strip label.
-}
gridCells :: Theme -> PlotBox -> Int -> Int -> [PlotBox]
gridCells :: Theme -> PlotBox -> Int -> Int -> [PlotBox]
gridCells Theme
theme PlotBox
box Int
nrow Int
ncol =
    let stripH :: Double
stripH = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
32 (Theme -> Double
themeFontSize Theme
theme Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
10)
        gutterX :: Double
gutterX = Double
10
        gutterY :: Double
gutterY = Double
14
        cellW :: Double
cellW = PlotBox -> Double
boxW PlotBox
box Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ncol
        cellH :: Double
cellH = PlotBox -> Double
boxH PlotBox
box Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nrow
     in [ PlotBox
box
            { boxX = boxX box + fromIntegral c * cellW + gutterX / 2
            , boxY = boxY box + fromIntegral r * cellH + stripH
            , boxW = cellW - gutterX
            , boxH = cellH - stripH - gutterY
            }
        | Int
r <- [Int
0 .. Int
nrow Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
        , Int
c <- [Int
0 .. Int
ncol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
        ]

wrapDims :: Int -> Maybe Int -> Maybe Int -> (Int, Int)
wrapDims :: Int -> Maybe Int -> Maybe Int -> (Int, Int)
wrapDims Int
n Maybe Int
mNcol Maybe Int
mNrow = case (Maybe Int
mNcol, Maybe Int
mNrow) of
    (Just Int
c, Just Int
r) -> (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
r, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
c)
    (Just Int
c, Maybe Int
Nothing) -> (Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
ceilingDiv Int
n (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
c), Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
c)
    (Maybe Int
Nothing, Just Int
r) -> (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
r, Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
ceilingDiv Int
n (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
r))
    (Maybe Int
Nothing, Maybe Int
Nothing) ->
        let c :: Int
c = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Double
forall a. Floating a => a -> a
sqrt (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Double)))
         in (Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
ceilingDiv Int
n Int
c, Int
c)
  where
    ceilingDiv :: a -> a -> a
ceilingDiv a
a a
b = (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> a -> a
forall {a}. Integral a => a -> a -> a
`div` a
b

facetKeys :: ColumnRef -> DataFrame -> [Layer] -> [Text]
facetKeys :: ColumnRef -> DataFrame -> [Layer] -> [Text]
facetKeys ColumnRef
colRef DataFrame
chartFrame [Layer]
layers =
    case ColumnRef -> DataFrame -> Maybe [Text]
keysFrom ColumnRef
colRef DataFrame
chartFrame of
        Just [Text]
ks -> [Text] -> [Text]
forall a. Eq a => [a] -> [a]
List.nub [Text]
ks
        Maybe [Text]
Nothing ->
            [Text] -> [Text]
forall a. Eq a => [a] -> [a]
List.nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
                [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ [Text]
ks
                    | Just DataFrame
frame <- (Layer -> Maybe DataFrame) -> [Layer] -> [Maybe DataFrame]
forall a b. (a -> b) -> [a] -> [b]
map Layer -> Maybe DataFrame
layerData [Layer]
layers
                    , Just [Text]
ks <- [ColumnRef -> DataFrame -> Maybe [Text]
keysFrom ColumnRef
colRef DataFrame
frame]
                    ]
  where
    keysFrom :: ColumnRef -> DataFrame -> Maybe [Text]
keysFrom (ColumnRef Text
name) (DataFrame [(Text, Column)]
cols) =
        case Text -> [(Text, Column)] -> Maybe Column
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
name [(Text, Column)]
cols of
            Just Column
c -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just (Column -> [Text]
columnAsText Column
c)
            Maybe Column
Nothing -> Maybe [Text]
forall a. Maybe a
Nothing

gridKeys ::
    [ColumnRef] -> [ColumnRef] -> DataFrame -> [Layer] -> ([Text], [Text])
gridKeys :: [ColumnRef]
-> [ColumnRef] -> DataFrame -> [Layer] -> ([Text], [Text])
gridKeys [ColumnRef]
rowRefs [ColumnRef]
colRefs DataFrame
chartFrame [Layer]
_layers =
    let rowKeys :: [Text]
rowKeys = [ColumnRef] -> DataFrame -> [Text]
compoundKeys [ColumnRef]
rowRefs DataFrame
chartFrame
        colKeys :: [Text]
colKeys = [ColumnRef] -> DataFrame -> [Text]
compoundKeys [ColumnRef]
colRefs DataFrame
chartFrame
     in ([Text]
rowKeys, [Text]
colKeys)
  where
    compoundKeys :: [ColumnRef] -> DataFrame -> [Text]
compoundKeys [ColumnRef]
refs DataFrame
frame
        | [ColumnRef] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ColumnRef]
refs = []
        | Bool
otherwise =
            let perCol :: [[Text]]
perCol = [[Text] -> (Column -> [Text]) -> Maybe Column -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Column -> [Text]
columnAsText (ColumnRef -> DataFrame -> Maybe Column
lookupColumnByRef ColumnRef
r DataFrame
frame) | ColumnRef
r <- [ColumnRef]
refs]
                rows :: [Text]
rows =
                    case [[Text]]
perCol of
                        [] -> []
                        ([Text]
xs : [[Text]]
_) -> (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([[Text]] -> Int -> Text
compoundAt [[Text]]
perCol) [Int
0 .. [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
             in [Text] -> [Text]
forall a. Eq a => [a] -> [a]
List.nub [Text]
rows
    compoundAt :: [[Text]] -> Int -> Text
compoundAt [[Text]]
cols Int
i =
        Text -> [Text] -> Text
Text.intercalate Text
"\x00" [if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
c then [Text]
c [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
i else Text
"" | [Text]
c <- [[Text]]
cols]
    lookupColumnByRef :: ColumnRef -> DataFrame -> Maybe Column
lookupColumnByRef (ColumnRef Text
n) (DataFrame [(Text, Column)]
cols) = Text -> [(Text, Column)] -> Maybe Column
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
n [(Text, Column)]
cols

filterFrameByKey :: ColumnRef -> Text -> DataFrame -> DataFrame
filterFrameByKey :: ColumnRef -> Text -> DataFrame -> DataFrame
filterFrameByKey (ColumnRef Text
name) Text
key df :: DataFrame
df@(DataFrame [(Text, Column)]
cols) =
    case Text -> [(Text, Column)] -> Maybe Column
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
name [(Text, Column)]
cols of
        Maybe Column
Nothing -> DataFrame
df
        Just Column
c ->
            let texts :: [Text]
texts = Column -> [Text]
columnAsText Column
c
                ixs :: [Int]
ixs = [Int
i | (Int
i, Text
v) <- [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Text]
texts, Text
v Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key]
             in [Int] -> DataFrame -> DataFrame
filterByRows [Int]
ixs DataFrame
df

filterChartByKey :: Chart -> ColumnRef -> Text -> (DataFrame, [Layer])
filterChartByKey :: Chart -> ColumnRef -> Text -> (DataFrame, [Layer])
filterChartByKey Chart
chart ColumnRef
colRef Text
key =
    let frame' :: DataFrame
frame' = ColumnRef -> Text -> DataFrame -> DataFrame
filterFrameByKey ColumnRef
colRef Text
key (Chart -> DataFrame
chartData Chart
chart)
        filterLayer :: Layer -> Layer
filterLayer Layer
l =
            Layer
l{layerData = fmap (filterFrameByKey colRef key) (layerData l)}
        layers' :: [Layer]
layers' = (Layer -> Layer) -> [Layer] -> [Layer]
forall a b. (a -> b) -> [a] -> [b]
map Layer -> Layer
filterLayer (Chart -> [Layer]
chartLayers Chart
chart)
     in (DataFrame
frame', [Layer]
layers')

runLayer ::
    Theme ->
    PlotBox ->
    Projector ->
    [ColorSpec] ->
    Maybe [(Text, ColorSpec)] ->
    Maybe [ColorSpec] ->
    Int ->
    DataFrame ->
    Layer ->
    [Mark]
runLayer :: Theme
-> PlotBox
-> Projector
-> [ColorSpec]
-> Maybe [(Text, ColorSpec)]
-> Maybe [ColorSpec]
-> Int
-> DataFrame
-> Layer
-> [Mark]
runLayer Theme
theme PlotBox
box Projector
proj [ColorSpec]
palette Maybe [(Text, ColorSpec)]
colorMap Maybe [ColorSpec]
fillCols Int
ix DataFrame
globalFrame Layer
layer =
    let frame0 :: DataFrame
frame0 = DataFrame -> Maybe DataFrame -> DataFrame
forall a. a -> Maybe a -> a
fromMaybe DataFrame
globalFrame (Layer -> Maybe DataFrame
layerData Layer
layer)
        framePostStat :: DataFrame
framePostStat = Stat -> Mapping -> DataFrame -> DataFrame
applyStat (Layer -> Stat
layerStat Layer
layer) (Layer -> Mapping
layerMapping Layer
layer) DataFrame
frame0
        frame :: DataFrame
frame = Position -> Mapping -> DataFrame -> DataFrame
applyPosition (Layer -> Position
layerPosition Layer
layer) (Layer -> Mapping
layerMapping Layer
layer) DataFrame
framePostStat
        m :: Mapping
m = Layer -> Mapping
layerMapping Layer
layer
        defaults :: AesDefaults
defaults = Layer -> AesDefaults
layerAesDef Layer
layer
        colorSpec :: ColorSpec
colorSpec = case AesDefaults -> Maybe ColorSpec
defColor AesDefaults
defaults of
            Just ColorSpec
c -> ColorSpec
c
            Maybe ColorSpec
Nothing -> [ColorSpec] -> Int -> Layer -> ColorSpec
layerDefaultColor [ColorSpec]
palette Int
ix Layer
layer
        col :: Color
col = ColorSpec -> Color
specToColor ColorSpec
colorSpec
        radius :: Double
radius = case AesDefaults -> Maybe Double
defSize AesDefaults
defaults of
            Just Double
r -> Double
r
            Maybe Double
Nothing -> Theme -> Layer -> Double
pointSize Theme
theme Layer
layer
        alpha :: Double
alpha = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1 (AesDefaults -> Maybe Double
defAlpha AesDefaults
defaults)
        lineW :: Double
lineW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2 (AesDefaults -> Maybe Double
defLineWidth AesDefaults
defaults)
        -- Per-row point colours: a mapped categorical 'aesColor' (when
        -- 'colorMap' is set for this layer) overrides the constant colour.
        pointColors :: [Color]
pointColors = case Maybe [(Text, ColorSpec)]
colorMap of
            Just [(Text, ColorSpec)]
levelColors
                | Just [Text]
cats <- DataFrame -> Mapping -> Maybe [Text]
categoricalColorColumn DataFrame
frame Mapping
m ->
                    (Text -> Color) -> [Text] -> [Color]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
cat -> ColorSpec -> Color
specToColor (ColorSpec -> Maybe ColorSpec -> ColorSpec
forall a. a -> Maybe a -> a
fromMaybe ColorSpec
colorSpec (Text -> [(Text, ColorSpec)] -> Maybe ColorSpec
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
cat [(Text, ColorSpec)]
levelColors))) [Text]
cats
            Maybe [(Text, ColorSpec)]
_ -> Color -> [Color]
forall a. a -> [a]
repeat Color
col
        -- Per-bar fill colours: a categorical 'aesFill' (falling back to
        -- 'aesColor') maps each bar to its colour from 'colorMap', which already
        -- folds in any manual\/discrete fill scale (see 'layerColorMap'), so the
        -- bars and the legend swatches agree. Unmapped categories keep 'col'.
        barColors :: [Color]
barColors = case DataFrame -> Mapping -> Maybe [Text]
categoricalFillColumn DataFrame
frame Mapping
m of
            Just [Text]
cats -> (Text -> Color) -> [Text] -> [Color]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
cat -> Color -> (ColorSpec -> Color) -> Maybe ColorSpec -> Color
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Color
col ColorSpec -> Color
specToColor (Maybe [(Text, ColorSpec)]
colorMap Maybe [(Text, ColorSpec)]
-> ([(Text, ColorSpec)] -> Maybe ColorSpec) -> Maybe ColorSpec
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [(Text, ColorSpec)] -> Maybe ColorSpec
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
cat)) [Text]
cats
            Maybe [Text]
Nothing -> Color -> [Color]
forall a. a -> [a]
repeat Color
col
        pointAlphas :: [Double]
pointAlphas = case DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesAlpha Mapping
m) of
            Just vs :: [Double]
vs@(Double
_ : [Double]
_) ->
                let lo :: Double
lo = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
vs
                    hi :: Double
hi = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
vs
                 in if Double
hi Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
lo
                        then Double -> [Double]
forall a. a -> [a]
repeat Double
alpha
                        else (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
v -> Double
0.15 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.85 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo)) [Double]
vs
            Maybe [Double]
_ -> Double -> [Double]
forall a. a -> [a]
repeat Double
alpha
     in case Layer -> Geom
layerGeom Layer
layer of
            Geom
GeomPoint -> Projector
-> DataFrame -> Mapping -> [Color] -> Double -> [Double] -> [Mark]
drawPoints Projector
proj DataFrame
frame Mapping
m [Color]
pointColors Double
radius [Double]
pointAlphas
            Geom
GeomLine -> Projector -> DataFrame -> Mapping -> ColorSpec -> Double -> [Mark]
drawLine Projector
proj DataFrame
frame Mapping
m ColorSpec
colorSpec Double
lineW
            Geom
GeomBar -> Projector -> DataFrame -> Mapping -> [Color] -> [Mark]
drawBars Projector
proj DataFrame
frame Mapping
m [Color]
barColors
            Geom
GeomCol -> Projector -> DataFrame -> Mapping -> [Color] -> [Mark]
drawBars Projector
proj DataFrame
frame Mapping
m [Color]
barColors
            Geom
GeomHistogram -> Projector -> DataFrame -> Mapping -> [Color] -> [Mark]
drawBars Projector
proj DataFrame
frame Mapping
m [Color]
barColors
            Geom
GeomRibbon -> Projector -> DataFrame -> Mapping -> Color -> [Mark]
drawRibbon Projector
proj DataFrame
frame Mapping
m Color
col
            Geom
GeomErrorbar -> Projector -> DataFrame -> Mapping -> Color -> [Mark]
drawErrorbar Projector
proj DataFrame
frame Mapping
m Color
col
            Geom
GeomTile -> Projector
-> DataFrame -> Mapping -> Color -> Maybe [ColorSpec] -> [Mark]
drawTiles Projector
proj DataFrame
frame Mapping
m Color
col Maybe [ColorSpec]
fillCols
            Geom
GeomBoxplot -> Projector -> DataFrame -> Mapping -> Color -> [Mark]
drawBoxplot Projector
proj DataFrame
frame Mapping
m Color
col
            Geom
GeomDensity -> Projector -> DataFrame -> Mapping -> Color -> [Mark]
drawDensity Projector
proj DataFrame
frame Mapping
m Color
col
            Geom
GeomText -> Projector -> DataFrame -> Mapping -> Color -> Double -> [Mark]
drawText Projector
proj DataFrame
frame Mapping
m Color
col (Theme -> Double
themeFontSize Theme
theme)
            Geom
GeomArc -> PlotBox -> DataFrame -> Mapping -> [ColorSpec] -> [Mark]
drawArcs PlotBox
box DataFrame
frame Mapping
m [ColorSpec]
palette

drawPoints ::
    Projector ->
    DataFrame ->
    Mapping ->
    [Color] ->
    Double ->
    [Double] ->
    [Mark]
drawPoints :: Projector
-> DataFrame -> Mapping -> [Color] -> Double -> [Double] -> [Mark]
drawPoints Projector
proj DataFrame
frame Mapping
m [Color]
cols Double
r [Double]
alphas =
    case (DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesX Mapping
m), DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesY Mapping
m)) of
        (Just [Double]
xv, Just [Double]
yv) ->
            [ Point -> Double -> Style -> Mark
MCircle
                (Projector
proj Double
x Double
y)
                Double
r
                Style
defaultStyle
                    { styleFill = Just c
                    , styleFillOpacity = a
                    }
            | ((Double
x, Double
y), Color
c, Double
a) <- [(Double, Double)]
-> [Color] -> [Double] -> [((Double, Double), Color, Double)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 ([Double] -> [Double] -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
xv [Double]
yv) [Color]
cols [Double]
alphas
            ]
        (Maybe [Double], Maybe [Double])
_ -> []

drawLine ::
    Projector ->
    DataFrame ->
    Mapping ->
    ColorSpec ->
    Double ->
    [Mark]
drawLine :: Projector -> DataFrame -> Mapping -> ColorSpec -> Double -> [Mark]
drawLine Projector
proj DataFrame
frame Mapping
m ColorSpec
col Double
lineW =
    case (DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesX Mapping
m), DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesY Mapping
m)) of
        (Just [Double]
xv, Just [Double]
yv) ->
            let sorted :: [(Double, Double)]
sorted = ((Double, Double) -> Double)
-> [(Double, Double)] -> [(Double, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Double, Double) -> Double
forall a b. (a, b) -> a
fst ([Double] -> [Double] -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
xv [Double]
yv)
                pts :: [Point]
pts = [Projector
proj Double
x Double
y | (Double
x, Double
y) <- [(Double, Double)]
sorted]
             in [ [Point] -> Style -> Mark
MPolyline
                    [Point]
pts
                    Style
defaultStyle
                        { styleStroke = Just (specToColor col)
                        , styleStrokeWidth = lineW
                        }
                ]
        (Maybe [Double], Maybe [Double])
_ -> []

{- | One rect per row; each painted its own colour from 'cols', cycled when
shorter than the rows, so a categorical @aesFill@\/@aesColor@ gives each bar a
distinct fill rather than a single constant colour. Empty 'cols' draws nothing.
-}
drawBars :: Projector -> DataFrame -> Mapping -> [Color] -> [Mark]
drawBars :: Projector -> DataFrame -> Mapping -> [Color] -> [Mark]
drawBars Projector
proj DataFrame
frame Mapping
m [Color]
cols =
    case (DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesX Mapping
m), DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesY Mapping
m)) of
        (Just [Double]
xs, Just [Double]
ys)
            | Bool -> Bool
not ([Color] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Color]
cols) ->
                let bases :: [Double]
bases = case Text -> DataFrame -> Maybe Column
lookupColumn Text
"__ybase" DataFrame
frame Maybe Column -> (Column -> Maybe [Double]) -> Maybe [Double]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Column -> Maybe [Double]
columnAsNum of
                        Just [Double]
bs | [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs -> [Double]
bs
                        Maybe [Double]
_ -> Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs) Double
0
                    w :: Double
w = [Double] -> Double
barWidth [Double]
xs
                    halfW :: Double
halfW = Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                 in [ Point -> Point -> Color -> Mark
rectFromCorners
                        (Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
halfW) Double
y0)
                        (Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
halfW) Double
y1)
                        Color
c
                    | ((Double
x, Double
y1, Double
y0), Color
c) <- [(Double, Double, Double)]
-> [Color] -> [((Double, Double, Double), Color)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Double] -> [Double] -> [Double] -> [(Double, Double, Double)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Double]
xs [Double]
ys [Double]
bases) ([Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle [Color]
cols)
                    ]
        (Maybe [Double], Maybe [Double])
_ -> []

barWidth :: [Double] -> Double
barWidth :: [Double] -> Double
barWidth [Double]
xs
    | [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
unique Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = Double
0.8
    | Bool
otherwise =
        let diffs :: [Double]
diffs = (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
drop Int
1 [Double]
unique) [Double]
unique
            pos :: [Double]
pos = (Double -> Bool) -> [Double] -> [Double]
forall a. (a -> Bool) -> [a] -> [a]
filter (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1e-9) [Double]
diffs
         in if [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
pos then Double
0.8 else [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
pos Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.8
  where
    unique :: [Double]
unique = [Double] -> [Double]
forall a. Eq a => [a] -> [a]
List.nub ([Double] -> [Double]
forall a. Ord a => [a] -> [a]
List.sort [Double]
xs)

rectFromCorners :: Point -> Point -> Color -> Mark
rectFromCorners :: Point -> Point -> Color -> Mark
rectFromCorners (Point Double
xa Double
ya) (Point Double
xb Double
yb) Color
col =
    let x0 :: Double
x0 = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
xa Double
xb
        y0 :: Double
y0 = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
ya Double
yb
        w :: Double
w = Double -> Double
forall a. Num a => a -> a
abs (Double
xa Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
xb)
        h :: Double
h = Double -> Double
forall a. Num a => a -> a
abs (Double
ya Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
yb)
     in Rect -> Style -> Mark
MRect (Double -> Double -> Double -> Double -> Rect
Rect Double
x0 Double
y0 Double
w Double
h) Style
defaultStyle{styleFill = Just col}

drawRibbon :: Projector -> DataFrame -> Mapping -> Color -> [Mark]
drawRibbon :: Projector -> DataFrame -> Mapping -> Color -> [Mark]
drawRibbon Projector
proj DataFrame
frame Mapping
m Color
col =
    case ( DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesX Mapping
m)
         , DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesYmin Mapping
m)
         , DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesYmax Mapping
m)
         ) of
        (Just [Double]
xs, Just [Double]
lo, Just [Double]
hi) ->
            let triples :: [(Double, Double, Double)]
triples = ((Double, Double, Double) -> Double)
-> [(Double, Double, Double)] -> [(Double, Double, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (\(Double
a, Double
_, Double
_) -> Double
a) ([Double] -> [Double] -> [Double] -> [(Double, Double, Double)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Double]
xs [Double]
lo [Double]
hi)
                topPts :: [Point]
topPts = [Projector
proj Double
x Double
h | (Double
x, Double
_, Double
h) <- [(Double, Double, Double)]
triples]
                botPts :: [Point]
botPts = [Point] -> [Point]
forall a. [a] -> [a]
reverse [Projector
proj Double
x Double
l | (Double
x, Double
l, Double
_) <- [(Double, Double, Double)]
triples]
             in [ [Point] -> Style -> Mark
MPolygon
                    ([Point]
topPts [Point] -> [Point] -> [Point]
forall a. Semigroup a => a -> a -> a
<> [Point]
botPts)
                    Style
defaultStyle
                        { styleFill = Just col
                        , styleFillOpacity = 0.4
                        , styleStroke = Just col
                        , styleStrokeWidth = 1
                        }
                ]
        (Maybe [Double], Maybe [Double], Maybe [Double])
_ -> []

drawErrorbar :: Projector -> DataFrame -> Mapping -> Color -> [Mark]
drawErrorbar :: Projector -> DataFrame -> Mapping -> Color -> [Mark]
drawErrorbar Projector
proj DataFrame
frame Mapping
m Color
col =
    case ( DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesX Mapping
m)
         , DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesYmin Mapping
m)
         , DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesYmax Mapping
m)
         ) of
        (Just [Double]
xs, Just [Double]
lo, Just [Double]
hi) ->
            let capW :: Double
capW = [Double] -> Double
barWidth [Double]
xs Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.4
                halfW :: Double
halfW = Double
capW Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                style :: Style
style = Style
defaultStyle{styleStroke = Just col, styleStrokeWidth = 1.5}
             in [[Mark]] -> [Mark]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ [ [Point] -> Style -> Mark
MPolyline [Projector
proj Double
x Double
l, Projector
proj Double
x Double
h] Style
style
                      , [Point] -> Style -> Mark
MPolyline [Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
halfW) Double
l, Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
halfW) Double
l] Style
style
                      , [Point] -> Style -> Mark
MPolyline [Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
halfW) Double
h, Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
halfW) Double
h] Style
style
                      ]
                    | (Double
x, Double
l, Double
h) <- [Double] -> [Double] -> [Double] -> [(Double, Double, Double)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Double]
xs [Double]
lo [Double]
hi
                    ]
        (Maybe [Double], Maybe [Double], Maybe [Double])
_ -> []

drawTiles ::
    Projector -> DataFrame -> Mapping -> Color -> Maybe [ColorSpec] -> [Mark]
drawTiles :: Projector
-> DataFrame -> Mapping -> Color -> Maybe [ColorSpec] -> [Mark]
drawTiles Projector
proj DataFrame
frame Mapping
m Color
col Maybe [ColorSpec]
fillCols =
    case (DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesX Mapping
m), DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesY Mapping
m)) of
        (Just [Double]
xs, Just [Double]
ys) ->
            let wX :: Double
wX = [Double] -> Double
barWidth [Double]
xs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.8
                wY :: Double
wY = [Double] -> Double
barWidth [Double]
ys Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.8
                halfX :: Double
halfX = Double
wX Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                halfY :: Double
halfY = Double
wY Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                fillCol :: Maybe [Double]
fillCol = DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesFill Mapping
m)
                fillRange :: (Double, Double)
fillRange = case Maybe [Double]
fillCol of
                    Just [Double]
vs | Bool -> Bool
not ([Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
vs) -> ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
vs, [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
vs)
                    Maybe [Double]
_ -> (Double
0, Double
1)
                colorFor :: Int -> Color
colorFor Int
i = case Maybe [Double]
fillCol of
                    Just [Double]
vs
                        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
vs ->
                            let (Double
lo, Double
hi) = (Double, Double)
fillRange
                                t :: Double
t =
                                    if Double
hi Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
lo
                                        then Double
0.5
                                        else ([Double]
vs [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo)
                             in case Maybe [ColorSpec]
fillCols of
                                    Just [ColorSpec]
cs -> [ColorSpec] -> Double -> Color
continuousColorFor [ColorSpec]
cs Double
t
                                    Maybe [ColorSpec]
Nothing -> Double -> Color
gradientColor Double
t
                    Maybe [Double]
_ -> Color
col
             in [ Point -> Point -> Color -> Mark
rectFromCorners
                    (Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
halfX) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
halfY))
                    (Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
halfX) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
halfY))
                    (Int -> Color
colorFor Int
i)
                | (Int
i, (Double
x, Double
y)) <- [Int] -> [(Double, Double)] -> [(Int, (Double, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] ([Double] -> [Double] -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
xs [Double]
ys)
                ]
        (Maybe [Double], Maybe [Double])
_ -> []

gradientColor :: Double -> Color
gradientColor :: Double -> Color
gradientColor Double
t =
    let palette :: [Color]
palette =
            [ Color
Blue
            , Color
BrightBlue
            , Color
BrightCyan
            , Color
BrightGreen
            , Color
BrightYellow
            , Color
BrightRed
            ]
        n :: Int
n = [Color] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Color]
palette
        clamped :: Double
clamped = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
0.9999 Double
t)
        ix :: Int
ix = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
clamped Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) :: Int
     in [Color]
palette [Color] -> Int -> Color
forall a. HasCallStack => [a] -> Int -> a
!! Int
ix

{- | Map @t@ in [0,1] to a colour by piecewise-linear RGB interpolation across
the anchor colours (used to honour a continuous 'scaleFill' on tiles).
-}
continuousColorFor :: [ColorSpec] -> Double -> Color
continuousColorFor :: [ColorSpec] -> Double -> Color
continuousColorFor [ColorSpec]
specs Double
t =
    case (ColorSpec -> Color) -> [ColorSpec] -> [Color]
forall a b. (a -> b) -> [a] -> [b]
map ColorSpec -> Color
specToColor [ColorSpec]
specs of
        [] -> Double -> Color
gradientColor Double
t
        [Color
c] -> Color
c
        [Color]
colors ->
            let n :: Int
n = [Color] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Color]
colors
                clamped :: Double
clamped = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
1 Double
t)
                pos :: Double
pos = Double
clamped Double -> Double -> Double
forall a. Num 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)
                i :: Int
i = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
pos)
                frac :: Double
frac = Double
pos Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
                Color Word8
r1 Word8
g1 Word8
b1 = [Color]
colors [Color] -> Int -> Color
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
                Color Word8
r2 Word8
g2 Word8
b2 = [Color]
colors [Color] -> Int -> Color
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                lerp :: a -> a -> b
lerp a
a a
b =
                    Double -> b
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
frac Double -> Double -> Double
forall a. Num a => a -> a -> a
* (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a))
             in Word8 -> Word8 -> Word8 -> Color
Color (Word8 -> Word8 -> Word8
forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
a -> a -> b
lerp Word8
r1 Word8
r2) (Word8 -> Word8 -> Word8
forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
a -> a -> b
lerp Word8
g1 Word8
g2) (Word8 -> Word8 -> Word8
forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
a -> a -> b
lerp Word8
b1 Word8
b2)

drawBoxplot :: Projector -> DataFrame -> Mapping -> Color -> [Mark]
drawBoxplot :: Projector -> DataFrame -> Mapping -> Color -> [Mark]
drawBoxplot Projector
proj DataFrame
frame Mapping
m Color
col =
    case ( DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesX Mapping
m)
         , Text -> DataFrame -> Maybe Column
lookupColumn Text
"__ymin" DataFrame
frame Maybe Column -> (Column -> Maybe [Double]) -> Maybe [Double]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Column -> Maybe [Double]
columnAsNum
         , Text -> DataFrame -> Maybe Column
lookupColumn Text
"__q1" DataFrame
frame Maybe Column -> (Column -> Maybe [Double]) -> Maybe [Double]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Column -> Maybe [Double]
columnAsNum
         , Text -> DataFrame -> Maybe Column
lookupColumn Text
"__median" DataFrame
frame Maybe Column -> (Column -> Maybe [Double]) -> Maybe [Double]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Column -> Maybe [Double]
columnAsNum
         , Text -> DataFrame -> Maybe Column
lookupColumn Text
"__q3" DataFrame
frame Maybe Column -> (Column -> Maybe [Double]) -> Maybe [Double]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Column -> Maybe [Double]
columnAsNum
         , Text -> DataFrame -> Maybe Column
lookupColumn Text
"__ymax" DataFrame
frame Maybe Column -> (Column -> Maybe [Double]) -> Maybe [Double]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Column -> Maybe [Double]
columnAsNum
         ) of
        (Just [Double]
xs, Just [Double]
mins, Just [Double]
qq1, Just [Double]
meds, Just [Double]
qq3, Just [Double]
maxs) ->
            let w :: Double
w = [Double] -> Double
barWidth [Double]
xs
                halfW :: Double
halfW = Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                style :: Style
style = Style
defaultStyle{styleStroke = Just col, styleStrokeWidth = 1}
                fillStyle :: Style
fillStyle = Style
style{styleFill = Just col, styleFillOpacity = 0.2}
             in [[Mark]] -> [Mark]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ [ [Point] -> Style -> Mark
MPolygon
                            [ Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
halfW) Double
qLo
                            , Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
halfW) Double
qLo
                            , Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
halfW) Double
qHi
                            , Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
halfW) Double
qHi
                            ]
                            Style
fillStyle
                      , [Point] -> Style -> Mark
MPolyline
                            [Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
halfW) Double
medV, Projector
proj (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
halfW) Double
medV]
                            Style
style{styleStrokeWidth = 2}
                      , [Point] -> Style -> Mark
MPolyline [Projector
proj Double
x Double
qLo, Projector
proj Double
x Double
ymin] Style
style
                      , [Point] -> Style -> Mark
MPolyline [Projector
proj Double
x Double
qHi, Projector
proj Double
x Double
ymax] Style
style
                      ]
                    | (Double
x, Double
ymin, Double
qLo, Double
medV, Double
qHi, Double
ymax) <- [Double]
-> [Double]
-> [Double]
-> [Double]
-> [Double]
-> [Double]
-> [(Double, Double, Double, Double, Double, Double)]
forall a b c d e f.
[a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)]
List.zip6 [Double]
xs [Double]
mins [Double]
qq1 [Double]
meds [Double]
qq3 [Double]
maxs
                    ]
        (Maybe [Double], Maybe [Double], Maybe [Double], Maybe [Double],
 Maybe [Double], Maybe [Double])
_ -> []

drawDensity :: Projector -> DataFrame -> Mapping -> Color -> [Mark]
drawDensity :: Projector -> DataFrame -> Mapping -> Color -> [Mark]
drawDensity Projector
proj DataFrame
frame Mapping
m Color
col =
    Projector -> DataFrame -> Mapping -> ColorSpec -> Double -> [Mark]
drawLine Projector
proj DataFrame
frame Mapping
m (Color -> ColorSpec
NamedColor Color
col) Double
2

drawText :: Projector -> DataFrame -> Mapping -> Color -> Double -> [Mark]
drawText :: Projector -> DataFrame -> Mapping -> Color -> Double -> [Mark]
drawText Projector
proj DataFrame
frame Mapping
m Color
col Double
size =
    case ( DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesX Mapping
m)
         , DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesY Mapping
m)
         , Mapping -> Maybe ColumnRef
aesLabel Mapping
m
         ) of
        (Just [Double]
xs, Just [Double]
ys, Just (ColumnRef Text
labelCol)) ->
            case Text -> DataFrame -> Maybe Column
lookupColumn Text
labelCol DataFrame
frame of
                Just Column
labelColData ->
                    let labels :: [Text]
labels = Column -> [Text]
columnAsText Column
labelColData
                        triples :: [(Double, Double, Text)]
triples = [Double] -> [Double] -> [Text] -> [(Double, Double, Text)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Double]
xs [Double]
ys [Text]
labels
                     in [ Point -> Text -> TextStyle -> Mark
MText
                            (Projector
proj Double
x Double
y)
                            Text
lbl
                            TextStyle
defaultTextStyle
                                { textFill = col
                                , textSize = size
                                , textAnchor = AnchorMiddle
                                }
                        | (Double
x, Double
y, Text
lbl) <- [(Double, Double, Text)]
triples
                        ]
                Maybe Column
Nothing -> []
        (Maybe [Double], Maybe [Double], Maybe ColumnRef)
_ -> []

drawArcs :: PlotBox -> DataFrame -> Mapping -> [ColorSpec] -> [Mark]
drawArcs :: PlotBox -> DataFrame -> Mapping -> [ColorSpec] -> [Mark]
drawArcs PlotBox
box DataFrame
frame Mapping
m [ColorSpec]
palette =
    case DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
aesY Mapping
m) of
        Just [Double]
vs
            | Bool -> Bool
not ([Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
vs) ->
                let total :: Double
total = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
vs
                    cx :: Double
cx = PlotBox -> Double
boxX PlotBox
box Double -> Double -> Double
forall a. Num a => a -> a -> a
+ PlotBox -> Double
boxW PlotBox
box Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                    cy :: Double
cy = PlotBox -> Double
boxY PlotBox
box Double -> Double -> Double
forall a. Num a => a -> a -> a
+ PlotBox -> Double
boxH PlotBox
box Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                    r :: Double
r = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (PlotBox -> Double
boxW PlotBox
box) (PlotBox -> Double
boxH PlotBox
box) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.9
                    fracs :: [Double]
fracs = if Double
total Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a b. a -> b -> a
const Double
0) [Double]
vs else (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
total) [Double]
vs
                    starts :: [Double]
starts = (Double -> Double -> Double) -> Double -> [Double] -> [Double]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) (-(Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)) ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi)) [Double]
fracs)
                    ends :: [Double]
ends = Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
drop Int
1 [Double]
starts
                    colorAt :: Int -> ColorSpec
colorAt Int
i = [ColorSpec]
palette [ColorSpec] -> Int -> ColorSpec
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`mod` Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 ([ColorSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColorSpec]
palette))
                 in [ Point -> Double -> Double -> Double -> Style -> Mark
MArc
                        (Projector
Point Double
cx Double
cy)
                        Double
r
                        Double
s
                        Double
e
                        Style
defaultStyle
                            { styleFill = Just (specToColor (colorAt i))
                            , styleStroke = Just (specToColor (NamedColor BrightBlack))
                            , styleStrokeWidth = 1
                            }
                    | (Int
i, (Double
s, Double
e)) <- [Int] -> [(Double, Double)] -> [(Int, (Double, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] ([Double] -> [Double] -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
starts [Double]
ends)
                    ]
        Maybe [Double]
_ -> []

{- | Resolve a column to numeric values for projection. Categorical
columns map each row to its position in the unique-value list, so
repeated values share an X position (needed for stacked / grouped
/ faceted bars).
-}
resolveNumColumn :: DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn :: DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
_ Maybe ColumnRef
Nothing = Maybe [Double]
forall a. Maybe a
Nothing
resolveNumColumn DataFrame
df (Just (ColumnRef Text
n)) =
    case Text -> DataFrame -> Maybe Column
lookupColumn Text
n DataFrame
df of
        Just (ColCat [Text]
xs) -> [Double] -> Maybe [Double]
forall a. a -> Maybe a
Just ([Text] -> [Double]
categoricalIndices [Text]
xs)
        Just Column
c -> Column -> Maybe [Double]
columnAsNum Column
c
        Maybe Column
Nothing -> Maybe [Double]
forall a. Maybe a
Nothing

categoricalIndices :: [Text] -> [Double]
categoricalIndices :: [Text] -> [Double]
categoricalIndices [Text]
xs =
    let uniques :: [Text]
uniques = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
List.nub [Text]
xs
        indexOf :: Text -> b
indexOf Text
x = b -> (Int -> b) -> Maybe Int -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
0 Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> [Text] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex Text
x [Text]
uniques)
     in (Text -> Double) -> [Text] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Double
forall {b}. Num b => Text -> b
indexOf [Text]
xs

{- | Range across one or more aesthetic getters; the Y-axis caller
folds @aesY@ + @aesYmin@ + @aesYmax@ + the conventional internal
columns so ribbon / errorbar / boxplot layers (which leave 'aesY'
unset) still get a sensible Y range. Stat and position are applied
so histogram-style @count@ columns appear.
-}
unionDataRange ::
    [Mapping -> Maybe ColumnRef] ->
    [Layer] ->
    DataFrame ->
    (Double, Double)
unionDataRange :: [Mapping -> Maybe ColumnRef]
-> [Layer] -> DataFrame -> (Double, Double)
unionDataRange [Mapping -> Maybe ColumnRef]
getRefs [Layer]
layers DataFrame
globalFrame =
    let pulls :: [[Double]]
pulls =
            [ [Double]
values
            | Layer
layer <- [Layer]
layers
            , let m :: Mapping
m = Layer -> Mapping
layerMapping Layer
layer
                  base :: DataFrame
base = DataFrame -> Maybe DataFrame -> DataFrame
forall a. a -> Maybe a -> a
fromMaybe DataFrame
globalFrame (Layer -> Maybe DataFrame
layerData Layer
layer)
                  stat' :: DataFrame
stat' = Stat -> Mapping -> DataFrame -> DataFrame
applyStat (Layer -> Stat
layerStat Layer
layer) Mapping
m DataFrame
base
                  frame :: DataFrame
frame = Position -> Mapping -> DataFrame -> DataFrame
applyPosition (Layer -> Position
layerPosition Layer
layer) Mapping
m DataFrame
stat'
            , Mapping -> Maybe ColumnRef
getRef <- [Mapping -> Maybe ColumnRef]
getRefs
            , Just [Double]
values <- [DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
frame (Mapping -> Maybe ColumnRef
getRef Mapping
m)]
            ]
        all_ :: [Double]
all_ = [[Double]] -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Double]]
pulls
     in if [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
all_
            then (Double
0, Double
1)
            else ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
all_, [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
all_)

{- | Range with geom adjustments: bar/col/histogram/tile pad ±halfWidth
around (x, y) so boundary rects don't overflow the plot box; bars
also extend the Y range to include their @__ybase@ (default 0) so a
horizontal bar chart with all-positive values doesn't put its
baseline outside the scale.
-}
paddedRange ::
    [Layer] ->
    DataFrame ->
    [Mapping -> Maybe ColumnRef] ->
    Bool ->
    (Double, Double)
paddedRange :: [Layer]
-> DataFrame
-> [Mapping -> Maybe ColumnRef]
-> Bool
-> (Double, Double)
paddedRange [Layer]
layers DataFrame
frame [Mapping -> Maybe ColumnRef]
getRefs Bool
isXAxis =
    let (Double
lo, Double
hi) = [Mapping -> Maybe ColumnRef]
-> [Layer] -> DataFrame -> (Double, Double)
unionDataRange [Mapping -> Maybe ColumnRef]
getRefs [Layer]
layers DataFrame
frame
        primary :: Mapping -> Maybe ColumnRef
primary = case [Mapping -> Maybe ColumnRef]
getRefs of
            (Mapping -> Maybe ColumnRef
g : [Mapping -> Maybe ColumnRef]
_) -> Mapping -> Maybe ColumnRef
g
            [] -> Maybe ColumnRef -> Mapping -> Maybe ColumnRef
forall a b. a -> b -> a
const Maybe ColumnRef
forall a. Maybe a
Nothing
        pad :: Double
pad = (Mapping -> Maybe ColumnRef)
-> Bool -> [Layer] -> DataFrame -> Double
geomAxisPadding Mapping -> Maybe ColumnRef
primary Bool
isXAxis [Layer]
layers DataFrame
frame
        loPadded :: Double
loPadded = Double
lo Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
pad
        hiPadded :: Double
hiPadded = Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
pad
     in case Bool -> [Layer] -> DataFrame -> Maybe Double
barAxisAnchor Bool
isXAxis [Layer]
layers DataFrame
frame of
            Maybe Double
Nothing -> (Double
loPadded, Double
hiPadded)
            Just Double
anchor -> (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
loPadded Double
anchor, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
hiPadded Double
anchor)

yRangeRefs :: [Mapping -> Maybe ColumnRef]
yRangeRefs :: [Mapping -> Maybe ColumnRef]
yRangeRefs =
    [ Mapping -> Maybe ColumnRef
aesY
    , Mapping -> Maybe ColumnRef
aesYmin
    , Mapping -> Maybe ColumnRef
aesYmax
    , Maybe ColumnRef -> Mapping -> Maybe ColumnRef
forall a b. a -> b -> a
const (ColumnRef -> Maybe ColumnRef
forall a. a -> Maybe a
Just (Text -> ColumnRef
ColumnRef Text
"__ymin"))
    , Maybe ColumnRef -> Mapping -> Maybe ColumnRef
forall a b. a -> b -> a
const (ColumnRef -> Maybe ColumnRef
forall a. a -> Maybe a
Just (Text -> ColumnRef
ColumnRef Text
"__q1"))
    , Maybe ColumnRef -> Mapping -> Maybe ColumnRef
forall a b. a -> b -> a
const (ColumnRef -> Maybe ColumnRef
forall a. a -> Maybe a
Just (Text -> ColumnRef
ColumnRef Text
"__median"))
    , Maybe ColumnRef -> Mapping -> Maybe ColumnRef
forall a b. a -> b -> a
const (ColumnRef -> Maybe ColumnRef
forall a. a -> Maybe a
Just (Text -> ColumnRef
ColumnRef Text
"__q3"))
    , Maybe ColumnRef -> Mapping -> Maybe ColumnRef
forall a b. a -> b -> a
const (ColumnRef -> Maybe ColumnRef
forall a. a -> Maybe a
Just (Text -> ColumnRef
ColumnRef Text
"__ymax"))
    , Maybe ColumnRef -> Mapping -> Maybe ColumnRef
forall a b. a -> b -> a
const (ColumnRef -> Maybe ColumnRef
forall a. a -> Maybe a
Just (Text -> ColumnRef
ColumnRef Text
"__ybase"))
    ]

xRangeRefs :: [Mapping -> Maybe ColumnRef]
xRangeRefs :: [Mapping -> Maybe ColumnRef]
xRangeRefs = [Mapping -> Maybe ColumnRef
aesX]

{- | When an aesthetic resolves to a 'ColCat' column, override the
trained scale's breaks and labels so each category sits at its
integer index with the category text as its tick label. Numeric
data passes through unchanged.
-}
applyCategorical ::
    (Mapping -> Maybe ColumnRef) ->
    [Layer] ->
    DataFrame ->
    TrainedScale ->
    TrainedScale
applyCategorical :: (Mapping -> Maybe ColumnRef)
-> [Layer] -> DataFrame -> TrainedScale -> TrainedScale
applyCategorical Mapping -> Maybe ColumnRef
getRef [Layer]
layers DataFrame
globalFrame TrainedScale
ts =
    case (Mapping -> Maybe ColumnRef)
-> [Layer] -> DataFrame -> Maybe [Text]
categoricalLabelsFor Mapping -> Maybe ColumnRef
getRef [Layer]
layers DataFrame
globalFrame of
        Maybe [Text]
Nothing -> TrainedScale
ts
        Just [Text]
labels ->
            let breaks :: [Double]
breaks = [Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i | Int
i <- [Int
0 .. [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
labels Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 :: Int]]
             in TrainedScale
ts{tsBreaks = breaks, tsLabels = labels}

{- | Read /pre-stat/ — a stat like 'Granite.Spec.StatBoxplot' consumes the
categorical X and emits numeric indices, but the labels we want
are the user's original group names.
-}
categoricalLabelsFor ::
    (Mapping -> Maybe ColumnRef) ->
    [Layer] ->
    DataFrame ->
    Maybe [Text]
categoricalLabelsFor :: (Mapping -> Maybe ColumnRef)
-> [Layer] -> DataFrame -> Maybe [Text]
categoricalLabelsFor Mapping -> Maybe ColumnRef
getRef [Layer]
layers DataFrame
globalFrame = [Layer] -> Maybe [Text]
findFirst [Layer]
layers
  where
    findFirst :: [Layer] -> Maybe [Text]
findFirst [] = Maybe [Text]
forall a. Maybe a
Nothing
    findFirst (Layer
layer : [Layer]
rest) =
        let m :: Mapping
m = Layer -> Mapping
layerMapping Layer
layer
            frame :: DataFrame
frame = DataFrame -> Maybe DataFrame -> DataFrame
forall a. a -> Maybe a -> a
fromMaybe DataFrame
globalFrame (Layer -> Maybe DataFrame
layerData Layer
layer)
         in case Mapping -> Maybe ColumnRef
getRef Mapping
m of
                Just (ColumnRef Text
n) -> case Text -> DataFrame -> Maybe Column
lookupColumn Text
n DataFrame
frame of
                    Just (ColCat [Text]
xs) -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
List.nub [Text]
xs)
                    Maybe Column
_ -> [Layer] -> Maybe [Text]
findFirst [Layer]
rest
                Maybe ColumnRef
Nothing -> [Layer] -> Maybe [Text]
findFirst [Layer]
rest

geomAxisPadding ::
    (Mapping -> Maybe ColumnRef) ->
    Bool ->
    [Layer] ->
    DataFrame ->
    Double
geomAxisPadding :: (Mapping -> Maybe ColumnRef)
-> Bool -> [Layer] -> DataFrame -> Double
geomAxisPadding Mapping -> Maybe ColumnRef
getRef Bool
isXAxis [Layer]
layers DataFrame
globalFrame =
    let perLayerPad :: Layer -> Double
perLayerPad Layer
layer
            | Bool -> Bool
not (Geom -> Bool -> Bool
needsPadding (Layer -> Geom
layerGeom Layer
layer) Bool
isXAxis) = Double
0
            | Bool
otherwise =
                let m :: Mapping
m = Layer -> Mapping
layerMapping Layer
layer
                    base :: DataFrame
base = DataFrame -> Maybe DataFrame -> DataFrame
forall a. a -> Maybe a -> a
fromMaybe DataFrame
globalFrame (Layer -> Maybe DataFrame
layerData Layer
layer)
                    postStat :: DataFrame
postStat = Stat -> Mapping -> DataFrame -> DataFrame
applyStat (Layer -> Stat
layerStat Layer
layer) Mapping
m DataFrame
base
                    postPos :: DataFrame
postPos = Position -> Mapping -> DataFrame -> DataFrame
applyPosition (Layer -> Position
layerPosition Layer
layer) Mapping
m DataFrame
postStat
                 in case DataFrame -> Maybe ColumnRef -> Maybe [Double]
resolveNumColumn DataFrame
postPos (Mapping -> Maybe ColumnRef
getRef Mapping
m) of
                        Just [Double]
vs -> [Double] -> Double
barWidth [Double]
vs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                        Maybe [Double]
Nothing -> Double
0
        pads :: [Double]
pads = (Layer -> Double) -> [Layer] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Layer -> Double
perLayerPad [Layer]
layers
     in if [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
pads then Double
0 else [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Double
0 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double]
pads)

needsPadding :: Geom -> Bool -> Bool
needsPadding :: Geom -> Bool -> Bool
needsPadding Geom
GeomBar Bool
isX = Bool
isX
needsPadding Geom
GeomCol Bool
isX = Bool
isX
needsPadding Geom
GeomHistogram Bool
isX = Bool
isX
needsPadding Geom
GeomBoxplot Bool
isX = Bool
isX
needsPadding Geom
GeomErrorbar Bool
isX = Bool
isX
needsPadding Geom
GeomTile Bool
_ = Bool
True
needsPadding Geom
_ Bool
_ = Bool
False

{- | Bar baseline: the minimum of @__ybase@ across bar-like layers
(default 0), so an all-positive chart still includes 0 at the
bottom of the bars.
-}
barAxisAnchor :: Bool -> [Layer] -> DataFrame -> Maybe Double
barAxisAnchor :: Bool -> [Layer] -> DataFrame -> Maybe Double
barAxisAnchor Bool
isXAxis [Layer]
layers DataFrame
globalFrame
    | Bool
isXAxis = Maybe Double
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let bases :: [Double]
bases = [Layer -> Double
anchorFor Layer
layer | Layer
layer <- [Layer]
layers, Geom -> Bool
isBarLike (Layer -> Geom
layerGeom Layer
layer)]
         in case [Double]
bases of
                [] -> Maybe Double
forall a. Maybe a
Nothing
                [Double]
xs -> Double -> Maybe Double
forall a. a -> Maybe a
Just ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Double
0 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double]
xs))
  where
    isBarLike :: Geom -> Bool
isBarLike Geom
GeomBar = Bool
True
    isBarLike Geom
GeomCol = Bool
True
    isBarLike Geom
GeomHistogram = Bool
True
    isBarLike Geom
_ = Bool
False

    anchorFor :: Layer -> Double
anchorFor Layer
layer =
        let m :: Mapping
m = Layer -> Mapping
layerMapping Layer
layer
            base :: DataFrame
base = DataFrame -> Maybe DataFrame -> DataFrame
forall a. a -> Maybe a -> a
fromMaybe DataFrame
globalFrame (Layer -> Maybe DataFrame
layerData Layer
layer)
            postStat :: DataFrame
postStat = Stat -> Mapping -> DataFrame -> DataFrame
applyStat (Layer -> Stat
layerStat Layer
layer) Mapping
m DataFrame
base
            postPos :: DataFrame
postPos = Position -> Mapping -> DataFrame -> DataFrame
applyPosition (Layer -> Position
layerPosition Layer
layer) Mapping
m DataFrame
postStat
         in case Text -> DataFrame -> Maybe Column
lookupColumn Text
"__ybase" DataFrame
postPos Maybe Column -> (Column -> Maybe [Double]) -> Maybe [Double]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Column -> Maybe [Double]
columnAsNum of
                Just [Double]
bs | Bool -> Bool
not ([Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
bs) -> [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
bs
                Maybe [Double]
_ -> Double
0

layerDefaultColor :: [ColorSpec] -> Int -> Layer -> ColorSpec
layerDefaultColor :: [ColorSpec] -> Int -> Layer -> ColorSpec
layerDefaultColor [ColorSpec]
palette Int
ix Layer
_layer
    | [ColorSpec] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ColorSpec]
palette = Color -> ColorSpec
NamedColor Color
BrightBlue
    | Bool
otherwise = [ColorSpec]
palette [ColorSpec] -> Int -> ColorSpec
forall a. HasCallStack => [a] -> Int -> a
!! (Int
ix Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`mod` [ColorSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColorSpec]
palette)

pointSize :: Theme -> Layer -> Double
pointSize :: Theme -> Layer -> Double
pointSize Theme
_ Layer
_ = Double
3

{- | Map the distinct values of a categorical column to palette colours, in
first-seen order; shared by the renderer and 'collectLegend' so points and the
legend agree.
-}
categoricalColorMap :: [ColorSpec] -> [Text] -> [(Text, ColorSpec)]
categoricalColorMap :: [ColorSpec] -> [Text] -> [(Text, ColorSpec)]
categoricalColorMap [ColorSpec]
palette [Text]
levels =
    [(Text
lvl, Int -> ColorSpec
colorAt Int
i) | (Int
i, Text
lvl) <- [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [Text]
levels]
  where
    colorAt :: Int -> ColorSpec
colorAt Int
i
        | [ColorSpec] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ColorSpec]
palette = Color -> ColorSpec
NamedColor Color
BrightBlue
        | Bool
otherwise = [ColorSpec]
palette [ColorSpec] -> Int -> ColorSpec
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`mod` [ColorSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColorSpec]
palette)

{- | The per-category colour map for a layer, when its 'aesColor' (points) or
'aesFill' (bars) maps to a categorical ('ColCat') column. Computed once from the
whole-chart layer frame so colours stay consistent across facets, bars, and the
legend; 'Nothing' otherwise (numeric colour columns keep the single per-layer
colour). For bars, any manual\/discrete fill scale ('fillOverride') is layered
on top of the palette so the legend swatches match the bars.
-}
layerColorMap ::
    [ColorSpec] ->
    Maybe [(Text, ColorSpec)] ->
    DataFrame ->
    Layer ->
    Maybe [(Text, ColorSpec)]
layerColorMap :: [ColorSpec]
-> Maybe [(Text, ColorSpec)]
-> DataFrame
-> Layer
-> Maybe [(Text, ColorSpec)]
layerColorMap [ColorSpec]
palette Maybe [(Text, ColorSpec)]
fillOverride DataFrame
globalFrame Layer
layer
    | Geom
GeomPoint <- Layer -> Geom
layerGeom Layer
layer
    , Just [Text]
cats <- DataFrame -> Mapping -> Maybe [Text]
categoricalColorColumn DataFrame
frame (Layer -> Mapping
layerMapping Layer
layer) =
        [(Text, ColorSpec)] -> Maybe [(Text, ColorSpec)]
forall a. a -> Maybe a
Just ([ColorSpec] -> [Text] -> [(Text, ColorSpec)]
categoricalColorMap [ColorSpec]
palette ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
List.nub [Text]
cats))
    | Geom -> Bool
isBarGeom (Layer -> Geom
layerGeom Layer
layer)
    , Just [Text]
cats <- DataFrame -> Mapping -> Maybe [Text]
categoricalFillColumn DataFrame
frame (Layer -> Mapping
layerMapping Layer
layer) =
        [(Text, ColorSpec)] -> Maybe [(Text, ColorSpec)]
forall a. a -> Maybe a
Just (Maybe [(Text, ColorSpec)]
-> [(Text, ColorSpec)] -> [(Text, ColorSpec)]
overrideColors Maybe [(Text, ColorSpec)]
fillOverride ([ColorSpec] -> [Text] -> [(Text, ColorSpec)]
categoricalColorMap [ColorSpec]
palette ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
List.nub [Text]
cats)))
    | Bool
otherwise = Maybe [(Text, ColorSpec)]
forall a. Maybe a
Nothing
  where
    frame :: DataFrame
frame = DataFrame -> Maybe DataFrame -> DataFrame
forall a. a -> Maybe a -> a
fromMaybe DataFrame
globalFrame (Layer -> Maybe DataFrame
layerData Layer
layer)

{- | Replace the colour of each category that appears in 'override', leaving the
rest at their base (palette) colour.
-}
overrideColors ::
    Maybe [(Text, ColorSpec)] -> [(Text, ColorSpec)] -> [(Text, ColorSpec)]
overrideColors :: Maybe [(Text, ColorSpec)]
-> [(Text, ColorSpec)] -> [(Text, ColorSpec)]
overrideColors Maybe [(Text, ColorSpec)]
override [(Text, ColorSpec)]
base =
    [(Text
cat, ColorSpec -> Maybe ColorSpec -> ColorSpec
forall a. a -> Maybe a -> a
fromMaybe ColorSpec
spec (Maybe [(Text, ColorSpec)]
override Maybe [(Text, ColorSpec)]
-> ([(Text, ColorSpec)] -> Maybe ColorSpec) -> Maybe ColorSpec
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [(Text, ColorSpec)] -> Maybe ColorSpec
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
cat)) | (Text
cat, ColorSpec
spec) <- [(Text, ColorSpec)]
base]

isBarGeom :: Geom -> Bool
isBarGeom :: Geom -> Bool
isBarGeom Geom
g = Geom
g Geom -> [Geom] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Geom
GeomBar, Geom
GeomCol, Geom
GeomHistogram]

{- | The categorical ('ColCat') colour column's per-row values, if 'aesColor'
maps to one.
-}
categoricalColorColumn :: DataFrame -> Mapping -> Maybe [Text]
categoricalColorColumn :: DataFrame -> Mapping -> Maybe [Text]
categoricalColorColumn DataFrame
frame Mapping
m = case Mapping -> Maybe ColumnRef
aesColor Mapping
m of
    Just (ColumnRef Text
n) -> case Text -> DataFrame -> Maybe Column
lookupColumn Text
n DataFrame
frame of
        Just (ColCat [Text]
xs) -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
xs
        Maybe Column
_ -> Maybe [Text]
forall a. Maybe a
Nothing
    Maybe ColumnRef
Nothing -> Maybe [Text]
forall a. Maybe a
Nothing

{- | The categorical ('ColCat') fill column's per-row values: 'aesFill' if it
maps to one, else 'aesColor'. Drives per-bar colours for bar\/col\/histogram.
-}
categoricalFillColumn :: DataFrame -> Mapping -> Maybe [Text]
categoricalFillColumn :: DataFrame -> Mapping -> Maybe [Text]
categoricalFillColumn DataFrame
frame Mapping
m =
    Maybe ColumnRef -> Maybe [Text]
catColumn (Mapping -> Maybe ColumnRef
aesFill Mapping
m) Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DataFrame -> Mapping -> Maybe [Text]
categoricalColorColumn DataFrame
frame Mapping
m
  where
    catColumn :: Maybe ColumnRef -> Maybe [Text]
catColumn Maybe ColumnRef
ref = case Maybe ColumnRef
ref of
        Just (ColumnRef Text
n) -> case Text -> DataFrame -> Maybe Column
lookupColumn Text
n DataFrame
frame of
            Just (ColCat [Text]
xs) -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
xs
            Maybe Column
_ -> Maybe [Text]
forall a. Maybe a
Nothing
        Maybe ColumnRef
Nothing -> Maybe [Text]
forall a. Maybe a
Nothing

{- | Resolve a discrete fill scale ('SColorDiscrete') into an explicit
category→colour map by zipping the chart's fill categories against the supplied
colours (cycled), so it reduces to the same manual-map path bars consume.
-}
discreteFillMap :: Chart -> [ColorSpec] -> [(Text, ColorSpec)]
discreteFillMap :: Chart -> [ColorSpec] -> [(Text, ColorSpec)]
discreteFillMap Chart
chart [ColorSpec]
specs
    | [ColorSpec] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ColorSpec]
specs = []
    | Bool
otherwise = [Text] -> [ColorSpec] -> [(Text, ColorSpec)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
cats ([ColorSpec] -> [ColorSpec]
forall a. HasCallStack => [a] -> [a]
cycle [ColorSpec]
specs)
  where
    cats :: [Text]
cats =
        [Text] -> [Text]
forall a. Eq a => [a] -> [a]
List.nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
            [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (DataFrame -> Mapping -> Maybe [Text]
categoricalFillColumn (Layer -> DataFrame
layerFrame Layer
l) (Layer -> Mapping
layerMapping Layer
l))
                | Layer
l <- Chart -> [Layer]
chartLayers Chart
chart
                ]
    layerFrame :: Layer -> DataFrame
layerFrame Layer
l = DataFrame -> Maybe DataFrame -> DataFrame
forall a. a -> Maybe a -> a
fromMaybe (Chart -> DataFrame
chartData Chart
chart) (Layer -> Maybe DataFrame
layerData Layer
l)

{- | Legend entries. A categorical-'aesColor' layer contributes one entry per
category value (colours matching the points via 'layerColorMap'); 'GeomText'
layers contribute none; any other layer keeps a single per-layer swatch.
-}
collectLegend ::
    [Layer] -> [ColorSpec] -> [Maybe [(Text, ColorSpec)]] -> [(Text, ColorSpec)]
collectLegend :: [Layer]
-> [ColorSpec]
-> [Maybe [(Text, ColorSpec)]]
-> [(Text, ColorSpec)]
collectLegend [Layer]
layers [ColorSpec]
palette [Maybe [(Text, ColorSpec)]]
colorMaps =
    [[(Text, ColorSpec)]] -> [(Text, ColorSpec)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ Int -> Layer -> Maybe [(Text, ColorSpec)] -> [(Text, ColorSpec)]
entriesFor Int
ix Layer
layer Maybe [(Text, ColorSpec)]
cmap
        | (Int
ix, Layer
layer, Maybe [(Text, ColorSpec)]
cmap) <- [Int]
-> [Layer]
-> [Maybe [(Text, ColorSpec)]]
-> [(Int, Layer, Maybe [(Text, ColorSpec)])]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0 :: Int ..] [Layer]
layers ([Maybe [(Text, ColorSpec)]]
colorMaps [Maybe [(Text, ColorSpec)]]
-> [Maybe [(Text, ColorSpec)]] -> [Maybe [(Text, ColorSpec)]]
forall a. [a] -> [a] -> [a]
++ Maybe [(Text, ColorSpec)] -> [Maybe [(Text, ColorSpec)]]
forall a. a -> [a]
repeat Maybe [(Text, ColorSpec)]
forall a. Maybe a
Nothing)
        ]
  where
    entriesFor :: Int -> Layer -> Maybe [(Text, ColorSpec)] -> [(Text, ColorSpec)]
entriesFor Int
ix Layer
layer Maybe [(Text, ColorSpec)]
cmap
        | Geom
GeomText <- Layer -> Geom
layerGeom Layer
layer = []
        | Geom
GeomTile <- Layer -> Geom
layerGeom Layer
layer = []
        | Just [(Text, ColorSpec)]
levelColors <- Maybe [(Text, ColorSpec)]
cmap = [(Text, ColorSpec)]
levelColors
        | Bool
otherwise =
            [(Int -> Layer -> Text
forall {a}. Show a => a -> Layer -> Text
legendName Int
ix Layer
layer, [ColorSpec]
palette [ColorSpec] -> Int -> ColorSpec
forall a. HasCallStack => [a] -> Int -> a
!! (Int
ix Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`mod` Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 ([ColorSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColorSpec]
palette)))]
    legendName :: a -> Layer -> Text
legendName a
ix Layer
layer =
        case Mapping -> Maybe ColumnRef
aesGroup (Layer -> Mapping
layerMapping Layer
layer) of
            Just (ColumnRef Text
n) -> Text
n
            Maybe ColumnRef
Nothing -> Text
"series " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (a -> String
forall a. Show a => a -> String
show a
ix)

{- | Resolve a 'ColorSpec' to an exact RGB 'Color'. The SVG backend renders
this exactly (via @colorHex@); the terminal backend quantises it to the nearest
ANSI slot (via @ansiCode@).
-}
specToColor :: ColorSpec -> Color
specToColor :: ColorSpec -> Color
specToColor (NamedColor Color
c) = Color
c
specToColor (RGB Word8
r Word8
g Word8
b) = Word8 -> Word8 -> Word8 -> Color
Color Word8
r Word8
g Word8
b
specToColor (Hex Text
t) = Color -> Maybe Color -> Color
forall a. a -> Maybe a -> a
fromMaybe Color
Black (Text -> Maybe Color
parseHex Text
t)