Compound.hs

{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Combine charts that share a common canvas.
module Chart.Compound
  ( runHudCompoundWith,
    addHudCompound,
    compoundMerge,
    writeChartOptionsCompound,
    encodeChartOptionsCompound,
    markupChartOptionsCompound,
  )
where

import Chart.Hud
import Chart.Markup
import Chart.Primitive
import Chart.Style
import Data.Bool
import Data.ByteString.Char8 qualified as C
import Data.Foldable
import Data.List qualified as List
import Data.Maybe
import MarkupParse
import Optics.Core
import Prelude

-- | Write multiple charts to a single file sharing the canvas.
writeChartOptionsCompound :: FilePath -> [ChartOptions] -> IO ()
writeChartOptionsCompound fp cs = C.writeFile fp (encodeChartOptionsCompound cs)

-- | Encode multiple charts.
encodeChartOptionsCompound :: [ChartOptions] -> C.ByteString
encodeChartOptionsCompound [] = mempty
encodeChartOptionsCompound cs@(c0 : _) =
  markdown_ (view (#markupOptions % #renderStyle) c0) Xml (markupChartOptionsCompound cs)

-- | Create Markup representing multiple charts sharing a common canvas.
markupChartOptionsCompound :: [ChartOptions] -> Markup
markupChartOptionsCompound [] = mempty
markupChartOptionsCompound cs@(co0 : _) =
  header
    (view (#markupOptions % #markupHeight) co0)
    viewbox
    ( markupCssOptions (view (#markupOptions % #cssOptions) co0)
        <> markupChartTree ctFinal
    )
  where
    viewbox = view safeStyleBox' ctFinal
    ctFinal =
      projectChartCompoundWith
        (view (#markupOptions % #chartAspect) co0)
        (zip (view #hudOptions <$> cs) (view #chartTree <$> cs))

projectChartCompoundWith :: ChartAspect -> [(HudOptions, ChartTree)] -> ChartTree
projectChartCompoundWith asp css = ctFinal
  where
    csAndHud = addHudCompound asp css
    viewbox = finalCanvas asp (Just csAndHud)
    ctFinal = set styleBox' (Just viewbox) csAndHud

-- | Merge a list of ChartOptions, treating each element as charts to be merged. Note that this routine mempties the hud options and converts them to charts.
compoundMerge :: [ChartOptions] -> ChartOptions
compoundMerge [] = mempty
compoundMerge cs@(c0 : _) =
  ChartOptions
    (view #markupOptions c0)
    mempty
    (addHudCompound (view (#markupOptions % #chartAspect) c0) (zip (view #hudOptions <$> cs) (view #chartTree <$> cs)))

-- | Decorate a ChartTree with HudOptions, merging the individual hud options.
addHudCompound :: ChartAspect -> [(HudOptions, ChartTree)] -> ChartTree
addHudCompound _ [] = mempty
addHudCompound asp ts@((_, cs0) : _) =
  runHudCompoundWith
    (initialCanvas asp (Just cs0))
    (zip3 dbs' hss css')
  where
    css :: [ChartTree]
    css = snd <$> ts
    hos = fst <$> ts
    dbs = view safeBox' <$> css
    huds = zipWith toHuds hos dbs
    mdbs = fst <$> huds
    hss = snd <$> huds
    dbs' = zipWith fromMaybe dbs mdbs
    css' :: [ChartTree]
    css' = zipWith3 (\cs mdb db -> cs <> maybe mempty (\r -> bool (named "datapadding" [BlankChart defaultStyle [r]]) mempty (r == db)) mdb) css mdbs dbs

-- | Combine a collection of chart trees that share a canvas box.
runHudCompoundWith ::
  -- | initial canvas
  ChartBox ->
  -- | databox-huds-chart tuples representing independent chart trees occupying the same canvas space
  [(DataBox, [Hud], ChartTree)] ->
  -- | integrated chart tree
  ChartTree
runHudCompoundWith cb ts = hss
  where
    hss =
      ts
        & fmap (\(_, hs, _) -> hs)
        & mconcat
        & prioritizeHuds
        & fmap (fmap (view (#phud % #item)))
        & foldl' (\x a -> makeHuds a x) hc0
        & fromHudChart
    css =
      ts
        & fmap (\(db, _, ct) -> over chart' (projectWith cb db) ct)
        & mconcat
    hc0 = HudChart (css & set styleBox' (Just cb)) mempty

prioritizeHuds :: [Hud] -> [[Hud]]
prioritizeHuds hss =
  hss
    & List.sortOn (view (#phud % #priority))
    & List.groupBy (\a b -> view (#phud % #priority) a == view (#phud % #priority) b)