{- Graphics.Vega.VegaLite.Theme
Gregory W. Schwartz

Theme for professional publication-quality figures.
-}

{-# LANGUAGE OverloadedStrings #-}

module Graphics.Vega.VegaLite.Theme
  ( theme
  , defaultConfig
  , Config (..)
  ) where

-- Remote
import Data.Maybe (catMaybes)
import Graphics.Vega.VegaLite
import qualified Data.Text as T

-- Local

data Config = Config { Config -> Maybe Double
configFontSize :: Maybe Double
                     , Config -> Maybe Double
configTitleFontSize :: Maybe Double
                     , Config -> Text
configFont :: T.Text
                     , Config -> Text
configLabelFont :: T.Text
                     , Config -> Text
configAxisColor :: T.Text
                     , Config -> Maybe Double
configHeight :: Maybe Double
                     , Config -> Maybe Double
configWidth :: Maybe Double
                     , Config -> Maybe Double
configLabelAngle :: Maybe Double
                     }

defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Maybe Double
-> Maybe Double
-> Text
-> Text
-> Text
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> Config
Config { configFontSize :: Maybe Double
configFontSize = Maybe Double
forall a. Maybe a
Nothing
                       , configTitleFontSize :: Maybe Double
configTitleFontSize = Maybe Double
forall a. Maybe a
Nothing
                       , configFont :: Text
configFont = Text
"Arial"
                       , configLabelFont :: Text
configLabelFont = Text
"Arial"
                       , configAxisColor :: Text
configAxisColor = Text
"#000000"
                       , configHeight :: Maybe Double
configHeight = Maybe Double
forall a. Maybe a
Nothing
                       , configWidth :: Maybe Double
configWidth = Maybe Double
forall a. Maybe a
Nothing
                       , configLabelAngle :: Maybe Double
configLabelAngle = Maybe Double
forall a. Maybe a
Nothing
                       }

theme :: Config -> [ConfigureSpec] -> (VLProperty, VLSpec)
theme :: Config -> [ConfigureSpec] -> (VLProperty, VLSpec)
theme Config
c = [ConfigureSpec] -> (VLProperty, VLSpec)
configure
        ([ConfigureSpec] -> (VLProperty, VLSpec))
-> ([ConfigureSpec] -> [ConfigureSpec])
-> [ConfigureSpec]
-> (VLProperty, VLSpec)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationProperty -> [ConfigureSpec] -> [ConfigureSpec]
configuration ([ViewConfig] -> ConfigurationProperty
ViewStyle ([ViewConfig] -> ConfigurationProperty)
-> [ViewConfig] -> ConfigurationProperty
forall a b. (a -> b) -> a -> b
$ Config -> [ViewConfig]
viewConfig Config
c)
        ([ConfigureSpec] -> [ConfigureSpec])
-> ([ConfigureSpec] -> [ConfigureSpec])
-> [ConfigureSpec]
-> [ConfigureSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationProperty -> [ConfigureSpec] -> [ConfigureSpec]
configuration ([LegendConfig] -> ConfigurationProperty
LegendStyle ([LegendConfig] -> ConfigurationProperty)
-> [LegendConfig] -> ConfigurationProperty
forall a b. (a -> b) -> a -> b
$ Config -> [LegendConfig]
legendConfig Config
c)
        ([ConfigureSpec] -> [ConfigureSpec])
-> ([ConfigureSpec] -> [ConfigureSpec])
-> [ConfigureSpec]
-> [ConfigureSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationProperty -> [ConfigureSpec] -> [ConfigureSpec]
configuration ([TitleConfig] -> ConfigurationProperty
TitleStyle ([TitleConfig] -> ConfigurationProperty)
-> [TitleConfig] -> ConfigurationProperty
forall a b. (a -> b) -> a -> b
$ Config -> [TitleConfig]
titleConfig Config
c)
        ([ConfigureSpec] -> [ConfigureSpec])
-> ([ConfigureSpec] -> [ConfigureSpec])
-> [ConfigureSpec]
-> [ConfigureSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationProperty -> [ConfigureSpec] -> [ConfigureSpec]
configuration ([AxisConfig] -> ConfigurationProperty
Axis ([AxisConfig] -> ConfigurationProperty)
-> [AxisConfig] -> ConfigurationProperty
forall a b. (a -> b) -> a -> b
$ Config -> [AxisConfig]
axisConfig (Config
c { configLabelAngle :: Maybe Double
configLabelAngle = Maybe Double
forall a. Maybe a
Nothing }))  -- Never change rotation for y axis.
        ([ConfigureSpec] -> [ConfigureSpec])
-> ([ConfigureSpec] -> [ConfigureSpec])
-> [ConfigureSpec]
-> [ConfigureSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationProperty -> [ConfigureSpec] -> [ConfigureSpec]
configuration ([AxisConfig] -> ConfigurationProperty
AxisX ([AxisConfig] -> ConfigurationProperty)
-> [AxisConfig] -> ConfigurationProperty
forall a b. (a -> b) -> a -> b
$ Config -> [AxisConfig]
axisConfig Config
c)
        ([ConfigureSpec] -> [ConfigureSpec])
-> ([ConfigureSpec] -> [ConfigureSpec])
-> [ConfigureSpec]
-> [ConfigureSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationProperty -> [ConfigureSpec] -> [ConfigureSpec]
configuration ([AxisConfig] -> ConfigurationProperty
AxisY ([AxisConfig] -> ConfigurationProperty)
-> [AxisConfig] -> ConfigurationProperty
forall a b. (a -> b) -> a -> b
$ Config -> [AxisConfig]
axisConfig (Config
c { configLabelAngle :: Maybe Double
configLabelAngle = Maybe Double
forall a. Maybe a
Nothing}))  -- Never change rotation for y axis.

viewConfig :: Config -> [ViewConfig]
viewConfig :: Config -> [ViewConfig]
viewConfig Config
c = [Maybe ViewConfig] -> [ViewConfig]
forall a. [Maybe a] -> [a]
catMaybes
                 [ (Double -> ViewConfig) -> Maybe Double -> Maybe ViewConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> ViewConfig
ViewContinuousHeight (Maybe Double -> Maybe ViewConfig)
-> Maybe Double -> Maybe ViewConfig
forall a b. (a -> b) -> a -> b
$ Config -> Maybe Double
configHeight Config
c  -- 80 for publishing
                 , (Double -> ViewConfig) -> Maybe Double -> Maybe ViewConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> ViewConfig
ViewContinuousWidth (Maybe Double -> Maybe ViewConfig)
-> Maybe Double -> Maybe ViewConfig
forall a b. (a -> b) -> a -> b
$ Config -> Maybe Double
configWidth Config
c  -- 100 for publishing
                 , ViewConfig -> Maybe ViewConfig
forall a. a -> Maybe a
Just (ViewConfig -> Maybe ViewConfig) -> ViewConfig -> Maybe ViewConfig
forall a b. (a -> b) -> a -> b
$ Double -> ViewConfig
ViewStrokeOpacity Double
0  -- Despine
                 ]

legendConfig :: Config -> [LegendConfig]
legendConfig :: Config -> [LegendConfig]
legendConfig Config
c = [Maybe LegendConfig] -> [LegendConfig]
forall a. [Maybe a] -> [a]
catMaybes
                   [ (Double -> LegendConfig) -> Maybe Double -> Maybe LegendConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> LegendConfig
LeLabelFontSize (Maybe Double -> Maybe LegendConfig)
-> Maybe Double -> Maybe LegendConfig
forall a b. (a -> b) -> a -> b
$ Config -> Maybe Double
configFontSize Config
c
                   , (Double -> LegendConfig) -> Maybe Double -> Maybe LegendConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> LegendConfig
LeTitleFontSize (Maybe Double -> Maybe LegendConfig)
-> Maybe Double -> Maybe LegendConfig
forall a b. (a -> b) -> a -> b
$ Config -> Maybe Double
configTitleFontSize Config
c
                   ]

titleConfig :: Config -> [TitleConfig]
titleConfig :: Config -> [TitleConfig]
titleConfig Config
c = [Maybe TitleConfig] -> [TitleConfig]
forall a. [Maybe a] -> [a]
catMaybes
                  [ (Double -> TitleConfig) -> Maybe Double -> Maybe TitleConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> TitleConfig
TFontSize (Maybe Double -> Maybe TitleConfig)
-> Maybe Double -> Maybe TitleConfig
forall a b. (a -> b) -> a -> b
$ Config -> Maybe Double
configTitleFontSize Config
c
                  , TitleConfig -> Maybe TitleConfig
forall a. a -> Maybe a
Just (TitleConfig -> Maybe TitleConfig)
-> TitleConfig -> Maybe TitleConfig
forall a b. (a -> b) -> a -> b
$ Text -> TitleConfig
TFont (Text -> TitleConfig) -> Text -> TitleConfig
forall a b. (a -> b) -> a -> b
$ Config -> Text
configFont Config
c
                  , TitleConfig -> Maybe TitleConfig
forall a. a -> Maybe a
Just (TitleConfig -> Maybe TitleConfig)
-> TitleConfig -> Maybe TitleConfig
forall a b. (a -> b) -> a -> b
$ Text -> TitleConfig
TColor Text
"#000000"
                  , TitleConfig -> Maybe TitleConfig
forall a. a -> Maybe a
Just (TitleConfig -> Maybe TitleConfig)
-> TitleConfig -> Maybe TitleConfig
forall a b. (a -> b) -> a -> b
$ FontWeight -> TitleConfig
TFontWeight FontWeight
Normal
                  ]

axisConfig :: Config -> [AxisConfig]
axisConfig :: Config -> [AxisConfig]
axisConfig Config
c = [Maybe AxisConfig] -> [AxisConfig]
forall a. [Maybe a] -> [a]
catMaybes
                 [ AxisConfig -> Maybe AxisConfig
forall a. a -> Maybe a
Just (AxisConfig -> Maybe AxisConfig) -> AxisConfig -> Maybe AxisConfig
forall a b. (a -> b) -> a -> b
$ Bool -> AxisConfig
Grid Bool
False
                 , AxisConfig -> Maybe AxisConfig
forall a. a -> Maybe a
Just (AxisConfig -> Maybe AxisConfig) -> AxisConfig -> Maybe AxisConfig
forall a b. (a -> b) -> a -> b
$ Text -> AxisConfig
DomainColor Text
"#000000"
                 , AxisConfig -> Maybe AxisConfig
forall a. a -> Maybe a
Just (AxisConfig -> Maybe AxisConfig) -> AxisConfig -> Maybe AxisConfig
forall a b. (a -> b) -> a -> b
$ Text -> AxisConfig
LabelFont (Text -> AxisConfig) -> Text -> AxisConfig
forall a b. (a -> b) -> a -> b
$ Config -> Text
configLabelFont Config
c
                 , (Double -> AxisConfig) -> Maybe Double -> Maybe AxisConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> AxisConfig
LabelFontSize (Maybe Double -> Maybe AxisConfig)
-> Maybe Double -> Maybe AxisConfig
forall a b. (a -> b) -> a -> b
$ Config -> Maybe Double
configFontSize Config
c
                 , (Double -> AxisConfig) -> Maybe Double -> Maybe AxisConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> AxisConfig
LabelAngle (Maybe Double -> Maybe AxisConfig)
-> Maybe Double -> Maybe AxisConfig
forall a b. (a -> b) -> a -> b
$ Config -> Maybe Double
configLabelAngle Config
c
                 , AxisConfig -> Maybe AxisConfig
forall a. a -> Maybe a
Just (AxisConfig -> Maybe AxisConfig) -> AxisConfig -> Maybe AxisConfig
forall a b. (a -> b) -> a -> b
$ Text -> AxisConfig
TickColor (Text -> AxisConfig) -> Text -> AxisConfig
forall a b. (a -> b) -> a -> b
$ Config -> Text
configAxisColor Config
c
                 , AxisConfig -> Maybe AxisConfig
forall a. a -> Maybe a
Just (AxisConfig -> Maybe AxisConfig) -> AxisConfig -> Maybe AxisConfig
forall a b. (a -> b) -> a -> b
$ Text -> AxisConfig
TitleFont (Text -> AxisConfig) -> Text -> AxisConfig
forall a b. (a -> b) -> a -> b
$ Config -> Text
configFont Config
c
                 , (Double -> AxisConfig) -> Maybe Double -> Maybe AxisConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> AxisConfig
TitleFontSize (Maybe Double -> Maybe AxisConfig)
-> Maybe Double -> Maybe AxisConfig
forall a b. (a -> b) -> a -> b
$ Config -> Maybe Double
configTitleFontSize Config
c
                 , AxisConfig -> Maybe AxisConfig
forall a. a -> Maybe a
Just (AxisConfig -> Maybe AxisConfig) -> AxisConfig -> Maybe AxisConfig
forall a b. (a -> b) -> a -> b
$ FontWeight -> AxisConfig
TitleFontWeight FontWeight
Normal
                 ]