{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Charts.Internal.Auto where

import Charts.Internal.Chart
import Generics.OneLiner
import Data.Aeson
import Data.Proxy
import qualified Data.Text as T
import Data.Scientific

-- | Class representing types for which a column type can be inferred.
--
-- You can implement your own instances for this if you like, but generally shouldn't need to.
class ChartColumn a where
  columnHeader :: Proxy a -> Column

instance ChartColumn Int where
  columnHeader :: Proxy Int -> Column
columnHeader Proxy Int
_ = Text -> Column
NumberColumn Text
""

instance ChartColumn Float where
  columnHeader :: Proxy Float -> Column
columnHeader Proxy Float
_ = Text -> Column
NumberColumn Text
""

instance ChartColumn Double where
  columnHeader :: Proxy Double -> Column
columnHeader Proxy Double
_ = Text -> Column
NumberColumn Text
""

instance ChartColumn Scientific where
  columnHeader :: Proxy Scientific -> Column
columnHeader Proxy Scientific
_ = Text -> Column
NumberColumn Text
""

instance ChartColumn T.Text where
  columnHeader :: Proxy Text -> Column
columnHeader Proxy Text
_ = Text -> Column
StringColumn Text
""

instance ChartColumn String where
  columnHeader :: Proxy String -> Column
columnHeader Proxy String
_ = Text -> Column
StringColumn Text
""

instance ChartColumn Bool where
  columnHeader :: Proxy Bool -> Column
columnHeader Proxy Bool
_ = Text -> Column
BoolColumn Text
""

-- | A constraint representing a type which can be converted into a chart row
--
-- This constraint is satisfied by tuple types containing JSON serializable types.
--
-- E.g. data rows of type @(Text, Int, Float)@ will infer a chart with a String column and two number
-- columns.
--
-- You shouldn't need to implement any instances of this constraint yourself.
type ChartRowAuto a = (ADT a, Constraints a ToJSON)

-- | A constraint that a column-type can be determined for all elements of the provided tuple
-- type.
type ChartRowHeaderAuto a = (Constraints a ChartColumn)


-- | Create a chart from the provided options, style, and data by inferring column header
-- types.
--
-- Prefer 'autoChartWithHeaders' when you know your column headers up front.
--
-- E.g. The following generates a 2-series bar chart with 4 sections, A, B, C, D
--
-- @
-- myAutoChart :: Chart
-- myAutoChart = autoChart defaultChartOptions BarChart myData
--   where
--     myData :: [(T.Text, Float, Int)]
--     myData = [ ("A", 16, 20)
--              , ("B", 11, 23)
--              , ("C", 9, 25)
--              , ("D", 8, 34)
--              ]
-- @
autoChart :: forall row. (ChartRowHeaderAuto row, ChartRowAuto row) => ChartOptions -> ChartStyle -> [row] -> Chart
autoChart :: ChartOptions -> ChartStyle -> [row] -> Chart
autoChart ChartOptions
opts ChartStyle
styl xs :: [row]
xs@[] = ChartOptions -> ChartStyle -> [Column] -> [row] -> Chart
forall row.
ChartRowAuto row =>
ChartOptions -> ChartStyle -> [Column] -> [row] -> Chart
autoChartWithHeaders ChartOptions
opts ChartStyle
styl [] [row]
xs
autoChart ChartOptions
opts ChartStyle
styl (row
x:[row]
xs) = ChartOptions -> ChartStyle -> [Column] -> [row] -> Chart
forall row.
ChartRowAuto row =>
ChartOptions -> ChartStyle -> [Column] -> [row] -> Chart
autoChartWithHeaders ChartOptions
opts ChartStyle
styl [Column]
cols (row
xrow -> [row] -> [row]
forall a. a -> [a] -> [a]
:[row]
xs)
  where
    cols :: [Column]
    cols :: [Column]
cols = (forall s. ChartColumn s => s -> [Column]) -> row -> [Column]
forall (c :: * -> Constraint) t m.
(ADT t, Constraints t c, Monoid m) =>
(forall s. c s => s -> m) -> t -> m
gfoldMap @ChartColumn forall s. ChartColumn s => s -> [Column]
toColumn row
x
    toColumn :: forall a. ChartColumn a => a -> [Column]
    toColumn :: a -> [Column]
toColumn a
_ = [Proxy a -> Column
forall a. ChartColumn a => Proxy a -> Column
columnHeader (Proxy a
forall k (t :: k). Proxy t
Proxy @a)]

-- | Create a chart from the provided options, style, and data, but use the explicitly
-- provided column headers and types.
--
-- E.g. The following generates a 2-series bar chart with 4 sections, A, B, C, D
--
-- @
-- myAutoChart :: Chart
-- myAutoChart = autoChartWithHeaders defaultChartOptions BarChart headers myData
--   where
--     headers :: [Column]
--     headers = [StringColumn "Series", NumberColumn "Successes", NumberColumn "Inconclusive"]
--     myData :: [(T.Text, Float, Int)]
--     myData = [ ("A", 16, 20)
--              , ("B", 11, 23)
--              , ("C", 9, 25)
--              , ("D", 8, 34)
--              ]
-- @
autoChartWithHeaders :: forall row. (ChartRowAuto row) => ChartOptions -> ChartStyle -> [Column] -> [row] -> Chart
autoChartWithHeaders :: ChartOptions -> ChartStyle -> [Column] -> [row] -> Chart
autoChartWithHeaders ChartOptions
opts ChartStyle
styl [Column]
cols [] = ChartOptions -> ChartStyle -> [Column] -> [[Value]] -> Chart
buildChart ChartOptions
opts ChartStyle
styl [Column]
cols []
autoChartWithHeaders ChartOptions
opts ChartStyle
styl [Column]
cols (row
x:[row]
xs) = ChartOptions -> ChartStyle -> [Column] -> [[Value]] -> Chart
buildChart ChartOptions
opts ChartStyle
styl [Column]
cols [[Value]]
rows
  where
    rows :: [[Value]]
    rows :: [[Value]]
rows = row -> [Value]
rowToJSON (row -> [Value]) -> [row] -> [[Value]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (row
xrow -> [row] -> [row]
forall a. a -> [a] -> [a]
:[row]
xs)
    rowToJSON :: row -> [Value]
    rowToJSON :: row -> [Value]
rowToJSON row
row = (forall s. ToJSON s => s -> [Value]) -> row -> [Value]
forall (c :: * -> Constraint) t m.
(ADT t, Constraints t c, Monoid m) =>
(forall s. c s => s -> m) -> t -> m
gfoldMap @ToJSON forall s. ToJSON s => s -> [Value]
singleToRow row
row
    singleToRow :: forall a. ToJSON a => a -> [Value]
    singleToRow :: a -> [Value]
singleToRow = (Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:[]) (Value -> [Value]) -> (a -> Value) -> a -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON