{-# LANGUAGE DeriveGeneric, OverloadedStrings,FlexibleInstances, TemplateHaskell #-}

{-|

This module defines datatypes that can be used to generate [Plotly.js](https://plot.ly/javascript/)
plots via their JSON values. The interface encourages the use of
lenses. Every trace on a plot is defined by a `Trace` type value, the
construction of which is the central goal of this module.

Example scatter plot of the Iris dataset:

@
import Graphics.Plotly
import Numeric.Dataset.Iris

tr :: Trace
tr = scatter & x ?~ map sepalLength iris
             & y ?~ map sepalWidth iris
             & marker ?~ (defMarker & markercolor ?~ catColors (map irisClass irisd))
             & mode ?~ [Markers]
@

Horizontal bars:

@
hbarData :: [(Text, Double)]
hbarData = [(\"Simon\", 14.5), (\"Joe\", 18.9), (\"Dorothy\", 16.2)]

hbarsTrace :: Trace
hbarsTrace = bars & ytext ?~ map fst hbarData
                  & x ?~ map snd hbarData
                  & orientation ?~ Horizontal
@

see Graphics.Plotly.Lucid for helper functions that turn traces into HTML.

-}

module Graphics.Plotly.Base where

import Data.Aeson
import Data.Aeson.Types
import Data.Char (toLower)
import Data.List (intercalate, nub, findIndex)
import Data.Monoid ((<>))
import Data.Maybe (fromJust)
import Data.Text (Text)

import GHC.Generics
import Lens.Micro.TH

import Graphics.Plotly.Utils

-- * Traces

-- |How should traces be drawn? (lines or markers)
data Mode = Markers | Lines | ModeText deriving Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show

instance {-# OVERLAPS #-} ToJSON [Mode] where
  toJSON :: [Mode] -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> ([Mode] -> String) -> [Mode] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"+" ([String] -> String) -> ([Mode] -> [String]) -> [Mode] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mode -> String) -> [Mode] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (Mode -> String) -> Mode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
dropInitial String
"Mode" ShowS -> (Mode -> String) -> Mode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> String
forall a. Show a => a -> String
show)

-- | What kind of plot type are we building - scatter (inluding line plots) or bars?
data TraceType  = Scatter
                | Scatter3D
                | Bar
                | Box
                | Mesh3D
                | Pie
                | Contour
                deriving Int -> TraceType -> ShowS
[TraceType] -> ShowS
TraceType -> String
(Int -> TraceType -> ShowS)
-> (TraceType -> String)
-> ([TraceType] -> ShowS)
-> Show TraceType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceType] -> ShowS
$cshowList :: [TraceType] -> ShowS
show :: TraceType -> String
$cshow :: TraceType -> String
showsPrec :: Int -> TraceType -> ShowS
$cshowsPrec :: Int -> TraceType -> ShowS
Show

instance ToJSON TraceType where
  toJSON :: TraceType -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (TraceType -> String) -> TraceType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (TraceType -> String) -> TraceType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceType -> String
forall a. Show a => a -> String
show


-- | A color specification, either as a concrete RGB/RGBA value or a color per point.
data Color = ColRGBA Int Int Int Int -- ^ use this RGBA color for every point in the trace
           | ColRGB Int Int Int -- ^ use this RGB color for every point in the trace
           | ColIx Int  -- ^ use a different color index for each point

instance Eq Color where
  (ColRGBA Int
r0 Int
g0 Int
b0 Int
a0) == :: Color -> Color -> Bool
== (ColRGBA Int
r1 Int
g1 Int
b1 Int
a1) = (Int
r0,Int
g0,Int
b0,Int
a0) (Int, Int, Int, Int) -> (Int, Int, Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
r1,Int
g1,Int
b1,Int
a1)
  (ColRGB  Int
r0 Int
g0 Int
b0)    == (ColRGB  Int
r1 Int
g1 Int
b1)    = (Int
r0,Int
g0,Int
b0)    (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
r1,Int
g1,Int
b1)
  (ColIx   Int
i0)          == (ColIx   Int
i1)          = Int
i0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i1

  (ColRGBA Int
r0 Int
g0 Int
b0 Int
1)  == (ColRGB  Int
r1 Int
g1 Int
b1)    = (Int
r0,Int
g0,Int
b0) (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
r1,Int
g1,Int
b1)
  (ColRGB  Int
r0 Int
g0 Int
b0)    == (ColRGBA Int
r1 Int
g1 Int
b1 Int
1)  = (Int
r0,Int
g0,Int
b0) (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
r1,Int
g1,Int
b1)

  Color
_ == Color
_ = Bool
False

instance ToJSON Color where
  toJSON :: Color -> Value
toJSON (ColRGB Int
r Int
g Int
b) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ String
"rgb("String -> ShowS
forall a. Semigroup a => a -> a -> a
<>Int -> String
forall a. Show a => a -> String
show Int
rString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
","String -> ShowS
forall a. Semigroup a => a -> a -> a
<>Int -> String
forall a. Show a => a -> String
show Int
gString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
","String -> ShowS
forall a. Semigroup a => a -> a -> a
<>Int -> String
forall a. Show a => a -> String
show Int
bString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
")"
  toJSON (ColRGBA Int
r Int
g Int
b Int
a) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ String
"rgba("String -> ShowS
forall a. Semigroup a => a -> a -> a
<>Int -> String
forall a. Show a => a -> String
show Int
rString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
","String -> ShowS
forall a. Semigroup a => a -> a -> a
<>Int -> String
forall a. Show a => a -> String
show Int
gString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
","String -> ShowS
forall a. Semigroup a => a -> a -> a
<>Int -> String
forall a. Show a => a -> String
show Int
bString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
","String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
aString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
")"
  toJSON (ColIx Int
cs) = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
cs

-- | Assign colors based on any categorical value
catColors :: Eq a => [a] -> ListOrElem Value
catColors :: forall a. Eq a => [a] -> ListOrElem Value
catColors [a]
xs =
  let vals :: [a]
vals = [a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
xs
      f :: a -> Int
f a
x = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x) [a]
vals
  in [Value] -> ListOrElem Value
forall a. [a] -> ListOrElem a
List ([Value] -> ListOrElem Value) -> [Value] -> ListOrElem Value
forall a b. (a -> b) -> a -> b
$ (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Value
forall a. ToJSON a => a -> Value
toJSON (Color -> Value) -> (a -> Color) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Color
ColIx (Int -> Color) -> (a -> Int) -> a -> Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
f) [a]
xs

-- | Different types of markers
data Symbol = Circle | Square | Diamond | Cross | CustomSymbol Text deriving (Int -> Symbol -> ShowS
[Symbol] -> ShowS
Symbol -> String
(Int -> Symbol -> ShowS)
-> (Symbol -> String) -> ([Symbol] -> ShowS) -> Show Symbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Symbol] -> ShowS
$cshowList :: [Symbol] -> ShowS
show :: Symbol -> String
$cshow :: Symbol -> String
showsPrec :: Int -> Symbol -> ShowS
$cshowsPrec :: Int -> Symbol -> ShowS
Show, Symbol -> Symbol -> Bool
(Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool) -> Eq Symbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Symbol -> Symbol -> Bool
$c/= :: Symbol -> Symbol -> Bool
== :: Symbol -> Symbol -> Bool
$c== :: Symbol -> Symbol -> Bool
Eq)

instance ToJSON Symbol where
  toJSON :: Symbol -> Value
toJSON (CustomSymbol Text
t) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t
  toJSON Symbol
s = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (Symbol -> String) -> Symbol -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (Symbol -> String) -> Symbol -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> String
forall a. Show a => a -> String
show (Symbol -> Value) -> Symbol -> Value
forall a b. (a -> b) -> a -> b
$ Symbol
s

data ListOrElem a = List [a] | All a deriving ListOrElem a -> ListOrElem a -> Bool
(ListOrElem a -> ListOrElem a -> Bool)
-> (ListOrElem a -> ListOrElem a -> Bool) -> Eq (ListOrElem a)
forall a. Eq a => ListOrElem a -> ListOrElem a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListOrElem a -> ListOrElem a -> Bool
$c/= :: forall a. Eq a => ListOrElem a -> ListOrElem a -> Bool
== :: ListOrElem a -> ListOrElem a -> Bool
$c== :: forall a. Eq a => ListOrElem a -> ListOrElem a -> Bool
Eq

instance ToJSON a => ToJSON (ListOrElem a) where
  toJSON :: ListOrElem a -> Value
toJSON (List [a]
xs) = [a] -> Value
forall a. ToJSON a => a -> Value
toJSON [a]
xs
  toJSON (All a
x) = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x

data Sizemode = Diameter | Area deriving (Int -> Sizemode -> ShowS
[Sizemode] -> ShowS
Sizemode -> String
(Int -> Sizemode -> ShowS)
-> (Sizemode -> String) -> ([Sizemode] -> ShowS) -> Show Sizemode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sizemode] -> ShowS
$cshowList :: [Sizemode] -> ShowS
show :: Sizemode -> String
$cshow :: Sizemode -> String
showsPrec :: Int -> Sizemode -> ShowS
$cshowsPrec :: Int -> Sizemode -> ShowS
Show, Sizemode -> Sizemode -> Bool
(Sizemode -> Sizemode -> Bool)
-> (Sizemode -> Sizemode -> Bool) -> Eq Sizemode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sizemode -> Sizemode -> Bool
$c/= :: Sizemode -> Sizemode -> Bool
== :: Sizemode -> Sizemode -> Bool
$c== :: Sizemode -> Sizemode -> Bool
Eq)

instance ToJSON Sizemode where
  toJSON :: Sizemode -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (Sizemode -> String) -> Sizemode -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (Sizemode -> String) -> Sizemode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sizemode -> String
forall a. Show a => a -> String
show

-- | Marker line specification
data MarkerLine = MarkerLine
  { MarkerLine -> Maybe (ListOrElem Double)
_markerlinewidth :: Maybe (ListOrElem Double)
  , MarkerLine -> Maybe (ListOrElem Value)
_markerlinecolor :: Maybe (ListOrElem Value)
  } deriving ((forall x. MarkerLine -> Rep MarkerLine x)
-> (forall x. Rep MarkerLine x -> MarkerLine) -> Generic MarkerLine
forall x. Rep MarkerLine x -> MarkerLine
forall x. MarkerLine -> Rep MarkerLine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MarkerLine x -> MarkerLine
$cfrom :: forall x. MarkerLine -> Rep MarkerLine x
Generic, MarkerLine -> MarkerLine -> Bool
(MarkerLine -> MarkerLine -> Bool)
-> (MarkerLine -> MarkerLine -> Bool) -> Eq MarkerLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkerLine -> MarkerLine -> Bool
$c/= :: MarkerLine -> MarkerLine -> Bool
== :: MarkerLine -> MarkerLine -> Bool
$c== :: MarkerLine -> MarkerLine -> Bool
Eq)

makeLenses ''MarkerLine

instance ToJSON MarkerLine where
  toJSON :: MarkerLine -> Value
toJSON = Options -> MarkerLine -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropInitial String
"markerline" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unLens}

-- | default marker line specification
defMarkerLine :: MarkerLine
defMarkerLine :: MarkerLine
defMarkerLine = Maybe (ListOrElem Double) -> Maybe (ListOrElem Value) -> MarkerLine
MarkerLine Maybe (ListOrElem Double)
forall a. Maybe a
Nothing Maybe (ListOrElem Value)
forall a. Maybe a
Nothing

-- | Marker specification
data Marker = Marker
  { Marker -> Maybe (ListOrElem Value)
_size :: Maybe (ListOrElem Value)
  , Marker -> Maybe Value
_sizeref :: Maybe Value
  , Marker -> Maybe Sizemode
_sizeMode :: Maybe Sizemode
  , Marker -> Maybe (ListOrElem Value)
_markercolor :: Maybe (ListOrElem Value)
  , Marker -> Maybe (ListOrElem Value)
_markercolors :: Maybe (ListOrElem Value) -- for pie charts
  , Marker -> Maybe (ListOrElem Symbol)
_symbol :: Maybe (ListOrElem Symbol)
  , Marker -> Maybe Double
_opacity :: Maybe Double
  , Marker -> Maybe MarkerLine
_markerline :: Maybe MarkerLine
  } deriving ((forall x. Marker -> Rep Marker x)
-> (forall x. Rep Marker x -> Marker) -> Generic Marker
forall x. Rep Marker x -> Marker
forall x. Marker -> Rep Marker x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Marker x -> Marker
$cfrom :: forall x. Marker -> Rep Marker x
Generic, Marker -> Marker -> Bool
(Marker -> Marker -> Bool)
-> (Marker -> Marker -> Bool) -> Eq Marker
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Marker -> Marker -> Bool
$c/= :: Marker -> Marker -> Bool
== :: Marker -> Marker -> Bool
$c== :: Marker -> Marker -> Bool
Eq)

makeLenses ''Marker

instance ToJSON Marker where
  toJSON :: Marker -> Value
toJSON = Options -> Marker -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropInitial String
"marker" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unLens}

-- | default marker specification
defMarker :: Marker
defMarker :: Marker
defMarker  = Maybe (ListOrElem Value)
-> Maybe Value
-> Maybe Sizemode
-> Maybe (ListOrElem Value)
-> Maybe (ListOrElem Value)
-> Maybe (ListOrElem Symbol)
-> Maybe Double
-> Maybe MarkerLine
-> Marker
Marker Maybe (ListOrElem Value)
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing Maybe Sizemode
forall a. Maybe a
Nothing Maybe (ListOrElem Value)
forall a. Maybe a
Nothing Maybe (ListOrElem Value)
forall a. Maybe a
Nothing Maybe (ListOrElem Symbol)
forall a. Maybe a
Nothing Maybe Double
forall a. Maybe a
Nothing Maybe MarkerLine
forall a. Maybe a
Nothing


-- | Dash type specification
data Dash = Solid | Dashdot | Dot deriving Int -> Dash -> ShowS
[Dash] -> ShowS
Dash -> String
(Int -> Dash -> ShowS)
-> (Dash -> String) -> ([Dash] -> ShowS) -> Show Dash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dash] -> ShowS
$cshowList :: [Dash] -> ShowS
show :: Dash -> String
$cshow :: Dash -> String
showsPrec :: Int -> Dash -> ShowS
$cshowsPrec :: Int -> Dash -> ShowS
Show

instance ToJSON Dash where
  toJSON :: Dash -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (Dash -> String) -> Dash -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (Dash -> String) -> Dash -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dash -> String
forall a. Show a => a -> String
show

-- | Horizontal or Vertical orientation of bars
data Orientation = Horizontal | Vertical

instance ToJSON Orientation where
  toJSON :: Orientation -> Value
toJSON Orientation
Horizontal = Value
"h"
  toJSON Orientation
Vertical = Value
"v"

-- | Are we filling area plots from the zero line or to the next Y value?
data Fill = FillNone | ToZeroY | ToNextY | ToZeroX | ToNextX | ToSelf | ToNext deriving Int -> Fill -> ShowS
[Fill] -> ShowS
Fill -> String
(Int -> Fill -> ShowS)
-> (Fill -> String) -> ([Fill] -> ShowS) -> Show Fill
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fill] -> ShowS
$cshowList :: [Fill] -> ShowS
show :: Fill -> String
$cshow :: Fill -> String
showsPrec :: Int -> Fill -> ShowS
$cshowsPrec :: Int -> Fill -> ShowS
Show

instance ToJSON Fill where
  toJSON :: Fill -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (Fill -> String) -> Fill -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (Fill -> String) -> Fill -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
dropInitial String
"Fill" ShowS -> (Fill -> String) -> Fill -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fill -> String
forall a. Show a => a -> String
show


data LineShape = Linear | Spline | Hv | Hvh | Vh | Vhv deriving Int -> LineShape -> ShowS
[LineShape] -> ShowS
LineShape -> String
(Int -> LineShape -> ShowS)
-> (LineShape -> String)
-> ([LineShape] -> ShowS)
-> Show LineShape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineShape] -> ShowS
$cshowList :: [LineShape] -> ShowS
show :: LineShape -> String
$cshow :: LineShape -> String
showsPrec :: Int -> LineShape -> ShowS
$cshowsPrec :: Int -> LineShape -> ShowS
Show

instance ToJSON LineShape where
  toJSON :: LineShape -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (LineShape -> String) -> LineShape -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (LineShape -> String) -> LineShape -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineShape -> String
forall a. Show a => a -> String
show

-- | line specification
data Line = Line
  { Line -> Maybe Double
_linewidth :: Maybe Double
  , Line -> Maybe Color
_linecolor :: Maybe Color
  , Line -> Maybe LineShape
_lineshape :: Maybe LineShape
  , Line -> Maybe Dash
_dash :: Maybe Dash
  } deriving (forall x. Line -> Rep Line x)
-> (forall x. Rep Line x -> Line) -> Generic Line
forall x. Rep Line x -> Line
forall x. Line -> Rep Line x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Line x -> Line
$cfrom :: forall x. Line -> Rep Line x
Generic

makeLenses ''Line

instance ToJSON Line where
  toJSON :: Line -> Value
toJSON = Options -> Line -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropInitial String
"line" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unLens}

defLine :: Line
defLine :: Line
defLine = Maybe Double
-> Maybe Color -> Maybe LineShape -> Maybe Dash -> Line
Line Maybe Double
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LineShape
forall a. Maybe a
Nothing Maybe Dash
forall a. Maybe a
Nothing

data HoverElem = HoverX | HoverY | HoverZ | HoverText | HoverName
  deriving ((forall x. HoverElem -> Rep HoverElem x)
-> (forall x. Rep HoverElem x -> HoverElem) -> Generic HoverElem
forall x. Rep HoverElem x -> HoverElem
forall x. HoverElem -> Rep HoverElem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HoverElem x -> HoverElem
$cfrom :: forall x. HoverElem -> Rep HoverElem x
Generic, Int -> HoverElem -> ShowS
[HoverElem] -> ShowS
HoverElem -> String
(Int -> HoverElem -> ShowS)
-> (HoverElem -> String)
-> ([HoverElem] -> ShowS)
-> Show HoverElem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HoverElem] -> ShowS
$cshowList :: [HoverElem] -> ShowS
show :: HoverElem -> String
$cshow :: HoverElem -> String
showsPrec :: Int -> HoverElem -> ShowS
$cshowsPrec :: Int -> HoverElem -> ShowS
Show)

data HoverInfo = HoverPlus [HoverElem] | HoverAll | HoverNone | HoverSkip
  deriving ((forall x. HoverInfo -> Rep HoverInfo x)
-> (forall x. Rep HoverInfo x -> HoverInfo) -> Generic HoverInfo
forall x. Rep HoverInfo x -> HoverInfo
forall x. HoverInfo -> Rep HoverInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HoverInfo x -> HoverInfo
$cfrom :: forall x. HoverInfo -> Rep HoverInfo x
Generic, Int -> HoverInfo -> ShowS
[HoverInfo] -> ShowS
HoverInfo -> String
(Int -> HoverInfo -> ShowS)
-> (HoverInfo -> String)
-> ([HoverInfo] -> ShowS)
-> Show HoverInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HoverInfo] -> ShowS
$cshowList :: [HoverInfo] -> ShowS
show :: HoverInfo -> String
$cshow :: HoverInfo -> String
showsPrec :: Int -> HoverInfo -> ShowS
$cshowsPrec :: Int -> HoverInfo -> ShowS
Show)

instance ToJSON HoverInfo where
  toJSON :: HoverInfo -> Value
toJSON (HoverPlus [HoverElem]
elems) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> ([String] -> String) -> [String] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"+" ([String] -> Value) -> [String] -> Value
forall a b. (a -> b) -> a -> b
$ ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (HoverElem -> String) -> HoverElem -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
dropInitial String
"Hover" ShowS -> (HoverElem -> String) -> HoverElem -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HoverElem -> String
forall a. Show a => a -> String
show) (HoverElem -> String) -> [HoverElem] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HoverElem]
elems
  toJSON HoverInfo
x                 = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> ShowS -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
dropInitial String
"Hover" (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ HoverInfo -> String
forall a. Show a => a -> String
show HoverInfo
x

data HoverMode = X | Y | Closest | False | XUnified | YUnified

instance ToJSON HoverMode where
  toJSON :: HoverMode -> Value
toJSON HoverMode
mode = Value -> Value
forall a. ToJSON a => a -> Value
toJSON ( HoverMode -> Value
showMode HoverMode
mode ) where
   showMode :: HoverMode -> Value
   showMode :: HoverMode -> Value
showMode HoverMode
m = case HoverMode
m of
     HoverMode
X -> Value
"x" 
     HoverMode
Y -> Value
"y"
     HoverMode
Closest -> Value
"closest"
     HoverMode
Graphics.Plotly.Base.False -> Value
"False"
     HoverMode
XUnified -> Value
"x unified"
     HoverMode
YUnified -> Value
"y unified"


data HoverOn = HoverPoints | HoverFills deriving ((forall x. HoverOn -> Rep HoverOn x)
-> (forall x. Rep HoverOn x -> HoverOn) -> Generic HoverOn
forall x. Rep HoverOn x -> HoverOn
forall x. HoverOn -> Rep HoverOn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HoverOn x -> HoverOn
$cfrom :: forall x. HoverOn -> Rep HoverOn x
Generic, Int -> HoverOn -> ShowS
[HoverOn] -> ShowS
HoverOn -> String
(Int -> HoverOn -> ShowS)
-> (HoverOn -> String) -> ([HoverOn] -> ShowS) -> Show HoverOn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HoverOn] -> ShowS
$cshowList :: [HoverOn] -> ShowS
show :: HoverOn -> String
$cshow :: HoverOn -> String
showsPrec :: Int -> HoverOn -> ShowS
$cshowsPrec :: Int -> HoverOn -> ShowS
Show)

instance {-# OVERLAPS #-} ToJSON [HoverOn] where
  toJSON :: [HoverOn] -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> ([HoverOn] -> String) -> [HoverOn] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"+" ([String] -> String)
-> ([HoverOn] -> [String]) -> [HoverOn] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HoverOn -> String) -> [HoverOn] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (HoverOn -> String) -> HoverOn -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
dropInitial String
"Hover" ShowS -> (HoverOn -> String) -> HoverOn -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HoverOn -> String
forall a. Show a => a -> String
show)

data TextPosition
  = TopLeft    | TopCenter    | TopRight
  | MiddleLeft | MiddleCenter | MiddleRight
  | BottomLeft | BottomCenter | BottomRight
  deriving ((forall x. TextPosition -> Rep TextPosition x)
-> (forall x. Rep TextPosition x -> TextPosition)
-> Generic TextPosition
forall x. Rep TextPosition x -> TextPosition
forall x. TextPosition -> Rep TextPosition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextPosition x -> TextPosition
$cfrom :: forall x. TextPosition -> Rep TextPosition x
Generic, Int -> TextPosition -> ShowS
[TextPosition] -> ShowS
TextPosition -> String
(Int -> TextPosition -> ShowS)
-> (TextPosition -> String)
-> ([TextPosition] -> ShowS)
-> Show TextPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextPosition] -> ShowS
$cshowList :: [TextPosition] -> ShowS
show :: TextPosition -> String
$cshow :: TextPosition -> String
showsPrec :: Int -> TextPosition -> ShowS
$cshowsPrec :: Int -> TextPosition -> ShowS
Show)

instance ToJSON TextPosition where
  toJSON :: TextPosition -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value)
-> (TextPosition -> String) -> TextPosition -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
camelTo2 Char
' ' ShowS -> (TextPosition -> String) -> TextPosition -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextPosition -> String
forall a. Show a => a -> String
show

-- | A `Trace` is the component of a plot. Multiple traces can be superimposed.
data Trace = Trace
  { Trace -> Maybe [Value]
_x :: Maybe [Value] -- ^ x values, as numbers
  , Trace -> Maybe [Value]
_y :: Maybe [Value] -- ^ y values, as numbers
  , Trace -> Maybe [Value]
_z :: Maybe [Value] -- ^ z values, as numbers
  , Trace -> Maybe [Value]
_values :: Maybe [Value] -- values for pie chart
  , Trace -> Maybe [Text]
_labels :: Maybe [Text] -- labels for pie chart
  , Trace -> Maybe Value
_hole :: Maybe Value -- pie chart hole property
  , Trace -> Maybe [Mode]
_mode :: Maybe [Mode] -- ^ select one or two modes.
  , Trace -> Maybe Text
_name :: Maybe Text -- ^ name of this trace, for legend
  , Trace -> Maybe [Text]
_text :: Maybe [Text]
  , Trace -> Maybe TextPosition
_textposition :: Maybe TextPosition
  , Trace -> TraceType
_tracetype :: TraceType
  , Trace -> Maybe Marker
_marker :: Maybe Marker
  , Trace -> Maybe Line
_line :: Maybe Line
  , Trace -> Maybe Fill
_fill :: Maybe Fill
  , Trace -> Maybe Orientation
_orientation :: Maybe Orientation
  , Trace -> Maybe Value
_visible :: Maybe Value
  , Trace -> Maybe Bool
_traceshowlegend :: Maybe Bool
  , Trace -> Maybe Text
_legendgroup :: Maybe Text
  , Trace -> Maybe [Value]
_customdata :: Maybe [Value]
  , Trace -> Maybe HoverInfo
_hoverinfo :: Maybe HoverInfo
  , Trace -> Maybe (ListOrElem Text)
_hovertext :: Maybe (ListOrElem Text)
  , Trace -> Maybe [HoverOn]
_hoveron :: Maybe [HoverOn]
  , Trace -> Maybe Bool
_connectgaps :: Maybe Bool

  -- Stacked Area Charts
  , Trace -> Maybe Text
_stackgroup :: Maybe Text
  , Trace -> Maybe Text
_fillcolor :: Maybe Text

  -- Pie
  , Trace -> Maybe Bool
_sort :: Maybe Bool

  -- 3D mesh
  , Trace -> Maybe [Int]
_i :: Maybe [Int] -- ^ i values, as ints
  , Trace -> Maybe [Int]
_j :: Maybe [Int] -- ^ j values, as ints
  , Trace -> Maybe [Int]
_k :: Maybe [Int] -- ^ k values, as ints
  , Trace -> Maybe Color
_tracecolor :: Maybe Color
  , Trace -> Maybe Double
_traceopacity :: Maybe Double

  -- Sub-plots
  , Trace -> Maybe Text
_tracexaxis :: Maybe Text -- ^ X-axis name
  , Trace -> Maybe Text
_traceyaxis :: Maybe Text -- ^ Y-axis name
  } deriving (forall x. Trace -> Rep Trace x)
-> (forall x. Rep Trace x -> Trace) -> Generic Trace
forall x. Rep Trace x -> Trace
forall x. Trace -> Rep Trace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Trace x -> Trace
$cfrom :: forall x. Trace -> Rep Trace x
Generic

makeLenses ''Trace

mkTrace :: TraceType -> Trace
mkTrace :: TraceType -> Trace
mkTrace TraceType
tt = Maybe [Value]
-> Maybe [Value]
-> Maybe [Value]
-> Maybe [Value]
-> Maybe [Text]
-> Maybe Value
-> Maybe [Mode]
-> Maybe Text
-> Maybe [Text]
-> Maybe TextPosition
-> TraceType
-> Maybe Marker
-> Maybe Line
-> Maybe Fill
-> Maybe Orientation
-> Maybe Value
-> Maybe Bool
-> Maybe Text
-> Maybe [Value]
-> Maybe HoverInfo
-> Maybe (ListOrElem Text)
-> Maybe [HoverOn]
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Int]
-> Maybe [Int]
-> Maybe [Int]
-> Maybe Color
-> Maybe Double
-> Maybe Text
-> Maybe Text
-> Trace
Trace Maybe [Value]
forall a. Maybe a
Nothing Maybe [Value]
forall a. Maybe a
Nothing Maybe [Value]
forall a. Maybe a
Nothing Maybe [Value]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing Maybe [Mode]
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe TextPosition
forall a. Maybe a
Nothing TraceType
tt Maybe Marker
forall a. Maybe a
Nothing Maybe Line
forall a. Maybe a
Nothing Maybe Fill
forall a. Maybe a
Nothing Maybe Orientation
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe [Value]
forall a. Maybe a
Nothing Maybe HoverInfo
forall a. Maybe a
Nothing Maybe (ListOrElem Text)
forall a. Maybe a
Nothing Maybe [HoverOn]
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe [Int]
forall a. Maybe a
Nothing Maybe [Int]
forall a. Maybe a
Nothing Maybe [Int]
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe Double
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing

-- TODO: there must be a way to avoid all that nothing. Something like this?
-- mkTrace :: TraceType -> Trace
-- mkTrace tt = Trace { _tracetype = tt 

-- |an empty scatter plot
scatter :: Trace
scatter :: Trace
scatter = TraceType -> Trace
mkTrace TraceType
Scatter

-- |an empty 3D scatter plot
scatter3d :: Trace
scatter3d :: Trace
scatter3d = TraceType -> Trace
mkTrace TraceType
Scatter3D

-- |an empty bar plot
bars :: Trace
bars :: Trace
bars = TraceType -> Trace
mkTrace TraceType
Bar

-- |an empty box plot
box :: Trace
box :: Trace
box = TraceType -> Trace
mkTrace TraceType
Box

-- |an empty 3D mesh plot
mesh3d :: Trace
mesh3d :: Trace
mesh3d = TraceType -> Trace
mkTrace TraceType
Mesh3D

-- |an empty 3D mesh plot
contour :: Trace
contour :: Trace
contour = TraceType -> Trace
mkTrace TraceType
Contour

-- | an empty pie chart
pie :: Trace
pie :: Trace
pie = TraceType -> Trace
mkTrace TraceType
Pie

instance ToJSON Trace where
  toJSON :: Trace -> Value
toJSON = Options -> Trace -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
renamer}
    where renamer :: ShowS
renamer = String -> ShowS
dropInitial String
"trace" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unLens

data AxisType = Log | Date | Category deriving Int -> AxisType -> ShowS
[AxisType] -> ShowS
AxisType -> String
(Int -> AxisType -> ShowS)
-> (AxisType -> String) -> ([AxisType] -> ShowS) -> Show AxisType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AxisType] -> ShowS
$cshowList :: [AxisType] -> ShowS
show :: AxisType -> String
$cshow :: AxisType -> String
showsPrec :: Int -> AxisType -> ShowS
$cshowsPrec :: Int -> AxisType -> ShowS
Show

instance ToJSON AxisType where
  toJSON :: AxisType -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (AxisType -> String) -> AxisType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (AxisType -> String) -> AxisType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AxisType -> String
forall a. Show a => a -> String
show

-- |Options for axes
data Axis = Axis
  { Axis -> Maybe (Double, Double)
_range :: Maybe (Double,Double)
  , Axis -> Maybe AxisType
_axistype :: Maybe AxisType
  , Axis -> Maybe Text
_axistitle :: Maybe Text
  , Axis -> Maybe Bool
_showgrid :: Maybe Bool
  , Axis -> Maybe Bool
_zeroline :: Maybe Bool
  , Axis -> Maybe Bool
_axisvisible :: Maybe Bool
  , Axis -> Maybe [Value]
_tickvals :: Maybe [Value]
  , Axis -> Maybe [Text]
_ticktext :: Maybe [Text]
  , Axis -> Maybe (Double, Double)
_domain :: Maybe (Double,Double)
  } deriving (forall x. Axis -> Rep Axis x)
-> (forall x. Rep Axis x -> Axis) -> Generic Axis
forall x. Rep Axis x -> Axis
forall x. Axis -> Rep Axis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Axis x -> Axis
$cfrom :: forall x. Axis -> Rep Axis x
Generic

makeLenses ''Axis

instance ToJSON Axis where
  toJSON :: Axis -> Value
toJSON = Options -> Axis -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropInitial String
"axis" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unLens}

defAxis :: Axis
defAxis :: Axis
defAxis = Maybe (Double, Double)
-> Maybe AxisType
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe [Value]
-> Maybe [Text]
-> Maybe (Double, Double)
-> Axis
Axis Maybe (Double, Double)
forall a. Maybe a
Nothing Maybe AxisType
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe [Value]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe (Double, Double)
forall a. Maybe a
Nothing

-- * Layouts

-- | How different bar traces be superimposed? By grouping or by stacking?
data Barmode = Stack | Group deriving Int -> Barmode -> ShowS
[Barmode] -> ShowS
Barmode -> String
(Int -> Barmode -> ShowS)
-> (Barmode -> String) -> ([Barmode] -> ShowS) -> Show Barmode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Barmode] -> ShowS
$cshowList :: [Barmode] -> ShowS
show :: Barmode -> String
$cshow :: Barmode -> String
showsPrec :: Int -> Barmode -> ShowS
$cshowsPrec :: Int -> Barmode -> ShowS
Show

instance ToJSON Barmode where
  toJSON :: Barmode -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (Barmode -> String) -> Barmode -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (Barmode -> String) -> Barmode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Barmode -> String
forall a. Show a => a -> String
show

-- |Options for Margins.
data Margin = Margin
  { Margin -> Int
_marginl :: Int
  , Margin -> Int
_marginr :: Int
  , Margin -> Int
_marginb :: Int
  , Margin -> Int
_margint :: Int
  , Margin -> Int
_marginpad :: Int
  } deriving (forall x. Margin -> Rep Margin x)
-> (forall x. Rep Margin x -> Margin) -> Generic Margin
forall x. Rep Margin x -> Margin
forall x. Margin -> Rep Margin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Margin x -> Margin
$cfrom :: forall x. Margin -> Rep Margin x
Generic

makeLenses ''Margin

instance ToJSON Margin where
  toJSON :: Margin -> Value
toJSON = Options -> Margin -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropInitial String
"margin" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unLens}

-- | some good values for margins
thinMargins, titleMargins :: Margin
thinMargins :: Margin
thinMargins = Int -> Int -> Int -> Int -> Int -> Margin
Margin Int
50 Int
25 Int
30 Int
10 Int
4
titleMargins :: Margin
titleMargins = Int -> Int -> Int -> Int -> Int -> Margin
Margin Int
50 Int
25 Int
30 Int
40 Int
4

-- | Options for Fonts.
data Font = Font
  { Font -> Maybe Text
_fontfamily :: Maybe Text
  , Font -> Maybe Double
_fontsize   :: Maybe Double
  , Font -> Maybe Color
_fontcolor  :: Maybe Color
  } deriving (forall x. Font -> Rep Font x)
-> (forall x. Rep Font x -> Font) -> Generic Font
forall x. Rep Font x -> Font
forall x. Font -> Rep Font x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Font x -> Font
$cfrom :: forall x. Font -> Rep Font x
Generic

makeLenses ''Font

instance ToJSON Font where
  toJSON :: Font -> Value
toJSON = Options -> Font -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropInitial String
"font" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unLens}

defFont :: Font
defFont :: Font
defFont = Maybe Text -> Maybe Double -> Maybe Color -> Font
Font Maybe Text
forall a. Maybe a
Nothing Maybe Double
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

data Align
  = AlignLeft | AlignCenter | AlignRight
  deriving ((forall x. Align -> Rep Align x)
-> (forall x. Rep Align x -> Align) -> Generic Align
forall x. Rep Align x -> Align
forall x. Align -> Rep Align x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Align x -> Align
$cfrom :: forall x. Align -> Rep Align x
Generic, Int -> Align -> ShowS
[Align] -> ShowS
Align -> String
(Int -> Align -> ShowS)
-> (Align -> String) -> ([Align] -> ShowS) -> Show Align
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Align] -> ShowS
$cshowList :: [Align] -> ShowS
show :: Align -> String
$cshow :: Align -> String
showsPrec :: Int -> Align -> ShowS
$cshowsPrec :: Int -> Align -> ShowS
Show)

instance ToJSON Align where
  toJSON :: Align -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (Align -> String) -> Align -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (Align -> String) -> Align -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
dropInitial String
"Align" ShowS -> (Align -> String) -> Align -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Align -> String
forall a. Show a => a -> String
show

-- | Options for annotations
data Annotation = Annotation
  { Annotation -> Maybe Bool
_annotationvisible     :: Maybe Bool
  , Annotation -> Maybe Text
_annotationtext        :: Maybe Text
  , Annotation -> Maybe Font
_annotationfont        :: Maybe Font
  , Annotation -> Maybe Double
_annotationwidth       :: Maybe Double
  , Annotation -> Maybe Double
_annotationheight      :: Maybe Double
  , Annotation -> Maybe Double
_annotationopacity     :: Maybe Double
  , Annotation -> Maybe Align
_annotationalign       :: Maybe Align
  , Annotation -> Maybe Color
_annotataonbgcolor     :: Maybe Color
  , Annotation -> Maybe Color
_annotationbordercolor :: Maybe Color
  , Annotation -> Maybe Bool
_annotationshowarrow   :: Maybe Bool
  , Annotation -> Maybe Value
_annotationx           :: Maybe Value
  , Annotation -> Maybe Text
_annotationxref        :: Maybe Text -- ^ "paper" or X-axis name
  , Annotation -> Maybe Double
_annotationxshift      :: Maybe Double
  , Annotation -> Maybe Value
_annotationy           :: Maybe Value
  , Annotation -> Maybe Text
_annotationyref        :: Maybe Text -- ^ "paper" or Y-axis name
  , Annotation -> Maybe Double
_annotationyshift      :: Maybe Double
  } deriving (forall x. Annotation -> Rep Annotation x)
-> (forall x. Rep Annotation x -> Annotation) -> Generic Annotation
forall x. Rep Annotation x -> Annotation
forall x. Annotation -> Rep Annotation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Annotation x -> Annotation
$cfrom :: forall x. Annotation -> Rep Annotation x
Generic

makeLenses ''Annotation

defAnnotation :: Annotation
defAnnotation :: Annotation
defAnnotation = Maybe Bool
-> Maybe Text
-> Maybe Font
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> Maybe Align
-> Maybe Color
-> Maybe Color
-> Maybe Bool
-> Maybe Value
-> Maybe Text
-> Maybe Double
-> Maybe Value
-> Maybe Text
-> Maybe Double
-> Annotation
Annotation Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Font
forall a. Maybe a
Nothing Maybe Double
forall a. Maybe a
Nothing Maybe Double
forall a. Maybe a
Nothing Maybe Double
forall a. Maybe a
Nothing Maybe Align
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Double
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Double
forall a. Maybe a
Nothing

instance ToJSON Annotation where
  toJSON :: Annotation -> Value
toJSON = Options -> Annotation -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropInitial String
"annotation" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unLens}

-- |options for the layout of the whole plot
data Layout = Layout
  { Layout -> Maybe Axis
_xaxis  :: Maybe Axis
  , Layout -> Maybe Axis
_xaxis2 :: Maybe Axis
  , Layout -> Maybe Axis
_xaxis3 :: Maybe Axis
  , Layout -> Maybe Axis
_xaxis4 :: Maybe Axis
  , Layout -> Maybe Axis
_yaxis  :: Maybe Axis
  , Layout -> Maybe Axis
_yaxis2 :: Maybe Axis
  , Layout -> Maybe Axis
_yaxis3 :: Maybe Axis
  , Layout -> Maybe Axis
_yaxis4 :: Maybe Axis
  , Layout -> Maybe Axis
_zaxis  :: Maybe Axis
  , Layout -> Maybe Text
_title  :: Maybe Text
  , Layout -> Maybe Font
_titlefont :: Maybe Font
  , Layout -> Maybe Bool
_showlegend :: Maybe Bool
  , Layout -> Maybe Int
_height :: Maybe Int
  , Layout -> Maybe Int
_width :: Maybe Int
  , Layout -> Maybe Barmode
_barmode :: Maybe Barmode
  , Layout -> Maybe HoverMode
_hovermode :: Maybe HoverMode
  , Layout -> Maybe Margin
_margin :: Maybe Margin
  , Layout -> Maybe Font
_font :: Maybe Font
  , Layout -> Maybe [Annotation]
_annotations :: Maybe [Annotation]
  } deriving (forall x. Layout -> Rep Layout x)
-> (forall x. Rep Layout x -> Layout) -> Generic Layout
forall x. Rep Layout x -> Layout
forall x. Layout -> Rep Layout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Layout x -> Layout
$cfrom :: forall x. Layout -> Rep Layout x
Generic

makeLenses ''Layout

-- -- |a defaultlayout
defLayout :: Layout
defLayout :: Layout
defLayout = Maybe Axis
-> Maybe Axis
-> Maybe Axis
-> Maybe Axis
-> Maybe Axis
-> Maybe Axis
-> Maybe Axis
-> Maybe Axis
-> Maybe Axis
-> Maybe Text
-> Maybe Font
-> Maybe Bool
-> Maybe Int
-> Maybe Int
-> Maybe Barmode
-> Maybe HoverMode
-> Maybe Margin
-> Maybe Font
-> Maybe [Annotation]
-> Layout
Layout Maybe Axis
forall a. Maybe a
Nothing Maybe Axis
forall a. Maybe a
Nothing Maybe Axis
forall a. Maybe a
Nothing Maybe Axis
forall a. Maybe a
Nothing Maybe Axis
forall a. Maybe a
Nothing Maybe Axis
forall a. Maybe a
Nothing Maybe Axis
forall a. Maybe a
Nothing Maybe Axis
forall a. Maybe a
Nothing Maybe Axis
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Font
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Barmode
forall a. Maybe a
Nothing Maybe HoverMode
forall a. Maybe a
Nothing Maybe Margin
forall a. Maybe a
Nothing Maybe Font
forall a. Maybe a
Nothing Maybe [Annotation]
forall a. Maybe a
Nothing

instance ToJSON Layout where
  toJSON :: Layout -> Value
toJSON = Options -> Layout -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions

-- * Plotly

-- | A helper record which represents the whole plot
data Plotly = Plotly
  { Plotly -> Text
_elemid :: Text
  , Plotly -> [Trace]
_traces :: [Trace]
  , Plotly -> Layout
_layout :: Layout
  } deriving (forall x. Plotly -> Rep Plotly x)
-> (forall x. Rep Plotly x -> Plotly) -> Generic Plotly
forall x. Rep Plotly x -> Plotly
forall x. Plotly -> Rep Plotly x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Plotly x -> Plotly
$cfrom :: forall x. Plotly -> Rep Plotly x
Generic

instance ToJSON Plotly where
  toJSON :: Plotly -> Value
toJSON = Options -> Plotly -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions

makeLenses ''Plotly

-- | helper function for building the plot.
plotly :: Text -> [Trace] -> Plotly
plotly :: Text -> [Trace] -> Plotly
plotly Text
idnm [Trace]
trs = Text -> [Trace] -> Layout -> Plotly
Plotly Text
idnm [Trace]
trs Layout
defLayout