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

module Dashi.Components.Plot where

import Clay
    ( alignItems
    , borderColor
    , borderStyle
    , borderWidth
    , byClass
    , center
    , display
    , em
    , flex
    , flexDirection
    , li
    , listStyleType
    , nil
    , none
    , opacity
    , relative
    , row
    , solid
    , transparent
    , (#)
    , (-:)
    , (?)
    , (|>)
    )
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.Tokens
import Dashi.Style.Util
import Data.Function ((&))
import Data.Functor (($>))
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.CSS (styleInline_)
import Miso.Html (ul_)
import Miso.Html.Element (div_, li_)
import Miso.Html.Property (class_)
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 -> MisoString
label :: MisoString
    , 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
    , forall num. Plot num -> Bool
showLegend :: Bool
    }

instance (RealFrac num, ToMisoString num) => Widget (Plot num) model action where
    widget' :: [Attribute action] -> Plot num -> View model action
widget' [Attribute action]
attrs Plot{Bool
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
showLegend :: forall num. Plot num -> Bool
width :: Int
height :: Int
padding :: Maybe (Padding num)
domainTransform :: Rect num -> Rect num
series :: [Series num]
xAxis :: Axis num
yAxis :: Axis num
showLegend :: Bool
..} =
        [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
div_
            [MisoString -> Attribute action
forall action. MisoString -> Attribute action
class_ MisoString
"plot-wrapper"]
            ([View model action] -> View model action)
-> [View model action] -> View model action
forall a b. (a -> b) -> a -> b
$ ( [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]
                      ]
              )
            View model action -> [View model action] -> [View model action]
forall a. a -> [a] -> [a]
: [[View model action]] -> [View model action]
forall a. Monoid a => [a] -> a
mconcat
                [ [ [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
ul_
                        [MisoString -> Attribute action
forall action. MisoString -> Attribute action
class_ MisoString
"legend"]
                        [ [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
li_
                            []
                            [ [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
div_
                                [ MisoString -> Attribute action
forall action. MisoString -> Attribute action
class_ MisoString
"key"
                                , MisoString -> Attribute action
forall action. MisoString -> Attribute action
styleInline_
                                    (MisoString -> Attribute action)
-> ([Maybe MisoString] -> MisoString)
-> [Maybe MisoString]
-> Attribute 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
. MisoString -> [MisoString] -> MisoString
MisoString.intercalate MisoString
";"
                                    ([MisoString] -> MisoString)
-> ([Maybe MisoString] -> [MisoString])
-> [Maybe MisoString]
-> 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
. [Maybe MisoString] -> [MisoString]
forall a. [Maybe a] -> [a]
catMaybes
                                    ([Maybe MisoString] -> Attribute action)
-> [Maybe MisoString] -> Attribute action
forall a b. (a -> b) -> a -> b
$ [ (MisoString
"background-color:" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<>) (MisoString -> MisoString)
-> (Color (Alpha OKLCH) Micro -> MisoString)
-> Color (Alpha OKLCH) 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
. Color (Alpha OKLCH) Micro -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (Color (Alpha OKLCH) Micro -> MisoString)
-> Maybe (Color (Alpha OKLCH) Micro) -> Maybe MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Color (Alpha OKLCH) Micro)
fillColour
                                      , (MisoString
"border-color:" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<>) (MisoString -> MisoString)
-> (Color (Alpha OKLCH) Micro -> MisoString)
-> Color (Alpha OKLCH) 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
. Color (Alpha OKLCH) Micro -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (Color (Alpha OKLCH) Micro -> MisoString)
-> Maybe (Color (Alpha OKLCH) Micro) -> Maybe MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Color (Alpha OKLCH) Micro)
strokeColour
                                      , Maybe (Color (Alpha OKLCH) Micro)
fillColour Maybe (Color (Alpha OKLCH) Micro) -> MisoString -> Maybe MisoString
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MisoString
"aspect-ratio:1"
                                      ]
                                ]
                                []
                            , MisoString -> View model action
forall model action. MisoString -> View model action
text MisoString
label
                            ]
                        | Series{Maybe (Color (Alpha OKLCH) Micro)
MisoString
Vector (Point num)
PlotType num
label :: forall num. Series num -> MisoString
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
fillColour :: Maybe (Color (Alpha OKLCH) Micro)
strokeColour :: Maybe (Color (Alpha OKLCH) Micro)
label :: MisoString
values :: Vector (Point num)
plotType :: PlotType num
..} <- [Series num]
series
                        ]
                  | Bool
showLegend
                  ]
                ]
      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)
MisoString
Vector (Point num)
PlotType num
label :: forall num. Series num -> MisoString
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
label :: MisoString
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)
MisoString
Vector (Point num)
PlotType num
label :: forall num. Series num -> MisoString
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
label :: MisoString
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 = do
        Selector
".plot-wrapper" Selector -> Css -> Css
? do
            Selector
".legend" Selector -> Css -> Css
? do
                Size LengthUnit -> Size LengthUnit -> Css
forall a. Size a -> Size a -> Css
marginYX (Space -> ValueType Space
forall t.
(Token t, Val (ValueType t), Other (ValueType t)) =>
t -> ValueType t
token (Space -> ValueType Space) -> Space -> ValueType Space
forall a b. (a -> b) -> a -> b
$ SizeToken -> Space
Space SizeToken
Medium) Size LengthUnit
forall a. Size a
nil
                Display -> Css
display Display
flex
                FlexDirection -> Css
flexDirection FlexDirection
row
                SizeToken -> Css
gap' SizeToken
Medium
                ListStyleType -> Css
listStyleType ListStyleType
forall a. None a => a
none
                Selector
li Selector -> Css -> Css
? do
                    Display -> Css
display Display
flex
                    FlexDirection -> Css
flexDirection FlexDirection
row
                    SizeToken -> Css
gap' SizeToken
XSmall
                    AlignItemsValue -> Css
alignItems AlignItemsValue
forall a. Center a => a
center
                Selector
".key" Selector -> Css -> Css
? do
                    Size LengthUnit -> Css
forall a. Size a -> Css
Clay.width (Size LengthUnit -> Css)
-> (Space -> Size LengthUnit) -> Space -> Css
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
. Space -> Size LengthUnit
Space -> ValueType Space
forall t.
(Token t, Val (ValueType t), Other (ValueType t)) =>
t -> ValueType t
token (Space -> Css) -> Space -> Css
forall a b. (a -> b) -> a -> b
$ SizeToken -> Space
Space SizeToken
Medium
                    Color -> Css
borderColor Color
transparent
                    Size LengthUnit -> Css
borderWidth (Size LengthUnit -> Css) -> Size LengthUnit -> Css
forall a b. (a -> b) -> a -> b
$ Number -> Size LengthUnit
em Number
0.15
                    Stroke -> Css
borderStyle Stroke
solid
                    Position -> Css
Clay.position Position
relative
                    Size LengthUnit -> Css
forall a. Size a -> Css
Clay.top (Size LengthUnit -> Css)
-> (Number -> Size LengthUnit) -> Number -> Css
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
. Number -> Size LengthUnit
em (Number -> Css) -> Number -> Css
forall a b. (a -> b) -> a -> b
$ -Number
0.05
        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