{-# 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 :: FilePath -> [ChartOptions] -> IO ()
writeChartOptionsCompound FilePath
fp [ChartOptions]
cs = FilePath -> ByteString -> IO ()
C.writeFile FilePath
fp ([ChartOptions] -> ByteString
encodeChartOptionsCompound [ChartOptions]
cs)

-- | Encode multiple charts.
encodeChartOptionsCompound :: [ChartOptions] -> C.ByteString
encodeChartOptionsCompound :: [ChartOptions] -> ByteString
encodeChartOptionsCompound [] = forall a. Monoid a => a
mempty
encodeChartOptionsCompound cs :: [ChartOptions]
cs@(ChartOptions
c0 : [ChartOptions]
_) =
  RenderStyle -> Standard -> Markup -> ByteString
markdown_ (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "markupOptions" a => a
#markupOptions forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "renderStyle" a => a
#renderStyle) ChartOptions
c0) Standard
Xml ([ChartOptions] -> Markup
markupChartOptionsCompound [ChartOptions]
cs)

-- | Create Markup representing multiple charts sharing a common canvas.
markupChartOptionsCompound :: [ChartOptions] -> Markup
markupChartOptionsCompound :: [ChartOptions] -> Markup
markupChartOptionsCompound [] = forall a. Monoid a => a
mempty
markupChartOptionsCompound cs :: [ChartOptions]
cs@(ChartOptions
co0 : [ChartOptions]
_) =
  Maybe Double -> Rect Double -> Markup -> Markup
header
    (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "markupOptions" a => a
#markupOptions forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "markupHeight" a => a
#markupHeight) ChartOptions
co0)
    Rect Double
viewbox
    ( CssOptions -> Markup
markupCssOptions (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "markupOptions" a => a
#markupOptions forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "cssOptions" a => a
#cssOptions) ChartOptions
co0)
        forall a. Semigroup a => a -> a -> a
<> ChartTree -> Markup
markupChartTree ChartTree
ctFinal
    )
  where
    viewbox :: Rect Double
viewbox = forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter ChartTree (Rect Double)
safeStyleBox' ChartTree
ctFinal
    ctFinal :: ChartTree
ctFinal =
      ChartAspect -> [(HudOptions, ChartTree)] -> ChartTree
projectChartCompoundWith
        (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "markupOptions" a => a
#markupOptions forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "chartAspect" a => a
#chartAspect) ChartOptions
co0)
        (forall a b. [a] -> [b] -> [(a, b)]
zip (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "hudOptions" a => a
#hudOptions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartOptions]
cs) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "chartTree" a => a
#chartTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartOptions]
cs))

projectChartCompoundWith :: ChartAspect -> [(HudOptions, ChartTree)] -> ChartTree
projectChartCompoundWith :: ChartAspect -> [(HudOptions, ChartTree)] -> ChartTree
projectChartCompoundWith ChartAspect
asp [(HudOptions, ChartTree)]
css = ChartTree
ctFinal
  where
    csAndHud :: ChartTree
csAndHud = ChartAspect -> [(HudOptions, ChartTree)] -> ChartTree
addHudCompound ChartAspect
asp [(HudOptions, ChartTree)]
css
    viewbox :: Rect Double
viewbox = ChartAspect -> Maybe ChartTree -> Rect Double
finalCanvas ChartAspect
asp (forall a. a -> Maybe a
Just ChartTree
csAndHud)
    ctFinal :: ChartTree
ctFinal = forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' ChartTree (Maybe (Rect Double))
styleBox' (forall a. a -> Maybe a
Just Rect Double
viewbox) ChartTree
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 :: [ChartOptions] -> ChartOptions
compoundMerge [] = forall a. Monoid a => a
mempty
compoundMerge cs :: [ChartOptions]
cs@(ChartOptions
c0 : [ChartOptions]
_) =
  MarkupOptions -> HudOptions -> ChartTree -> ChartOptions
ChartOptions
    (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "markupOptions" a => a
#markupOptions ChartOptions
c0)
    forall a. Monoid a => a
mempty
    (ChartAspect -> [(HudOptions, ChartTree)] -> ChartTree
addHudCompound (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "markupOptions" a => a
#markupOptions forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "chartAspect" a => a
#chartAspect) ChartOptions
c0) (forall a b. [a] -> [b] -> [(a, b)]
zip (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "hudOptions" a => a
#hudOptions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartOptions]
cs) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "chartTree" a => a
#chartTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartOptions]
cs)))

-- | Decorate a ChartTree with HudOptions, merging the individual hud options.
addHudCompound :: ChartAspect -> [(HudOptions, ChartTree)] -> ChartTree
addHudCompound :: ChartAspect -> [(HudOptions, ChartTree)] -> ChartTree
addHudCompound ChartAspect
_ [] = forall a. Monoid a => a
mempty
addHudCompound ChartAspect
asp ts :: [(HudOptions, ChartTree)]
ts@((HudOptions
_, ChartTree
cs0) : [(HudOptions, ChartTree)]
_) =
  Rect Double -> [(Rect Double, [Hud], ChartTree)] -> ChartTree
runHudCompoundWith
    (ChartAspect -> Maybe ChartTree -> Rect Double
initialCanvas ChartAspect
asp (forall a. a -> Maybe a
Just ChartTree
cs0))
    (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Rect Double]
dbs' [[Hud]]
hss [ChartTree]
css')
  where
    css :: [ChartTree]
    css :: [ChartTree]
css = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(HudOptions, ChartTree)]
ts
    hos :: [HudOptions]
hos = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(HudOptions, ChartTree)]
ts
    dbs :: [Rect Double]
dbs = forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter ChartTree (Rect Double)
safeBox' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartTree]
css
    huds :: [(Maybe (Rect Double), [Hud])]
huds = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith HudOptions -> Rect Double -> (Maybe (Rect Double), [Hud])
toHuds [HudOptions]
hos [Rect Double]
dbs
    mdbs :: [Maybe (Rect Double)]
mdbs = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe (Rect Double), [Hud])]
huds
    hss :: [[Hud]]
hss = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe (Rect Double), [Hud])]
huds
    dbs' :: [Rect Double]
dbs' = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. a -> Maybe a -> a
fromMaybe [Rect Double]
dbs [Maybe (Rect Double)]
mdbs
    css' :: [ChartTree]
    css' :: [ChartTree]
css' = forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\ChartTree
cs Maybe (Rect Double)
mdb Rect Double
db -> ChartTree
cs forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\Rect Double
r -> forall a. a -> a -> Bool -> a
bool (Text -> [Chart] -> ChartTree
named Text
"datapadding" [Style -> [Rect Double] -> Chart
BlankChart Style
defaultStyle [Rect Double
r]]) forall a. Monoid a => a
mempty (Rect Double
r forall a. Eq a => a -> a -> Bool
== Rect Double
db)) Maybe (Rect Double)
mdb) [ChartTree]
css [Maybe (Rect Double)]
mdbs [Rect Double]
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 :: Rect Double -> [(Rect Double, [Hud], ChartTree)] -> ChartTree
runHudCompoundWith Rect Double
cb [(Rect Double, [Hud], ChartTree)]
ts = ChartTree
hss
  where
    hss :: ChartTree
hss =
      [(Rect Double, [Hud], ChartTree)]
ts
        forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Rect Double
_, [Hud]
hs, ChartTree
_) -> [Hud]
hs)
        forall a b. a -> (a -> b) -> b
& forall a. Monoid a => [a] -> a
mconcat
        forall a b. a -> (a -> b) -> b
& [Hud] -> [[Hud]]
prioritizeHuds
        forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "phud" a => a
#phud forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "item" a => a
#item)))
        forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\HudChart
x [HudChart -> ChartTree]
a -> [HudChart -> ChartTree] -> HudChart -> HudChart
makeHuds [HudChart -> ChartTree]
a HudChart
x) HudChart
hc0
        forall a b. a -> (a -> b) -> b
& HudChart -> ChartTree
fromHudChart
    css :: ChartTree
css =
      [(Rect Double, [Hud], ChartTree)]
ts
        forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Rect Double
db, [Hud]
_, ChartTree
ct) -> forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (Rect Double -> Rect Double -> Chart -> Chart
projectWith Rect Double
cb Rect Double
db) ChartTree
ct)
        forall a b. a -> (a -> b) -> b
& forall a. Monoid a => [a] -> a
mconcat
    hc0 :: HudChart
hc0 = ChartTree -> ChartTree -> HudChart
HudChart (ChartTree
css forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' ChartTree (Maybe (Rect Double))
styleBox' (forall a. a -> Maybe a
Just Rect Double
cb)) forall a. Monoid a => a
mempty

prioritizeHuds :: [Hud] -> [[Hud]]
prioritizeHuds :: [Hud] -> [[Hud]]
prioritizeHuds [Hud]
hss =
  [Hud]
hss
    forall a b. a -> (a -> b) -> b
& forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "phud" a => a
#phud forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "priority" a => a
#priority))
    forall a b. a -> (a -> b) -> b
& forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy (\Hud
a Hud
b -> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "phud" a => a
#phud forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "priority" a => a
#priority) Hud
a forall a. Eq a => a -> a -> Bool
== forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "phud" a => a
#phud forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "priority" a => a
#priority) Hud
b)