{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Charts.Internal.Chart where

import qualified Data.Text as T
import Data.Aeson as A

-- | Valid Column types. Each "data" column also accepts a column header.
-- "Role" columns do not.
--
-- See https://developers.google.com/chart/interactive/docs/roles
data Column =
        NumberColumn T.Text
      | StringColumn T.Text
      | BoolColumn T.Text
      | DateColumn T.Text
      | DateTimeColumn T.Text
      | TimeOfDayColumn T.Text
      | AnnotationColumn
      | AnnotationTextColumn
      | CertaintyColumn
      | EmphasisColumn
      | IntervalColumn
      | ScopeColumn
      | StyleColumn
      | TooltipColumn
      | DomainColumn
    -- ^ This is typically inferred and explicitly
      | DataColumn
    -- ^ This is typically inferred and explicitly
  deriving (Int -> Column -> ShowS
[Column] -> ShowS
Column -> String
(Int -> Column -> ShowS)
-> (Column -> String) -> ([Column] -> ShowS) -> Show Column
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Column] -> ShowS
$cshowList :: [Column] -> ShowS
show :: Column -> String
$cshow :: Column -> String
showsPrec :: Int -> Column -> ShowS
$cshowsPrec :: Int -> Column -> ShowS
Show, Column -> Column -> Bool
(Column -> Column -> Bool)
-> (Column -> Column -> Bool) -> Eq Column
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Column -> Column -> Bool
$c/= :: Column -> Column -> Bool
== :: Column -> Column -> Bool
$c== :: Column -> Column -> Bool
Eq)

-- Types from https://developers.google.com/chart/interactive/docs/reference#DataTable_addColumn
instance ToJSON Column where
  toJSON :: Column -> Value
toJSON col :: Column
col =
              case Column
col of
                  StringColumn a :: Text
a -> [Pair] -> Value
object [ "label" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
a, "type" Text -> Text -> Pair
~= "string"]
                  NumberColumn a :: Text
a -> [Pair] -> Value
object [ "label" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
a, "type" Text -> Text -> Pair
~= "number"]
                  BoolColumn a :: Text
a -> [Pair] -> Value
object [ "label" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
a, "type" Text -> Text -> Pair
~= "boolean"]
                  DateColumn a :: Text
a -> [Pair] -> Value
object [ "label" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
a, "type" Text -> Text -> Pair
~= "date"]
                  DateTimeColumn a :: Text
a -> [Pair] -> Value
object [ "label" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
a, "type" Text -> Text -> Pair
~= "datetime"]
                  TimeOfDayColumn a :: Text
a -> [Pair] -> Value
object [ "label" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
a, "type" Text -> Text -> Pair
~= "timeofday"]
                  AnnotationColumn -> [Pair] -> Value
object ["role" Text -> Text -> Pair
~= "annotation"]
                  AnnotationTextColumn -> [Pair] -> Value
object ["role" Text -> Text -> Pair
~= "annotationText"]
                  CertaintyColumn -> [Pair] -> Value
object ["role" Text -> Text -> Pair
~= "certainty"]
                  EmphasisColumn -> [Pair] -> Value
object ["role" Text -> Text -> Pair
~= "emphasis"]
                  IntervalColumn -> [Pair] -> Value
object ["role" Text -> Text -> Pair
~= "interval"]
                  ScopeColumn -> [Pair] -> Value
object ["role" Text -> Text -> Pair
~= "scope"]
                  StyleColumn -> [Pair] -> Value
object ["role" Text -> Text -> Pair
~= "style"]
                  TooltipColumn -> [Pair] -> Value
object ["role" Text -> Text -> Pair
~= "tooltip"]
                  DomainColumn -> [Pair] -> Value
object ["role" Text -> Text -> Pair
~= "domain"]
                  DataColumn -> [Pair] -> Value
object ["role" Text -> Text -> Pair
~= "data"]
    where
      (~=):: T.Text -> T.Text -> (T.Text, Value)
      ~= :: Text -> Text -> Pair
(~=) = Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
(.=)

-- | Supported chart types
-- See https://developers.google.com/chart/interactive/docs/gallery
data ChartStyle = LineChart
                | Histogram
                | BarChart
                | ColumnChart
                | ScatterChart
                | AreaChart
                | PieChart
                | BubbleChart
                | SteppedAreaChart
                | CandlestickChart
                  deriving (Int -> ChartStyle -> ShowS
[ChartStyle] -> ShowS
ChartStyle -> String
(Int -> ChartStyle -> ShowS)
-> (ChartStyle -> String)
-> ([ChartStyle] -> ShowS)
-> Show ChartStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChartStyle] -> ShowS
$cshowList :: [ChartStyle] -> ShowS
show :: ChartStyle -> String
$cshow :: ChartStyle -> String
showsPrec :: Int -> ChartStyle -> ShowS
$cshowsPrec :: Int -> ChartStyle -> ShowS
Show, ChartStyle -> ChartStyle -> Bool
(ChartStyle -> ChartStyle -> Bool)
-> (ChartStyle -> ChartStyle -> Bool) -> Eq ChartStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartStyle -> ChartStyle -> Bool
$c/= :: ChartStyle -> ChartStyle -> Bool
== :: ChartStyle -> ChartStyle -> Bool
$c== :: ChartStyle -> ChartStyle -> Bool
Eq, Eq ChartStyle
Eq ChartStyle =>
(ChartStyle -> ChartStyle -> Ordering)
-> (ChartStyle -> ChartStyle -> Bool)
-> (ChartStyle -> ChartStyle -> Bool)
-> (ChartStyle -> ChartStyle -> Bool)
-> (ChartStyle -> ChartStyle -> Bool)
-> (ChartStyle -> ChartStyle -> ChartStyle)
-> (ChartStyle -> ChartStyle -> ChartStyle)
-> Ord ChartStyle
ChartStyle -> ChartStyle -> Bool
ChartStyle -> ChartStyle -> Ordering
ChartStyle -> ChartStyle -> ChartStyle
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ChartStyle -> ChartStyle -> ChartStyle
$cmin :: ChartStyle -> ChartStyle -> ChartStyle
max :: ChartStyle -> ChartStyle -> ChartStyle
$cmax :: ChartStyle -> ChartStyle -> ChartStyle
>= :: ChartStyle -> ChartStyle -> Bool
$c>= :: ChartStyle -> ChartStyle -> Bool
> :: ChartStyle -> ChartStyle -> Bool
$c> :: ChartStyle -> ChartStyle -> Bool
<= :: ChartStyle -> ChartStyle -> Bool
$c<= :: ChartStyle -> ChartStyle -> Bool
< :: ChartStyle -> ChartStyle -> Bool
$c< :: ChartStyle -> ChartStyle -> Bool
compare :: ChartStyle -> ChartStyle -> Ordering
$ccompare :: ChartStyle -> ChartStyle -> Ordering
$cp1Ord :: Eq ChartStyle
Ord)

instance ToJSON ChartStyle where
  toJSON :: ChartStyle -> Value
toJSON = \case
    LineChart -> "line"
    Histogram -> "histogram"
    BarChart -> "bar"
    ColumnChart -> "column"
    ScatterChart -> "scatter"
    AreaChart -> "area"
    PieChart -> "pie"
    BubbleChart -> "bubble"
    SteppedAreaChart -> "steppedarea"
    CandlestickChart -> "candlestick"

-- | I plan to make this typesafe for each partiular chart type
-- but that's a LOT of work, so for now it's just free-form, if you'd actually
-- use this, please make an issue on Github so I know folks need this behaviour :)
--
-- Find your chart in the chart gallery to see which options it will accept.
--
-- https://developers.google.com/chart/interactive/docs/gallery
data ChartOptions = ChartOptions Value

instance ToJSON ChartOptions where
  toJSON :: ChartOptions -> Value
toJSON (ChartOptions v :: Value
v) = Value
v

-- | Empty chart options
defaultChartOptions :: ChartOptions
defaultChartOptions :: ChartOptions
defaultChartOptions = Value -> ChartOptions
ChartOptions ([Pair] -> Value
object [])

-- | The primary chart type.
data Chart =
    Chart { Chart -> ChartOptions
options :: ChartOptions
          , Chart -> ChartStyle
style :: ChartStyle
          , Chart -> [Column]
columns :: [Column]
          , Chart -> [[Value]]
dataTable :: [[Value]]
          , Chart -> Bool
dynamic :: Bool
          }

instance ToJSON Chart where
  toJSON :: Chart -> Value
toJSON (Chart{..}) =
      [Pair] -> Value
object [ "rows" Text -> [[Value]] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [[Value]]
dataTable
             , "options" Text -> ChartOptions -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ChartOptions
options
             , "columns" Text -> [Column] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Column]
columns
             , "style" Text -> ChartStyle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ChartStyle
style
             , "dynamic" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
dynamic
             ]

-- | Construct a chart.
--
-- e.g.
--
-- @
-- myChart :: Chart
-- myChart = buildChart defaultChartOptions BarChart
--   [StringColumn "Year", NumberColumn "Population"]
--   [ [ String "2004", Number 1000 ]
--   , [ String "2005", Number 1170 ]
--   , [ String "2006", Number 660 ]
--   , [ String "2007", Number 1030 ]
--   ]
-- @
buildChart :: ChartOptions -> ChartStyle -> [Column] -> [[Value]] ->  Chart
buildChart :: ChartOptions -> ChartStyle -> [Column] -> [[Value]] -> Chart
buildChart opts :: ChartOptions
opts style :: ChartStyle
style columns :: [Column]
columns vals :: [[Value]]
vals = ChartOptions
-> ChartStyle -> [Column] -> [[Value]] -> Bool -> Chart
Chart ChartOptions
opts ChartStyle
style [Column]
columns [[Value]]
vals Bool
True