{-# OPTIONS_GHC -Wno-missing-role-annotations #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

module Dashi.Components.Plot where

import Clay
    ( byClass
    , em
    , opacity
    , (#)
    , (-:)
    , (?)
    , (|>)
    )
import Clay qualified
import Dashi.Components.Spinner (Spinner (..))
import Dashi.Components.Util
import Dashi.Diagram
import Dashi.Prelude hiding (has, none, transform, (#), (&), (|>))
import Dashi.Style.Colour (Alpha)
import Dashi.Style.Util
import Data.Function ((&))
import Data.List qualified as List
import Data.List.Extra qualified as List
import Data.Vector.Strict qualified as Vector
import Graphics.Color.Space.OKLAB.LCH
import Miso.Html.Property qualified as Svg
import Miso.String qualified as MisoString
import Miso.Svg qualified as Svg
import Miso.Svg.Property qualified as Svg

data PlotType num = LinePlot | BarPlot {forall num. PlotType num -> num
barWidth :: num}
    deriving stock (PlotType num -> PlotType num -> Bool
(PlotType num -> PlotType num -> Bool)
-> (PlotType num -> PlotType num -> Bool) -> Eq (PlotType num)
forall num. Eq num => PlotType num -> PlotType num -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall num. Eq num => PlotType num -> PlotType num -> Bool
== :: PlotType num -> PlotType num -> Bool
$c/= :: forall num. Eq num => PlotType num -> PlotType num -> Bool
/= :: PlotType num -> PlotType num -> Bool
Eq, Int -> PlotType num -> ShowS
[PlotType num] -> ShowS
PlotType num -> String
(Int -> PlotType num -> ShowS)
-> (PlotType num -> String)
-> ([PlotType num] -> ShowS)
-> Show (PlotType num)
forall num. Show num => Int -> PlotType num -> ShowS
forall num. Show num => [PlotType num] -> ShowS
forall num. Show num => PlotType num -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall num. Show num => Int -> PlotType num -> ShowS
showsPrec :: Int -> PlotType num -> ShowS
$cshow :: forall num. Show num => PlotType num -> String
show :: PlotType num -> String
$cshowList :: forall num. Show num => [PlotType num] -> ShowS
showList :: [PlotType num] -> ShowS
Show)

data Series num = Series
    { forall num. Series num -> Maybe (Color (Alpha OKLCH) Micro)
strokeColour :: Maybe (Color (Alpha OKLCH) Micro)
    , forall num. Series num -> Maybe (Color (Alpha OKLCH) Micro)
fillColour :: Maybe (Color (Alpha OKLCH) Micro)
    , forall num. Series num -> Vector (Point num)
values :: Vector (Point num)
    , forall num. Series num -> PlotType num
plotType :: PlotType num
    }

data PaddingAmount num
    = Relative num
    | Absolute num

absolutePadding :: (Num num) => num -> PaddingAmount num -> num
absolutePadding :: forall num. Num num => num -> PaddingAmount num -> num
absolutePadding num
total (Relative num
r) = num
total num -> num -> num
forall a. Num a => a -> a -> a
* num
r
absolutePadding num
_ (Absolute num
a) = num
a

data Padding num
    = SymmetricPadding
        { forall num. Padding num -> PaddingAmount num
yPadding :: PaddingAmount num
        , forall num. Padding num -> PaddingAmount num
xPadding :: PaddingAmount num
        }
    | Padding
        { forall num. Padding num -> PaddingAmount num
topPadding :: PaddingAmount num
        , forall num. Padding num -> PaddingAmount num
rightPadding :: PaddingAmount num
        , forall num. Padding num -> PaddingAmount num
bottomPadding :: PaddingAmount num
        , forall num. Padding num -> PaddingAmount num
leftPadding :: PaddingAmount num
        }

expand :: (Num num) => Padding num -> Rect num -> Rect num
expand :: forall num. Num num => Padding num -> Rect num -> Rect num
expand SymmetricPadding{PaddingAmount num
yPadding :: forall num. Padding num -> PaddingAmount num
xPadding :: forall num. Padding num -> PaddingAmount num
yPadding :: PaddingAmount num
xPadding :: PaddingAmount num
..} Rect num
r =
    Padding num -> Rect num -> Rect num
forall num. Num num => Padding num -> Rect num -> Rect num
expand
        Padding
            { topPadding :: PaddingAmount num
topPadding = PaddingAmount num
yPadding
            , rightPadding :: PaddingAmount num
rightPadding = PaddingAmount num
xPadding
            , bottomPadding :: PaddingAmount num
bottomPadding = PaddingAmount num
yPadding
            , leftPadding :: PaddingAmount num
leftPadding = PaddingAmount num
xPadding
            }
        Rect num
r
expand Padding{PaddingAmount num
topPadding :: forall num. Padding num -> PaddingAmount num
rightPadding :: forall num. Padding num -> PaddingAmount num
bottomPadding :: forall num. Padding num -> PaddingAmount num
leftPadding :: forall num. Padding num -> PaddingAmount num
topPadding :: PaddingAmount num
rightPadding :: PaddingAmount num
bottomPadding :: PaddingAmount num
leftPadding :: PaddingAmount num
..} Rect num
r =
    Rect num
r
        Rect num -> (Rect num -> Rect num) -> Rect num
forall a b. a -> (a -> b) -> b
& ASetter (Rect num) (Rect num) (Point num) (Point num)
#topLeft
            ASetter (Rect num) (Rect num) (Point num) (Point num)
-> (Point num -> Point num) -> Rect num -> Rect num
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (num -> num) -> (num -> num) -> Point num -> Point num
forall num. (num -> num) -> (num -> num) -> Point num -> Point num
offsetPoint (num -> num -> num
forall a. Num a => a -> a -> a
subtract (num -> num -> num) -> num -> num -> num
forall a b. (a -> b) -> a -> b
$ PaddingAmount num -> num
padX PaddingAmount num
leftPadding) (num -> num -> num
forall a. Num a => a -> a -> a
subtract (num -> num -> num) -> num -> num -> num
forall a b. (a -> b) -> a -> b
$ PaddingAmount num -> num
padY PaddingAmount num
topPadding)
        Rect num -> (Rect num -> Rect num) -> Rect num
forall a b. a -> (a -> b) -> b
& ASetter (Rect num) (Rect num) (Point num) (Point num)
#bottomRight ASetter (Rect num) (Rect num) (Point num) (Point num)
-> (Point num -> Point num) -> Rect num -> Rect num
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (num -> num) -> (num -> num) -> Point num -> Point num
forall num. (num -> num) -> (num -> num) -> Point num -> Point num
offsetPoint (num -> num -> num
forall a. Num a => a -> a -> a
+ PaddingAmount num -> num
padX PaddingAmount num
rightPadding) (num -> num -> num
forall a. Num a => a -> a -> a
+ PaddingAmount num -> num
padY PaddingAmount num
bottomPadding)
  where
    (num -> PaddingAmount num -> num
forall num. Num num => num -> PaddingAmount num -> num
absolutePadding -> PaddingAmount num -> num
padX, num -> PaddingAmount num -> num
forall num. Num num => num -> PaddingAmount num -> num
absolutePadding -> PaddingAmount num -> num
padY) = Rect num -> (num, num)
forall num. Num num => Rect num -> (num, num)
rectSize Rect num
r

contract :: (Num num) => Padding num -> Rect num -> Rect num
contract :: forall num. Num num => Padding num -> Rect num -> Rect num
contract SymmetricPadding{PaddingAmount num
yPadding :: forall num. Padding num -> PaddingAmount num
xPadding :: forall num. Padding num -> PaddingAmount num
yPadding :: PaddingAmount num
xPadding :: PaddingAmount num
..} Rect num
r =
    Padding num -> Rect num -> Rect num
forall num. Num num => Padding num -> Rect num -> Rect num
contract
        Padding
            { topPadding :: PaddingAmount num
topPadding = PaddingAmount num
yPadding
            , rightPadding :: PaddingAmount num
rightPadding = PaddingAmount num
xPadding
            , bottomPadding :: PaddingAmount num
bottomPadding = PaddingAmount num
yPadding
            , leftPadding :: PaddingAmount num
leftPadding = PaddingAmount num
xPadding
            }
        Rect num
r
contract Padding{PaddingAmount num
topPadding :: forall num. Padding num -> PaddingAmount num
rightPadding :: forall num. Padding num -> PaddingAmount num
bottomPadding :: forall num. Padding num -> PaddingAmount num
leftPadding :: forall num. Padding num -> PaddingAmount num
topPadding :: PaddingAmount num
rightPadding :: PaddingAmount num
bottomPadding :: PaddingAmount num
leftPadding :: PaddingAmount num
..} Rect num
r =
    Rect num
r
        Rect num -> (Rect num -> Rect num) -> Rect num
forall a b. a -> (a -> b) -> b
& ASetter (Rect num) (Rect num) (Point num) (Point num)
#topLeft ASetter (Rect num) (Rect num) (Point num) (Point num)
-> (Point num -> Point num) -> Rect num -> Rect num
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (num -> num) -> (num -> num) -> Point num -> Point num
forall num. (num -> num) -> (num -> num) -> Point num -> Point num
offsetPoint (num -> num -> num
forall a. Num a => a -> a -> a
+ PaddingAmount num -> num
padX PaddingAmount num
leftPadding) (num -> num -> num
forall a. Num a => a -> a -> a
+ PaddingAmount num -> num
padY PaddingAmount num
topPadding)
        Rect num -> (Rect num -> Rect num) -> Rect num
forall a b. a -> (a -> b) -> b
& ASetter (Rect num) (Rect num) (Point num) (Point num)
#bottomRight
            ASetter (Rect num) (Rect num) (Point num) (Point num)
-> (Point num -> Point num) -> Rect num -> Rect num
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (num -> num) -> (num -> num) -> Point num -> Point num
forall num. (num -> num) -> (num -> num) -> Point num -> Point num
offsetPoint (num -> num -> num
forall a. Num a => a -> a -> a
subtract (num -> num -> num) -> num -> num -> num
forall a b. (a -> b) -> a -> b
$ PaddingAmount num -> num
padX PaddingAmount num
rightPadding) (num -> num -> num
forall a. Num a => a -> a -> a
subtract (num -> num -> num) -> num -> num -> num
forall a b. (a -> b) -> a -> b
$ PaddingAmount num -> num
padY PaddingAmount num
bottomPadding)
  where
    (num -> PaddingAmount num -> num
forall num. Num num => num -> PaddingAmount num -> num
absolutePadding -> PaddingAmount num -> num
padX, num -> PaddingAmount num -> num
forall num. Num num => num -> PaddingAmount num -> num
absolutePadding -> PaddingAmount num -> num
padY) = Rect num -> (num, num)
forall num. Num num => Rect num -> (num, num)
rectSize Rect num
r

data Ticks num
    = Numeric
    | Time
    | Custom [num]

data Axis num = Axis
    { forall num. Axis num -> Bool
showAxis :: Bool
    , forall num. Axis num -> Bool
showGrid :: Bool
    , forall num. Axis num -> Ticks num
ticks :: Ticks num
    , forall num. Axis num -> num -> MisoString
renderTick :: num -> MisoString
    }

data Plot num = Plot
    { forall num. Plot num -> Int
width :: Int
    -- ^ The overall width of the canvas, including padding and plot area
    , forall num. Plot num -> Int
height :: Int
    -- ^ The overall height of the canvas, including padding and plot area
    , forall num. Plot num -> Maybe (Padding num)
padding :: Maybe (Padding num)
    -- ^ The space from the edge of the canvas to the plot area
    , forall num. Plot num -> Rect num -> Rect num
domainTransform :: Rect num -> Rect num
    -- ^ The transformation of the domain, e.g. padding or forcing a 0 baseline.
    , forall num. Plot num -> [Series num]
series :: [Series num]
    -- ^ The series to plot
    , forall num. Plot num -> Axis num
xAxis :: Axis num
    , forall num. Plot num -> Axis num
yAxis :: Axis num
    }

instance (RealFrac num, ToMisoString num) => Widget (Plot num) model action where
    widget' :: [Attribute action] -> Plot num -> View model action
widget' [Attribute action]
attrs Plot{Int
[Series num]
Maybe (Padding num)
Axis num
Rect num -> Rect num
width :: forall num. Plot num -> Int
height :: forall num. Plot num -> Int
padding :: forall num. Plot num -> Maybe (Padding num)
domainTransform :: forall num. Plot num -> Rect num -> Rect num
series :: forall num. Plot num -> [Series num]
xAxis :: forall num. Plot num -> Axis num
yAxis :: forall num. Plot num -> Axis num
width :: Int
height :: Int
padding :: Maybe (Padding num)
domainTransform :: Rect num -> Rect num
series :: [Series num]
xAxis :: Axis num
yAxis :: Axis num
..} =
        [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
Svg.svg_
            ( MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.width_ (Int -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString Int
width)
                Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.height_ (Int -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString Int
height)
                Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.viewBox_
                    ( [MisoString] -> MisoString
MisoString.unwords
                        [ num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString Rect num
viewBox.topLeft.x
                        , num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString Rect num
viewBox.topLeft.y
                        , Int -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString Int
width
                        , Int -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString Int
height
                        ]
                    )
                Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.className MisoString
"plot"
                Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs
            )
            ([View model action] -> View model action)
-> ([[View model action]] -> [View model action])
-> [[View model action]]
-> View model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [[View model action]] -> [View model action]
forall a. Monoid a => [a] -> a
mconcat
            ([[View model action]] -> View model action)
-> [[View model action]] -> View model action
forall a b. (a -> b) -> a -> b
$ [ [View model action]
gridElements
              , [View model action]
axisElements
              , [View model action]
plotElements
              , [Spinner -> View model action
forall w model action.
Widget w model action =>
w -> View model action
widget Spinner
Spinner | [Attribute action] -> Bool
forall action. [Attribute action] -> Bool
hasAriaBusy [Attribute action]
attrs]
              ]
      where
        width', height' :: num
        width' :: num
width' = Int -> num
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width
        height' :: num
height' = Int -> num
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height

        viewBox :: Rect num
        viewBox :: Rect num
viewBox =
            Rect
                { topLeft :: Point num
topLeft = Point{x :: num
x = num
0, y :: num
y = num
0}
                , bottomRight :: Point num
bottomRight = Point{x :: num
x = num
width', y :: num
y = num
height'}
                }

        swap :: Lens' s a -> Lens' s a -> s -> s
        swap :: forall s a. Lens' s a -> Lens' s a -> s -> s
swap Lens' s a
a Lens' s a
b s
x = s
x s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> s -> Identity s
Lens' s a
a ((a -> Identity a) -> s -> Identity s) -> a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (s
x s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
Lens' s a
b) s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> s -> Identity s
Lens' s a
b ((a -> Identity a) -> s -> Identity s) -> a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (s
x s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
Lens' s a
a)

        (<~>) :: Lens' s a -> Lens' s a -> s -> s
        <~> :: forall s a. Lens' s a -> Lens' s a -> s -> s
(<~>) = Lens' s a -> Lens' s a -> s -> s
forall s a. Lens' s a -> Lens' s a -> s -> s
swap

        swapY :: Rect num -> Rect num
        swapY :: Rect num -> Rect num
swapY = ((Point num -> f (Point num)) -> Rect num -> f (Rect num)
#topLeft ((Point num -> f (Point num)) -> Rect num -> f (Rect num))
-> ((num -> f num) -> Point num -> f (Point num))
-> (num -> f num)
-> Rect num
-> f (Rect num)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (num -> f num) -> Point num -> f (Point num)
#y) (forall {f :: * -> *}.
 Functor f =>
 (num -> f num) -> Rect num -> f (Rect num))
-> (forall {f :: * -> *}.
    Functor f =>
    (num -> f num) -> Rect num -> f (Rect num))
-> Rect num
-> Rect num
forall s a. Lens' s a -> Lens' s a -> s -> s
<~> ((Point num -> f (Point num)) -> Rect num -> f (Rect num)
#bottomRight ((Point num -> f (Point num)) -> Rect num -> f (Rect num))
-> ((num -> f num) -> Point num -> f (Point num))
-> (num -> f num)
-> Rect num
-> f (Rect num)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (num -> f num) -> Point num -> f (Point num)
#y)

        paddedViewBox :: Rect num
paddedViewBox = Rect num
viewBox Rect num -> (Rect num -> Rect num) -> Rect num
forall a b. a -> (a -> b) -> b
& (Rect num -> Rect num)
-> (Padding num -> Rect num -> Rect num)
-> Maybe (Padding num)
-> Rect num
-> Rect num
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect num -> Rect num
forall a. a -> a
id Padding num -> Rect num -> Rect num
forall num. Num num => Padding num -> Rect num -> Rect num
contract Maybe (Padding num)
padding Rect num -> (Rect num -> Rect num) -> Rect num
forall a b. a -> (a -> b) -> b
& Rect num -> Rect num
swapY

        gridElements :: [View model action]
        gridElements :: [View model action]
gridElements =
            [Attribute action] -> [SomeShape num] -> [View model action]
forall action model.
[Attribute action] -> [SomeShape num] -> [View model action]
forall s num action model.
ToSVG s num =>
[Attribute action] -> s -> [View model action]
toSVG [MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.stroke_ (Micro -> MisoString
axisColour Micro
0.5), MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.strokeWidth_ MisoString
"1"]
                ([SomeShape num] -> [View model action])
-> ([SomeShape num] -> [SomeShape num])
-> [SomeShape num]
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rect num -> Rect num -> [SomeShape num] -> [SomeShape num]
forall s num.
(Shape s num, Eq num, Fractional num) =>
Rect num -> Rect num -> s -> s
translateDomain Rect num
paddedViewBox Rect num
domain
                ([SomeShape num] -> [View model action])
-> [SomeShape num] -> [View model action]
forall a b. (a -> b) -> a -> b
$ [SomeShape num]
xElements
                [SomeShape num] -> [SomeShape num] -> [SomeShape num]
forall a. Semigroup a => a -> a -> a
<> [SomeShape num]
yElements
          where
            Rect{topLeft :: forall num. Rect num -> Point num
topLeft = Point{x :: forall num. Point num -> num
x = num
l, y :: forall num. Point num -> num
y = num
t}, bottomRight :: forall num. Rect num -> Point num
bottomRight = Point{x :: forall num. Point num -> num
x = num
r, y :: forall num. Point num -> num
y = num
b}} = Rect num
domain
            xElements :: [SomeShape num]
xElements =
                [ Line num -> SomeShape num
forall num s. (Shape s num, ToSVG s num) => s -> SomeShape num
Shape (Line num -> SomeShape num) -> Line num -> SomeShape num
forall a b. (a -> b) -> a -> b
$ Point num -> Point num -> Line num
forall num. Point num -> Point num -> Line num
Line Point{num
x :: num
x :: num
x, y :: num
y = num
t} Point{num
x :: num
x :: num
x, y :: num
y = num
b}
                | Bool
hasNonBarPlots
                , Axis num
xAxis.showGrid
                , num
x <- [num]
ticksX
                ]
            yElements :: [SomeShape num]
yElements = [Line num -> SomeShape num
forall num s. (Shape s num, ToSVG s num) => s -> SomeShape num
Shape (Line num -> SomeShape num) -> Line num -> SomeShape num
forall a b. (a -> b) -> a -> b
$ Point num -> Point num -> Line num
forall num. Point num -> Point num -> Line num
Line Point{x :: num
x = num
l, num
y :: num
y :: num
y} Point{x :: num
x = num
r, num
y :: num
y :: num
y} | Axis num
yAxis.showGrid, num
y <- [num]
ticksY]

        axisElements :: [View model action]
        axisElements :: [View model action]
axisElements =
            [[View model action]] -> [View model action]
forall a. Monoid a => [a] -> a
mconcat
                ([[View model action]] -> [View model action])
-> ([[[View model action]]] -> [[View model action]])
-> [[[View model action]]]
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [[[View model action]]] -> [[View model action]]
forall a. Monoid a => [a] -> a
mconcat
                ([[[View model action]]] -> [View model action])
-> [[[View model action]]] -> [View model action]
forall a b. (a -> b) -> a -> b
$ [Line num -> [View model action]
forall s. ToSVG s num => s -> [View model action]
mkLine (Line num -> Line num
forall s. Shape s num => s -> s
inViewBox Line num
xLine) [View model action]
-> [[View model action]] -> [[View model action]]
forall a. a -> [a] -> [a]
: (num -> [[View model action]]) -> [num] -> [[View model action]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap num -> [[View model action]]
mkTickX [num]
ticksX | Axis num
xAxis.showAxis]
                [[[View model action]]]
-> [[[View model action]]] -> [[[View model action]]]
forall a. Semigroup a => a -> a -> a
<> [Line num -> [View model action]
forall s. ToSVG s num => s -> [View model action]
mkLine (Line num -> Line num
forall s. Shape s num => s -> s
inViewBox Line num
yLine) [View model action]
-> [[View model action]] -> [[View model action]]
forall a. a -> [a] -> [a]
: (num -> [[View model action]]) -> [num] -> [[View model action]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap num -> [[View model action]]
mkTickY [num]
ticksY | Axis num
yAxis.showAxis]
          where
            Rect{Point num
topLeft :: forall num. Rect num -> Point num
bottomRight :: forall num. Rect num -> Point num
topLeft :: Point num
bottomRight :: Point num
..} = Rect num
domain
            topRight' :: Point num
topRight' = Point{x :: num
x = Point num
bottomRight.x, y :: num
y = Point num
topLeft.y}
            bottomLeft' :: Point num
bottomLeft' = Point{x :: num
x = Point num
topLeft.x, y :: num
y = Point num
bottomRight.y}
            mkLine :: (ToSVG s num) => s -> [View model action]
            mkLine :: forall s. ToSVG s num => s -> [View model action]
mkLine = [Attribute action] -> s -> [View model action]
forall action model. [Attribute action] -> s -> [View model action]
forall s num action model.
ToSVG s num =>
[Attribute action] -> s -> [View model action]
toSVG [MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.stroke_ (Micro -> MisoString
axisColour Micro
1), MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.strokeWidth_ MisoString
"1"]
            xLine, yLine :: Line num
            xLine :: Line num
xLine = Point num -> Point num -> Line num
forall num. Point num -> Point num -> Line num
Line Point num
topLeft Point num
topRight'
            yLine :: Line num
yLine = Point num -> Point num -> Line num
forall num. Point num -> Point num -> Line num
Line Point num
topLeft Point num
bottomLeft'
            inViewBox :: (Shape s num) => s -> s
            inViewBox :: forall s. Shape s num => s -> s
inViewBox = Rect num -> Rect num -> s -> s
forall s num.
(Shape s num, Eq num, Fractional num) =>
Rect num -> Rect num -> s -> s
translateDomain Rect num
paddedViewBox Rect num
domain

            mkTickX, mkTickY :: num -> [[View model action]]
            mkTickX :: num -> [[View model action]]
mkTickX num
x =
                [ Line num -> [View model action]
forall s. ToSVG s num => s -> [View model action]
mkLine (Line num -> [View model action])
-> Line num -> [View model action]
forall a b. (a -> b) -> a -> b
$ Point num -> Point num -> Line num
forall num. Point num -> Point num -> Line num
Line Point num
p ((num -> num) -> (num -> num) -> Point num -> Point num
forall num. (num -> num) -> (num -> num) -> Point num -> Point num
offsetPoint num -> num
forall a. a -> a
id (num -> num -> num
forall a. Num a => a -> a -> a
+ num
5) Point num
p)
                , [Attribute action] -> Text num -> [View model action]
forall action model.
[Attribute action] -> Text num -> [View model action]
forall s num action model.
ToSVG s num =>
[Attribute action] -> s -> [View model action]
toSVG
                    [MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.dominantBaseline_ MisoString
"hanging"]
                    Text
                        { position :: Point num
position = (num -> num) -> (num -> num) -> Point num -> Point num
forall num. (num -> num) -> (num -> num) -> Point num -> Point num
offsetPoint num -> num
forall a. a -> a
id (num -> num -> num
forall a. Num a => a -> a -> a
+ num
8) Point num
p
                        , anchor :: TextAnchor
anchor = TextAnchor
Middle
                        , content :: MisoString
content = Axis num
xAxis.renderTick num
x
                        }
                ]
              where
                p :: Point num
p = Point num -> Point num
forall s. Shape s num => s -> s
inViewBox Point{num
x :: num
x :: num
x, y :: num
y = Point num
topLeft.y}

            mkTickY :: num -> [[View model action]]
mkTickY num
y =
                [ Line num -> [View model action]
forall s. ToSVG s num => s -> [View model action]
mkLine (Line num -> [View model action])
-> Line num -> [View model action]
forall a b. (a -> b) -> a -> b
$ Point num -> Point num -> Line num
forall num. Point num -> Point num -> Line num
Line ((num -> num) -> (num -> num) -> Point num -> Point num
forall num. (num -> num) -> (num -> num) -> Point num -> Point num
offsetPoint (num -> num -> num
forall a. Num a => a -> a -> a
subtract num
5) num -> num
forall a. a -> a
id Point num
p) Point num
p
                , [Attribute action] -> Text num -> [View model action]
forall action model.
[Attribute action] -> Text num -> [View model action]
forall s num action model.
ToSVG s num =>
[Attribute action] -> s -> [View model action]
toSVG
                    [MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.dominantBaseline_ MisoString
"middle"]
                    Text
                        { position :: Point num
position = (num -> num) -> (num -> num) -> Point num -> Point num
forall num. (num -> num) -> (num -> num) -> Point num -> Point num
offsetPoint (num -> num -> num
forall a. Num a => a -> a -> a
subtract num
8) num -> num
forall a. a -> a
id Point num
p
                        , anchor :: TextAnchor
anchor = TextAnchor
End
                        , content :: MisoString
content = Axis num
yAxis.renderTick num
y
                        }
                ]
              where
                p :: Point num
p = Point num -> Point num
forall s. Shape s num => s -> s
inViewBox Point{x :: num
x = Point num
topLeft.x, num
y :: num
y :: num
y}

        isBarPlot :: PlotType num -> Bool
        isBarPlot :: PlotType num -> Bool
isBarPlot BarPlot{} = Bool
True
        isBarPlot PlotType num
_ = Bool
False

        barPlotSeries :: [Series num]
        barPlotSeries :: [Series num]
barPlotSeries = (Series num -> Bool) -> [Series num] -> [Series num]
forall a. (a -> Bool) -> [a] -> [a]
filter (PlotType num -> Bool
isBarPlot (PlotType num -> Bool)
-> (Series num -> PlotType num) -> Series num -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Series num -> PlotType num
forall num. Series num -> PlotType num
plotType) [Series num]
series

        barPlotWidth :: PlotType num -> num
        barPlotWidth :: PlotType num -> num
barPlotWidth BarPlot{num
barWidth :: forall num. PlotType num -> num
barWidth :: num
barWidth} = num
barWidth
        barPlotWidth PlotType num
_ = num
0

        totalBarPlotWidth :: num
        totalBarPlotWidth :: num
totalBarPlotWidth = [num] -> num
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([num] -> num) -> [num] -> num
forall a b. (a -> b) -> a -> b
$ PlotType num -> num
barPlotWidth (PlotType num -> num)
-> (Series num -> PlotType num) -> Series num -> num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Series num -> PlotType num
forall num. Series num -> PlotType num
plotType (Series num -> num) -> [Series num] -> [num]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Series num]
barPlotSeries

        plotElements :: [View model action]
        plotElements :: [View model action]
plotElements =
            [[View model action]] -> [View model action]
forall a. Monoid a => [a] -> a
mconcat
                [ ((Series num, Rect num) -> [View model action])
-> [(Series num, Rect num)] -> [View model action]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Series num -> Rect num -> [View model action])
-> (Series num, Rect num) -> [View model action]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Series num -> Rect num -> [View model action]
renderLinePlot)
                    ([(Series num, Rect num)] -> [View model action])
-> ([(Series num, Rect num)] -> [(Series num, Rect num)])
-> [(Series num, Rect num)]
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Series num, Rect num) -> Bool)
-> [(Series num, Rect num)] -> [(Series num, Rect num)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Series num, Rect num) -> Bool)
-> (Series num, Rect num)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PlotType num -> Bool
isBarPlot (PlotType num -> Bool)
-> ((Series num, Rect num) -> PlotType num)
-> (Series num, Rect num)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Series num -> PlotType num
forall num. Series num -> PlotType num
plotType (Series num -> PlotType num)
-> ((Series num, Rect num) -> Series num)
-> (Series num, Rect num)
-> PlotType num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Series num, Rect num) -> Series num
forall a b. (a, b) -> a
fst)
                    ([(Series num, Rect num)] -> [View model action])
-> [(Series num, Rect num)] -> [View model action]
forall a b. (a -> b) -> a -> b
$ [Series num] -> [Rect num] -> [(Series num, Rect num)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Series num]
series [Rect num]
seriesBoundingBoxes
                , let widths :: [num]
widths = (num -> num -> num) -> num -> [num] -> [num]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
List.scanl' num -> num -> num
forall a. Num a => a -> a -> a
(+) num
0 ([num] -> [num]) -> [num] -> [num]
forall a b. (a -> b) -> a -> b
$ PlotType num -> num
barPlotWidth (PlotType num -> num)
-> (Series num -> PlotType num) -> Series num -> num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Series num -> PlotType num
forall num. Series num -> PlotType num
plotType (Series num -> num) -> [Series num] -> [num]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Series num]
barPlotSeries
                   in ((num, Series num) -> [View model action])
-> [(num, Series num)] -> [View model action]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((num -> Series num -> [View model action])
-> (num, Series num) -> [View model action]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry num -> Series num -> [View model action]
renderBarPlot) ([(num, Series num)] -> [View model action])
-> [(num, Series num)] -> [View model action]
forall a b. (a -> b) -> a -> b
$ [num] -> [Series num] -> [(num, Series num)]
forall a b. [a] -> [b] -> [(a, b)]
zip [num]
widths [Series num]
barPlotSeries
                ]

        renderLinePlot :: Series num -> Rect num -> [View model action]
        renderLinePlot :: Series num -> Rect num -> [View model action]
renderLinePlot Series{Maybe (Color (Alpha OKLCH) Micro)
Vector (Point num)
PlotType num
strokeColour :: forall num. Series num -> Maybe (Color (Alpha OKLCH) Micro)
fillColour :: forall num. Series num -> Maybe (Color (Alpha OKLCH) Micro)
values :: forall num. Series num -> Vector (Point num)
plotType :: forall num. Series num -> PlotType num
strokeColour :: Maybe (Color (Alpha OKLCH) Micro)
fillColour :: Maybe (Color (Alpha OKLCH) Micro)
values :: Vector (Point num)
plotType :: PlotType num
..} Rect{Point num
topLeft :: forall num. Rect num -> Point num
bottomRight :: forall num. Rect num -> Point num
topLeft :: Point num
bottomRight :: Point num
..} =
            [[View model action]] -> [View model action]
forall a. Monoid a => [a] -> a
mconcat
                ([[View model action]] -> [View model action])
-> ([Maybe [View model action]] -> [[View model action]])
-> [Maybe [View model action]]
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Maybe [View model action]] -> [[View model action]]
forall a. [Maybe a] -> [a]
catMaybes
                ([Maybe [View model action]] -> [View model action])
-> [Maybe [View model action]] -> [View model action]
forall a b. (a -> b) -> a -> b
$ [ Color (Alpha OKLCH) Micro -> [View model action]
line (Color (Alpha OKLCH) Micro -> [View model action])
-> Maybe (Color (Alpha OKLCH) Micro) -> Maybe [View model action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Color (Alpha OKLCH) Micro)
strokeColour
                  , Color (Alpha OKLCH) Micro -> [View model action]
area (Color (Alpha OKLCH) Micro -> [View model action])
-> Maybe (Color (Alpha OKLCH) Micro) -> Maybe [View model action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Color (Alpha OKLCH) Micro)
fillColour
                  ]
          where
            bottomRight' :: Point num
bottomRight' = Point num
bottomRight{y = domain.topLeft.y}
            bottomLeft' :: Point num
bottomLeft' = Point num
bottomRight'{x = topLeft.x}
            line :: Color (Alpha OKLCH) Micro -> [View model action]
line Color (Alpha OKLCH) Micro
colour =
                [Attribute action] -> Polyline num -> [View model action]
forall action model.
[Attribute action] -> Polyline num -> [View model action]
forall s num action model.
ToSVG s num =>
[Attribute action] -> s -> [View model action]
toSVG
                    [ MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.fill_ MisoString
"none"
                    , MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.stroke_ (MisoString -> Attribute action) -> MisoString -> Attribute action
forall a b. (a -> b) -> a -> b
$ Color (Alpha OKLCH) Micro -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString Color (Alpha OKLCH) Micro
colour
                    , MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.strokeLinecap_ MisoString
"round"
                    , MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.strokeWidth_ MisoString
"2"
                    ]
                    (Polyline num -> [View model action])
-> (Polyline num -> Polyline num)
-> Polyline num
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rect num -> Rect num -> Polyline num -> Polyline num
forall s num.
(Shape s num, Eq num, Fractional num) =>
Rect num -> Rect num -> s -> s
translateDomain Rect num
paddedViewBox Rect num
domain
                    (Polyline num -> [View model action])
-> Polyline num -> [View model action]
forall a b. (a -> b) -> a -> b
$ Polyline{points :: [Point num]
points = Vector (Point num) -> [Point num]
forall a. Vector a -> [a]
Vector.toList Vector (Point num)
values}
            area :: Color (Alpha OKLCH) Micro -> [View model action]
area Color (Alpha OKLCH) Micro
colour =
                [Attribute action] -> Polygon num -> [View model action]
forall action model.
[Attribute action] -> Polygon num -> [View model action]
forall s num action model.
ToSVG s num =>
[Attribute action] -> s -> [View model action]
toSVG
                    [ MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.fill_ (MisoString -> Attribute action) -> MisoString -> Attribute action
forall a b. (a -> b) -> a -> b
$ Color (Alpha OKLCH) Micro -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString Color (Alpha OKLCH) Micro
colour
                    , MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.stroke_ MisoString
"none"
                    ]
                    (Polygon num -> [View model action])
-> (Polygon num -> Polygon num)
-> Polygon num
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rect num -> Rect num -> Polygon num -> Polygon num
forall s num.
(Shape s num, Eq num, Fractional num) =>
Rect num -> Rect num -> s -> s
translateDomain Rect num
paddedViewBox Rect num
domain
                    (Polygon num -> [View model action])
-> Polygon num -> [View model action]
forall a b. (a -> b) -> a -> b
$ Polygon{points :: [Point num]
points = Point num
bottomRight' Point num -> [Point num] -> [Point num]
forall a. a -> [a] -> [a]
: Point num
bottomLeft' Point num -> [Point num] -> [Point num]
forall a. a -> [a] -> [a]
: Vector (Point num) -> [Point num]
forall a. Vector a -> [a]
Vector.toList Vector (Point num)
values}

        renderBarPlot :: num -> Series num -> [View model action]
        renderBarPlot :: num -> Series num -> [View model action]
renderBarPlot num
leftOffset Series{Maybe (Color (Alpha OKLCH) Micro)
Vector (Point num)
PlotType num
strokeColour :: forall num. Series num -> Maybe (Color (Alpha OKLCH) Micro)
fillColour :: forall num. Series num -> Maybe (Color (Alpha OKLCH) Micro)
values :: forall num. Series num -> Vector (Point num)
plotType :: forall num. Series num -> PlotType num
strokeColour :: Maybe (Color (Alpha OKLCH) Micro)
fillColour :: Maybe (Color (Alpha OKLCH) Micro)
values :: Vector (Point num)
plotType :: PlotType num
..} =
            ((Point num -> [View model action])
 -> Vector (Point num) -> [View model action])
-> Vector (Point num)
-> (Point num -> [View model action])
-> [View model action]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Point num -> [View model action])
-> Vector (Point num) -> [View model action]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Vector (Point num)
values \Point{num
x :: forall num. Point num -> num
y :: forall num. Point num -> num
x :: num
y :: num
..} ->
                let
                    l :: num
l = num
x num -> num -> num
forall a. Num a => a -> a -> a
+ num
leftOffset num -> num -> num
forall a. Num a => a -> a -> a
- num
totalBarPlotWidth num -> num -> num
forall a. Fractional a => a -> a -> a
/ num
2
                    r :: num
r = num
l num -> num -> num
forall a. Num a => a -> a -> a
+ PlotType num -> num
barPlotWidth PlotType num
plotType
                 in
                    [Attribute action] -> Rect num -> [View model action]
forall action model.
[Attribute action] -> Rect num -> [View model action]
forall s num action model.
ToSVG s num =>
[Attribute action] -> s -> [View model action]
toSVG
                        [ MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.fill_ (MisoString -> Attribute action) -> MisoString -> Attribute action
forall a b. (a -> b) -> a -> b
$ MisoString
-> (Color (Alpha OKLCH) Micro -> MisoString)
-> Maybe (Color (Alpha OKLCH) Micro)
-> MisoString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MisoString
"none" Color (Alpha OKLCH) Micro -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString Maybe (Color (Alpha OKLCH) Micro)
fillColour
                        , MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.stroke_ (MisoString -> Attribute action) -> MisoString -> Attribute action
forall a b. (a -> b) -> a -> b
$ MisoString
-> (Color (Alpha OKLCH) Micro -> MisoString)
-> Maybe (Color (Alpha OKLCH) Micro)
-> MisoString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MisoString
"none" Color (Alpha OKLCH) Micro -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString Maybe (Color (Alpha OKLCH) Micro)
strokeColour
                        ]
                        (Rect num -> [View model action])
-> (Rect num -> Rect num) -> Rect num -> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rect num -> Rect num -> Rect num -> Rect num
forall s num.
(Shape s num, Eq num, Fractional num) =>
Rect num -> Rect num -> s -> s
translateDomain Rect num
paddedViewBox Rect num
domain
                        (Rect num -> [View model action])
-> Rect num -> [View model action]
forall a b. (a -> b) -> a -> b
$ [Point num] -> Rect num
forall (f :: * -> *) num.
(Foldable f, Functor f, Ord num) =>
f (Point num) -> Rect num
boundingBoxOfPoints1
                            [ Point{x :: num
x = num
l, num
y :: num
y :: num
y}
                            , Point{x :: num
x = num
r, y :: num
y = num
0}
                            ]

        seriesBoundingBoxes :: [Rect num]
        seriesBoundingBoxes :: [Rect num]
seriesBoundingBoxes = Vector (Point num) -> Rect num
forall s num. Shape s num => s -> Rect num
boundingBox (Vector (Point num) -> Rect num)
-> (Series num -> Vector (Point num)) -> Series num -> Rect num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Series num -> Vector (Point num)
forall num. Series num -> Vector (Point num)
values (Series num -> Rect num) -> [Series num] -> [Rect num]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Series num]
series

        domain :: Rect num
        domain :: Rect num
domain = Rect num -> Rect num
swapY (Rect num -> Rect num)
-> (Rect num -> Rect num) -> Rect num -> Rect num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rect num -> Rect num
domainTransform (Rect num -> Rect num)
-> (Rect num -> Rect num) -> Rect num -> Rect num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rect num -> Rect num
swapY (Rect num -> Rect num) -> Rect num -> Rect num
forall a b. (a -> b) -> a -> b
$ [Rect num] -> Rect num
forall s num. Shape s num => s -> Rect num
boundingBox [Rect num]
seriesBoundingBoxes

        axisColour :: Micro -> MisoString
        axisColour :: Micro -> MisoString
axisColour = Color (Alpha OKLCH) Micro -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (Color (Alpha OKLCH) Micro -> MisoString)
-> (Micro -> Color (Alpha OKLCH) Micro) -> Micro -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Micro -> Micro -> Micro -> Micro -> Color (Alpha OKLCH) Micro
forall e. e -> e -> e -> e -> Color (Alpha OKLCH) e
ColorOKLCHA Micro
0.7 Micro
0 Micro
0

        hasNonBarPlots :: Bool
hasNonBarPlots = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Series num -> Bool) -> [Series num] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (PlotType num -> Bool
isBarPlot (PlotType num -> Bool)
-> (Series num -> PlotType num) -> Series num -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Series num -> PlotType num
forall num. Series num -> PlotType num
plotType) [Series num]
series

        ticksX, ticksY :: [num]
        ticksX :: [num]
ticksX =
            if Bool
hasNonBarPlots
                then (Point num -> num) -> Ticks num -> Int -> [num]
calculateTicks Point num -> num
forall num. Point num -> num
x Axis num
xAxis.ticks (Int -> [num]) -> Int -> [num]
forall a b. (a -> b) -> a -> b
$ Int
width Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100
                else
                    [num] -> [num]
forall a. Ord a => [a] -> [a]
List.sort ([num] -> [num]) -> ([num] -> [num]) -> [num] -> [num]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [num] -> [num]
forall a. Ord a => [a] -> [a]
List.nubOrd ([num] -> [num]) -> [num] -> [num]
forall a b. (a -> b) -> a -> b
$ (Series num -> [num]) -> [Series num] -> [num]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Point num -> num) -> [Point num] -> [num]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point num -> num
forall num. Point num -> num
x ([Point num] -> [num])
-> (Series num -> [Point num]) -> Series num -> [num]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Vector (Point num) -> [Point num]
forall a. Vector a -> [a]
Vector.toList (Vector (Point num) -> [Point num])
-> (Series num -> Vector (Point num)) -> Series num -> [Point num]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Series num -> Vector (Point num)
forall num. Series num -> Vector (Point num)
values) [Series num]
series
        ticksY :: [num]
ticksY = (Point num -> num) -> Ticks num -> Int -> [num]
calculateTicks Point num -> num
forall num. Point num -> num
y Axis num
yAxis.ticks (Int -> [num]) -> Int -> [num]
forall a b. (a -> b) -> a -> b
$ Int
height Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
80

        calculateTicks :: (Point num -> num) -> Ticks num -> Int -> [num]
        calculateTicks :: (Point num -> num) -> Ticks num -> Int -> [num]
calculateTicks Point num -> num
dim Ticks num
ticks Int
targetCount =
            case Ticks num
ticks of
                Custom [num]
ts -> (num -> Bool) -> [num] -> [num]
forall a. (a -> Bool) -> [a] -> [a]
filter (\num
v -> num
v num -> num -> Bool
forall a. Ord a => a -> a -> Bool
>= num
dMin Bool -> Bool -> Bool
&& num
v num -> num -> Bool
forall a. Ord a => a -> a -> Bool
<= num
dMax) [num]
ts
                Ticks num
Numeric -> [num]
numericTicks
                Ticks num
Time -> [num]
timeTicks
          where
            (num
dMin, num
dMax) = (Point num -> num) -> Rect num -> (num, num)
minMax Point num -> num
dim Rect num
domain
            range :: num
range = num
dMax num -> num -> num
forall a. Num a => a -> a -> a
- num
dMin

            numericTicks :: [num]
numericTicks =
                if num
range num -> num -> Bool
forall a. Eq a => a -> a -> Bool
== num
0
                    then [num]
forall a. Monoid a => a
mempty
                    else (num
niceStep num -> num -> num
forall a. Num a => a -> a -> a
*) (num -> num) -> (Int -> num) -> Int -> num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> num
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> num) -> [Int] -> [num]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
startIdx .. Int
endIdx]
              where
                roughStep :: num
roughStep = num
range num -> num -> num
forall a. Fractional a => a -> a -> a
/ Int -> num
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
targetCount)

                e :: Int
e = forall a b. (RealFrac a, Integral b) => a -> b
floor @Double @Int (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
10 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ num -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac num
roughStep)
                e10 :: num
e10 = num -> num -> num
forall a. Ord a => a -> a -> a
max num
1 (num -> num) -> num -> num
forall a b. (a -> b) -> a -> b
$ num
10 num -> Int -> num
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ Int
e
                fraction :: num
fraction = num
roughStep num -> num -> num
forall a. Fractional a => a -> a -> a
/ num
e10

                niceFraction :: num
niceFraction
                    | num
fraction num -> num -> Bool
forall a. Ord a => a -> a -> Bool
< num
1.5 = num
1
                    | num
fraction num -> num -> Bool
forall a. Ord a => a -> a -> Bool
< num
3.5 = num
2
                    | num
fraction num -> num -> Bool
forall a. Ord a => a -> a -> Bool
< num
7.5 = num
5
                    | Bool
otherwise = num
10

                niceStep :: num
niceStep = num
niceFraction num -> num -> num
forall a. Num a => a -> a -> a
* num
e10

                startIdx, endIdx :: Int
                startIdx :: Int
startIdx = num -> Int
forall b. Integral b => num -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (num -> Int) -> num -> Int
forall a b. (a -> b) -> a -> b
$ num
dMin num -> num -> num
forall a. Fractional a => a -> a -> a
/ num
niceStep
                endIdx :: Int
endIdx = num -> Int
forall b. Integral b => num -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (num -> Int) -> num -> Int
forall a b. (a -> b) -> a -> b
$ num
dMax num -> num -> num
forall a. Fractional a => a -> a -> a
/ num
niceStep

            timeTicks :: [num]
timeTicks = (num
niceStep num -> num -> num
forall a. Num a => a -> a -> a
*) (num -> num) -> (Int -> num) -> Int -> num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> num
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> num) -> [Int] -> [num]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
startIdx .. Int
endIdx]
              where
                second, minute, hour, day :: num
                second :: num
second = num
1
                minute :: num
minute = num
60 num -> num -> num
forall a. Num a => a -> a -> a
* num
second
                hour :: num
hour = num
60 num -> num -> num
forall a. Num a => a -> a -> a
* num
minute
                day :: num
day = num
24 num -> num -> num
forall a. Num a => a -> a -> a
* num
hour
                week :: num
week = num
7 num -> num -> num
forall a. Num a => a -> a -> a
* num
day
                year :: num
year = num
365.25 num -> num -> num
forall a. Num a => a -> a -> a
* num
day

                possibleSteps :: [num]
possibleSteps =
                    [[num]] -> [num]
forall a. Monoid a => [a] -> a
mconcat
                        [ [num
1, num
2, num
5, num
10, num
15, num
30]
                        , (num
minute num -> num -> num
forall a. Num a => a -> a -> a
*) (num -> num) -> [num] -> [num]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [num
1, num
2, num
5, num
10, num
15, num
30]
                        , (num
hour num -> num -> num
forall a. Num a => a -> a -> a
*) (num -> num) -> [num] -> [num]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [num
1, num
2, num
3, num
4, num
6, num
8, num
12]
                        , (num
day num -> num -> num
forall a. Num a => a -> a -> a
*) (num -> num) -> [num] -> [num]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [num
1, num
2, num
5]
                        , (num
week num -> num -> num
forall a. Num a => a -> a -> a
*) (num -> num) -> [num] -> [num]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [num
1, num
2, num
4, num
8, num
12]
                        , [num
year]
                        ]

                niceStep :: num
niceStep =
                    (num -> num) -> [num] -> num
forall b a. (Partial, Ord b) => (a -> b) -> [a] -> a
List.minimumOn
                        (\num
step -> num -> num
forall a. Num a => a -> a
abs (num -> num) -> num -> num
forall a b. (a -> b) -> a -> b
$ num
range num -> num -> num
forall a. Fractional a => a -> a -> a
/ num
step num -> num -> num
forall a. Num a => a -> a -> a
- Int -> num
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
targetCount)
                        [num]
possibleSteps

                startIdx, endIdx :: Int
                startIdx :: Int
startIdx = num -> Int
forall b. Integral b => num -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (num -> Int) -> num -> Int
forall a b. (a -> b) -> a -> b
$ num
dMin num -> num -> num
forall a. Fractional a => a -> a -> a
/ num
niceStep
                endIdx :: Int
endIdx = num -> Int
forall b. Integral b => num -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (num -> Int) -> num -> Int
forall a b. (a -> b) -> a -> b
$ num
dMax num -> num -> num
forall a. Fractional a => a -> a -> a
/ num
niceStep

        minMax :: (Point num -> num) -> Rect num -> (num, num)
        minMax :: (Point num -> num) -> Rect num -> (num, num)
minMax Point num -> num
dim Rect num
rect = (Point num -> num
dim (Point num -> num) -> (Rect num -> Point num) -> Rect num -> num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rect num -> Point num
forall num. Rect num -> Point num
topLeft (Rect num -> num) -> Rect num -> num
forall a b. (a -> b) -> a -> b
$ Rect num
rect, Point num -> num
dim (Point num -> num) -> (Rect num -> Point num) -> Rect num -> num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rect num -> Point num
forall num. Rect num -> Point num
bottomRight (Rect num -> num) -> Rect num -> num
forall a b. (a -> b) -> a -> b
$ Rect num
rect)

    style :: Css
style =
        Selector
".plot" Selector -> Css -> Css
? do
            Position -> Css
Clay.position Position
Clay.relative
            Selector
"text" Selector -> Css -> Css
? do
                Key MisoString
"fill" Key MisoString -> MisoString -> Css
-: MisoString
"currentColor"
                UserSelect -> Css
Clay.userSelect UserSelect
forall a. None a => a
Clay.none
                Number -> Css
Clay.opacity Number
0.75
                Size LengthUnit -> Css
forall a. Size a -> Css
Clay.fontSize (Size LengthUnit -> Css) -> Size LengthUnit -> Css
forall a b. (a -> b) -> a -> b
$ Number -> Size LengthUnit
em Number
0.8
            Selector
".spinner" Selector -> Css -> Css
? do
                Key MisoString
"transform" Key MisoString -> MisoString -> Css
-: MisoString
"translateX(50%) translateY(50%)"
            Selector -> Refinement
has Selector
".spinner"
                Refinement -> Css -> Css
Clay.& (Selector
self Selector -> Selector -> Selector
|> (Selector
self Selector -> Refinement -> Selector
# Refinement -> Refinement
forall a. Not a => a -> Refinement
Clay.not (MisoString -> Refinement
byClass MisoString
"spinner")))
                Selector -> Css -> Css
? Number -> Css
opacity Number
0.25