{-# OPTIONS_GHC -Wall -fno-warn-missing-export-lists #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DuplicateRecordFields #-}
module Graphics.Plotly.Internal where
import Data.List (nub)
import Data.Aeson
import Data.Aeson.Types
import GHC.Generics
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as C8
import Data.ByteString.Lazy (ByteString)
omitNulls :: [Pair] -> [Pair]
omitNulls :: [Pair] -> [Pair]
omitNulls = (Pair -> Bool) -> [Pair] -> [Pair]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null) (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair -> Value
forall a b. (a, b) -> b
snd)
prependColor :: [[Double]] -> Int -> [[Double]]
prependColor :: [[Double]] -> Int -> [[Double]]
prependColor [[Double]]
ds Int
i = [Double]
is [Double] -> [[Double]] -> [[Double]]
forall a. a -> [a] -> [a]
: [[Double]]
ds
where
is :: [Double]
is = Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate ([Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> [Double] -> Int
forall a b. (a -> b) -> a -> b
$ [[Double]] -> [Double]
forall a. [a] -> a
head [[Double]]
ds) (Double -> [Double]) -> Double -> [Double]
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
i
type Script = ByteString
toHtml :: Script -> ByteString
toHtml :: Script -> Script
toHtml Script
script = [Script] -> Script
C8.unlines [ Script
"<head>"
, Script
"<script src=\"https://cdn.plot.ly/plotly-latest.min.js\"></script>"
, Script
"</head>"
, Script
"<body>"
, Script
"<div id=\"plotDiv\"></div>"
, Script
"<script>", Script
script, Script
"</script>"
, Script
"</body>" ]
data Margin = Margin { Margin -> Int
l :: !Int
, Margin -> Int
r :: !Int
, Margin -> Int
b :: !Int
, Margin -> Int
t :: !Int
} deriving (Margin -> Margin -> Bool
(Margin -> Margin -> Bool)
-> (Margin -> Margin -> Bool) -> Eq Margin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Margin -> Margin -> Bool
$c/= :: Margin -> Margin -> Bool
== :: Margin -> Margin -> Bool
$c== :: Margin -> Margin -> Bool
Eq, Int -> Margin -> ShowS
[Margin] -> ShowS
Margin -> String
(Int -> Margin -> ShowS)
-> (Margin -> String) -> ([Margin] -> ShowS) -> Show Margin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Margin] -> ShowS
$cshowList :: [Margin] -> ShowS
show :: Margin -> String
$cshow :: Margin -> String
showsPrec :: Int -> Margin -> ShowS
$cshowsPrec :: Int -> Margin -> ShowS
Show, (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, [Margin] -> Encoding
[Margin] -> Value
Margin -> Encoding
Margin -> Value
(Margin -> Value)
-> (Margin -> Encoding)
-> ([Margin] -> Value)
-> ([Margin] -> Encoding)
-> ToJSON Margin
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Margin] -> Encoding
$ctoEncodingList :: [Margin] -> Encoding
toJSONList :: [Margin] -> Value
$ctoJSONList :: [Margin] -> Value
toEncoding :: Margin -> Encoding
$ctoEncoding :: Margin -> Encoding
toJSON :: Margin -> Value
$ctoJSON :: Margin -> Value
ToJSON)
data Layout = Layout { Layout -> String
title :: !String
, Layout -> Maybe Axis
xaxis :: !(Maybe Axis)
, Layout -> Maybe Axis
yaxis :: !(Maybe Axis)
, Layout -> Maybe BarMode
barmode :: !(Maybe BarMode)
, Layout -> Int
height :: !Int
, Layout -> Int
width :: !Int
, Layout -> Maybe Bool
showlegend :: !(Maybe Bool)
, Layout -> Maybe Margin
margin :: !(Maybe Margin)
} deriving (Int -> Layout -> ShowS
[Layout] -> ShowS
Layout -> String
(Int -> Layout -> ShowS)
-> (Layout -> String) -> ([Layout] -> ShowS) -> Show Layout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Layout] -> ShowS
$cshowList :: [Layout] -> ShowS
show :: Layout -> String
$cshow :: Layout -> String
showsPrec :: Int -> Layout -> ShowS
$cshowsPrec :: Int -> Layout -> ShowS
Show, (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, [Layout] -> Encoding
[Layout] -> Value
Layout -> Encoding
Layout -> Value
(Layout -> Value)
-> (Layout -> Encoding)
-> ([Layout] -> Value)
-> ([Layout] -> Encoding)
-> ToJSON Layout
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Layout] -> Encoding
$ctoEncodingList :: [Layout] -> Encoding
toJSONList :: [Layout] -> Value
$ctoJSONList :: [Layout] -> Value
toEncoding :: Layout -> Encoding
$ctoEncoding :: Layout -> Encoding
toJSON :: Layout -> Value
$ctoJSON :: Layout -> Value
ToJSON)
data AxisType = Linear
| Log
| Date
| Category
| MultiCategory
deriving (AxisType -> AxisType -> Bool
(AxisType -> AxisType -> Bool)
-> (AxisType -> AxisType -> Bool) -> Eq AxisType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AxisType -> AxisType -> Bool
$c/= :: AxisType -> AxisType -> Bool
== :: AxisType -> AxisType -> Bool
$c== :: AxisType -> AxisType -> Bool
Eq, 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, (forall x. AxisType -> Rep AxisType x)
-> (forall x. Rep AxisType x -> AxisType) -> Generic AxisType
forall x. Rep AxisType x -> AxisType
forall x. AxisType -> Rep AxisType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AxisType x -> AxisType
$cfrom :: forall x. AxisType -> Rep AxisType x
Generic, [AxisType] -> Encoding
[AxisType] -> Value
AxisType -> Encoding
AxisType -> Value
(AxisType -> Value)
-> (AxisType -> Encoding)
-> ([AxisType] -> Value)
-> ([AxisType] -> Encoding)
-> ToJSON AxisType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AxisType] -> Encoding
$ctoEncodingList :: [AxisType] -> Encoding
toJSONList :: [AxisType] -> Value
$ctoJSONList :: [AxisType] -> Value
toEncoding :: AxisType -> Encoding
$ctoEncoding :: AxisType -> Encoding
toJSON :: AxisType -> Value
$ctoJSON :: AxisType -> Value
ToJSON)
data Axis = Axis { Axis -> String
title :: !String
, Axis -> Bool
showGrid :: !Bool
, Axis -> Bool
zeroLine :: !Bool
, Axis -> AxisType
type' :: !AxisType
} deriving (Int -> Axis -> ShowS
[Axis] -> ShowS
Axis -> String
(Int -> Axis -> ShowS)
-> (Axis -> String) -> ([Axis] -> ShowS) -> Show Axis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Axis] -> ShowS
$cshowList :: [Axis] -> ShowS
show :: Axis -> String
$cshow :: Axis -> String
showsPrec :: Int -> Axis -> ShowS
$cshowsPrec :: Int -> Axis -> ShowS
Show, (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)
instance ToJSON Axis where
toJSON :: Axis -> Value
toJSON Axis{Bool
String
AxisType
type' :: AxisType
zeroLine :: Bool
showGrid :: Bool
title :: String
$sel:type':Axis :: Axis -> AxisType
$sel:zeroLine:Axis :: Axis -> Bool
$sel:showGrid:Axis :: Axis -> Bool
$sel:title:Axis :: Axis -> String
..} = [Pair] -> Value
object [ Text
"title" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
title
, Text
"showgrid" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
showGrid
, Text
"zeroline" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
zeroLine
, Text
"type" Text -> AxisType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AxisType
type' ]
data Line = Line { Line -> Maybe Bool
showscale :: !(Maybe Bool)
, Line -> Maybe Bool
reversescale :: !(Maybe Bool)
, Line -> Maybe ColorScale
colorscale :: !(Maybe ColorScale)
, Line -> Maybe ColorMap
colormap :: !(Maybe ColorMap)
, Line -> Maybe [Double]
color :: !(Maybe [Double])
} deriving (Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show, (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)
instance ToJSON Line where
toJSON :: Line -> Value
toJSON Line{Maybe Bool
Maybe [Double]
Maybe ColorMap
Maybe ColorScale
color :: Maybe [Double]
colormap :: Maybe ColorMap
colorscale :: Maybe ColorScale
reversescale :: Maybe Bool
showscale :: Maybe Bool
$sel:color:Line :: Line -> Maybe [Double]
$sel:colormap:Line :: Line -> Maybe ColorMap
$sel:colorscale:Line :: Line -> Maybe ColorScale
$sel:reversescale:Line :: Line -> Maybe Bool
$sel:showscale:Line :: Line -> Maybe Bool
..} = [Pair] -> Value
object
([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> [Pair]
omitNulls [ Text
"showscale" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
showscale
, Text
"color" Text -> Maybe [Double] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Double]
color
, Text
"reversescale" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
reversescale
, Text
"colorscale" Text -> Maybe ColorMap -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ColorMap
colormap
, Text
"colorscale" Text -> Maybe ColorScale -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ColorScale
colorscale ]
data Marker = Marker { Marker -> Double
size :: !Double
, Marker -> Symbol
symbol :: !Symbol
, Marker -> Double
opacity :: !Double
} deriving (Int -> Marker -> ShowS
[Marker] -> ShowS
Marker -> String
(Int -> Marker -> ShowS)
-> (Marker -> String) -> ([Marker] -> ShowS) -> Show Marker
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Marker] -> ShowS
$cshowList :: [Marker] -> ShowS
show :: Marker -> String
$cshow :: Marker -> String
showsPrec :: Int -> Marker -> ShowS
$cshowsPrec :: Int -> Marker -> ShowS
Show, (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] -> Encoding
[Marker] -> Value
Marker -> Encoding
Marker -> Value
(Marker -> Value)
-> (Marker -> Encoding)
-> ([Marker] -> Value)
-> ([Marker] -> Encoding)
-> ToJSON Marker
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Marker] -> Encoding
$ctoEncodingList :: [Marker] -> Encoding
toJSONList :: [Marker] -> Value
$ctoJSONList :: [Marker] -> Value
toEncoding :: Marker -> Encoding
$ctoEncoding :: Marker -> Encoding
toJSON :: Marker -> Value
$ctoJSON :: Marker -> Value
ToJSON)
data Trace = Trace { Trace -> Maybe String
name :: !(Maybe String)
, Trace -> Maybe [Double]
x :: !(Maybe [Double])
, Trace -> Maybe [Double]
y :: !(Maybe [Double])
, Trace -> Maybe [Double]
z :: !(Maybe [Double])
, Trace -> Maybe Mode
mode :: !(Maybe Mode)
, Trace -> Type
type' :: !Type
, Trace -> Maybe BarMode
barmode :: !(Maybe BarMode)
, Trace -> Maybe XBins
xbins :: !(Maybe XBins)
, Trace -> Maybe Marker
marker :: !(Maybe Marker)
} 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, Int -> Trace -> ShowS
[Trace] -> ShowS
Trace -> String
(Int -> Trace -> ShowS)
-> (Trace -> String) -> ([Trace] -> ShowS) -> Show Trace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trace] -> ShowS
$cshowList :: [Trace] -> ShowS
show :: Trace -> String
$cshow :: Trace -> String
showsPrec :: Int -> Trace -> ShowS
$cshowsPrec :: Int -> Trace -> ShowS
Show)
instance ToJSON Trace where
toJSON :: Trace -> Value
toJSON Trace{Maybe String
Maybe [Double]
Maybe XBins
Maybe BarMode
Maybe Mode
Maybe Marker
Type
marker :: Maybe Marker
xbins :: Maybe XBins
barmode :: Maybe BarMode
type' :: Type
mode :: Maybe Mode
z :: Maybe [Double]
y :: Maybe [Double]
x :: Maybe [Double]
name :: Maybe String
$sel:marker:Trace :: Trace -> Maybe Marker
$sel:xbins:Trace :: Trace -> Maybe XBins
$sel:barmode:Trace :: Trace -> Maybe BarMode
$sel:type':Trace :: Trace -> Type
$sel:mode:Trace :: Trace -> Maybe Mode
$sel:z:Trace :: Trace -> Maybe [Double]
$sel:y:Trace :: Trace -> Maybe [Double]
$sel:x:Trace :: Trace -> Maybe [Double]
$sel:name:Trace :: Trace -> Maybe String
..} = [Pair] -> Value
object
([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> [Pair]
omitNulls [ Text
"name" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
name
, Text
"x" Text -> Maybe [Double] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Double]
x
, Text
"y" Text -> Maybe [Double] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Double]
y
, Text
"z" Text -> Maybe [Double] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Double]
z
, Text
"mode" Text -> Maybe Mode -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Mode
mode
, Text
"type" Text -> Type -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Type
type'
, Text
"marker" Text -> Maybe Marker -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Marker
marker
, Text
"barmode" Text -> Maybe BarMode -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe BarMode
barmode
, Text
"xbins" Text -> Maybe XBins -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe XBins
xbins ]
data TraceH = TraceH { TraceH -> [[Double]]
z :: ![[Double]]
, TraceH -> Maybe [String]
x :: !(Maybe [String])
, TraceH -> Maybe [String]
y :: !(Maybe [String])
, TraceH -> Type
type' :: !Type
, TraceH -> Maybe Bool
hoverOnGaps :: !(Maybe Bool)
, TraceH -> Maybe Bool
showScale :: !(Maybe Bool)
, TraceH -> Maybe ColorScale
colorScale :: !(Maybe ColorScale)
} deriving (Int -> TraceH -> ShowS
[TraceH] -> ShowS
TraceH -> String
(Int -> TraceH -> ShowS)
-> (TraceH -> String) -> ([TraceH] -> ShowS) -> Show TraceH
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceH] -> ShowS
$cshowList :: [TraceH] -> ShowS
show :: TraceH -> String
$cshow :: TraceH -> String
showsPrec :: Int -> TraceH -> ShowS
$cshowsPrec :: Int -> TraceH -> ShowS
Show)
instance ToJSON TraceH where
toJSON :: TraceH -> Value
toJSON TraceH{[[Double]]
Maybe Bool
Maybe [String]
Maybe ColorScale
Type
colorScale :: Maybe ColorScale
showScale :: Maybe Bool
hoverOnGaps :: Maybe Bool
type' :: Type
y :: Maybe [String]
x :: Maybe [String]
z :: [[Double]]
$sel:colorScale:TraceH :: TraceH -> Maybe ColorScale
$sel:showScale:TraceH :: TraceH -> Maybe Bool
$sel:hoverOnGaps:TraceH :: TraceH -> Maybe Bool
$sel:type':TraceH :: TraceH -> Type
$sel:y:TraceH :: TraceH -> Maybe [String]
$sel:x:TraceH :: TraceH -> Maybe [String]
$sel:z:TraceH :: TraceH -> [[Double]]
..} = [Pair] -> Value
object [ Text
"z" Text -> [[Double]] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [[Double]]
z
, Text
"x" Text -> Maybe [String] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [String]
x
, Text
"y" Text -> Maybe [String] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [String]
y
, Text
"hoverongaps" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
hoverOnGaps
, Text
"showscale" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
showScale
, Text
"colorscale" Text -> Maybe ColorScale -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ColorScale
colorScale
, Text
"type" Text -> Type -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Type
type' ]
data TraceS = TraceS { TraceS -> Maybe String
name :: !(Maybe String)
, TraceS -> [[Double]]
z :: ![[Double]]
, TraceS -> Maybe [Double]
x :: !(Maybe [Double])
, TraceS -> Maybe [Double]
y :: !(Maybe [Double])
, TraceS -> Type
type' :: !Type
, TraceS -> Maybe ColorScale
colorScale :: !(Maybe ColorScale)
} deriving (Int -> TraceS -> ShowS
[TraceS] -> ShowS
TraceS -> String
(Int -> TraceS -> ShowS)
-> (TraceS -> String) -> ([TraceS] -> ShowS) -> Show TraceS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceS] -> ShowS
$cshowList :: [TraceS] -> ShowS
show :: TraceS -> String
$cshow :: TraceS -> String
showsPrec :: Int -> TraceS -> ShowS
$cshowsPrec :: Int -> TraceS -> ShowS
Show)
instance ToJSON TraceS where
toJSON :: TraceS -> Value
toJSON TraceS{[[Double]]
Maybe String
Maybe [Double]
Maybe ColorScale
Type
colorScale :: Maybe ColorScale
type' :: Type
y :: Maybe [Double]
x :: Maybe [Double]
z :: [[Double]]
name :: Maybe String
$sel:colorScale:TraceS :: TraceS -> Maybe ColorScale
$sel:type':TraceS :: TraceS -> Type
$sel:y:TraceS :: TraceS -> Maybe [Double]
$sel:x:TraceS :: TraceS -> Maybe [Double]
$sel:z:TraceS :: TraceS -> [[Double]]
$sel:name:TraceS :: TraceS -> Maybe String
..} = [Pair] -> Value
object [ Text
"name" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
name
, Text
"z" Text -> [[Double]] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [[Double]]
z
, Text
"x" Text -> Maybe [Double] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Double]
x
, Text
"y" Text -> Maybe [Double] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Double]
y
, Text
"colorscale" Text -> Maybe ColorScale -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ColorScale
colorScale
, Text
"type" Text -> Type -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Type
type' ]
data TraceP = TraceP { TraceP -> Type
type' :: !Type
, TraceP -> Maybe Line
line :: !(Maybe Line)
, TraceP -> [Dimension]
dimensions :: ![Dimension]
} deriving (Int -> TraceP -> ShowS
[TraceP] -> ShowS
TraceP -> String
(Int -> TraceP -> ShowS)
-> (TraceP -> String) -> ([TraceP] -> ShowS) -> Show TraceP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceP] -> ShowS
$cshowList :: [TraceP] -> ShowS
show :: TraceP -> String
$cshow :: TraceP -> String
showsPrec :: Int -> TraceP -> ShowS
$cshowsPrec :: Int -> TraceP -> ShowS
Show)
instance ToJSON TraceP where
toJSON :: TraceP -> Value
toJSON TraceP{[Dimension]
Maybe Line
Type
dimensions :: [Dimension]
line :: Maybe Line
type' :: Type
$sel:dimensions:TraceP :: TraceP -> [Dimension]
$sel:line:TraceP :: TraceP -> Maybe Line
$sel:type':TraceP :: TraceP -> Type
..} = [Pair] -> Value
object
([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> [Pair]
omitNulls [ Text
"dimensions" Text -> [Dimension] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Dimension]
dimensions
, Text
"line" Text -> Maybe Line -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Line
line
, Text
"type" Text -> Type -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Type
type' ]
data Dimension = Dimension { Dimension -> Maybe [Int]
range :: !(Maybe [Int])
, Dimension -> String
label :: !String
, Dimension -> [Double]
values :: ![Double]
} deriving (Int -> Dimension -> ShowS
[Dimension] -> ShowS
Dimension -> String
(Int -> Dimension -> ShowS)
-> (Dimension -> String)
-> ([Dimension] -> ShowS)
-> Show Dimension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dimension] -> ShowS
$cshowList :: [Dimension] -> ShowS
show :: Dimension -> String
$cshow :: Dimension -> String
showsPrec :: Int -> Dimension -> ShowS
$cshowsPrec :: Int -> Dimension -> ShowS
Show, (forall x. Dimension -> Rep Dimension x)
-> (forall x. Rep Dimension x -> Dimension) -> Generic Dimension
forall x. Rep Dimension x -> Dimension
forall x. Dimension -> Rep Dimension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Dimension x -> Dimension
$cfrom :: forall x. Dimension -> Rep Dimension x
Generic, [Dimension] -> Encoding
[Dimension] -> Value
Dimension -> Encoding
Dimension -> Value
(Dimension -> Value)
-> (Dimension -> Encoding)
-> ([Dimension] -> Value)
-> ([Dimension] -> Encoding)
-> ToJSON Dimension
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Dimension] -> Encoding
$ctoEncodingList :: [Dimension] -> Encoding
toJSONList :: [Dimension] -> Value
$ctoJSONList :: [Dimension] -> Value
toEncoding :: Dimension -> Encoding
$ctoEncoding :: Dimension -> Encoding
toJSON :: Dimension -> Value
$ctoJSON :: Dimension -> Value
ToJSON)
data Type = Scatter
| Histogram
| Heatmap
| Scatter3D
| Surface
| ParCoords
deriving (Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, (forall x. Type -> Rep Type x)
-> (forall x. Rep Type x -> Type) -> Generic Type
forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type x -> Type
$cfrom :: forall x. Type -> Rep Type x
Generic, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show)
instance ToJSON Type where
toJSON :: Type -> Value
toJSON Type
Scatter = Value
"scatter"
toJSON Type
Histogram = Value
"histogram"
toJSON Type
Heatmap = Value
"heatmap"
toJSON Type
Scatter3D = Value
"scatter3d"
toJSON Type
Surface = Value
"surface"
toJSON Type
ParCoords = Value
"parcoords"
data Mode = Lines
| Markers
| LinesMarkers
deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, (forall x. Mode -> Rep Mode x)
-> (forall x. Rep Mode x -> Mode) -> Generic Mode
forall x. Rep Mode x -> Mode
forall x. Mode -> Rep Mode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mode x -> Mode
$cfrom :: forall x. Mode -> Rep Mode x
Generic, 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 ToJSON Mode where
toJSON :: Mode -> Value
toJSON Mode
Lines = Value
"lines"
toJSON Mode
Markers = Value
"markers"
toJSON Mode
LinesMarkers = Value
"lines+markers"
data Symbol = Circle
| CircleOpen
| Cross
| Diamond
| DiamondOpen
| Square
| SquareOpen
| X
deriving (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, 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, (forall x. Symbol -> Rep Symbol x)
-> (forall x. Rep Symbol x -> Symbol) -> Generic Symbol
forall x. Rep Symbol x -> Symbol
forall x. Symbol -> Rep Symbol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Symbol x -> Symbol
$cfrom :: forall x. Symbol -> Rep Symbol x
Generic)
instance ToJSON Symbol where
toJSON :: Symbol -> Value
toJSON Symbol
Circle = Value
"circle"
toJSON Symbol
CircleOpen = Value
"circle-open"
toJSON Symbol
Cross = Value
"cross"
toJSON Symbol
Diamond = Value
"diamond"
toJSON Symbol
DiamondOpen = Value
"diamond-open"
toJSON Symbol
Square = Value
"square"
toJSON Symbol
SquareOpen = Value
"square-open"
toJSON Symbol
X = Value
"x"
data ColorScale = Discrete
| Blackbody
| Bluered
| Blues
| Cividis
| Earth
| Electric
| Greens
| Greys
| Hot
| Jet
| Picnic
| Portland
| Rainbow
| RdBu
| Reds
| Viridis
| YlGnBu
| YlOrRd
deriving (ColorScale -> ColorScale -> Bool
(ColorScale -> ColorScale -> Bool)
-> (ColorScale -> ColorScale -> Bool) -> Eq ColorScale
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorScale -> ColorScale -> Bool
$c/= :: ColorScale -> ColorScale -> Bool
== :: ColorScale -> ColorScale -> Bool
$c== :: ColorScale -> ColorScale -> Bool
Eq, Int -> ColorScale -> ShowS
[ColorScale] -> ShowS
ColorScale -> String
(Int -> ColorScale -> ShowS)
-> (ColorScale -> String)
-> ([ColorScale] -> ShowS)
-> Show ColorScale
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorScale] -> ShowS
$cshowList :: [ColorScale] -> ShowS
show :: ColorScale -> String
$cshow :: ColorScale -> String
showsPrec :: Int -> ColorScale -> ShowS
$cshowsPrec :: Int -> ColorScale -> ShowS
Show, (forall x. ColorScale -> Rep ColorScale x)
-> (forall x. Rep ColorScale x -> ColorScale) -> Generic ColorScale
forall x. Rep ColorScale x -> ColorScale
forall x. ColorScale -> Rep ColorScale x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColorScale x -> ColorScale
$cfrom :: forall x. ColorScale -> Rep ColorScale x
Generic, [ColorScale] -> Encoding
[ColorScale] -> Value
ColorScale -> Encoding
ColorScale -> Value
(ColorScale -> Value)
-> (ColorScale -> Encoding)
-> ([ColorScale] -> Value)
-> ([ColorScale] -> Encoding)
-> ToJSON ColorScale
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ColorScale] -> Encoding
$ctoEncodingList :: [ColorScale] -> Encoding
toJSONList :: [ColorScale] -> Value
$ctoJSONList :: [ColorScale] -> Value
toEncoding :: ColorScale -> Encoding
$ctoEncoding :: ColorScale -> Encoding
toJSON :: ColorScale -> Value
$ctoJSON :: ColorScale -> Value
ToJSON)
data Color = Red
| Green
| Blue
| Yellow
| Magenta
| Cyan
| Black
| Gray
| White
deriving (Int -> Color
Color -> Int
Color -> [Color]
Color -> Color
Color -> Color -> [Color]
Color -> Color -> Color -> [Color]
(Color -> Color)
-> (Color -> Color)
-> (Int -> Color)
-> (Color -> Int)
-> (Color -> [Color])
-> (Color -> Color -> [Color])
-> (Color -> Color -> [Color])
-> (Color -> Color -> Color -> [Color])
-> Enum Color
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Color -> Color -> Color -> [Color]
$cenumFromThenTo :: Color -> Color -> Color -> [Color]
enumFromTo :: Color -> Color -> [Color]
$cenumFromTo :: Color -> Color -> [Color]
enumFromThen :: Color -> Color -> [Color]
$cenumFromThen :: Color -> Color -> [Color]
enumFrom :: Color -> [Color]
$cenumFrom :: Color -> [Color]
fromEnum :: Color -> Int
$cfromEnum :: Color -> Int
toEnum :: Int -> Color
$ctoEnum :: Int -> Color
pred :: Color -> Color
$cpred :: Color -> Color
succ :: Color -> Color
$csucc :: Color -> Color
Enum, Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq, (forall x. Color -> Rep Color x)
-> (forall x. Rep Color x -> Color) -> Generic Color
forall x. Rep Color x -> Color
forall x. Color -> Rep Color x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Color x -> Color
$cfrom :: forall x. Color -> Rep Color x
Generic)
instance Show Color where
show :: Color -> String
show Color
Red = String
"red"
show Color
Green = String
"green"
show Color
Blue = String
"blue"
show Color
Yellow = String
"yellow"
show Color
Magenta = String
"magenta"
show Color
Cyan = String
"cyan"
show Color
Black = String
"black"
show Color
Gray = String
"gray"
show Color
White = String
"white"
instance ToJSON Color where
toJSON :: Color -> Value
toJSON Color
Red = Value
"red"
toJSON Color
Green = Value
"green"
toJSON Color
Blue = Value
"blue"
toJSON Color
Yellow = Value
"yellow"
toJSON Color
Magenta = Value
"magenta"
toJSON Color
Cyan = Value
"cyan"
toJSON Color
Black = Value
"black"
toJSON Color
Gray = Value
"gray"
toJSON Color
White = Value
"white"
data ColorMapping = ColorMapping !Double !Color
deriving ((forall x. ColorMapping -> Rep ColorMapping x)
-> (forall x. Rep ColorMapping x -> ColorMapping)
-> Generic ColorMapping
forall x. Rep ColorMapping x -> ColorMapping
forall x. ColorMapping -> Rep ColorMapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColorMapping x -> ColorMapping
$cfrom :: forall x. ColorMapping -> Rep ColorMapping x
Generic, ColorMap -> Encoding
ColorMap -> Value
ColorMapping -> Encoding
ColorMapping -> Value
(ColorMapping -> Value)
-> (ColorMapping -> Encoding)
-> (ColorMap -> Value)
-> (ColorMap -> Encoding)
-> ToJSON ColorMapping
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: ColorMap -> Encoding
$ctoEncodingList :: ColorMap -> Encoding
toJSONList :: ColorMap -> Value
$ctoJSONList :: ColorMap -> Value
toEncoding :: ColorMapping -> Encoding
$ctoEncoding :: ColorMapping -> Encoding
toJSON :: ColorMapping -> Value
$ctoJSON :: ColorMapping -> Value
ToJSON)
instance Show ColorMapping where
show :: ColorMapping -> String
show (ColorMapping Double
n Color
c) = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Color -> String
forall a. Show a => a -> String
show Color
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"]"
type ColorMap = [ColorMapping]
data BarMode = Stack
| Group
| Overlay
| Relative
deriving (BarMode -> BarMode -> Bool
(BarMode -> BarMode -> Bool)
-> (BarMode -> BarMode -> Bool) -> Eq BarMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BarMode -> BarMode -> Bool
$c/= :: BarMode -> BarMode -> Bool
== :: BarMode -> BarMode -> Bool
$c== :: BarMode -> BarMode -> Bool
Eq, (forall x. BarMode -> Rep BarMode x)
-> (forall x. Rep BarMode x -> BarMode) -> Generic BarMode
forall x. Rep BarMode x -> BarMode
forall x. BarMode -> Rep BarMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BarMode x -> BarMode
$cfrom :: forall x. BarMode -> Rep BarMode x
Generic, 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 BarMode
Stack = Value
"stack"
toJSON BarMode
Group = Value
"group"
toJSON BarMode
Overlay = Value
"overlay"
toJSON BarMode
Relative = Value
"relative"
data XBins = XBins { XBins -> Double
size :: !Double
, XBins -> Maybe Double
start :: !(Maybe Double)
, XBins -> Maybe Double
end :: !(Maybe Double)
} deriving (Int -> XBins -> ShowS
[XBins] -> ShowS
XBins -> String
(Int -> XBins -> ShowS)
-> (XBins -> String) -> ([XBins] -> ShowS) -> Show XBins
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XBins] -> ShowS
$cshowList :: [XBins] -> ShowS
show :: XBins -> String
$cshow :: XBins -> String
showsPrec :: Int -> XBins -> ShowS
$cshowsPrec :: Int -> XBins -> ShowS
Show, (forall x. XBins -> Rep XBins x)
-> (forall x. Rep XBins x -> XBins) -> Generic XBins
forall x. Rep XBins x -> XBins
forall x. XBins -> Rep XBins x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XBins x -> XBins
$cfrom :: forall x. XBins -> Rep XBins x
Generic, [XBins] -> Encoding
[XBins] -> Value
XBins -> Encoding
XBins -> Value
(XBins -> Value)
-> (XBins -> Encoding)
-> ([XBins] -> Value)
-> ([XBins] -> Encoding)
-> ToJSON XBins
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [XBins] -> Encoding
$ctoEncodingList :: [XBins] -> Encoding
toJSONList :: [XBins] -> Value
$ctoJSONList :: [XBins] -> Value
toEncoding :: XBins -> Encoding
$ctoEncoding :: XBins -> Encoding
toJSON :: XBins -> Value
$ctoJSON :: XBins -> Value
ToJSON)
traceData :: Int -> Script
traceData :: Int -> Script
traceData Int
num = [Script] -> Script
BL.concat [ Script
"var data = [", Script
ids, Script
"];" ]
where
ids :: Script
ids = Script -> [Script] -> Script
C8.intercalate Script
"," [ String -> Script
C8.pack (String -> Script) -> String -> Script
forall a b. (a -> b) -> a -> b
$ String
"trace" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i | Int
i <- [Int
0 .. Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]
traceLine :: (ToJSON a) => a -> Int -> ByteString
traceLine :: a -> Int -> Script
traceLine a
t Int
i = [Script] -> Script
BL.concat [Script
"var trace", Script
i', Script
" = ", a -> Script
forall a. ToJSON a => a -> Script
encode a
t, Script
";"]
where
i' :: Script
i' = String -> Script
C8.pack (Int -> String
forall a. Show a => a -> String
show Int
i)
toScript :: (ToJSON a) => Maybe Layout -> [a] -> ByteString
toScript :: Maybe Layout -> [a] -> Script
toScript Maybe Layout
layout [a]
traces = [Script] -> Script
C8.unlines ([Script] -> Script) -> [Script] -> Script
forall a b. (a -> b) -> a -> b
$ [Script]
ls [Script] -> [Script] -> [Script]
forall a. [a] -> [a] -> [a]
++ [Script
ds, Script
lay, Script
"Plotly.newPlot('plotDiv', data, layout);"]
where
num :: Int
num = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
traces
ls :: [Script]
ls = (a -> Int -> Script) -> [a] -> [Int] -> [Script]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> Int -> Script
forall a. ToJSON a => a -> Int -> Script
traceLine [a]
traces [ Int
0 .. ]
ds :: Script
ds = Int -> Script
traceData Int
num
lay :: Script
lay = [Script] -> Script
BL.concat [Script
"var layout = ", Maybe Layout -> Script
forall a. ToJSON a => a -> Script
encode Maybe Layout
layout, Script
";"]
mkTrace :: Maybe String -> Maybe Mode -> Maybe Marker -> Type -> BarMode
-> XBins -> [Double] -> [Double] -> [Double] -> Trace
mkTrace :: Maybe String
-> Maybe Mode
-> Maybe Marker
-> Type
-> BarMode
-> XBins
-> [Double]
-> [Double]
-> [Double]
-> Trace
mkTrace Maybe String
n Maybe Mode
m Maybe Marker
m' Type
t BarMode
b XBins
s [Double]
xs [Double]
ys [Double]
zs = Maybe String
-> Maybe [Double]
-> Maybe [Double]
-> Maybe [Double]
-> Maybe Mode
-> Type
-> Maybe BarMode
-> Maybe XBins
-> Maybe Marker
-> Trace
Trace Maybe String
n Maybe [Double]
xs' Maybe [Double]
ys' Maybe [Double]
zs' Maybe Mode
m Type
t Maybe BarMode
bm' Maybe XBins
bs' Maybe Marker
m'
where
bs' :: Maybe XBins
bs' = if Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
Histogram then XBins -> Maybe XBins
forall a. a -> Maybe a
Just XBins
s else Maybe XBins
forall a. Maybe a
Nothing
bm' :: Maybe BarMode
bm' = if Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
Histogram then BarMode -> Maybe BarMode
forall a. a -> Maybe a
Just BarMode
b else Maybe BarMode
forall a. Maybe a
Nothing
xs' :: Maybe [Double]
xs' = if [Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
xs then Maybe [Double]
forall a. Maybe a
Nothing else [Double] -> Maybe [Double]
forall a. a -> Maybe a
Just [Double]
xs
ys' :: Maybe [Double]
ys' = if [Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
ys then Maybe [Double]
forall a. Maybe a
Nothing else [Double] -> Maybe [Double]
forall a. a -> Maybe a
Just [Double]
ys
zs' :: Maybe [Double]
zs' = if [Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
zs then Maybe [Double]
forall a. Maybe a
Nothing else [Double] -> Maybe [Double]
forall a. a -> Maybe a
Just [Double]
zs
mkTraceH :: ColorScale -> Bool -> Bool -> [String] -> [String] -> [[Double]] -> TraceH
mkTraceH :: ColorScale
-> Bool -> Bool -> [String] -> [String] -> [[Double]] -> TraceH
mkTraceH ColorScale
cs Bool
hv Bool
sc [String]
xs [String]
ys [[Double]]
zs = [[Double]]
-> Maybe [String]
-> Maybe [String]
-> Type
-> Maybe Bool
-> Maybe Bool
-> Maybe ColorScale
-> TraceH
TraceH [[Double]]
zs Maybe [String]
xs' Maybe [String]
ys' Type
Heatmap (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
hv) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
sc) (ColorScale -> Maybe ColorScale
forall a. a -> Maybe a
Just ColorScale
cs)
where
ys' :: Maybe [String]
ys' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ys then Maybe [String]
forall a. Maybe a
Nothing else [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
ys
xs' :: Maybe [String]
xs' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs then Maybe [String]
forall a. Maybe a
Nothing else [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
xs
mkTraceS :: Maybe String -> ColorScale -> [Double] -> [Double] -> [[Double]] -> TraceS
mkTraceS :: Maybe String
-> ColorScale -> [Double] -> [Double] -> [[Double]] -> TraceS
mkTraceS Maybe String
ns ColorScale
cs [Double]
xs [Double]
ys [[Double]]
zs = Maybe String
-> [[Double]]
-> Maybe [Double]
-> Maybe [Double]
-> Type
-> Maybe ColorScale
-> TraceS
TraceS Maybe String
ns [[Double]]
zs Maybe [Double]
xs' Maybe [Double]
ys' Type
Surface (ColorScale -> Maybe ColorScale
forall a. a -> Maybe a
Just ColorScale
cs)
where
ys' :: Maybe [Double]
ys' = if [Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
ys then Maybe [Double]
forall a. Maybe a
Nothing else [Double] -> Maybe [Double]
forall a. a -> Maybe a
Just [Double]
ys
xs' :: Maybe [Double]
xs' = if [Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
xs then Maybe [Double]
forall a. Maybe a
Nothing else [Double] -> Maybe [Double]
forall a. a -> Maybe a
Just [Double]
xs
mkTraceP :: ColorScale -> Bool -> Bool -> [Double] -> [String] -> [[[Double]]] -> TraceP
mkTraceP :: ColorScale
-> Bool -> Bool -> [Double] -> [String] -> [[[Double]]] -> TraceP
mkTraceP ColorScale
scale Bool
show' Bool
rev' [Double]
colors [String]
labels [[[Double]]]
ds = Type -> Maybe Line -> [Dimension] -> TraceP
TraceP Type
ParCoords (Line -> Maybe Line
forall a. a -> Maybe a
Just Line
line) [Dimension]
dims
where
mapping :: ColorMap
mapping = (Double -> Color -> ColorMapping)
-> [Double] -> [Color] -> ColorMap
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Color -> ColorMapping
ColorMapping ([Double] -> [Double]
forall a. Eq a => [a] -> [a]
nub [Double]
colors) [ Color
Red .. ]
line :: Line
line = if ColorScale
scale ColorScale -> ColorScale -> Bool
forall a. Eq a => a -> a -> Bool
== ColorScale
Discrete then Maybe Bool
-> Maybe Bool
-> Maybe ColorScale
-> Maybe ColorMap
-> Maybe [Double]
-> Line
Line (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
show') (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
rev') Maybe ColorScale
forall a. Maybe a
Nothing (ColorMap -> Maybe ColorMap
forall a. a -> Maybe a
Just ColorMap
mapping) ([Double] -> Maybe [Double]
forall a. a -> Maybe a
Just [Double]
colors)
else Maybe Bool
-> Maybe Bool
-> Maybe ColorScale
-> Maybe ColorMap
-> Maybe [Double]
-> Line
Line (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
show') (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
rev') (ColorScale -> Maybe ColorScale
forall a. a -> Maybe a
Just ColorScale
scale) Maybe ColorMap
forall a. Maybe a
Nothing ([Double] -> Maybe [Double]
forall a. a -> Maybe a
Just [Double]
colors)
ds' :: [[Double]]
ds' = ([[Double]] -> [[Double]] -> [[Double]])
-> [[[Double]]] -> [[Double]]
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (([Double] -> [Double] -> [Double])
-> [[Double]] -> [[Double]] -> [[Double]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
(++)) [[[Double]]]
ds
dims :: [Dimension]
dims = (String -> [Double] -> Dimension)
-> [String] -> [[Double]] -> [Dimension]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Maybe [Int] -> String -> [Double] -> Dimension
Dimension Maybe [Int]
forall a. Maybe a
Nothing) [String]
labels [[Double]]
ds'
mkTraceP' :: [String] -> [[[Double]]] -> TraceP
mkTraceP' :: [String] -> [[[Double]]] -> TraceP
mkTraceP' [String]
labels [[[Double]]]
ds = Type -> Maybe Line -> [Dimension] -> TraceP
TraceP Type
ParCoords (Line -> Maybe Line
forall a. a -> Maybe a
Just Line
line) [Dimension]
dims
where
num :: Double
num = Int -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [[[Double]]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[Double]]]
ds
len :: Int
len = [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> ([[Double]] -> [Double]) -> [[Double]] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [Double]
forall a. [a] -> a
head ([[Double]] -> Int) -> [[Double]] -> Int
forall a b. (a -> b) -> a -> b
$ [[[Double]]] -> [[Double]]
forall a. [a] -> a
head [[[Double]]]
ds
colors :: Maybe [Double]
colors = if [[[Double]]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[Double]]]
ds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then [Double] -> Maybe [Double]
forall a. a -> Maybe a
Just ([Double] -> Maybe [Double])
-> ([[Double]] -> [Double]) -> [[Double]] -> Maybe [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Double] -> [Double] -> [Double]) -> [[Double]] -> [Double]
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
(++) ([[Double]] -> Maybe [Double]) -> [[Double]] -> Maybe [Double]
forall a b. (a -> b) -> a -> b
$ (Double -> [Double]) -> [Double] -> [[Double]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
len) [Double
1.0 .. Double
num]
else Maybe [Double]
forall a. Maybe a
Nothing
line :: Line
line = Maybe Bool
-> Maybe Bool
-> Maybe ColorScale
-> Maybe ColorMap
-> Maybe [Double]
-> Line
Line (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) Maybe ColorScale
forall a. Maybe a
Nothing Maybe ColorMap
forall a. Maybe a
Nothing Maybe [Double]
colors
ds' :: [[Double]]
ds' = ([[Double]] -> [[Double]] -> [[Double]])
-> [[[Double]]] -> [[Double]]
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (([Double] -> [Double] -> [Double])
-> [[Double]] -> [[Double]] -> [[Double]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
(++)) [[[Double]]]
ds
dims :: [Dimension]
dims = (String -> [Double] -> Dimension)
-> [String] -> [[Double]] -> [Dimension]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Maybe [Int] -> String -> [Double] -> Dimension
Dimension Maybe [Int]
forall a. Maybe a
Nothing) [String]
labels [[Double]]
ds'