{-# OPTIONS_GHC -Wall #-}

{-# LANGUAGE RecordWildCards #-} 
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DuplicateRecordFields #-}

-- | Plotly Plots in Haskell
module Graphics.Plotly ( plot, scatter', scatter, histogram, heatmap
                       , scatter3d, surface'', surface', surface
                       , parcoord'', parcoord', parcoord
                       , Script, Mode (..), Type (..), Layout (..), BarMode (..)
                       , AxisType (..), Color (..), ColorMap, ColorScale (..)
                       , Symbol (..), Marker (..), Line (..), XBins (..), Margin (..)
                       , PlotConfig (..), defaultConfig
                       ) where

import           Data.List                      (zipWith4)
import qualified Data.ByteString.Lazy     as BL
import           Graphics.Plotly.Internal
import           Graphics.Plotly.Default

-- | Scatter Plot with individual x values per trace
scatter' :: [String]  -- ^ Trace Names
         -> [[Double]] -- ^ xs
         -> [[Double]] -- ^ ys
         -> PlotConfig -- ^ Plot Config
         -> Script     -- ^ Plotly Script
scatter' :: [String] -> [[Double]] -> [[Double]] -> PlotConfig -> Script
scatter' [String]
ns [[Double]]
xs [[Double]]
ys cfg :: PlotConfig
cfg@PlotConfig{Bool
Int
String
XBins
BarMode
ColorScale
Mode
Marker
AxisType
Margin
$sel:bins:PlotConfig :: PlotConfig -> XBins
$sel:marker:PlotConfig :: PlotConfig -> Marker
$sel:margin:PlotConfig :: PlotConfig -> Margin
$sel:width:PlotConfig :: PlotConfig -> Int
$sel:height:PlotConfig :: PlotConfig -> Int
$sel:legend:PlotConfig :: PlotConfig -> Bool
$sel:reverseScale:PlotConfig :: PlotConfig -> Bool
$sel:showScale:PlotConfig :: PlotConfig -> Bool
$sel:colorScale:PlotConfig :: PlotConfig -> ColorScale
$sel:lineMode:PlotConfig :: PlotConfig -> Mode
$sel:barMode:PlotConfig :: PlotConfig -> BarMode
$sel:ymode:PlotConfig :: PlotConfig -> AxisType
$sel:xmode:PlotConfig :: PlotConfig -> AxisType
$sel:ylabel:PlotConfig :: PlotConfig -> String
$sel:xlabel:PlotConfig :: PlotConfig -> String
$sel:title':PlotConfig :: PlotConfig -> String
bins :: XBins
marker :: Marker
margin :: Margin
width :: Int
height :: Int
legend :: Bool
reverseScale :: Bool
showScale :: Bool
colorScale :: ColorScale
lineMode :: Mode
barMode :: BarMode
ymode :: AxisType
xmode :: AxisType
ylabel :: String
xlabel :: String
title' :: String
..} = Maybe Layout -> [Trace] -> Script
forall a. ToJSON a => Maybe Layout -> [a] -> Script
toScript Maybe Layout
layout [Trace]
traces
  where
    z' :: [a]
z'          = []
    layout :: Maybe Layout
layout      = Layout -> Maybe Layout
forall a. a -> Maybe a
Just (Layout -> Maybe Layout) -> Layout -> Maybe Layout
forall a b. (a -> b) -> a -> b
$ PlotConfig -> Layout
fromConfig PlotConfig
cfg
    traces :: [Trace]
traces      = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ns then ([Double] -> [Double] -> Trace)
-> [[Double]] -> [[Double]] -> [Trace]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Maybe String -> [Double] -> [Double] -> Trace
mt Maybe String
forall a. Maybe a
Nothing) [[Double]]
xs [[Double]]
ys else (Maybe String -> [Double] -> [Double] -> Trace)
-> [Maybe String] -> [[Double]] -> [[Double]] -> [Trace]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Maybe String -> [Double] -> [Double] -> Trace
mt ((String -> Maybe String) -> [String] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe String
forall a. a -> Maybe a
Just [String]
ns) [[Double]]
xs [[Double]]
ys
    mt :: Maybe String -> [Double] -> [Double] -> Trace
mt Maybe String
n' [Double]
x' [Double]
y' = Maybe String
-> Maybe Mode
-> Maybe Marker
-> Type
-> BarMode
-> XBins
-> [Double]
-> [Double]
-> [Double]
-> Trace
mkTrace Maybe String
n' (Mode -> Maybe Mode
forall a. a -> Maybe a
Just Mode
lineMode) (Marker -> Maybe Marker
forall a. a -> Maybe a
Just Marker
marker) Type
Scatter BarMode
barMode XBins
bins [Double]
x' [Double]
y' [Double]
forall a. [a]
z'

-- | Scatter Plot with same x axis for all ys
scatter :: [String]   -- ^ Trace Names
        -> [Double]   -- ^ xs
        -> [[Double]] -- ^ ys
        -> PlotConfig -- ^ Plot Config
        -> Script     -- ^ Plotly Script
scatter :: [String] -> [Double] -> [[Double]] -> PlotConfig -> Script
scatter [String]
ns [Double]
x [[Double]]
ys PlotConfig
cfg = [String] -> [[Double]] -> [[Double]] -> PlotConfig -> Script
scatter' [String]
ns [[Double]]
xs [[Double]]
ys PlotConfig
cfg
  where
    xs :: [[Double]]
xs = Int -> [Double] -> [[Double]]
forall a. Int -> a -> [a]
replicate ([[Double]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
ys) [Double]
x

-- | Histogram Plot
histogram :: [String]    -- ^ Trace Names
          -> [[Double]]  -- ^ Traces
          -> PlotConfig  -- ^ Plot Config
          -> Script      -- ^ Plotly Script
histogram :: [String] -> [[Double]] -> PlotConfig -> Script
histogram [String]
ns [[Double]]
xs cfg :: PlotConfig
cfg@PlotConfig{Bool
Int
String
XBins
BarMode
ColorScale
Mode
Marker
AxisType
Margin
bins :: XBins
marker :: Marker
margin :: Margin
width :: Int
height :: Int
legend :: Bool
reverseScale :: Bool
showScale :: Bool
colorScale :: ColorScale
lineMode :: Mode
barMode :: BarMode
ymode :: AxisType
xmode :: AxisType
ylabel :: String
xlabel :: String
title' :: String
$sel:bins:PlotConfig :: PlotConfig -> XBins
$sel:marker:PlotConfig :: PlotConfig -> Marker
$sel:margin:PlotConfig :: PlotConfig -> Margin
$sel:width:PlotConfig :: PlotConfig -> Int
$sel:height:PlotConfig :: PlotConfig -> Int
$sel:legend:PlotConfig :: PlotConfig -> Bool
$sel:reverseScale:PlotConfig :: PlotConfig -> Bool
$sel:showScale:PlotConfig :: PlotConfig -> Bool
$sel:colorScale:PlotConfig :: PlotConfig -> ColorScale
$sel:lineMode:PlotConfig :: PlotConfig -> Mode
$sel:barMode:PlotConfig :: PlotConfig -> BarMode
$sel:ymode:PlotConfig :: PlotConfig -> AxisType
$sel:xmode:PlotConfig :: PlotConfig -> AxisType
$sel:ylabel:PlotConfig :: PlotConfig -> String
$sel:xlabel:PlotConfig :: PlotConfig -> String
$sel:title':PlotConfig :: PlotConfig -> String
..} = Maybe Layout -> [Trace] -> Script
forall a. ToJSON a => Maybe Layout -> [a] -> Script
toScript Maybe Layout
layout [Trace]
traces
  where
    layout :: Maybe Layout
layout = Layout -> Maybe Layout
forall a. a -> Maybe a
Just (Layout -> Maybe Layout) -> Layout -> Maybe Layout
forall a b. (a -> b) -> a -> b
$ PlotConfig -> Layout
fromConfig PlotConfig
cfg
    traces :: [Trace]
traces = (String -> [Double] -> Trace) -> [String] -> [[Double]] -> [Trace]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
ns' [Double]
xs' -> Maybe String
-> Maybe Mode
-> Maybe Marker
-> Type
-> BarMode
-> XBins
-> [Double]
-> [Double]
-> [Double]
-> Trace
mkTrace (String -> Maybe String
forall a. a -> Maybe a
Just String
ns') Maybe Mode
forall a. Maybe a
Nothing Maybe Marker
forall a. Maybe a
Nothing Type
Histogram BarMode
barMode XBins
bins [Double]
xs' [] []) [String]
ns [[Double]]
xs

-- | Heatmap Plot
heatmap :: [String]   -- ^ X Categories
        -> [String]   -- ^ Y Categories
        -> [[Double]] -- ^ Data Matrix
        -> PlotConfig -- ^ Plot Config
        -> Script     -- ^ Plotly Script
heatmap :: [String] -> [String] -> [[Double]] -> PlotConfig -> Script
heatmap [String]
xs [String]
ys [[Double]]
zs cfg :: PlotConfig
cfg@PlotConfig{Bool
Int
String
XBins
BarMode
ColorScale
Mode
Marker
AxisType
Margin
bins :: XBins
marker :: Marker
margin :: Margin
width :: Int
height :: Int
legend :: Bool
reverseScale :: Bool
showScale :: Bool
colorScale :: ColorScale
lineMode :: Mode
barMode :: BarMode
ymode :: AxisType
xmode :: AxisType
ylabel :: String
xlabel :: String
title' :: String
$sel:bins:PlotConfig :: PlotConfig -> XBins
$sel:marker:PlotConfig :: PlotConfig -> Marker
$sel:margin:PlotConfig :: PlotConfig -> Margin
$sel:width:PlotConfig :: PlotConfig -> Int
$sel:height:PlotConfig :: PlotConfig -> Int
$sel:legend:PlotConfig :: PlotConfig -> Bool
$sel:reverseScale:PlotConfig :: PlotConfig -> Bool
$sel:showScale:PlotConfig :: PlotConfig -> Bool
$sel:colorScale:PlotConfig :: PlotConfig -> ColorScale
$sel:lineMode:PlotConfig :: PlotConfig -> Mode
$sel:barMode:PlotConfig :: PlotConfig -> BarMode
$sel:ymode:PlotConfig :: PlotConfig -> AxisType
$sel:xmode:PlotConfig :: PlotConfig -> AxisType
$sel:ylabel:PlotConfig :: PlotConfig -> String
$sel:xlabel:PlotConfig :: PlotConfig -> String
$sel:title':PlotConfig :: PlotConfig -> String
..} = Maybe Layout -> [TraceH] -> Script
forall a. ToJSON a => Maybe Layout -> [a] -> Script
toScript Maybe Layout
layout [TraceH
traceh]
  where
    layout :: Maybe Layout
layout = Layout -> Maybe Layout
forall a. a -> Maybe a
Just (Layout -> Maybe Layout) -> Layout -> Maybe Layout
forall a b. (a -> b) -> a -> b
$ PlotConfig -> Layout
fromConfig PlotConfig
cfg
    traceh :: TraceH
traceh = ColorScale
-> Bool -> Bool -> [String] -> [String] -> [[Double]] -> TraceH
mkTraceH ColorScale
colorScale Bool
True Bool
True [String]
xs [String]
ys [[Double]]
zs

-- | 3D Scatter Plot
scatter3d :: [String]   -- ^ Trace Names
          -> [[Double]] -- ^ xs
          -> [[Double]] -- ^ ys
          -> [[Double]] -- ^ zs
          -> PlotConfig -- ^ Plot Config
          -> Script     -- ^ Plotly Script
scatter3d :: [String]
-> [[Double]] -> [[Double]] -> [[Double]] -> PlotConfig -> Script
scatter3d [String]
ns [[Double]]
xs [[Double]]
ys [[Double]]
zs cfg :: PlotConfig
cfg@PlotConfig{Bool
Int
String
XBins
BarMode
ColorScale
Mode
Marker
AxisType
Margin
bins :: XBins
marker :: Marker
margin :: Margin
width :: Int
height :: Int
legend :: Bool
reverseScale :: Bool
showScale :: Bool
colorScale :: ColorScale
lineMode :: Mode
barMode :: BarMode
ymode :: AxisType
xmode :: AxisType
ylabel :: String
xlabel :: String
title' :: String
$sel:bins:PlotConfig :: PlotConfig -> XBins
$sel:marker:PlotConfig :: PlotConfig -> Marker
$sel:margin:PlotConfig :: PlotConfig -> Margin
$sel:width:PlotConfig :: PlotConfig -> Int
$sel:height:PlotConfig :: PlotConfig -> Int
$sel:legend:PlotConfig :: PlotConfig -> Bool
$sel:reverseScale:PlotConfig :: PlotConfig -> Bool
$sel:showScale:PlotConfig :: PlotConfig -> Bool
$sel:colorScale:PlotConfig :: PlotConfig -> ColorScale
$sel:lineMode:PlotConfig :: PlotConfig -> Mode
$sel:barMode:PlotConfig :: PlotConfig -> BarMode
$sel:ymode:PlotConfig :: PlotConfig -> AxisType
$sel:xmode:PlotConfig :: PlotConfig -> AxisType
$sel:ylabel:PlotConfig :: PlotConfig -> String
$sel:xlabel:PlotConfig :: PlotConfig -> String
$sel:title':PlotConfig :: PlotConfig -> String
..} = Maybe Layout -> [Trace] -> Script
forall a. ToJSON a => Maybe Layout -> [a] -> Script
toScript Maybe Layout
layout [Trace]
traces
  where
    layout :: Maybe Layout
layout         = Layout -> Maybe Layout
forall a. a -> Maybe a
Just (Layout -> Maybe Layout) -> Layout -> Maybe Layout
forall a b. (a -> b) -> a -> b
$ PlotConfig -> Layout
fromConfig PlotConfig
cfg
    traces :: [Trace]
traces         = (String -> [Double] -> [Double] -> [Double] -> Trace)
-> [String] -> [[Double]] -> [[Double]] -> [[Double]] -> [Trace]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 String -> [Double] -> [Double] -> [Double] -> Trace
mt [String]
ns [[Double]]
xs [[Double]]
ys [[Double]]
zs
    mt :: String -> [Double] -> [Double] -> [Double] -> Trace
mt String
n' [Double]
x' [Double]
y' [Double]
z' = Maybe String
-> Maybe Mode
-> Maybe Marker
-> Type
-> BarMode
-> XBins
-> [Double]
-> [Double]
-> [Double]
-> Trace
mkTrace (String -> Maybe String
forall a. a -> Maybe a
Just String
n') (Mode -> Maybe Mode
forall a. a -> Maybe a
Just Mode
lineMode) (Marker -> Maybe Marker
forall a. a -> Maybe a
Just Marker
marker) Type
Scatter3D BarMode
barMode XBins
bins [Double]
x' [Double]
y' [Double]
z'

-- | 3D Surface Plot
surface :: [String]     -- ^ Trace Names
        -> [[Double]]   -- ^ xs
        -> [[Double]]   -- ^ ys
        -> [[[Double]]] -- ^ zs
        -> PlotConfig   -- ^ P
        -> Script       -- ^ Trace
surface :: [String]
-> [[Double]] -> [[Double]] -> [[[Double]]] -> PlotConfig -> Script
surface [String]
ns [[Double]]
xs [[Double]]
ys [[[Double]]]
zs cfg :: PlotConfig
cfg@PlotConfig{Bool
Int
String
XBins
BarMode
ColorScale
Mode
Marker
AxisType
Margin
bins :: XBins
marker :: Marker
margin :: Margin
width :: Int
height :: Int
legend :: Bool
reverseScale :: Bool
showScale :: Bool
colorScale :: ColorScale
lineMode :: Mode
barMode :: BarMode
ymode :: AxisType
xmode :: AxisType
ylabel :: String
xlabel :: String
title' :: String
$sel:bins:PlotConfig :: PlotConfig -> XBins
$sel:marker:PlotConfig :: PlotConfig -> Marker
$sel:margin:PlotConfig :: PlotConfig -> Margin
$sel:width:PlotConfig :: PlotConfig -> Int
$sel:height:PlotConfig :: PlotConfig -> Int
$sel:legend:PlotConfig :: PlotConfig -> Bool
$sel:reverseScale:PlotConfig :: PlotConfig -> Bool
$sel:showScale:PlotConfig :: PlotConfig -> Bool
$sel:colorScale:PlotConfig :: PlotConfig -> ColorScale
$sel:lineMode:PlotConfig :: PlotConfig -> Mode
$sel:barMode:PlotConfig :: PlotConfig -> BarMode
$sel:ymode:PlotConfig :: PlotConfig -> AxisType
$sel:xmode:PlotConfig :: PlotConfig -> AxisType
$sel:ylabel:PlotConfig :: PlotConfig -> String
$sel:xlabel:PlotConfig :: PlotConfig -> String
$sel:title':PlotConfig :: PlotConfig -> String
..} = Maybe Layout -> [TraceS] -> Script
forall a. ToJSON a => Maybe Layout -> [a] -> Script
toScript Maybe Layout
layout [TraceS]
traces
  where
    layout :: Maybe Layout
layout   = Layout -> Maybe Layout
forall a. a -> Maybe a
Just (Layout -> Maybe Layout) -> Layout -> Maybe Layout
forall a b. (a -> b) -> a -> b
$ PlotConfig -> Layout
fromConfig PlotConfig
cfg
    traces :: [TraceS]
traces   = (String -> [Double] -> [Double] -> [[Double]] -> TraceS)
-> [String] -> [[Double]] -> [[Double]] -> [[[Double]]] -> [TraceS]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 String -> [Double] -> [Double] -> [[Double]] -> TraceS
mt [String]
ns [[Double]]
xs [[Double]]
ys [[[Double]]]
zs
    mt :: String -> [Double] -> [Double] -> [[Double]] -> TraceS
mt String
n' [Double]
x' [Double]
y' [[Double]]
z' = Maybe String
-> ColorScale -> [Double] -> [Double] -> [[Double]] -> TraceS
mkTraceS (String -> Maybe String
forall a. a -> Maybe a
Just String
n') ColorScale
colorScale [Double]
x' [Double]
y' [[Double]]
z'

-- | 3D Surface Plot with same xs and ys for all zs
surface' :: [String]     -- ^ Trace Names
         -> [Double]     -- ^ xs
         -> [Double]     -- ys
         -> [[[Double]]] -- ^ zs
         -> PlotConfig   -- ^ Plot Config
         -> Script       -- ^ Plotly Script
surface' :: [String]
-> [Double] -> [Double] -> [[[Double]]] -> PlotConfig -> Script
surface' [String]
ns [Double]
xs [Double]
ys = [String]
-> [[Double]] -> [[Double]] -> [[[Double]]] -> PlotConfig -> Script
surface [String]
ns ([Double] -> [[Double]]
forall a. a -> [a]
repeat [Double]
xs) ([Double] -> [[Double]]
forall a. a -> [a]
repeat [Double]
ys)

-- | 3D Surface Plot where X and Y are indices
surface'' :: [String]    -- ^ Trace Names
         -> [[[Double]]] -- ^ zs
         -> PlotConfig   -- ^ Plot Config
         -> Script       -- ^ Ploty Script
surface'' :: [String] -> [[[Double]]] -> PlotConfig -> Script
surface'' [String]
ns = [String]
-> [Double] -> [Double] -> [[[Double]]] -> PlotConfig -> Script
surface' [String]
ns [] []

-- | Parallel Coordinate Plot with line gradient
parcoord :: [Double]     -- ^ Color column
         -> [String]     -- ^ Axis Labels
         -> [[[Double]]] -- ^ traces ( rows ( values ) )
         -> PlotConfig   -- ^ Plot Config
         -> Script       -- ^ Plotly Script
parcoord :: [Double] -> [String] -> [[[Double]]] -> PlotConfig -> Script
parcoord [Double]
cs [String]
ns [[[Double]]]
vs cfg :: PlotConfig
cfg@PlotConfig{Bool
Int
String
XBins
BarMode
ColorScale
Mode
Marker
AxisType
Margin
bins :: XBins
marker :: Marker
margin :: Margin
width :: Int
height :: Int
legend :: Bool
reverseScale :: Bool
showScale :: Bool
colorScale :: ColorScale
lineMode :: Mode
barMode :: BarMode
ymode :: AxisType
xmode :: AxisType
ylabel :: String
xlabel :: String
title' :: String
$sel:bins:PlotConfig :: PlotConfig -> XBins
$sel:marker:PlotConfig :: PlotConfig -> Marker
$sel:margin:PlotConfig :: PlotConfig -> Margin
$sel:width:PlotConfig :: PlotConfig -> Int
$sel:height:PlotConfig :: PlotConfig -> Int
$sel:legend:PlotConfig :: PlotConfig -> Bool
$sel:reverseScale:PlotConfig :: PlotConfig -> Bool
$sel:showScale:PlotConfig :: PlotConfig -> Bool
$sel:colorScale:PlotConfig :: PlotConfig -> ColorScale
$sel:lineMode:PlotConfig :: PlotConfig -> Mode
$sel:barMode:PlotConfig :: PlotConfig -> BarMode
$sel:ymode:PlotConfig :: PlotConfig -> AxisType
$sel:xmode:PlotConfig :: PlotConfig -> AxisType
$sel:ylabel:PlotConfig :: PlotConfig -> String
$sel:xlabel:PlotConfig :: PlotConfig -> String
$sel:title':PlotConfig :: PlotConfig -> String
..} = Maybe Layout -> [TraceP] -> Script
forall a. ToJSON a => Maybe Layout -> [a] -> Script
toScript Maybe Layout
layout [TraceP]
traces
  where
    layout :: Maybe Layout
layout   = Layout -> Maybe Layout
forall a. a -> Maybe a
Just (Layout -> Maybe Layout) -> Layout -> Maybe Layout
forall a b. (a -> b) -> a -> b
$ PlotConfig -> Layout
fromConfig PlotConfig
cfg
    traces :: [TraceP]
traces   = [ColorScale
-> Bool -> Bool -> [Double] -> [String] -> [[[Double]]] -> TraceP
mkTraceP ColorScale
colorScale Bool
showScale Bool
reverseScale [Double]
cs [String]
ns [[[Double]]]
vs]

-- | Parallel Coordinate Plot with discrete line colors
parcoord' :: [Double]     -- ^ Color column
          -> [String]     -- ^ Axis Labels
          -> [[[Double]]] -- ^ traces ( rows ( values ) )
          -> PlotConfig   -- ^ Plot Config
          -> Script       -- ^ Plotly Script
parcoord' :: [Double] -> [String] -> [[[Double]]] -> PlotConfig -> Script
parcoord' [Double]
cs [String]
ns [[[Double]]]
vs cfg :: PlotConfig
cfg@PlotConfig{Bool
Int
String
XBins
BarMode
ColorScale
Mode
Marker
AxisType
Margin
bins :: XBins
marker :: Marker
margin :: Margin
width :: Int
height :: Int
legend :: Bool
reverseScale :: Bool
showScale :: Bool
colorScale :: ColorScale
lineMode :: Mode
barMode :: BarMode
ymode :: AxisType
xmode :: AxisType
ylabel :: String
xlabel :: String
title' :: String
$sel:bins:PlotConfig :: PlotConfig -> XBins
$sel:marker:PlotConfig :: PlotConfig -> Marker
$sel:margin:PlotConfig :: PlotConfig -> Margin
$sel:width:PlotConfig :: PlotConfig -> Int
$sel:height:PlotConfig :: PlotConfig -> Int
$sel:legend:PlotConfig :: PlotConfig -> Bool
$sel:reverseScale:PlotConfig :: PlotConfig -> Bool
$sel:showScale:PlotConfig :: PlotConfig -> Bool
$sel:colorScale:PlotConfig :: PlotConfig -> ColorScale
$sel:lineMode:PlotConfig :: PlotConfig -> Mode
$sel:barMode:PlotConfig :: PlotConfig -> BarMode
$sel:ymode:PlotConfig :: PlotConfig -> AxisType
$sel:xmode:PlotConfig :: PlotConfig -> AxisType
$sel:ylabel:PlotConfig :: PlotConfig -> String
$sel:xlabel:PlotConfig :: PlotConfig -> String
$sel:title':PlotConfig :: PlotConfig -> String
..} = Maybe Layout -> [TraceP] -> Script
forall a. ToJSON a => Maybe Layout -> [a] -> Script
toScript Maybe Layout
layout [TraceP]
traces
  where
    layout :: Maybe Layout
layout   = Layout -> Maybe Layout
forall a. a -> Maybe a
Just (Layout -> Maybe Layout) -> Layout -> Maybe Layout
forall a b. (a -> b) -> a -> b
$ PlotConfig -> Layout
fromConfig PlotConfig
cfg
    traces :: [TraceP]
traces   = [ColorScale
-> Bool -> Bool -> [Double] -> [String] -> [[[Double]]] -> TraceP
mkTraceP ColorScale
colorScale Bool
False Bool
False [Double]
cs [String]
ns [[[Double]]]
vs]

-- | Parallel Coordinate Plot without line gradient
parcoord'' :: [String]     -- ^ Axis Names
           -> [[[Double]]] -- ^ traces ( rows ( values ) )
           -> PlotConfig   -- ^ Plot Config
           -> Script       -- ^ Plot Script
parcoord'' :: [String] -> [[[Double]]] -> PlotConfig -> Script
parcoord'' [String]
ns [[[Double]]]
vs PlotConfig
cfg = Maybe Layout -> [TraceP] -> Script
forall a. ToJSON a => Maybe Layout -> [a] -> Script
toScript Maybe Layout
layout [TraceP]
traces
  where
    layout :: Maybe Layout
layout   = Layout -> Maybe Layout
forall a. a -> Maybe a
Just (Layout -> Maybe Layout) -> Layout -> Maybe Layout
forall a b. (a -> b) -> a -> b
$ PlotConfig -> Layout
fromConfig PlotConfig
cfg 
    traces :: [TraceP]
traces   = [[String] -> [[[Double]]] -> TraceP
mkTraceP' [String]
ns [[[Double]]]
vs]

-- | Save Plot to HTML File
plot :: FilePath -- ^ Target path to .html file
     -> Script   -- ^ Plotly Script
     -> IO ()
plot :: String -> Script -> IO ()
plot String
path = String -> Script -> IO ()
BL.writeFile String
path (Script -> IO ()) -> (Script -> Script) -> Script -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> Script
toHtml