{-# LANGUAGE ScopedTypeVariables, TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-}
module Graphics.Rendering.Chart.Easy(
module Control.Lens,
module Data.Default.Class,
module Data.Colour,
module Data.Colour.Names,
module Graphics.Rendering.Chart,
module Graphics.Rendering.Chart.State,
line,
points,
bars,
setColors,
setShapes
) where
import Control.Lens
import Control.Monad(when)
import Data.Default.Class
import Data.Colour hiding (over)
import Data.Colour.Names
import Graphics.Rendering.Chart
import Graphics.Rendering.Chart.State
setColors :: [AlphaColour Double] -> EC l ()
setColors :: [AlphaColour Double] -> EC l ()
setColors [AlphaColour Double]
cs = State CState () -> EC l ()
forall a l. State CState a -> EC l a
liftCState (State CState () -> EC l ()) -> State CState () -> EC l ()
forall a b. (a -> b) -> a -> b
$ ([AlphaColour Double] -> Identity [AlphaColour Double])
-> CState -> Identity CState
Lens' CState [AlphaColour Double]
colors (([AlphaColour Double] -> Identity [AlphaColour Double])
-> CState -> Identity CState)
-> [AlphaColour Double] -> State CState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [AlphaColour Double] -> [AlphaColour Double]
forall a. [a] -> [a]
cycle [AlphaColour Double]
cs
setShapes :: [PointShape] -> EC l ()
setShapes :: [PointShape] -> EC l ()
setShapes [PointShape]
ps = State CState () -> EC l ()
forall a l. State CState a -> EC l a
liftCState (State CState () -> EC l ()) -> State CState () -> EC l ()
forall a b. (a -> b) -> a -> b
$ ([PointShape] -> Identity [PointShape])
-> CState -> Identity CState
Lens' CState [PointShape]
shapes (([PointShape] -> Identity [PointShape])
-> CState -> Identity CState)
-> [PointShape] -> State CState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [PointShape] -> [PointShape]
forall a. [a] -> [a]
cycle [PointShape]
ps
line :: String -> [[(x,y)]] -> EC l (PlotLines x y)
line :: String -> [[(x, y)]] -> EC l (PlotLines x y)
line String
title [[(x, y)]]
values = EC (PlotLines x y) () -> EC l (PlotLines x y)
forall l1 a l2. Default l1 => EC l1 a -> EC l2 l1
liftEC (EC (PlotLines x y) () -> EC l (PlotLines x y))
-> EC (PlotLines x y) () -> EC l (PlotLines x y)
forall a b. (a -> b) -> a -> b
$ do
AlphaColour Double
color <- EC (PlotLines x y) (AlphaColour Double)
forall l. EC l (AlphaColour Double)
takeColor
(String -> Identity String)
-> PlotLines x y -> Identity (PlotLines x y)
forall x y. Lens' (PlotLines x y) String
plot_lines_title ((String -> Identity String)
-> PlotLines x y -> Identity (PlotLines x y))
-> String -> EC (PlotLines x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= String
title
([[(x, y)]] -> Identity [[(x, y)]])
-> PlotLines x y -> Identity (PlotLines x y)
forall x y. Lens' (PlotLines x y) [[(x, y)]]
plot_lines_values (([[(x, y)]] -> Identity [[(x, y)]])
-> PlotLines x y -> Identity (PlotLines x y))
-> [[(x, y)]] -> EC (PlotLines x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [[(x, y)]]
values
(LineStyle -> Identity LineStyle)
-> PlotLines x y -> Identity (PlotLines x y)
forall x y. Lens' (PlotLines x y) LineStyle
plot_lines_style ((LineStyle -> Identity LineStyle)
-> PlotLines x y -> Identity (PlotLines x y))
-> ((AlphaColour Double -> Identity (AlphaColour Double))
-> LineStyle -> Identity LineStyle)
-> (AlphaColour Double -> Identity (AlphaColour Double))
-> PlotLines x y
-> Identity (PlotLines x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlphaColour Double -> Identity (AlphaColour Double))
-> LineStyle -> Identity LineStyle
Lens' LineStyle (AlphaColour Double)
line_color ((AlphaColour Double -> Identity (AlphaColour Double))
-> PlotLines x y -> Identity (PlotLines x y))
-> AlphaColour Double -> EC (PlotLines x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AlphaColour Double
color
points :: String -> [(x,y)] -> EC l (PlotPoints x y)
points :: String -> [(x, y)] -> EC l (PlotPoints x y)
points String
title [(x, y)]
values = EC (PlotPoints x y) () -> EC l (PlotPoints x y)
forall l1 a l2. Default l1 => EC l1 a -> EC l2 l1
liftEC (EC (PlotPoints x y) () -> EC l (PlotPoints x y))
-> EC (PlotPoints x y) () -> EC l (PlotPoints x y)
forall a b. (a -> b) -> a -> b
$ do
AlphaColour Double
color <- EC (PlotPoints x y) (AlphaColour Double)
forall l. EC l (AlphaColour Double)
takeColor
PointShape
shape <- EC (PlotPoints x y) PointShape
forall l. EC l PointShape
takeShape
([(x, y)] -> Identity [(x, y)])
-> PlotPoints x y -> Identity (PlotPoints x y)
forall x1 y1 x2 y2.
Lens (PlotPoints x1 y1) (PlotPoints x2 y2) [(x1, y1)] [(x2, y2)]
plot_points_values (([(x, y)] -> Identity [(x, y)])
-> PlotPoints x y -> Identity (PlotPoints x y))
-> [(x, y)] -> EC (PlotPoints x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [(x, y)]
values
(String -> Identity String)
-> PlotPoints x y -> Identity (PlotPoints x y)
forall x1 y1. Lens' (PlotPoints x1 y1) String
plot_points_title ((String -> Identity String)
-> PlotPoints x y -> Identity (PlotPoints x y))
-> String -> EC (PlotPoints x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= String
title
(PointStyle -> Identity PointStyle)
-> PlotPoints x y -> Identity (PlotPoints x y)
forall x1 y1. Lens' (PlotPoints x1 y1) PointStyle
plot_points_style ((PointStyle -> Identity PointStyle)
-> PlotPoints x y -> Identity (PlotPoints x y))
-> ((AlphaColour Double -> Identity (AlphaColour Double))
-> PointStyle -> Identity PointStyle)
-> (AlphaColour Double -> Identity (AlphaColour Double))
-> PlotPoints x y
-> Identity (PlotPoints x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlphaColour Double -> Identity (AlphaColour Double))
-> PointStyle -> Identity PointStyle
Lens' PointStyle (AlphaColour Double)
point_color ((AlphaColour Double -> Identity (AlphaColour Double))
-> PlotPoints x y -> Identity (PlotPoints x y))
-> AlphaColour Double -> EC (PlotPoints x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AlphaColour Double
color
(PointStyle -> Identity PointStyle)
-> PlotPoints x y -> Identity (PlotPoints x y)
forall x1 y1. Lens' (PlotPoints x1 y1) PointStyle
plot_points_style ((PointStyle -> Identity PointStyle)
-> PlotPoints x y -> Identity (PlotPoints x y))
-> ((PointShape -> Identity PointShape)
-> PointStyle -> Identity PointStyle)
-> (PointShape -> Identity PointShape)
-> PlotPoints x y
-> Identity (PlotPoints x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointShape -> Identity PointShape)
-> PointStyle -> Identity PointStyle
Lens' PointStyle PointShape
point_shape ((PointShape -> Identity PointShape)
-> PlotPoints x y -> Identity (PlotPoints x y))
-> PointShape -> EC (PlotPoints x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= PointShape
shape
(PointStyle -> Identity PointStyle)
-> PlotPoints x y -> Identity (PlotPoints x y)
forall x1 y1. Lens' (PlotPoints x1 y1) PointStyle
plot_points_style ((PointStyle -> Identity PointStyle)
-> PlotPoints x y -> Identity (PlotPoints x y))
-> ((Double -> Identity Double)
-> PointStyle -> Identity PointStyle)
-> (Double -> Identity Double)
-> PlotPoints x y
-> Identity (PlotPoints x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double) -> PointStyle -> Identity PointStyle
Lens' PointStyle Double
point_radius ((Double -> Identity Double)
-> PlotPoints x y -> Identity (PlotPoints x y))
-> Double -> EC (PlotPoints x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Double
2
Bool -> EC (PlotPoints x y) () -> EC (PlotPoints x y) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (PointShape -> Bool
isFilled PointShape
shape)) (EC (PlotPoints x y) () -> EC (PlotPoints x y) ())
-> EC (PlotPoints x y) () -> EC (PlotPoints x y) ()
forall a b. (a -> b) -> a -> b
$ do
(PointStyle -> Identity PointStyle)
-> PlotPoints x y -> Identity (PlotPoints x y)
forall x1 y1. Lens' (PlotPoints x1 y1) PointStyle
plot_points_style ((PointStyle -> Identity PointStyle)
-> PlotPoints x y -> Identity (PlotPoints x y))
-> ((AlphaColour Double -> Identity (AlphaColour Double))
-> PointStyle -> Identity PointStyle)
-> (AlphaColour Double -> Identity (AlphaColour Double))
-> PlotPoints x y
-> Identity (PlotPoints x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlphaColour Double -> Identity (AlphaColour Double))
-> PointStyle -> Identity PointStyle
Lens' PointStyle (AlphaColour Double)
point_border_color ((AlphaColour Double -> Identity (AlphaColour Double))
-> PlotPoints x y -> Identity (PlotPoints x y))
-> AlphaColour Double -> EC (PlotPoints x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AlphaColour Double
color
(PointStyle -> Identity PointStyle)
-> PlotPoints x y -> Identity (PlotPoints x y)
forall x1 y1. Lens' (PlotPoints x1 y1) PointStyle
plot_points_style ((PointStyle -> Identity PointStyle)
-> PlotPoints x y -> Identity (PlotPoints x y))
-> ((Double -> Identity Double)
-> PointStyle -> Identity PointStyle)
-> (Double -> Identity Double)
-> PlotPoints x y
-> Identity (PlotPoints x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double) -> PointStyle -> Identity PointStyle
Lens' PointStyle Double
point_border_width ((Double -> Identity Double)
-> PlotPoints x y -> Identity (PlotPoints x y))
-> Double -> EC (PlotPoints x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Double
1
isFilled :: PointShape -> Bool
isFilled :: PointShape -> Bool
isFilled PointShape
PointShapeCircle = Bool
True
isFilled PointShapePolygon{} = Bool
True
isFilled PointShape
_ = Bool
False
bars :: (PlotValue x, BarsPlotValue y) => [String] -> [(x,[y])] -> EC l (PlotBars x y)
bars :: [String] -> [(x, [y])] -> EC l (PlotBars x y)
bars [String]
titles [(x, [y])]
vals = EC (PlotBars x y) () -> EC l (PlotBars x y)
forall l1 a l2. Default l1 => EC l1 a -> EC l2 l1
liftEC (EC (PlotBars x y) () -> EC l (PlotBars x y))
-> EC (PlotBars x y) () -> EC l (PlotBars x y)
forall a b. (a -> b) -> a -> b
$ do
[(FillStyle, Maybe LineStyle)]
styles <- [StateT (PlotBars x y) (State CState) (FillStyle, Maybe LineStyle)]
-> StateT
(PlotBars x y) (State CState) [(FillStyle, Maybe LineStyle)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [(AlphaColour Double -> (FillStyle, Maybe LineStyle))
-> StateT (PlotBars x y) (State CState) (AlphaColour Double)
-> StateT
(PlotBars x y) (State CState) (FillStyle, Maybe LineStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AlphaColour Double -> (FillStyle, Maybe LineStyle)
mkStyle StateT (PlotBars x y) (State CState) (AlphaColour Double)
forall l. EC l (AlphaColour Double)
takeColor | String
_ <- [String]
titles]
([String] -> Identity [String])
-> PlotBars x y -> Identity (PlotBars x y)
forall x y. Lens' (PlotBars x y) [String]
plot_bars_titles (([String] -> Identity [String])
-> PlotBars x y -> Identity (PlotBars x y))
-> [String] -> EC (PlotBars x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [String]
titles
([(x, [y])] -> Identity [(x, [y])])
-> PlotBars x y -> Identity (PlotBars x y)
forall x y x2.
Lens (PlotBars x y) (PlotBars x2 y) [(x, [y])] [(x2, [y])]
plot_bars_values (([(x, [y])] -> Identity [(x, [y])])
-> PlotBars x y -> Identity (PlotBars x y))
-> [(x, [y])] -> EC (PlotBars x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [(x, [y])]
vals
(PlotBarsStyle -> Identity PlotBarsStyle)
-> PlotBars x y -> Identity (PlotBars x y)
forall x y. Lens' (PlotBars x y) PlotBarsStyle
plot_bars_style ((PlotBarsStyle -> Identity PlotBarsStyle)
-> PlotBars x y -> Identity (PlotBars x y))
-> PlotBarsStyle -> EC (PlotBars x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= PlotBarsStyle
BarsClustered
(PlotBarsSpacing -> Identity PlotBarsSpacing)
-> PlotBars x y -> Identity (PlotBars x y)
forall x y. Lens' (PlotBars x y) PlotBarsSpacing
plot_bars_spacing ((PlotBarsSpacing -> Identity PlotBarsSpacing)
-> PlotBars x y -> Identity (PlotBars x y))
-> PlotBarsSpacing -> EC (PlotBars x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Double -> Double -> PlotBarsSpacing
BarsFixGap Double
30 Double
5
([(FillStyle, Maybe LineStyle)]
-> Identity [(FillStyle, Maybe LineStyle)])
-> PlotBars x y -> Identity (PlotBars x y)
forall x y. Lens' (PlotBars x y) [(FillStyle, Maybe LineStyle)]
plot_bars_item_styles (([(FillStyle, Maybe LineStyle)]
-> Identity [(FillStyle, Maybe LineStyle)])
-> PlotBars x y -> Identity (PlotBars x y))
-> [(FillStyle, Maybe LineStyle)] -> EC (PlotBars x y) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [(FillStyle, Maybe LineStyle)]
styles
where
mkStyle :: AlphaColour Double -> (FillStyle, Maybe LineStyle)
mkStyle AlphaColour Double
c = (AlphaColour Double -> FillStyle
solidFillStyle AlphaColour Double
c, LineStyle -> Maybe LineStyle
forall a. a -> Maybe a
Just (Double -> AlphaColour Double -> LineStyle
solidLine Double
1.0 (AlphaColour Double -> LineStyle)
-> AlphaColour Double -> LineStyle
forall a b. (a -> b) -> a -> b
$ Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. Num a => Colour a
black))