{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RebindableSyntax #-}

-- | Base 'Chart' and 'ChartTree' types and support
module Chart.Primitive
  ( -- * Charts
    Chart (..),
    ChartData (..),
    rectData',
    lineData',
    glyphData',
    textData',
    pathData',
    blankData',
    pattern RectChart,
    pattern LineChart,
    pattern GlyphChart,
    pattern TextChart,
    pattern PathChart,
    pattern BlankChart,
    pattern LineChart1,
    blankChart1,
    ChartTree (..),
    tree',
    chart',
    charts',
    named,
    unnamed,
    renamed,
    rename,
    blank,
    group,
    filterChartTree,
    Orientation (..),
    Stacked (..),
    ChartAspect (..),

    -- * Boxes
    -- $boxes
    box,
    sbox,
    projectWith,
    projectChartDataWith,
    moveChartData,
    moveChart,
    scaleChart,
    scaleChartData,
    colourStyle,
    projectChartTree,
    boxes,
    box',
    styleBoxes,
    styleBox',
    safeBox',
    safeStyleBox',

    -- * Combinators
    vert,
    hori,
    stack,
    besideChart,
    frameChart,
    isEmptyChart,
    padChart,
    rectangularize,
    glyphize,

    -- * Relative position
    Align (..),
    Place (..),
    flipPlace,
    beside,
  )
where

import Chart.Data
import Chart.Style
import Data.Bifunctor
import Data.Bool
import Data.Colour
import Data.Foldable
import Data.Maybe
import Data.Path
import Data.Text (Text)
import Data.Tree
import GHC.Generics
import NumHask.Prelude
import NumHask.Space
import Optics.Core

-- $setup
--
-- >>> :m -Prelude
-- >>> :set -XOverloadedLabels
-- >>> :set -XOverloadedStrings
-- >>> import Chart
-- >>> import Optics.Core
-- >>> import NumHask.Prelude
-- >>> let r = RectChart defaultRectStyle [one]

-- | A product type consisting of a 'Style', which is the stylistic manifestation of chart data, and 'ChartData' representing where data is located on the chart canvas (an xy-plane).
--
-- A simple example is:
--
-- >>> Chart defaultRectStyle (RectData [one])
-- Chart {chartStyle = Style {size = 6.0e-2, borderSize = 1.0e-2, color = Colour 0.02 0.73 0.80 0.10, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, textAnchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}, chartData = RectData [Rect (-0.5) 0.5 (-0.5) 0.5]}
--
-- Using the defaults, this chart is rendered as:
--
-- > writeChartOptions "other/unit.hs" $ mempty & #hudOptions .~ defaultHudOptions & #chartTree .~ unnamed [r]
--
-- ![unit example](other/unit.svg)
data Chart = Chart {Chart -> Style
chartStyle :: Style, Chart -> ChartData
chartData :: ChartData} deriving (Chart -> Chart -> Bool
(Chart -> Chart -> Bool) -> (Chart -> Chart -> Bool) -> Eq Chart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Chart -> Chart -> Bool
== :: Chart -> Chart -> Bool
$c/= :: Chart -> Chart -> Bool
/= :: Chart -> Chart -> Bool
Eq, Int -> Chart -> ShowS
[Chart] -> ShowS
Chart -> String
(Int -> Chart -> ShowS)
-> (Chart -> String) -> ([Chart] -> ShowS) -> Show Chart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Chart -> ShowS
showsPrec :: Int -> Chart -> ShowS
$cshow :: Chart -> String
show :: Chart -> String
$cshowList :: [Chart] -> ShowS
showList :: [Chart] -> ShowS
Show, (forall x. Chart -> Rep Chart x)
-> (forall x. Rep Chart x -> Chart) -> Generic Chart
forall x. Rep Chart x -> Chart
forall x. Chart -> Rep Chart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Chart -> Rep Chart x
from :: forall x. Chart -> Rep Chart x
$cto :: forall x. Rep Chart x -> Chart
to :: forall x. Rep Chart x -> Chart
Generic)

-- | Data of a 'Chart'
--
-- A sum type representing the data behind six different types of chart:
--
-- - 'RectData': a list of rectangles in the XY-domain. For example, a @'Rect' 0 1 0 1@ is the set of points on the XY Plane bounded by (0,0), (0,1), (1,0) & (1,1). Much of the library is built on 'Rect' Doubles.
-- - 'LineData': a list of (list of points) which represent connected straight lines. ['Point' 0 0, 'Point' 1 1, 'Point' 2 2, 'Point' 3 3] is an example; three lines connected up to form a line from (0,0) to (3,3).
-- - 'GlyphData': a list of points to draw a 'GlyphShape'.
-- - 'TextData': A list of Text,Point tuples representing text centered at a 'Point' in XY space.
-- - 'PathData': specification of curvilinear paths using the SVG standards.
-- - 'BlankData': a rectangular space that has no visual representation.
data ChartData
  = -- | List of rectangles
    RectData [Rect Double]
  | -- | List of (List of Points)
    LineData [[Point Double]]
  | -- | List of Points (to place the 'GlyphShape')
    GlyphData [Point Double]
  | -- | List of text and point to place it.
    TextData [(Text, Point Double)]
  | -- | List of paths
    PathData [PathData Double]
  | -- | List of rectangles with no 'Style' representation
    BlankData [Rect Double]
  deriving (ChartData -> ChartData -> Bool
(ChartData -> ChartData -> Bool)
-> (ChartData -> ChartData -> Bool) -> Eq ChartData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChartData -> ChartData -> Bool
== :: ChartData -> ChartData -> Bool
$c/= :: ChartData -> ChartData -> Bool
/= :: ChartData -> ChartData -> Bool
Eq, Int -> ChartData -> ShowS
[ChartData] -> ShowS
ChartData -> String
(Int -> ChartData -> ShowS)
-> (ChartData -> String)
-> ([ChartData] -> ShowS)
-> Show ChartData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChartData -> ShowS
showsPrec :: Int -> ChartData -> ShowS
$cshow :: ChartData -> String
show :: ChartData -> String
$cshowList :: [ChartData] -> ShowS
showList :: [ChartData] -> ShowS
Show, (forall x. ChartData -> Rep ChartData x)
-> (forall x. Rep ChartData x -> ChartData) -> Generic ChartData
forall x. Rep ChartData x -> ChartData
forall x. ChartData -> Rep ChartData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChartData -> Rep ChartData x
from :: forall x. ChartData -> Rep ChartData x
$cto :: forall x. Rep ChartData x -> ChartData
to :: forall x. Rep ChartData x -> ChartData
Generic)

-- | RectData partial lens
rectData' :: Lens' ChartData (Maybe [Rect Double])
rectData' :: Lens' ChartData (Maybe [Rect Double])
rectData' =
  (ChartData -> Maybe [Rect Double])
-> (ChartData -> Maybe [Rect Double] -> ChartData)
-> Lens' ChartData (Maybe [Rect Double])
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChartData -> Maybe [Rect Double]
getData ChartData -> Maybe [Rect Double] -> ChartData
setData
  where
    getData :: ChartData -> Maybe [Rect Double]
getData (RectData [Rect Double]
xs) = [Rect Double] -> Maybe [Rect Double]
forall a. a -> Maybe a
Just [Rect Double]
xs
    getData ChartData
_ = Maybe [Rect Double]
forall a. Maybe a
Nothing
    setData :: ChartData -> Maybe [Rect Double] -> ChartData
setData (RectData [Rect Double]
_) (Just [Rect Double]
xs) = [Rect Double] -> ChartData
RectData [Rect Double]
xs
    setData ChartData
cd Maybe [Rect Double]
_ = ChartData
cd

-- | LineData partial lens
lineData' :: Lens' ChartData (Maybe [[Point Double]])
lineData' :: Lens' ChartData (Maybe [[Point Double]])
lineData' =
  (ChartData -> Maybe [[Point Double]])
-> (ChartData -> Maybe [[Point Double]] -> ChartData)
-> Lens' ChartData (Maybe [[Point Double]])
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChartData -> Maybe [[Point Double]]
getData ChartData -> Maybe [[Point Double]] -> ChartData
setData
  where
    getData :: ChartData -> Maybe [[Point Double]]
getData (LineData [[Point Double]]
xs) = [[Point Double]] -> Maybe [[Point Double]]
forall a. a -> Maybe a
Just [[Point Double]]
xs
    getData ChartData
_ = Maybe [[Point Double]]
forall a. Maybe a
Nothing
    setData :: ChartData -> Maybe [[Point Double]] -> ChartData
setData (LineData [[Point Double]]
_) (Just [[Point Double]]
xs) = [[Point Double]] -> ChartData
LineData [[Point Double]]
xs
    setData ChartData
cd Maybe [[Point Double]]
_ = ChartData
cd

-- | GlyphData partial lens
glyphData' :: Lens' ChartData (Maybe [Point Double])
glyphData' :: Lens' ChartData (Maybe [Point Double])
glyphData' =
  (ChartData -> Maybe [Point Double])
-> (ChartData -> Maybe [Point Double] -> ChartData)
-> Lens' ChartData (Maybe [Point Double])
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChartData -> Maybe [Point Double]
getData ChartData -> Maybe [Point Double] -> ChartData
setData
  where
    getData :: ChartData -> Maybe [Point Double]
getData (GlyphData [Point Double]
xs) = [Point Double] -> Maybe [Point Double]
forall a. a -> Maybe a
Just [Point Double]
xs
    getData ChartData
_ = Maybe [Point Double]
forall a. Maybe a
Nothing
    setData :: ChartData -> Maybe [Point Double] -> ChartData
setData (GlyphData [Point Double]
_) (Just [Point Double]
xs) = [Point Double] -> ChartData
GlyphData [Point Double]
xs
    setData ChartData
cd Maybe [Point Double]
_ = ChartData
cd

-- | TextData partial lens
textData' :: Lens' ChartData (Maybe [(Text, Point Double)])
textData' :: Lens' ChartData (Maybe [(Text, Point Double)])
textData' =
  (ChartData -> Maybe [(Text, Point Double)])
-> (ChartData -> Maybe [(Text, Point Double)] -> ChartData)
-> Lens' ChartData (Maybe [(Text, Point Double)])
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChartData -> Maybe [(Text, Point Double)]
getData ChartData -> Maybe [(Text, Point Double)] -> ChartData
setData
  where
    getData :: ChartData -> Maybe [(Text, Point Double)]
getData (TextData [(Text, Point Double)]
xs) = [(Text, Point Double)] -> Maybe [(Text, Point Double)]
forall a. a -> Maybe a
Just [(Text, Point Double)]
xs
    getData ChartData
_ = Maybe [(Text, Point Double)]
forall a. Maybe a
Nothing
    setData :: ChartData -> Maybe [(Text, Point Double)] -> ChartData
setData (TextData [(Text, Point Double)]
_) (Just [(Text, Point Double)]
xs) = [(Text, Point Double)] -> ChartData
TextData [(Text, Point Double)]
xs
    setData ChartData
cd Maybe [(Text, Point Double)]
_ = ChartData
cd

-- | PathData partial lens
pathData' :: Lens' ChartData (Maybe [PathData Double])
pathData' :: Lens' ChartData (Maybe [PathData Double])
pathData' =
  (ChartData -> Maybe [PathData Double])
-> (ChartData -> Maybe [PathData Double] -> ChartData)
-> Lens' ChartData (Maybe [PathData Double])
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChartData -> Maybe [PathData Double]
getData ChartData -> Maybe [PathData Double] -> ChartData
setData
  where
    getData :: ChartData -> Maybe [PathData Double]
getData (PathData [PathData Double]
xs) = [PathData Double] -> Maybe [PathData Double]
forall a. a -> Maybe a
Just [PathData Double]
xs
    getData ChartData
_ = Maybe [PathData Double]
forall a. Maybe a
Nothing
    setData :: ChartData -> Maybe [PathData Double] -> ChartData
setData (PathData [PathData Double]
_) (Just [PathData Double]
xs) = [PathData Double] -> ChartData
PathData [PathData Double]
xs
    setData ChartData
cd Maybe [PathData Double]
_ = ChartData
cd

-- | BlankData partial lens
blankData' :: Lens' ChartData (Maybe [Rect Double])
blankData' :: Lens' ChartData (Maybe [Rect Double])
blankData' =
  (ChartData -> Maybe [Rect Double])
-> (ChartData -> Maybe [Rect Double] -> ChartData)
-> Lens' ChartData (Maybe [Rect Double])
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChartData -> Maybe [Rect Double]
getData ChartData -> Maybe [Rect Double] -> ChartData
setData
  where
    getData :: ChartData -> Maybe [Rect Double]
getData (BlankData [Rect Double]
xs) = [Rect Double] -> Maybe [Rect Double]
forall a. a -> Maybe a
Just [Rect Double]
xs
    getData ChartData
_ = Maybe [Rect Double]
forall a. Maybe a
Nothing
    setData :: ChartData -> Maybe [Rect Double] -> ChartData
setData (BlankData [Rect Double]
_) (Just [Rect Double]
xs) = [Rect Double] -> ChartData
BlankData [Rect Double]
xs
    setData ChartData
cd Maybe [Rect Double]
_ = ChartData
cd

-- | pattern of a Chart with RectData
pattern RectChart :: Style -> [Rect Double] -> Chart
pattern $mRectChart :: forall {r}.
Chart -> (Style -> [Rect Double] -> r) -> ((# #) -> r) -> r
$bRectChart :: Style -> [Rect Double] -> Chart
RectChart s xs = Chart s (RectData xs)

{-# COMPLETE RectChart #-}

-- | pattern of a Chart with LineData
pattern LineChart :: Style -> [[Point Double]] -> Chart
pattern $mLineChart :: forall {r}.
Chart -> (Style -> [[Point Double]] -> r) -> ((# #) -> r) -> r
$bLineChart :: Style -> [[Point Double]] -> Chart
LineChart s xss = Chart s (LineData xss)

{-# COMPLETE LineChart #-}

-- | pattern of a Chart with a singleton LineData
pattern LineChart1 :: Style -> [Point Double] -> Chart
pattern $mLineChart1 :: forall {r}.
Chart -> (Style -> [Point Double] -> r) -> ((# #) -> r) -> r
$bLineChart1 :: Style -> [Point Double] -> Chart
LineChart1 s xs = Chart s (LineData [xs])

{-# COMPLETE LineChart1 #-}

-- | pattern of a Chart with GlyphData
pattern GlyphChart :: Style -> [Point Double] -> Chart
pattern $mGlyphChart :: forall {r}.
Chart -> (Style -> [Point Double] -> r) -> ((# #) -> r) -> r
$bGlyphChart :: Style -> [Point Double] -> Chart
GlyphChart s xs = Chart s (GlyphData xs)

{-# COMPLETE GlyphChart #-}

-- | pattern of a Chart with TextData
pattern TextChart :: Style -> [(Text, Point Double)] -> Chart
pattern $mTextChart :: forall {r}.
Chart
-> (Style -> [(Text, Point Double)] -> r) -> ((# #) -> r) -> r
$bTextChart :: Style -> [(Text, Point Double)] -> Chart
TextChart s xs = Chart s (TextData xs)

{-# COMPLETE TextChart #-}

-- | pattern of a Chart with PathData
pattern PathChart :: Style -> [PathData Double] -> Chart
pattern $mPathChart :: forall {r}.
Chart -> (Style -> [PathData Double] -> r) -> ((# #) -> r) -> r
$bPathChart :: Style -> [PathData Double] -> Chart
PathChart s xs = Chart s (PathData xs)

{-# COMPLETE PathChart #-}

-- | pattern of a Chart with BlankData
pattern BlankChart :: Style -> [Rect Double] -> Chart
pattern $mBlankChart :: forall {r}.
Chart -> (Style -> [Rect Double] -> r) -> ((# #) -> r) -> r
$bBlankChart :: Style -> [Rect Double] -> Chart
BlankChart s xs = Chart s (BlankData xs)

{-# COMPLETE BlankChart #-}

-- | Create a blank Chart with a single Rect
blankChart1 :: Rect Double -> Chart
blankChart1 :: Rect Double -> Chart
blankChart1 Rect Double
r = Style -> ChartData -> Chart
Chart Style
defaultStyle ([Rect Double] -> ChartData
BlankData [Rect Double
r])

-- | A group of charts represented by a 'Tree' of chart lists with labelled branches. The labelling is particularly useful downstream, when groupings become grouped SVG elements with classes or ids.
newtype ChartTree = ChartTree {ChartTree -> Tree (Maybe Text, [Chart])
tree :: Tree (Maybe Text, [Chart])} deriving (ChartTree -> ChartTree -> Bool
(ChartTree -> ChartTree -> Bool)
-> (ChartTree -> ChartTree -> Bool) -> Eq ChartTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChartTree -> ChartTree -> Bool
== :: ChartTree -> ChartTree -> Bool
$c/= :: ChartTree -> ChartTree -> Bool
/= :: ChartTree -> ChartTree -> Bool
Eq, Int -> ChartTree -> ShowS
[ChartTree] -> ShowS
ChartTree -> String
(Int -> ChartTree -> ShowS)
-> (ChartTree -> String)
-> ([ChartTree] -> ShowS)
-> Show ChartTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChartTree -> ShowS
showsPrec :: Int -> ChartTree -> ShowS
$cshow :: ChartTree -> String
show :: ChartTree -> String
$cshowList :: [ChartTree] -> ShowS
showList :: [ChartTree] -> ShowS
Show, (forall x. ChartTree -> Rep ChartTree x)
-> (forall x. Rep ChartTree x -> ChartTree) -> Generic ChartTree
forall x. Rep ChartTree x -> ChartTree
forall x. ChartTree -> Rep ChartTree x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChartTree -> Rep ChartTree x
from :: forall x. ChartTree -> Rep ChartTree x
$cto :: forall x. Rep ChartTree x -> ChartTree
to :: forall x. Rep ChartTree x -> ChartTree
Generic)

-- | Group a list of trees into a new tree.
group :: Maybe Text -> [ChartTree] -> ChartTree
group :: Maybe Text -> [ChartTree] -> ChartTree
group Maybe Text
name [ChartTree]
cs = Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart]) -> ChartTree
forall a b. (a -> b) -> a -> b
$ (Maybe Text, [Chart])
-> [Tree (Maybe Text, [Chart])] -> Tree (Maybe Text, [Chart])
forall a. a -> [Tree a] -> Tree a
Node (Maybe Text
name, []) (ChartTree -> Tree (Maybe Text, [Chart])
tree (ChartTree -> Tree (Maybe Text, [Chart]))
-> [ChartTree] -> [Tree (Maybe Text, [Chart])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartTree]
cs)

instance Semigroup ChartTree where
  <> :: ChartTree -> ChartTree -> ChartTree
(<>) (ChartTree x :: Tree (Maybe Text, [Chart])
x@(Node (Maybe Text
n, [Chart]
cs) [Tree (Maybe Text, [Chart])]
xs)) (ChartTree x' :: Tree (Maybe Text, [Chart])
x'@(Node (Maybe Text
n', [Chart]
cs') [Tree (Maybe Text, [Chart])]
xs')) =
    case (Maybe Text
n, Maybe Text
n') of
      (Maybe Text
Nothing, Maybe Text
Nothing) -> Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart]) -> ChartTree
forall a b. (a -> b) -> a -> b
$ (Maybe Text, [Chart])
-> [Tree (Maybe Text, [Chart])] -> Tree (Maybe Text, [Chart])
forall a. a -> [Tree a] -> Tree a
Node (Maybe Text
forall a. Maybe a
Nothing, [Chart]
cs [Chart] -> [Chart] -> [Chart]
forall a. Semigroup a => a -> a -> a
<> [Chart]
cs') ([Tree (Maybe Text, [Chart])]
xs [Tree (Maybe Text, [Chart])]
-> [Tree (Maybe Text, [Chart])] -> [Tree (Maybe Text, [Chart])]
forall a. Semigroup a => a -> a -> a
<> [Tree (Maybe Text, [Chart])]
xs')
      (Maybe Text, Maybe Text)
_ -> Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart]) -> ChartTree
forall a b. (a -> b) -> a -> b
$ (Maybe Text, [Chart])
-> [Tree (Maybe Text, [Chart])] -> Tree (Maybe Text, [Chart])
forall a. a -> [Tree a] -> Tree a
Node (Maybe Text
forall a. Maybe a
Nothing, []) [Tree (Maybe Text, [Chart])
x, Tree (Maybe Text, [Chart])
x']

instance Monoid ChartTree where
  mempty :: ChartTree
mempty = Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart]) -> ChartTree
forall a b. (a -> b) -> a -> b
$ (Maybe Text, [Chart])
-> [Tree (Maybe Text, [Chart])] -> Tree (Maybe Text, [Chart])
forall a. a -> [Tree a] -> Tree a
Node (Maybe Text
forall a. Maybe a
Nothing, []) []

-- | Apply a filter to a 'ChartTree'
filterChartTree :: (Chart -> Bool) -> ChartTree -> ChartTree
filterChartTree :: (Chart -> Bool) -> ChartTree -> ChartTree
filterChartTree Chart -> Bool
p (ChartTree (Node (Maybe Text
a, [Chart]
cs) [Tree (Maybe Text, [Chart])]
xs)) =
  Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree ((Maybe Text, [Chart])
-> [Tree (Maybe Text, [Chart])] -> Tree (Maybe Text, [Chart])
forall a. a -> [Tree a] -> Tree a
Node (Maybe Text
a, (Chart -> Maybe Chart) -> [Chart] -> [Chart]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Chart -> Maybe Chart
rem' [Chart]
cs) (ChartTree -> Tree (Maybe Text, [Chart])
tree (ChartTree -> Tree (Maybe Text, [Chart]))
-> (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart])
-> Tree (Maybe Text, [Chart])
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
. (Chart -> Bool) -> ChartTree -> ChartTree
filterChartTree Chart -> Bool
p (ChartTree -> ChartTree)
-> (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart])
-> ChartTree
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
. Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> Tree (Maybe Text, [Chart]))
-> [Tree (Maybe Text, [Chart])] -> [Tree (Maybe Text, [Chart])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree (Maybe Text, [Chart])]
xs))
  where
    rem' :: Chart -> Maybe Chart
rem' Chart
x = Maybe Chart -> Maybe Chart -> Bool -> Maybe Chart
forall a. a -> a -> Bool -> a
bool Maybe Chart
forall a. Maybe a
Nothing (Chart -> Maybe Chart
forall a. a -> Maybe a
Just Chart
x) (Chart -> Bool
p Chart
x)

-- | Lens between ChartTree and the underlying Tree representation
tree' :: Iso' ChartTree (Tree (Maybe Text, [Chart]))
tree' :: Iso' ChartTree (Tree (Maybe Text, [Chart]))
tree' = (ChartTree -> Tree (Maybe Text, [Chart]))
-> (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Iso' ChartTree (Tree (Maybe Text, [Chart]))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ChartTree -> Tree (Maybe Text, [Chart])
tree Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree

-- | A traversal of each chart list in a tree.
charts' :: Traversal' ChartTree [Chart]
charts' :: Traversal' ChartTree [Chart]
charts' = Iso' ChartTree (Tree (Maybe Text, [Chart]))
tree' Iso' ChartTree (Tree (Maybe Text, [Chart]))
-> Optic
     A_Traversal
     NoIx
     (Tree (Maybe Text, [Chart]))
     (Tree (Maybe Text, [Chart]))
     (Maybe Text, [Chart])
     (Maybe Text, [Chart])
-> Optic
     A_Traversal
     NoIx
     ChartTree
     ChartTree
     (Maybe Text, [Chart])
     (Maybe Text, [Chart])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  NoIx
  (Tree (Maybe Text, [Chart]))
  (Tree (Maybe Text, [Chart]))
  (Maybe Text, [Chart])
  (Maybe Text, [Chart])
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed Optic
  A_Traversal
  NoIx
  ChartTree
  ChartTree
  (Maybe Text, [Chart])
  (Maybe Text, [Chart])
-> Optic
     A_Lens
     NoIx
     (Maybe Text, [Chart])
     (Maybe Text, [Chart])
     [Chart]
     [Chart]
-> Traversal' ChartTree [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Maybe Text, [Chart])
  (Maybe Text, [Chart])
  [Chart]
  [Chart]
forall s t a b. Field2 s t a b => Lens s t a b
_2

-- | A traversal of each chart in a tree.
chart' :: Traversal' ChartTree Chart
chart' :: Traversal' ChartTree Chart
chart' = Iso' ChartTree (Tree (Maybe Text, [Chart]))
tree' Iso' ChartTree (Tree (Maybe Text, [Chart]))
-> Optic
     A_Traversal
     NoIx
     (Tree (Maybe Text, [Chart]))
     (Tree (Maybe Text, [Chart]))
     (Maybe Text, [Chart])
     (Maybe Text, [Chart])
-> Optic
     A_Traversal
     NoIx
     ChartTree
     ChartTree
     (Maybe Text, [Chart])
     (Maybe Text, [Chart])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  NoIx
  (Tree (Maybe Text, [Chart]))
  (Tree (Maybe Text, [Chart]))
  (Maybe Text, [Chart])
  (Maybe Text, [Chart])
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed Optic
  A_Traversal
  NoIx
  ChartTree
  ChartTree
  (Maybe Text, [Chart])
  (Maybe Text, [Chart])
-> Optic
     A_Lens
     NoIx
     (Maybe Text, [Chart])
     (Maybe Text, [Chart])
     [Chart]
     [Chart]
-> Traversal' ChartTree [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Maybe Text, [Chart])
  (Maybe Text, [Chart])
  [Chart]
  [Chart]
forall s t a b. Field2 s t a b => Lens s t a b
_2 Traversal' ChartTree [Chart]
-> Optic A_Traversal NoIx [Chart] [Chart] Chart Chart
-> Traversal' ChartTree Chart
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx [Chart] [Chart] Chart Chart
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed

-- | Convert a chart list to a tree, adding a specific text label.
named :: Text -> [Chart] -> ChartTree
named :: Text -> [Chart] -> ChartTree
named Text
l [Chart]
cs = Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart]) -> ChartTree
forall a b. (a -> b) -> a -> b
$ (Maybe Text, [Chart])
-> [Tree (Maybe Text, [Chart])] -> Tree (Maybe Text, [Chart])
forall a. a -> [Tree a] -> Tree a
Node (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l, [Chart]
cs) []

-- | Convert a chart list to a tree, with no text label.
unnamed :: [Chart] -> ChartTree
unnamed :: [Chart] -> ChartTree
unnamed [Chart]
cs = Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart]) -> ChartTree
forall a b. (a -> b) -> a -> b
$ (Maybe Text, [Chart])
-> [Tree (Maybe Text, [Chart])] -> Tree (Maybe Text, [Chart])
forall a. a -> [Tree a] -> Tree a
Node (Maybe Text
forall a. Maybe a
Nothing, [Chart]
cs) []

-- | Rename a ChartTree, removing descendent names
renamed :: Text -> ChartTree -> ChartTree
renamed :: Text -> ChartTree -> ChartTree
renamed Text
l ChartTree
ct = Text -> [Chart] -> ChartTree
named Text
l ([Chart] -> ChartTree) -> [Chart] -> ChartTree
forall a b. (a -> b) -> a -> b
$ Traversal' ChartTree [Chart] -> ChartTree -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Traversal' ChartTree [Chart]
charts' ChartTree
ct

-- | Rename a top-level label in a tree.
rename :: Maybe Text -> ChartTree -> ChartTree
rename :: Maybe Text -> ChartTree -> ChartTree
rename Maybe Text
l (ChartTree (Node (Maybe Text
_, [Chart]
cs) [Tree (Maybe Text, [Chart])]
xs)) = Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree ((Maybe Text, [Chart])
-> [Tree (Maybe Text, [Chart])] -> Tree (Maybe Text, [Chart])
forall a. a -> [Tree a] -> Tree a
Node (Maybe Text
l, [Chart]
cs) [Tree (Maybe Text, [Chart])]
xs)

-- | A tree with no charts and no label.
blank :: Rect Double -> ChartTree
blank :: Rect Double -> ChartTree
blank Rect Double
r = [Chart] -> ChartTree
unnamed [Style -> ChartData -> Chart
Chart Style
defaultStyle ([Rect Double] -> ChartData
BlankData [Rect Double
r])]

-- $boxes
--
-- Library functionality (rescaling, combining charts, working out axes and generally putting charts together) is driven by a box model. A box is a rectangular space that bounds chart elements.

-- | The 'Rect' which encloses the data elements of the chart. /Bounding box/ is a synonym.
--
-- >>> box (chartData r)
-- Just Rect (-0.5) 0.5 (-0.5) 0.5
box :: ChartData -> Maybe (Rect Double)
box :: ChartData -> Maybe (Rect Double)
box (RectData [Rect Double]
a) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect [Rect Double]
a
box (TextData [(Text, Point Double)]
a) = [Element (Rect Double)] -> Maybe (Rect Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 ([Element (Rect Double)] -> Maybe (Rect Double))
-> [Element (Rect Double)] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ (Text, Point Double) -> Point Double
forall a b. (a, b) -> b
snd ((Text, Point Double) -> Point Double)
-> [(Text, Point Double)] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
a
box (LineData [[Point Double]]
a) = [Element (Rect Double)] -> Maybe (Rect Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 ([Element (Rect Double)] -> Maybe (Rect Double))
-> [Element (Rect Double)] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [[Point Double]] -> [Point Double]
forall a. Monoid a => [a] -> a
mconcat [[Point Double]]
a
box (GlyphData [Point Double]
a) = [Element (Rect Double)] -> Maybe (Rect Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 [Element (Rect Double)]
[Point Double]
a
box (PathData [PathData Double]
a) = [PathData Double] -> Maybe (Rect Double)
pathBoxes [PathData Double]
a
box (BlankData [Rect Double]
a) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect [Rect Double]
a

-- | The bounding box for a chart including both data and style elements.
--
-- >>> sbox r
-- Just Rect (-0.505) 0.505 (-0.505) 0.505
--
-- In the above example, the border of the rectangle adds an extra 0.1 to the height and width of the bounding box enclosing the chart.
sbox :: Chart -> Maybe (Rect Double)
sbox :: Chart -> Maybe (Rect Double)
sbox (Chart Style
s (RectData [Rect Double]
a)) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#borderSize Style
s) (Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a
sbox (Chart Style
s (TextData [(Text, Point Double)]
a)) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ (Text -> Point Double -> Rect Double)
-> (Text, Point Double) -> Rect Double
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Style -> Text -> Point Double -> Rect Double
styleBoxText Style
s) ((Text, Point Double) -> Rect Double)
-> [(Text, Point Double)] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
a
sbox (Chart Style
s (LineData [[Point Double]]
a)) = Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#size Style
s) (Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Element (Rect Double)] -> Maybe (Rect Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 ([Element (Rect Double)] -> Maybe (Rect Double))
-> [Element (Rect Double)] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [[Point Double]] -> [Point Double]
forall a. Monoid a => [a] -> a
mconcat [[Point Double]]
a)
sbox (Chart Style
s (GlyphData [Point Double]
a)) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ (\Point Double
x -> Point Double -> Rect Double -> Rect Double
forall a. Additive a => Point a -> Rect a -> Rect a
addPoint Point Double
x (Style -> Rect Double
styleBoxGlyph Style
s)) (Point Double -> Rect Double) -> [Point Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
a
sbox (Chart Style
s (PathData [PathData Double]
a)) = Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#borderSize Style
s) (Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double] -> Maybe (Rect Double)
pathBoxes [PathData Double]
a
sbox (Chart Style
_ (BlankData [Rect Double]
a)) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect [Rect Double]
a

-- | projects a Chart to a new space from an old rectangular space, preserving linear metric structure.
--
-- >>> projectWith (fmap (2*) one) one r
-- Chart {chartStyle = Style {size = 6.0e-2, borderSize = 1.0e-2, color = Colour 0.02 0.73 0.80 0.10, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, textAnchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}, chartData = RectData [Rect (-1.0) 1.0 (-1.0) 1.0]}
projectWith :: Rect Double -> Rect Double -> Chart -> Chart
projectWith :: Rect Double -> Rect Double -> Chart -> Chart
projectWith Rect Double
new Rect Double
old Chart
c = Chart
c Chart -> (Chart -> Chart) -> Chart
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Chart Chart Style Style
-> (Style -> Style) -> Chart -> Chart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Chart Chart Style Style
#chartStyle (Double -> Style -> Style
scaleStyle (ScaleP -> Rect Double -> Rect Double -> Double
scaleRatio (Optic' A_Lens NoIx Chart ScaleP -> Chart -> ScaleP
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic A_Lens NoIx Chart Chart Style Style
#chartStyle Optic A_Lens NoIx Chart Chart Style Style
-> Optic A_Lens NoIx Style Style ScaleP ScaleP
-> Optic' A_Lens NoIx Chart ScaleP
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style ScaleP ScaleP
#scaleP) Chart
c) Rect Double
new Rect Double
old)) Chart -> (Chart -> Chart) -> Chart
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Chart Chart ChartData ChartData
-> (ChartData -> ChartData) -> Chart -> Chart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Chart Chart ChartData ChartData
#chartData (Rect Double -> Rect Double -> ChartData -> ChartData
projectChartDataWith Rect Double
new Rect Double
old)

-- | Projects 'ChartData' from an old space to a new space.
projectChartDataWith :: Rect Double -> Rect Double -> ChartData -> ChartData
projectChartDataWith :: Rect Double -> Rect Double -> ChartData -> ChartData
projectChartDataWith Rect Double
new Rect Double
old (RectData [Rect Double]
a) = [Rect Double] -> ChartData
RectData (Rect Double -> Rect Double -> Rect Double -> Rect Double
projectOnR Rect Double
new Rect Double
old (Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a)
projectChartDataWith Rect Double
new Rect Double
old (TextData [(Text, Point Double)]
a) = [(Text, Point Double)] -> ChartData
TextData ((Point Double -> Point Double)
-> (Text, Point Double) -> (Text, Point Double)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old) ((Text, Point Double) -> (Text, Point Double))
-> [(Text, Point Double)] -> [(Text, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
a)
projectChartDataWith Rect Double
new Rect Double
old (LineData [[Point Double]]
a) = [[Point Double]] -> ChartData
LineData ((Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old) ([Point Double] -> [Point Double])
-> [[Point Double]] -> [[Point Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Point Double]]
a)
projectChartDataWith Rect Double
new Rect Double
old (GlyphData [Point Double]
a) = [Point Double] -> ChartData
GlyphData (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old (Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
a)
projectChartDataWith Rect Double
new Rect Double
old (PathData [PathData Double]
a) = [PathData Double] -> ChartData
PathData (Rect Double
-> Rect Double -> [PathData Double] -> [PathData Double]
projectPaths Rect Double
new Rect Double
old [PathData Double]
a)
projectChartDataWith Rect Double
new Rect Double
old (BlankData [Rect Double]
a) = [Rect Double] -> ChartData
BlankData (Rect Double -> Rect Double -> Rect Double -> Rect Double
projectOnR Rect Double
new Rect Double
old (Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a)

-- | Move 'ChartData' by a 'Point'
moveChartData :: Point Double -> ChartData -> ChartData
moveChartData :: Point Double -> ChartData -> ChartData
moveChartData Point Double
p (RectData [Rect Double]
a) = [Rect Double] -> ChartData
RectData (Point Double -> Rect Double -> Rect Double
forall a. Additive a => Point a -> Rect a -> Rect a
addPoint Point Double
p (Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a)
moveChartData Point Double
p (TextData [(Text, Point Double)]
a) = [(Text, Point Double)] -> ChartData
TextData ((Point Double -> Point Double)
-> (Text, Point Double) -> (Text, Point Double)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Point Double -> Point Double -> Point Double
addp Point Double
p) ((Text, Point Double) -> (Text, Point Double))
-> [(Text, Point Double)] -> [(Text, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
a)
moveChartData Point Double
p (LineData [[Point Double]]
a) = [[Point Double]] -> ChartData
LineData ((Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point Double -> Point Double -> Point Double
addp Point Double
p) ([Point Double] -> [Point Double])
-> [[Point Double]] -> [[Point Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Point Double]]
a)
moveChartData Point Double
p (GlyphData [Point Double]
a) = [Point Double] -> ChartData
GlyphData (Point Double -> Point Double -> Point Double
addp Point Double
p (Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
a)
moveChartData Point Double
p (PathData [PathData Double]
a) = [PathData Double] -> ChartData
PathData (Point Double -> PathData Double -> PathData Double
forall a. Additive a => Point a -> PathData a -> PathData a
movePath Point Double
p (PathData Double -> PathData Double)
-> [PathData Double] -> [PathData Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double]
a)
moveChartData Point Double
p (BlankData [Rect Double]
a) = [Rect Double] -> ChartData
BlankData (Point Double -> Rect Double -> Rect Double
forall a. Additive a => Point a -> Rect a -> Rect a
addPoint Point Double
p (Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a)

-- | Move a chart.
moveChart :: Point Double -> Chart -> Chart
moveChart :: Point Double -> Chart -> Chart
moveChart Point Double
p Chart
c = Chart
c Chart -> (Chart -> Chart) -> Chart
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Chart Chart ChartData ChartData
-> (ChartData -> ChartData) -> Chart -> Chart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Chart Chart ChartData ChartData
#chartData (Point Double -> ChartData -> ChartData
moveChartData Point Double
p)

-- | Scale 'ChartData'
scaleChartData :: Double -> ChartData -> ChartData
scaleChartData :: Double -> ChartData -> ChartData
scaleChartData Double
p (RectData [Rect Double]
a) =
  [Rect Double] -> ChartData
RectData ((Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> Rect a -> Rect b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
p)) [Rect Double]
a)
scaleChartData Double
p (LineData [[Point Double]]
a) =
  [[Point Double]] -> ChartData
LineData (([Point Double] -> [Point Double])
-> [[Point Double]] -> [[Point Double]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double) -> Point Double -> Point Double
forall a b. (a -> b) -> Point a -> Point b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
p))) [[Point Double]]
a)
scaleChartData Double
p (TextData [(Text, Point Double)]
a) =
  [(Text, Point Double)] -> ChartData
TextData (((Text, Point Double) -> (Text, Point Double))
-> [(Text, Point Double)] -> [(Text, Point Double)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Point Double -> Point Double)
-> (Text, Point Double) -> (Text, Point Double)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Double -> Double) -> Point Double -> Point Double
forall a b. (a -> b) -> Point a -> Point b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
p))) [(Text, Point Double)]
a)
scaleChartData Double
p (GlyphData [Point Double]
a) =
  [Point Double] -> ChartData
GlyphData ((Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double) -> Point Double -> Point Double
forall a b. (a -> b) -> Point a -> Point b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
p)) [Point Double]
a)
scaleChartData Double
p (PathData [PathData Double]
a) =
  [PathData Double] -> ChartData
PathData (Double -> PathData Double -> PathData Double
forall a. Multiplicative a => a -> PathData a -> PathData a
scalePath Double
p (PathData Double -> PathData Double)
-> [PathData Double] -> [PathData Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double]
a)
scaleChartData Double
p (BlankData [Rect Double]
a) =
  [Rect Double] -> ChartData
BlankData ((Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> Rect a -> Rect b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
p)) [Rect Double]
a)

-- | Scale a chart (effecting both the chart data and the style, if /#style % #scaleP/ is a scaling value).
scaleChart :: Double -> Chart -> Chart
scaleChart :: Double -> Chart -> Chart
scaleChart Double
p Chart
c = Chart
c Chart -> (Chart -> Chart) -> Chart
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Chart Chart ChartData ChartData
-> (ChartData -> ChartData) -> Chart -> Chart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Chart Chart ChartData ChartData
#chartData (Double -> ChartData -> ChartData
scaleChartData Double
p) Chart -> (Chart -> Chart) -> Chart
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Chart Chart Style Style
-> (Style -> Style) -> Chart -> Chart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Chart Chart Style Style
#chartStyle ((Style -> Style) -> (Style -> Style) -> Bool -> Style -> Style
forall a. a -> a -> Bool -> a
bool (Double -> Style -> Style
scaleStyle Double
p) Style -> Style
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (Optic' A_Lens NoIx Chart ScaleP -> Chart -> ScaleP
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic A_Lens NoIx Chart Chart Style Style
#chartStyle Optic A_Lens NoIx Chart Chart Style Style
-> Optic A_Lens NoIx Style Style ScaleP ScaleP
-> Optic' A_Lens NoIx Chart ScaleP
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style ScaleP ScaleP
#scaleP) Chart
c ScaleP -> ScaleP -> Bool
forall a. Eq a => a -> a -> Bool
== ScaleP
NoScaleP))

-- | Modify chart colors, applying to both border and main colors.
colourStyle :: (Colour -> Colour) -> Style -> Style
colourStyle :: (Colour -> Colour) -> Style -> Style
colourStyle Colour -> Colour
f Style
s = Style
s Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> (Colour -> Colour) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Style Style Colour Colour
#color Colour -> Colour
f Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> (Colour -> Colour) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Style Style Colour Colour
#borderColor Colour -> Colour
f

-- | Project a chart tree to a new bounding box, guarding against singleton bounds.
projectChartTree :: Rect Double -> ChartTree -> ChartTree
projectChartTree :: Rect Double -> ChartTree -> ChartTree
projectChartTree Rect Double
new ChartTree
ct = case Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' ChartTree
ct of
  Maybe (Rect Double)
Nothing -> ChartTree
ct
  Just Rect Double
b -> ChartTree
ct ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Traversal' ChartTree [Chart]
-> ([Chart] -> [Chart]) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree [Chart]
charts' ((Chart -> Chart) -> [Chart] -> [Chart]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rect Double -> Rect Double -> Chart -> Chart
projectWith Rect Double
new Rect Double
b))

-- | Compute the bounding box of a list of charts, not including style allowances.
boxes :: [Chart] -> Maybe (Rect Double)
boxes :: [Chart] -> Maybe (Rect Double)
boxes [Chart]
cs = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [[Rect Double]] -> [Rect Double]
forall a. Monoid a => [a] -> a
mconcat ([[Rect Double]] -> [Rect Double])
-> [[Rect Double]] -> [Rect Double]
forall a b. (a -> b) -> a -> b
$ (Maybe (Rect Double) -> [Rect Double]
forall a. Maybe a -> [a]
maybeToList (Maybe (Rect Double) -> [Rect Double])
-> (ChartData -> Maybe (Rect Double)) -> ChartData -> [Rect Double]
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
. ChartData -> Maybe (Rect Double)
box) (ChartData -> [Rect Double])
-> (Chart -> ChartData) -> Chart -> [Rect Double]
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
. Chart -> ChartData
chartData (Chart -> [Rect Double]) -> [Chart] -> [[Rect Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart]
cs

box_ :: ChartTree -> Maybe (Rect Double)
box_ :: ChartTree -> Maybe (Rect Double)
box_ = [Chart] -> Maybe (Rect Double)
boxes ([Chart] -> Maybe (Rect Double))
-> (ChartTree -> [Chart]) -> ChartTree -> Maybe (Rect Double)
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
. Traversal' ChartTree [Chart] -> ChartTree -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Traversal' ChartTree [Chart]
charts'

rebox_ :: ChartTree -> Maybe (Rect Double) -> ChartTree
rebox_ :: ChartTree -> Maybe (Rect Double) -> ChartTree
rebox_ ChartTree
cs Maybe (Rect Double)
r =
  ChartTree
cs
    ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Traversal' ChartTree Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' ((Chart -> Chart) -> Maybe (Chart -> Chart) -> Chart -> Chart
forall a. a -> Maybe a -> a
fromMaybe Chart -> Chart
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (Maybe (Chart -> Chart) -> Chart -> Chart)
-> Maybe (Chart -> Chart) -> Chart -> Chart
forall a b. (a -> b) -> a -> b
$ Rect Double -> Rect Double -> Chart -> Chart
projectWith (Rect Double -> Rect Double -> Chart -> Chart)
-> Maybe (Rect Double) -> Maybe (Rect Double -> Chart -> Chart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Rect Double)
r Maybe (Rect Double -> Chart -> Chart)
-> Maybe (Rect Double) -> Maybe (Chart -> Chart)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ChartTree -> Maybe (Rect Double)
box_ ChartTree
cs)

-- | Lens between a ChartTree and its bounding box.
box' :: Lens' ChartTree (Maybe (Rect Double))
box' :: Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
box' =
  (ChartTree -> Maybe (Rect Double))
-> (ChartTree -> Maybe (Rect Double) -> ChartTree)
-> Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChartTree -> Maybe (Rect Double)
box_ ChartTree -> Maybe (Rect Double) -> ChartTree
rebox_

-- | Compute the bounding box of the data and style elements contained in a list of charts.
styleBoxes :: [Chart] -> Maybe (Rect Double)
styleBoxes :: [Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
cs = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [[Rect Double]] -> [Rect Double]
forall a. Monoid a => [a] -> a
mconcat ([[Rect Double]] -> [Rect Double])
-> [[Rect Double]] -> [Rect Double]
forall a b. (a -> b) -> a -> b
$ Maybe (Rect Double) -> [Rect Double]
forall a. Maybe a -> [a]
maybeToList (Maybe (Rect Double) -> [Rect Double])
-> (Chart -> Maybe (Rect Double)) -> Chart -> [Rect Double]
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
. Chart -> Maybe (Rect Double)
sbox (Chart -> [Rect Double]) -> [Chart] -> [[Rect Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart]
cs

styleBox_ :: ChartTree -> Maybe (Rect Double)
styleBox_ :: ChartTree -> Maybe (Rect Double)
styleBox_ = [Chart] -> Maybe (Rect Double)
styleBoxes ([Chart] -> Maybe (Rect Double))
-> (ChartTree -> [Chart]) -> ChartTree -> Maybe (Rect Double)
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
. Traversal' ChartTree [Chart] -> ChartTree -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Traversal' ChartTree [Chart]
charts'

styleRebox_ :: ChartTree -> Maybe (Rect Double) -> ChartTree
styleRebox_ :: ChartTree -> Maybe (Rect Double) -> ChartTree
styleRebox_ ChartTree
cs Maybe (Rect Double)
r =
  ChartTree
cs
    ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Traversal' ChartTree Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' ((Chart -> Chart) -> Maybe (Chart -> Chart) -> Chart -> Chart
forall a. a -> Maybe a -> a
fromMaybe Chart -> Chart
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (Maybe (Chart -> Chart) -> Chart -> Chart)
-> Maybe (Chart -> Chart) -> Chart -> Chart
forall a b. (a -> b) -> a -> b
$ Rect Double -> Rect Double -> Chart -> Chart
projectWith (Rect Double -> Rect Double -> Chart -> Chart)
-> Maybe (Rect Double) -> Maybe (Rect Double -> Chart -> Chart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Rect Double)
r Maybe (Rect Double -> Chart -> Chart)
-> Maybe (Rect Double) -> Maybe (Chart -> Chart)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ChartTree -> Maybe (Rect Double)
styleBox_ ChartTree
cs)

-- | Lens between a style bounding box and a ChartTree tree.
--
-- Note that a round trip may be only approximately isomorphic ie
--
-- > forall c r. \c -> view styleBox' . set styleBox' r c ~= r
styleBox' :: Lens' ChartTree (Maybe (Rect Double))
styleBox' :: Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' =
  (ChartTree -> Maybe (Rect Double))
-> (ChartTree -> Maybe (Rect Double) -> ChartTree)
-> Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChartTree -> Maybe (Rect Double)
styleBox_ ChartTree -> Maybe (Rect Double) -> ChartTree
styleRebox_

-- | Getter of a ChartTree bounding box, including style, with singleton dimension guards, defaulting to one:
safeStyleBox' :: Getter ChartTree (Rect Double)
safeStyleBox' :: Getter ChartTree (Rect Double)
safeStyleBox' = (ChartTree -> Rect Double) -> Getter ChartTree (Rect Double)
forall s a. (s -> a) -> Getter s a
Optics.Core.to (Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Rect Double
safeBox_ Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox')

-- | Getter of a ChartTree bounding box, excluding style, with singleton dimension guards, defaulting to one:
safeBox' :: Getter ChartTree (Rect Double)
safeBox' :: Getter ChartTree (Rect Double)
safeBox' = (ChartTree -> Rect Double) -> Getter ChartTree (Rect Double)
forall s a. (s -> a) -> Getter s a
Optics.Core.to (Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Rect Double
safeBox_ Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
box')

safeBox_ :: Lens' ChartTree (Maybe (Rect Double)) -> ChartTree -> Rect Double
safeBox_ :: Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Rect Double
safeBox_ Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
l ChartTree
ct
  | Maybe (Rect Double)
b Maybe (Rect Double) -> Maybe (Rect Double) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Rect Double)
forall a. Maybe a
Nothing Bool -> Bool -> Bool
|| (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (Rect Double -> Bool) -> Maybe (Rect Double) -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rect Double -> Bool
isSingleton Maybe (Rect Double)
b) = Rect Double
-> (Rect Double -> Rect Double)
-> Maybe (Rect Double)
-> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double
forall a. Multiplicative a => a
one Rect Double -> Rect Double
padSingletons (Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
l ChartTree
ct)
  | Bool
otherwise = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one Maybe (Rect Double)
b
  where
    b :: Maybe (Rect Double)
b = Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
l ChartTree
ct

-- | Create a frame over some charts with (additive) padding.
--
-- >>> frameChart defaultRectStyle 0.1 (unnamed [BlankChart defaultStyle []])
-- ChartTree {tree = Node {rootLabel = (Just "frame",[Chart {chartStyle = Style {size = 6.0e-2, borderSize = 1.0e-2, color = Colour 0.02 0.73 0.80 0.10, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, textAnchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}, chartData = RectData []}]), subForest = []}}
frameChart :: Style -> Double -> ChartTree -> ChartTree
frameChart :: Style -> Double -> ChartTree -> ChartTree
frameChart Style
rs Double
p ChartTree
cs = Text -> [Chart] -> ChartTree
named Text
"frame" [Style -> ChartData -> Chart
Chart Style
rs ([Rect Double] -> ChartData
RectData (Maybe (Rect Double) -> [Rect Double]
forall a. Maybe a -> [a]
maybeToList (Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> Rect a -> Rect a
padRect Double
p (Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' ChartTree
cs)))]

-- | Additive padding, framing or buffering for a chart list.
padChart :: Double -> ChartTree -> ChartTree
padChart :: Double -> ChartTree -> ChartTree
padChart Double
p ChartTree
ct = Text -> [Chart] -> ChartTree
named Text
"padding" [Style -> ChartData -> Chart
Chart Style
defaultStyle ([Rect Double] -> ChartData
BlankData (Maybe (Rect Double) -> [Rect Double]
forall a. Maybe a -> [a]
maybeToList (Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> Rect a -> Rect a
padRect Double
p (Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' ChartTree
ct)))]

-- | Whether a chart is empty of data to be represented.
isEmptyChart :: ChartData -> Bool
isEmptyChart :: ChartData -> Bool
isEmptyChart (RectData []) = Bool
True
isEmptyChart (LineData []) = Bool
True
isEmptyChart (GlyphData []) = Bool
True
isEmptyChart (TextData []) = Bool
True
isEmptyChart (PathData []) = Bool
True
isEmptyChart (BlankData [Rect Double]
_) = Bool
True
isEmptyChart ChartData
_ = Bool
False

-- | Horizontally stack a list of trees (proceeding to the right), at the supplied Align and with the supplied gap intercalated.
hori :: Align -> Double -> [ChartTree] -> ChartTree
hori :: Align -> Double -> [ChartTree] -> ChartTree
hori Align
align Double
gap [ChartTree]
cs = (ChartTree -> ChartTree -> ChartTree)
-> ChartTree -> [ChartTree] -> ChartTree
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ChartTree -> ChartTree -> ChartTree
step ChartTree
forall a. Monoid a => a
mempty ([ChartTree] -> [ChartTree]
forall a. [a] -> [a]
reverse [ChartTree]
cs)
  where
    step :: ChartTree -> ChartTree -> ChartTree
step ChartTree
x ChartTree
c = ChartTree
x ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> Traversal' ChartTree Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (Point Double -> Chart -> Chart
moveChart (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (ChartTree -> ChartTree -> Double
movex ChartTree
x ChartTree
c) (ChartTree -> Double
aligny ChartTree
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- ChartTree -> Double
aligny ChartTree
c))) ChartTree
c
    movex :: ChartTree -> ChartTree -> Double
movex ChartTree
x ChartTree
c =
      Double -> (Double -> Double) -> Maybe Double -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Double
forall a. Additive a => a
zero
        (-Double
gap +)
        ( (-)
            (Double -> Double -> Double)
-> Maybe Double -> Maybe (Double -> Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rect Double -> Double
forall a. Rect a -> a
rx (Rect Double -> Double) -> Maybe (Rect Double) -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' ChartTree
x)
            Maybe (Double -> Double) -> Maybe Double -> Maybe Double
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Rect Double -> Double
forall a. Rect a -> a
rz (Rect Double -> Double) -> Maybe (Rect Double) -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' ChartTree
c)
        )
    aligny :: ChartTree -> Double
aligny ChartTree
x = case Traversal' ChartTree [Chart] -> ChartTree -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Traversal' ChartTree [Chart]
charts' ChartTree
x of
      [] -> Double
forall a. Additive a => a
zero
      [Chart]
xs -> case Align
align of
        Align
AlignLeft -> Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
forall a. Additive a => a
zero (\(Rect Double
_ Double
_ Double
y' Double
_) -> Double
y') ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)
        Align
AlignRight -> Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
forall a. Additive a => a
zero (\(Rect Double
_ Double
_ Double
_ Double
y') -> Double
y') ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)
        Align
AlignMid -> Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
forall a. Additive a => a
zero (\(Rect Double
_ Double
_ Double
y' Double
w') -> (Double
y' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
w') Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2) ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)
        Align
NoAlign -> Double
forall a. Additive a => a
zero

-- | Vertically stack a list of trees (proceeding upwards), at the supplied Align and with the supplied gap intercalated.
vert :: Align -> Double -> [ChartTree] -> ChartTree
vert :: Align -> Double -> [ChartTree] -> ChartTree
vert Align
align Double
gap [ChartTree]
cs = (ChartTree -> ChartTree -> ChartTree)
-> ChartTree -> [ChartTree] -> ChartTree
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ChartTree -> ChartTree -> ChartTree
step ChartTree
forall a. Monoid a => a
mempty ([ChartTree] -> [ChartTree]
forall a. [a] -> [a]
reverse [ChartTree]
cs)
  where
    step :: ChartTree -> ChartTree -> ChartTree
step ChartTree
x ChartTree
c = ChartTree
x ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> Traversal' ChartTree Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (Point Double -> Chart -> Chart
moveChart (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (ChartTree -> Double
alignx ChartTree
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- ChartTree -> Double
alignx ChartTree
c) (ChartTree -> ChartTree -> Double
movey ChartTree
x ChartTree
c))) ChartTree
c
    movey :: ChartTree -> ChartTree -> Double
movey ChartTree
x ChartTree
c =
      Double -> (Double -> Double) -> Maybe Double -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Double
forall a. Additive a => a
zero
        (Double
gap +)
        ( (-)
            (Double -> Double -> Double)
-> Maybe Double -> Maybe (Double -> Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rect Double -> Double
forall a. Rect a -> a
rw (Rect Double -> Double) -> Maybe (Rect Double) -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' ChartTree
x)
            Maybe (Double -> Double) -> Maybe Double -> Maybe Double
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Rect Double -> Double
forall a. Rect a -> a
ry (Rect Double -> Double) -> Maybe (Rect Double) -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' ChartTree
c)
        )
    alignx :: ChartTree -> Double
alignx ChartTree
x = case Traversal' ChartTree [Chart] -> ChartTree -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Traversal' ChartTree [Chart]
charts' ChartTree
x of
      [] -> Double
forall a. Additive a => a
zero
      [Chart]
xs -> case Align
align of
        Align
AlignLeft -> Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
forall a. Additive a => a
zero (\(Rect Double
x' Double
_ Double
_ Double
_) -> Double
x') ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)
        Align
AlignRight -> Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
forall a. Additive a => a
zero (\(Rect Double
_ Double
x' Double
_ Double
_) -> Double
x') ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)
        Align
AlignMid -> Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
forall a. Additive a => a
zero (\(Rect Double
x' Double
z' Double
_ Double
_) -> (Double
x' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
z') Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2) ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)
        Align
NoAlign -> Double
forall a. Additive a => a
zero

-- | Stack a list of tree charts horizontally, then vertically (proceeding downwards which is opposite to the usual coordinate reference system but intuitively the way people read charts)
stack :: Int -> Align -> Align -> Double -> [ChartTree] -> ChartTree
stack :: Int -> Align -> Align -> Double -> [ChartTree] -> ChartTree
stack Int
n Align
alignV Align
alignH Double
gap [ChartTree]
cs = Align -> Double -> [ChartTree] -> ChartTree
vert Align
alignV Double
gap (Align -> Double -> [ChartTree] -> ChartTree
hori Align
alignH Double
gap ([ChartTree] -> ChartTree) -> [[ChartTree]] -> [ChartTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartTree] -> [[ChartTree]] -> [[ChartTree]]
group' [ChartTree]
cs [])
  where
    group' :: [ChartTree] -> [[ChartTree]] -> [[ChartTree]]
group' [] [[ChartTree]]
acc = [[ChartTree]] -> [[ChartTree]]
forall a. [a] -> [a]
reverse [[ChartTree]]
acc
    group' [ChartTree]
x [[ChartTree]]
acc = [ChartTree] -> [[ChartTree]] -> [[ChartTree]]
group' (Int -> [ChartTree] -> [ChartTree]
forall a. Int -> [a] -> [a]
drop Int
n [ChartTree]
x) (Int -> [ChartTree] -> [ChartTree]
forall a. Int -> [a] -> [a]
take Int
n [ChartTree]
x [ChartTree] -> [[ChartTree]] -> [[ChartTree]]
forall a. a -> [a] -> [a]
: [[ChartTree]]
acc)

-- | Place a ChartTree beside a 'Rect'.
besideChart :: Place -> Double -> Double -> Rect Double -> ChartTree -> ChartTree
besideChart :: Place -> Double -> Double -> Rect Double -> ChartTree -> ChartTree
besideChart Place
place Double
anc Double
buff Rect Double
cb ChartTree
ct = ChartTree
-> (Rect Double -> ChartTree) -> Maybe (Rect Double) -> ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChartTree
ct (\Rect Double
b -> ChartTree
ct ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Traversal' ChartTree Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (Point Double -> Chart -> Chart
moveChart (Place
-> Double -> Double -> Rect Double -> Rect Double -> Point Double
beside Place
place Double
anc Double
buff Rect Double
cb Rect Double
b))) (Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' ChartTree
ct)

-- | Make a new chart tree out of the bounding boxes of a chart tree.
--
-- This includes any extra space for style elements.
rectangularize :: Style -> ChartTree -> ChartTree
rectangularize :: Style -> ChartTree -> ChartTree
rectangularize Style
r ChartTree
ct = Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"rectangularize") [Traversal' ChartTree Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (\Chart
c -> Optic A_Lens NoIx Chart Chart Style Style
-> Style -> Chart -> Chart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Chart Chart Style Style
#chartStyle Style
r (Chart -> Chart) -> Chart -> Chart
forall a b. (a -> b) -> a -> b
$ Optic A_Lens NoIx Chart Chart ChartData ChartData
-> ChartData -> Chart -> Chart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Chart Chart ChartData ChartData
#chartData (Chart -> ChartData
rectangularize_ Chart
c) Chart
c) ChartTree
ct]

rectangularize_ :: Chart -> ChartData
rectangularize_ :: Chart -> ChartData
rectangularize_ Chart
c = [Rect Double] -> ChartData
RectData (Maybe (Rect Double) -> [Rect Double]
forall a. Maybe a -> [a]
maybeToList (Maybe (Rect Double) -> [Rect Double])
-> Maybe (Rect Double) -> [Rect Double]
forall a b. (a -> b) -> a -> b
$ Chart -> Maybe (Rect Double)
sbox Chart
c)

-- | Make a new chart tree out of the data points of a chart tree, using the supplied style (for glyphs).
glyphize :: Style -> ChartTree -> ChartTree
glyphize :: Style -> ChartTree -> ChartTree
glyphize Style
s ChartTree
ct =
  Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"glyphize") [Traversal' ChartTree Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (Optic A_Lens NoIx Chart Chart Style Style
-> Style -> Chart -> Chart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Chart Chart Style Style
#chartStyle Style
s (Chart -> Chart) -> (Chart -> Chart) -> Chart -> Chart
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
. Optic A_Lens NoIx Chart Chart ChartData ChartData
-> (ChartData -> ChartData) -> Chart -> Chart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Chart Chart ChartData ChartData
#chartData ChartData -> ChartData
pointize_) ChartTree
ct]

pointize_ :: ChartData -> ChartData
pointize_ :: ChartData -> ChartData
pointize_ (TextData [(Text, Point Double)]
xs) = [Point Double] -> ChartData
GlyphData ((Text, Point Double) -> Point Double
forall a b. (a, b) -> b
snd ((Text, Point Double) -> Point Double)
-> [(Text, Point Double)] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
xs)
pointize_ (PathData [PathData Double]
xs) = [Point Double] -> ChartData
GlyphData (PathData Double -> Point Double
forall a. PathData a -> Point a
pointPath (PathData Double -> Point Double)
-> [PathData Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double]
xs)
pointize_ (LineData [[Point Double]]
xs) = [Point Double] -> ChartData
GlyphData ([[Point Double]] -> [Point Double]
forall a. Monoid a => [a] -> a
mconcat [[Point Double]]
xs)
pointize_ (BlankData [Rect Double]
xs) = [Point Double] -> ChartData
GlyphData (Rect Double -> Element (Rect Double)
Rect Double -> Point Double
forall s. (Space s, Field (Element s)) => s -> Element s
mid (Rect Double -> Point Double) -> [Rect Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
xs)
pointize_ (RectData [Rect Double]
xs) = [Point Double] -> ChartData
GlyphData (Rect Double -> Element (Rect Double)
Rect Double -> Point Double
forall s. (Space s, Field (Element s)) => s -> Element s
mid (Rect Double -> Point Double) -> [Rect Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
xs)
pointize_ (GlyphData [Point Double]
xs) = [Point Double] -> ChartData
GlyphData [Point Double]
xs

-- | Verticle or Horizontal
data Orientation = Vert | Hori deriving (Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
/= :: Orientation -> Orientation -> Bool
Eq, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Orientation -> ShowS
showsPrec :: Int -> Orientation -> ShowS
$cshow :: Orientation -> String
show :: Orientation -> String
$cshowList :: [Orientation] -> ShowS
showList :: [Orientation] -> ShowS
Show, (forall x. Orientation -> Rep Orientation x)
-> (forall x. Rep Orientation x -> Orientation)
-> Generic Orientation
forall x. Rep Orientation x -> Orientation
forall x. Orientation -> Rep Orientation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Orientation -> Rep Orientation x
from :: forall x. Orientation -> Rep Orientation x
$cto :: forall x. Rep Orientation x -> Orientation
to :: forall x. Rep Orientation x -> Orientation
Generic)

-- | Whether to stack chart data
data Stacked = Stacked | NonStacked deriving (Stacked -> Stacked -> Bool
(Stacked -> Stacked -> Bool)
-> (Stacked -> Stacked -> Bool) -> Eq Stacked
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stacked -> Stacked -> Bool
== :: Stacked -> Stacked -> Bool
$c/= :: Stacked -> Stacked -> Bool
/= :: Stacked -> Stacked -> Bool
Eq, Int -> Stacked -> ShowS
[Stacked] -> ShowS
Stacked -> String
(Int -> Stacked -> ShowS)
-> (Stacked -> String) -> ([Stacked] -> ShowS) -> Show Stacked
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Stacked -> ShowS
showsPrec :: Int -> Stacked -> ShowS
$cshow :: Stacked -> String
show :: Stacked -> String
$cshowList :: [Stacked] -> ShowS
showList :: [Stacked] -> ShowS
Show, (forall x. Stacked -> Rep Stacked x)
-> (forall x. Rep Stacked x -> Stacked) -> Generic Stacked
forall x. Rep Stacked x -> Stacked
forall x. Stacked -> Rep Stacked x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Stacked -> Rep Stacked x
from :: forall x. Stacked -> Rep Stacked x
$cto :: forall x. Rep Stacked x -> Stacked
to :: forall x. Rep Stacked x -> Stacked
Generic)

-- | The basis for the x-y ratio of a chart
--
-- Default style features tend towards assuming that the usual height of the overall svg image is around 1, and ChartAspect is based on this assumption, so that a ChartAspect of @FixedAspect 1.5@, say, means a height of 1 and a width of 1.5.
data ChartAspect
  = -- | Rescale charts to a fixed x-y ratio, inclusive of hud and style features
    FixedAspect Double
  | -- | Rescale charts to an overall height of 1, preserving the x-y ratio of the data canvas.
    CanvasAspect Double
  | -- | Rescale charts to a height of 1, preserving the existing x-y ratio of the underlying charts, inclusive of hud and style.
    ChartAspect
  | -- | Do not rescale charts. The style values should make sense in relation to the data ranges.
    UnscaledAspect
  deriving (Int -> ChartAspect -> ShowS
[ChartAspect] -> ShowS
ChartAspect -> String
(Int -> ChartAspect -> ShowS)
-> (ChartAspect -> String)
-> ([ChartAspect] -> ShowS)
-> Show ChartAspect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChartAspect -> ShowS
showsPrec :: Int -> ChartAspect -> ShowS
$cshow :: ChartAspect -> String
show :: ChartAspect -> String
$cshowList :: [ChartAspect] -> ShowS
showList :: [ChartAspect] -> ShowS
Show, ChartAspect -> ChartAspect -> Bool
(ChartAspect -> ChartAspect -> Bool)
-> (ChartAspect -> ChartAspect -> Bool) -> Eq ChartAspect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChartAspect -> ChartAspect -> Bool
== :: ChartAspect -> ChartAspect -> Bool
$c/= :: ChartAspect -> ChartAspect -> Bool
/= :: ChartAspect -> ChartAspect -> Bool
Eq, (forall x. ChartAspect -> Rep ChartAspect x)
-> (forall x. Rep ChartAspect x -> ChartAspect)
-> Generic ChartAspect
forall x. Rep ChartAspect x -> ChartAspect
forall x. ChartAspect -> Rep ChartAspect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChartAspect -> Rep ChartAspect x
from :: forall x. ChartAspect -> Rep ChartAspect x
$cto :: forall x. Rep ChartAspect x -> ChartAspect
to :: forall x. Rep ChartAspect x -> ChartAspect
Generic)

-- | Rectangular placement
data Place
  = PlaceLeft
  | PlaceRight
  | PlaceTop
  | PlaceBottom
  | PlaceAbsolute (Point Double)
  deriving (Int -> Place -> ShowS
[Place] -> ShowS
Place -> String
(Int -> Place -> ShowS)
-> (Place -> String) -> ([Place] -> ShowS) -> Show Place
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Place -> ShowS
showsPrec :: Int -> Place -> ShowS
$cshow :: Place -> String
show :: Place -> String
$cshowList :: [Place] -> ShowS
showList :: [Place] -> ShowS
Show, Place -> Place -> Bool
(Place -> Place -> Bool) -> (Place -> Place -> Bool) -> Eq Place
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Place -> Place -> Bool
== :: Place -> Place -> Bool
$c/= :: Place -> Place -> Bool
/= :: Place -> Place -> Bool
Eq, (forall x. Place -> Rep Place x)
-> (forall x. Rep Place x -> Place) -> Generic Place
forall x. Rep Place x -> Place
forall x. Place -> Rep Place x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Place -> Rep Place x
from :: forall x. Place -> Rep Place x
$cto :: forall x. Rep Place x -> Place
to :: forall x. Rep Place x -> Place
Generic)

-- | Flip Place to the opposite side, or negate if 'PlaceAbsolute'.
--
-- >>> flipPlace PlaceLeft
-- PlaceRight
flipPlace :: Place -> Place
flipPlace :: Place -> Place
flipPlace Place
PlaceLeft = Place
PlaceRight
flipPlace Place
PlaceRight = Place
PlaceLeft
flipPlace Place
PlaceTop = Place
PlaceBottom
flipPlace Place
PlaceBottom = Place
PlaceTop
flipPlace (PlaceAbsolute Point Double
p) = Point Double -> Place
PlaceAbsolute (Point Double -> Point Double
forall a. Subtractive a => a -> a
negate Point Double
p)

-- | Point that moves a 'Rect' in relation to another 'Rect'
--
-- above and centered
-- >>> beside PlaceTop 0 0.01 one half
-- Point 0.0 0.76
--
-- above and right-aligned
-- >>> beside PlaceTop 0.5 0.01 one half
-- Point 0.25 0.76
--
-- left and with tops inline
-- >>> beside PlaceLeft (-0.5) 0 one half
-- Point (-0.75) 0.25
--
-- left and with bottoms aligned
-- >>> beside PlaceLeft 0.5 0 one half
-- Point (-0.75) (-0.25)
beside :: Place -> Double -> Double -> Rect Double -> Rect Double -> Point Double
beside :: Place
-> Double -> Double -> Rect Double -> Rect Double -> Point Double
beside Place
pl Double
anc Double
buff Rect Double
r Rect Double
r' = Rect Double -> Element (Rect Double)
forall s. (Space s, Field (Element s)) => s -> Element s
mid Rect Double
r Point Double -> Point Double -> Point Double
forall a. Subtractive a => a -> a -> a
- Rect Double -> Element (Rect Double)
forall s. (Space s, Field (Element s)) => s -> Element s
mid Rect Double
r' Point Double -> Point Double -> Point Double
forall a. Additive a => a -> a -> a
+ Point Double
p Point Double -> Point Double -> Point Double
forall a. Additive a => a -> a -> a
+ Point Double
b Point Double -> Point Double -> Point Double
forall a. Additive a => a -> a -> a
+ Point Double
a
  where
    wplus :: Point Double
wplus = Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect Double
r Point Double -> Scalar (Point Double) -> Point Double
forall m. DivisiveAction m => m -> Scalar m -> m
|/ Double
Scalar (Point Double)
2 Point Double -> Point Double -> Point Double
forall a. Additive a => a -> a -> a
+ Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect Double
r' Point Double -> Scalar (Point Double) -> Point Double
forall m. DivisiveAction m => m -> Scalar m -> m
|/ Double
Scalar (Point Double)
2
    wneg :: Point Double
wneg = Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect Double
r Point Double -> Point Double -> Point Double
forall a. Subtractive a => a -> a -> a
- Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect Double
r'
    b :: Point Double
b = case Place
pl of
      Place
PlaceTop -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
forall a. Additive a => a
zero Double
buff
      Place
PlaceBottom -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
forall a. Additive a => a
zero (-Double
buff)
      Place
PlaceLeft -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (-Double
buff) Double
forall a. Additive a => a
zero
      Place
PlaceRight -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
buff Double
forall a. Additive a => a
zero
      PlaceAbsolute Point Double
_ -> Point Double
forall a. Additive a => a
zero
    p :: Point Double
p = case Place
pl of
      Place
PlaceTop -> Point Double
wplus {_x = zero}
      Place
PlaceBottom -> -Point Double
wplus {_x = zero}
      Place
PlaceLeft -> -Point Double
wplus {_y = zero}
      Place
PlaceRight -> Point Double
wplus {_y = zero}
      PlaceAbsolute Point Double
p' -> Point Double
p'
    -- This is the opposite of the usual convention, but aligns
    -- with TextAnchor usage when text is vertical.
    a :: Point Double
a = case Place
pl of
      Place
PlaceTop -> Point Double
wneg {_y = zero} Point Double -> Scalar (Point Double) -> Point Double
forall m. MultiplicativeAction m => m -> Scalar m -> m
|* Double
Scalar (Point Double)
anc
      Place
PlaceBottom -> Point Double
wneg {_y = zero} Point Double -> Scalar (Point Double) -> Point Double
forall m. MultiplicativeAction m => m -> Scalar m -> m
|* Double
Scalar (Point Double)
anc
      Place
PlaceLeft -> -(Point Double
wneg {_x = zero} Point Double -> Scalar (Point Double) -> Point Double
forall m. MultiplicativeAction m => m -> Scalar m -> m
|* Double
Scalar (Point Double)
anc)
      Place
PlaceRight -> -(Point Double
wneg {_x = zero} Point Double -> Scalar (Point Double) -> Point Double
forall m. MultiplicativeAction m => m -> Scalar m -> m
|* Double
Scalar (Point Double)
anc)
      PlaceAbsolute Point Double
_ -> Point Double
forall a. Additive a => a
zero