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

-- | 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,
    frameChart,
    isEmptyChart,
    padChart,
    rectangularize,
    glyphize,
  )
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 Optics.Core
import Prelude

-- $setup
--
-- >>> :set -XOverloadedLabels
-- >>> :set -XOverloadedStrings
-- >>> import Chart
-- >>> import Optics.Core
-- >>> 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:
--
-- >>> let r = Chart defaultRectStyle (RectData [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, anchor = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chart -> Chart -> Bool
$c/= :: Chart -> Chart -> Bool
== :: Chart -> Chart -> Bool
$c== :: Chart -> Chart -> Bool
Eq, Int -> Chart -> ShowS
[Chart] -> ShowS
Chart -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chart] -> ShowS
$cshowList :: [Chart] -> ShowS
show :: Chart -> String
$cshow :: Chart -> String
showsPrec :: Int -> Chart -> ShowS
$cshowsPrec :: Int -> Chart -> ShowS
Show, 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
$cto :: forall x. Rep Chart x -> Chart
$cfrom :: forall x. Chart -> Rep Chart x
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartData -> ChartData -> Bool
$c/= :: ChartData -> ChartData -> Bool
== :: ChartData -> ChartData -> Bool
$c== :: ChartData -> ChartData -> Bool
Eq, Int -> ChartData -> ShowS
[ChartData] -> ShowS
ChartData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChartData] -> ShowS
$cshowList :: [ChartData] -> ShowS
show :: ChartData -> String
$cshow :: ChartData -> String
showsPrec :: Int -> ChartData -> ShowS
$cshowsPrec :: Int -> ChartData -> ShowS
Show, 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
$cto :: forall x. Rep ChartData x -> ChartData
$cfrom :: forall x. ChartData -> Rep ChartData x
Generic)

-- | RectData partial lens
rectData' :: Lens' ChartData (Maybe [Rect Double])
rectData' :: Lens' ChartData (Maybe [Rect Double])
rectData' =
  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) = forall a. a -> Maybe a
Just [Rect Double]
xs
    getData ChartData
_ = 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' =
  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) = forall a. a -> Maybe a
Just [[Point Double]]
xs
    getData ChartData
_ = 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' =
  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) = forall a. a -> Maybe a
Just [Point Double]
xs
    getData ChartData
_ = 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' =
  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) = forall a. a -> Maybe a
Just [(Text, Point Double)]
xs
    getData ChartData
_ = 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' =
  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) = forall a. a -> Maybe a
Just [PathData Double]
xs
    getData ChartData
_ = 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' =
  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) = forall a. a -> Maybe a
Just [Rect Double]
xs
    getData ChartData
_ = 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 $bRectChart :: Style -> [Rect Double] -> Chart
$mRectChart :: forall {r}.
Chart -> (Style -> [Rect Double] -> r) -> ((# #) -> r) -> r
RectChart s xs = Chart s (RectData xs)

{-# COMPLETE RectChart #-}

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

{-# COMPLETE LineChart #-}

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

{-# COMPLETE LineChart1 #-}

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

{-# COMPLETE GlyphChart #-}

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

{-# COMPLETE TextChart #-}

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

{-# COMPLETE PathChart #-}

-- | pattern of a Chart with BlankData
pattern BlankChart :: Style -> [Rect Double] -> Chart
pattern $bBlankChart :: Style -> [Rect Double] -> Chart
$mBlankChart :: forall {r}.
Chart -> (Style -> [Rect Double] -> r) -> ((# #) -> r) -> r
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartTree -> ChartTree -> Bool
$c/= :: ChartTree -> ChartTree -> Bool
== :: ChartTree -> ChartTree -> Bool
$c== :: ChartTree -> ChartTree -> Bool
Eq, Int -> ChartTree -> ShowS
[ChartTree] -> ShowS
ChartTree -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChartTree] -> ShowS
$cshowList :: [ChartTree] -> ShowS
show :: ChartTree -> String
$cshow :: ChartTree -> String
showsPrec :: Int -> ChartTree -> ShowS
$cshowsPrec :: Int -> ChartTree -> ShowS
Show, 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
$cto :: forall x. Rep ChartTree x -> ChartTree
$cfrom :: forall x. ChartTree -> Rep ChartTree x
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 forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Node (Maybe Text
name, []) (ChartTree -> Tree (Maybe Text, [Chart])
tree 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 forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Node (forall a. Maybe a
Nothing, [Chart]
cs forall a. Semigroup a => a -> a -> a
<> [Chart]
cs') ([Tree (Maybe Text, [Chart])]
xs forall a. Semigroup a => a -> a -> a
<> [Tree (Maybe Text, [Chart])]
xs')
      (Maybe Text, Maybe Text)
_ -> Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Node (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 forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Node (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 (forall a. a -> [Tree a] -> Tree a
Node (Maybe Text
a, forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Chart -> Maybe Chart
rem' [Chart]
cs) (ChartTree -> Tree (Maybe Text, [Chart])
tree forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chart -> Bool) -> ChartTree -> ChartTree
filterChartTree Chart -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree 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 = forall a. a -> a -> Bool -> a
bool forall a. Maybe a
Nothing (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' = 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' forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall 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' forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field2 s t a b => Lens s t a b
_2 forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (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 forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Node (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 forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Node (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 forall a b. (a -> b) -> a -> b
$ 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 (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) = forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect [Rect Double]
a
box (TextData [(Text, Point Double)]
a) = forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
a
box (LineData [[Point Double]]
a) = forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [[Point Double]]
a
box (GlyphData [Point Double]
a) = forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 [Point Double]
a
box (PathData [PathData Double]
a) = [PathData Double] -> Maybe (Rect Double)
pathBoxes [PathData Double]
a
box (BlankData [Rect Double]
a) = 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)) = forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect forall a b. (a -> b) -> a -> b
$ forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Double
0.5 forall a. Num a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "borderSize" a => a
#borderSize Style
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a
sbox (Chart Style
s (TextData [(Text, Point Double)]
a)) = forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Style -> Text -> Point Double -> Rect Double
styleBoxText Style
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
a
sbox (Chart Style
s (LineData [[Point Double]]
a)) = forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Double
0.5 forall a. Num a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size Style
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [[Point Double]]
a)
sbox (Chart Style
s (GlyphData [Point Double]
a)) = forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect forall a b. (a -> b) -> a -> b
$ (\Point Double
x -> forall a. Additive a => Point a -> Rect a -> Rect a
addPoint Point Double
x (Style -> Rect Double
styleBoxGlyph Style
s)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
a
sbox (Chart Style
s (PathData [PathData Double]
a)) = forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Double
0.5 forall a. Num a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "borderSize" a => a
#borderSize Style
s) 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)) = 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, anchor = 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 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "chartStyle" a => a
#chartStyle (Double -> Style -> Style
scaleStyle (ScaleP -> Rect Double -> Rect Double -> Double
scaleRatio (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "chartStyle" a => a
#chartStyle forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "scaleP" a => a
#scaleP) Chart
c) Rect Double
new Rect Double
old)) forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "chartData" a => a
#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 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 (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) 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 (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) 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 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 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 (forall a. Additive a => Point a -> Rect a -> Rect a
addPoint Point Double
p 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 (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) 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point Double -> Point Double -> Point Double
addp Point Double
p) 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 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 (forall a. Additive a => Point a -> PathData a -> PathData a
movePath Point Double
p 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 (forall a. Additive a => Point a -> Rect a -> Rect a
addPoint Point Double
p 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 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "chartData" a => a
#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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
* Double
p)) [Rect Double]
a)
scaleChartData Double
p (LineData [[Point Double]]
a) =
  [[Point Double]] -> ChartData
LineData (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
* Double
p))) [[Point Double]]
a)
scaleChartData Double
p (TextData [(Text, Point Double)]
a) =
  [(Text, Point Double)] -> ChartData
TextData (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
* Double
p))) [(Text, Point Double)]
a)
scaleChartData Double
p (GlyphData [Point Double]
a) =
  [Point Double] -> ChartData
GlyphData (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
* Double
p)) [Point Double]
a)
scaleChartData Double
p (PathData [PathData Double]
a) =
  [PathData Double] -> ChartData
PathData (forall a. Multiplicative a => a -> PathData a -> PathData a
scalePath Double
p 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num 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 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "chartData" a => a
#chartData (Double -> ChartData -> ChartData
scaleChartData Double
p) forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "chartStyle" a => a
#chartStyle (forall a. a -> a -> Bool -> a
bool (Double -> Style -> Style
scaleStyle Double
p) forall a. a -> a
id (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "chartStyle" a => a
#chartStyle forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "scaleP" a => a
#scaleP) Chart
c 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 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "color" a => a
#color Colour -> Colour
f forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "borderColor" a => a
#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 forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' ChartTree (Maybe (Rect Double))
styleBox' ChartTree
ct of
  Maybe (Rect Double)
Nothing -> ChartTree
ct
  Just Rect Double
b -> ChartTree
ct forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree [Chart]
charts' (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 = forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChartData -> Maybe (Rect Double)
box forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Chart -> ChartData
chartData 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (forall a. a -> Maybe a -> a
fromMaybe forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Rect Double -> Rect Double -> Chart -> Chart
projectWith forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Rect Double)
r 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' :: Lens' ChartTree (Maybe (Rect Double))
box' =
  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 = forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chart -> Maybe (Rect Double)
sbox 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (forall a. a -> Maybe a -> a
fromMaybe forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Rect Double -> Rect Double -> Chart -> Chart
projectWith forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Rect Double)
r 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' :: Lens' ChartTree (Maybe (Rect Double))
styleBox' =
  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' = forall s a. (s -> a) -> Getter s a
Optics.Core.to (Lens' ChartTree (Maybe (Rect Double)) -> ChartTree -> Rect Double
safeBox_ Lens' 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' = forall s a. (s -> a) -> Getter s a
Optics.Core.to (Lens' ChartTree (Maybe (Rect Double)) -> ChartTree -> Rect Double
safeBox_ Lens' ChartTree (Maybe (Rect Double))
box')

safeBox_ :: Lens' ChartTree (Maybe (Rect Double)) -> ChartTree -> Rect Double
safeBox_ :: Lens' ChartTree (Maybe (Rect Double)) -> ChartTree -> Rect Double
safeBox_ Lens' ChartTree (Maybe (Rect Double))
l ChartTree
ct
  | Maybe (Rect Double)
b forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing Bool -> Bool -> Bool
|| (forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rect Double -> Bool
isSingleton Maybe (Rect Double)
b) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Multiplicative a => a
one Rect Double -> Rect Double
padSingletons (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' ChartTree (Maybe (Rect Double))
l ChartTree
ct)
  | Bool
otherwise = forall a. a -> Maybe a -> a
fromMaybe forall a. Multiplicative a => a
one Maybe (Rect Double)
b
  where
    b :: Maybe (Rect Double)
b = forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' 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, anchor = 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 (forall a. Maybe a -> [a]
maybeToList (forall a. Subtractive a => a -> Rect a -> Rect a
padRect Double
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' 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 (forall a. Maybe a -> [a]
maybeToList (forall a. Subtractive a => a -> Rect a -> Rect a
padRect Double
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' 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) with a gap between
hori :: Double -> [ChartTree] -> ChartTree
hori :: Double -> [ChartTree] -> ChartTree
hori Double
_ [] = forall a. Monoid a => a
mempty
hori Double
gap [ChartTree]
cs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ChartTree -> ChartTree -> ChartTree
step forall a. Monoid a => a
mempty [ChartTree]
cs
  where
    step :: ChartTree -> ChartTree -> ChartTree
step ChartTree
x ChartTree
c = ChartTree
x forall a. Semigroup a => a -> a -> a
<> 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 (forall a. a -> a -> Point a
Point (ChartTree -> Double
widthx ChartTree
x) (ChartTree -> Double
aligny ChartTree
x forall a. Num a => a -> a -> a
- ChartTree -> Double
aligny ChartTree
c))) ChartTree
c
    widthx :: ChartTree -> Double
widthx ChartTree
x = case 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
      [] -> forall a. Additive a => a
zero
      [Chart]
xs -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Additive a => a
zero (\(Rect Double
x' Double
z' Double
_ Double
_) -> Double
z' forall a. Num a => a -> a -> a
- Double
x' forall a. Num a => a -> a -> a
+ Double
gap) ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)
    aligny :: ChartTree -> Double
aligny ChartTree
x = case 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
      [] -> forall a. Additive a => a
zero
      [Chart]
xs -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Additive a => a
zero (\(Rect Double
_ Double
_ Double
y' Double
w') -> (Double
y' forall a. Num a => a -> a -> a
+ Double
w') forall a. Fractional a => a -> a -> a
/ Double
2) ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)

-- | Vertically stack a list of trees (proceeding upwards), aligning them to the left
vert :: Double -> [ChartTree] -> ChartTree
vert :: Double -> [ChartTree] -> ChartTree
vert Double
_ [] = forall a. Monoid a => a
mempty
vert Double
gap [ChartTree]
cs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ChartTree -> ChartTree -> ChartTree
step forall a. Monoid a => a
mempty [ChartTree]
cs
  where
    step :: ChartTree -> ChartTree -> ChartTree
step ChartTree
x ChartTree
c = ChartTree
x forall a. Semigroup a => a -> a -> a
<> 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 (forall a. a -> a -> Point a
Point (ChartTree -> Double
alignx ChartTree
x forall a. Num a => a -> a -> a
- ChartTree -> Double
alignx ChartTree
c) (ChartTree -> Double
widthy ChartTree
x))) ChartTree
c
    widthy :: ChartTree -> Double
widthy ChartTree
x = case 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
      [] -> forall a. Additive a => a
zero
      [Chart]
xs -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Additive a => a
zero (\(Rect Double
_ Double
_ Double
y' Double
w') -> Double
w' forall a. Num a => a -> a -> a
- Double
y' forall a. Num a => a -> a -> a
+ Double
gap) ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)
    alignx :: ChartTree -> Double
alignx ChartTree
x = case 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
      [] -> forall a. Additive a => a
zero
      [Chart]
xs -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Additive a => a
zero (\(Rect Double
x' Double
_ Double
_ Double
_) -> Double
x') ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)

-- | 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 -> Double -> [ChartTree] -> ChartTree
stack :: Int -> Double -> [ChartTree] -> ChartTree
stack Int
_ Double
_ [] = forall a. Monoid a => a
mempty
stack Int
n Double
gap [ChartTree]
cs = Double -> [ChartTree] -> ChartTree
vert Double
gap (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Double -> [ChartTree] -> ChartTree
hori Double
gap 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 = forall a. [a] -> [a]
reverse [[ChartTree]]
acc
    group' [ChartTree]
x [[ChartTree]]
acc = [ChartTree] -> [[ChartTree]] -> [[ChartTree]]
group' (forall a. Int -> [a] -> [a]
drop Int
n [ChartTree]
x) (forall a. Int -> [a] -> [a]
take Int
n [ChartTree]
x forall a. a -> [a] -> [a]
: [[ChartTree]]
acc)

-- | 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 (forall a. a -> Maybe a
Just Text
"rectangularize") [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 -> forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "chartStyle" a => a
#chartStyle Style
r forall a b. (a -> b) -> a -> b
$ forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "chartData" a => a
#chartData (Chart -> ChartData
rectangularize_ Chart
c) Chart
c) ChartTree
ct]

rectangularize_ :: Chart -> ChartData
rectangularize_ :: Chart -> ChartData
rectangularize_ Chart
c = [Rect Double] -> ChartData
RectData (forall a. Maybe a -> [a]
maybeToList 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 (forall a. a -> Maybe a
Just Text
"glyphize") [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' (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "chartStyle" a => a
#chartStyle Style
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "chartData" a => a
#chartData ChartData -> ChartData
pointize_) ChartTree
ct]

pointize_ :: ChartData -> ChartData
pointize_ :: ChartData -> ChartData
pointize_ (TextData [(Text, Point Double)]
xs) = [Point Double] -> ChartData
GlyphData (forall a b. (a, b) -> b
snd 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 (forall a. PathData a -> Point a
pointPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double]
xs)
pointize_ (LineData [[Point Double]]
xs) = [Point Double] -> ChartData
GlyphData (forall a. Monoid a => [a] -> a
mconcat [[Point Double]]
xs)
pointize_ (BlankData [Rect Double]
xs) = [Point Double] -> ChartData
GlyphData (forall s. (Space s, Field (Element s)) => s -> Element s
mid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
xs)
pointize_ (RectData [Rect Double]
xs) = [Point Double] -> ChartData
GlyphData (forall s. (Space s, Field (Element s)) => s -> Element s
mid 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c== :: Orientation -> Orientation -> Bool
Eq, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orientation] -> ShowS
$cshowList :: [Orientation] -> ShowS
show :: Orientation -> String
$cshow :: Orientation -> String
showsPrec :: Int -> Orientation -> ShowS
$cshowsPrec :: Int -> Orientation -> ShowS
Show, 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
$cto :: forall x. Rep Orientation x -> Orientation
$cfrom :: forall x. Orientation -> Rep Orientation x
Generic)

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