{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : Graphics.Vega.VegaLite.Selection
Copyright   : (c) Douglas Burke, 2018-2020
License     : BSD3

Maintainer  : dburke.gw@gmail.com
Stability   : unstable
Portability : OverloadedStrings

User selections.

-}

module Graphics.Vega.VegaLite.Selection
       ( selection
       , select
       , Selection(..)
       , SelectionProperty(..)
       , Binding(..)
       , BindLegendProperty(..)
       , InputProperty(..)
       , SelectionMarkProperty(..)
       , SelectionResolution(..)

       -- not for external export
       , selectionProperties
       , selectionLabel
       )
    where

import qualified Data.Text as T

import Control.Arrow (second)

import Data.Aeson ((.=), object, toJSON)
import Data.Aeson.Types (Pair)
import Data.Maybe (mapMaybe)


import Graphics.Vega.VegaLite.Data
  ( DataValue
  , dataValueSpec
  )
import Graphics.Vega.VegaLite.Foundation
  ( Color
  , DashStyle
  , DashOffset
  , FieldName
  , Opacity
  , Channel
  , Cursor
  , channelLabel
  , fromT
  , fromColor
  , fromDS
  , cursorLabel
  , (.=~), toKey, toObject
  )
import Graphics.Vega.VegaLite.Specification
  ( VLProperty(VLSelection)
  , PropertySpec
  , SelectSpec(..)
  , BuildSelectSpecs
  , SelectionLabel
  )


-- | Indicates the type of selection to be generated by the user.

data Selection
    = Single
      -- ^ Allows one mark at a time to be selected.
    | Multi
      -- ^ Allows multiple items to be selected (e.g. with
      --   shift-click).
    | Interval
      -- ^ Allows a bounding rectangle to be dragged by the user,
      --   selecting all items which intersect it.


selectionLabel :: Selection -> T.Text
selectionLabel :: Selection -> Text
selectionLabel Selection
Single = Text
"single"
selectionLabel Selection
Multi = Text
"multi"
selectionLabel Selection
Interval = Text
"interval"


{-|

Properties for customising the nature of the selection. See the
<https://vega.github.io/vega-lite/docs/selection.html#selection-properties Vega-Lite documentation>
for details.

For use with 'select' and 'Graphics.Vega.VegaLite.SelectionStyle'.
-}
data SelectionProperty
    = Empty
      -- ^ Make a selection empty by default when nothing selected.
    | BindScales
      -- ^ Enable two-way binding between a selection and the scales used
      --   in the same view. This is commonly used for zooming and panning
      --   by binding selection to position scaling:
      --
      --   @sel = 'selection' . 'select' \"mySelection\" 'Interval' ['BindScales']@
    | BindLegend BindLegendProperty
      -- ^ Enable binding between a legend selection and the item it
      --   references. This is __only applicable__ to categorical (symbol)
      --   legends.
      --
      --   The following will allow the \"crimeType\" legend to be selected:
      --
      --   @
      --   'select' \"mySelection\" 'Single' [ 'BindLegend' ('BLField' \"crimeType\") ]
      --   @
      --
      --   Use 'On' to make a two-way binding (that is, selecting the legend or the symbol
      --   type will highlight the other):
      --
      --   @
      --   'select' \"sel\" 'Multi' [ 'On' \"click\"
      --                      , 'BindLegend' ('BLFieldEvent' \"crimeType\" \"dblclick\")
      --                      ]
      --   @
      --
      --   @since 0.5.0.0
    | On T.Text
      -- ^ [Vega event stream selector](https://vega.github.io/vega/docs/event-streams/#selector)
      --   that triggers a selection, or the empty string (which sets the property to @false@).
    | Clear T.Text
      -- ^ [Vega event stream selector](https://vega.github.io/vega/docs/event-streams/#selector)
      --   that can clear a selection. For example, to allow a zoomed/panned view to be reset
      --   on shift-click:
      --
      -- @
      -- 'selection'
      --     . 'select' \"myZoomPan\"
      --         'Interval'
      --         ['BindScales', 'Clear' \"click[event.shiftKey]\"]
      -- @
      --
      --   To remove the default clearing behaviour of a selection, provide an empty string
      --   rather than an event stream selector.
      --
      --   @since 0.4.0.0
    | Translate T.Text
      -- ^ Translation selection transformation used for panning a view. See the
      --   [Vega-Lite translate documentation](https://vega.github.io/vega-lite/docs/translate.html).
    | Zoom T.Text
      -- ^ Zooming selection transformation used for zooming a view. See the
      --   [Vega-Lite zoom documentation](https://vega.github.io/vega-lite/docs/zoom.html).
    | Fields [FieldName]
      -- ^ Field names for projecting a selection.
    | Encodings [Channel]
      -- ^ Encoding channels that form a named selection.
      --
      --   For example, to __project__ a selection across all items that
      --   share the same value in the color channel:
      --
      --   @sel = 'selection' . 'select' \"mySelection\" 'Multi' ['Encodings' ['Graphics.Vega.VegaLite.ChColor']]@
    | SInit [(FieldName, DataValue)]
      -- ^ Initialise one or more selections with values from bound fields.
      --   See also 'SInitInterval'.
      --
      --   For example,
      --
      --   @
      --   'selection'
      --       . 'select' \"CylYr\"
      --           'Single'
      --           [ 'Fields' [\"Cylinders\", \"Year\"]
      --           , 'SInit'
      --               [ (\"Cylinders\", 'Graphics.Vega.VegaLite.Number' 4)
      --               , (\"Year\", 'Graphics.Vega.VegaLite.Number' 1977)
      --               ]
      --           , 'Bind'
      --               [ 'IRange' \"Cylinders\" ['InMin' 3, 'InMax' 8, 'InStep' 1]
      --               , 'IRange' \"Year\" ['InMin' 1969, 'InMax' 1981, 'InStep' 1]
      --               ]
      --           ]
      --   @
      --
      --   @since 0.4.0.0
    | SInitInterval (Maybe (DataValue, DataValue)) (Maybe (DataValue, DataValue))
      -- ^ Initialize the domain extent of an interval selection. See
      --   also 'SInit'.
      --
      --   The parameters refer to the x and y axes, given in the order
      --   @(minimum, maximum)@ for each axis. If an axis is set to
      --   @Nothing@ then the selection is projected over that
      --   dimension. At least one of the two arguments should be
      --   set (i.e. not @Nothing@).
      --
      --   @
      --   'select' \"mySelection\"
      --          'Interval'
      --          [ 'SInitInterval'
      --              (Just ( 'Graphics.Vega.VegaLite.DateTime' ['Graphics.Vega.VegaLite.DTYear' 2013]
      --                    , 'Graphics.Vega.VegaLite.DateTime' ['Graphics.Vega.VegaLite.DTYear' 2015]
      --                    )
      --              (Just ('Graphics.Vega.VegaLite.Number' 40, 'Graphics.Vega.VegaLite.Number' 80))
      --          ]
      --   @
      --
      --   @since 0.4.0.0
    | ResolveSelections SelectionResolution
      -- ^ Strategy that determines how selections' data queries are resolved when applied
      --   in a filter transform, conditional encoding rule, or scale domain.
    | SelectionMark [SelectionMarkProperty]
      -- ^ Appearance of an interval selection mark (dragged rectangle).
    | Bind [Binding]
      -- ^ Binding to some input elements as part of a named selection.
      --
      --   The followig example allows a selection to be based on a
      --   drop-down list of options:
      --
      --   @
      --   sel = 'selection'
      --           . 'select' \"mySelection\"
      --               'Single'
      --               ['Fields' [\"crimeType\"]
      --               , 'Bind' ['ISelect' \"crimeType\"
      --                         ['InOptions'
      --                            [ \"Anti-social behaviour\"
      --                            , \"Criminal damage and arson\"
      --                            , \"Drugs\"
      --                            , \"Robbery\"
      --                            , \"Vehicle crime\"
      --                            ]
      --                         ]
      --                      ]
      --               ]
      --   @
    | Nearest Bool
      -- ^ Whether or not a selection should capture nearest marks to a pointer
      --   rather than an exact position match.
    | Toggle T.Text
      -- ^ Predicate expression that determines a toggled selection. See the
      --   [Vega-Lite toggle documentation](https://vega.github.io/vega-lite/docs/toggle.html).


selectionProperties :: SelectionProperty -> [Pair]
selectionProperties :: SelectionProperty -> [Pair]
selectionProperties (Fields [Text]
fNames) = [Key
"fields" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
fNames]
selectionProperties (Encodings [Channel]
channels) = [Key
"encodings" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Channel -> Text) -> [Channel] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Channel -> Text
channelLabel [Channel]
channels]
selectionProperties (SInit [(Text, DataValue)]
iVals) = [Key
"init" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [LabelledSpec] -> VLSpec
toObject (((Text, DataValue) -> LabelledSpec)
-> [(Text, DataValue)] -> [LabelledSpec]
forall a b. (a -> b) -> [a] -> [b]
map ((DataValue -> VLSpec) -> (Text, DataValue) -> LabelledSpec
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second DataValue -> VLSpec
dataValueSpec) [(Text, DataValue)]
iVals)]
selectionProperties (SInitInterval Maybe (DataValue, DataValue)
Nothing Maybe (DataValue, DataValue)
Nothing) = []
selectionProperties (SInitInterval Maybe (DataValue, DataValue)
mx Maybe (DataValue, DataValue)
my) =
  let conv :: (Key, Maybe (DataValue, DataValue)) -> Maybe a
conv (Key
_, Maybe (DataValue, DataValue)
Nothing) = Maybe a
forall a. Maybe a
Nothing
      conv (Key
lbl, Just (DataValue
lo, DataValue
hi)) = a -> Maybe a
forall a. a -> Maybe a
Just (Key
lbl Key -> [VLSpec] -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ DataValue -> VLSpec
dataValueSpec DataValue
lo, DataValue -> VLSpec
dataValueSpec DataValue
hi ])

  in [Key
"init" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> VLSpec
object (((Key, Maybe (DataValue, DataValue)) -> Maybe Pair)
-> [(Key, Maybe (DataValue, DataValue))] -> [Pair]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Key, Maybe (DataValue, DataValue)) -> Maybe Pair
forall a.
KeyValue a =>
(Key, Maybe (DataValue, DataValue)) -> Maybe a
conv ([Key]
-> [Maybe (DataValue, DataValue)]
-> [(Key, Maybe (DataValue, DataValue))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key
"x", Key
"y"] [Maybe (DataValue, DataValue)
mx, Maybe (DataValue, DataValue)
my]))]

selectionProperties (On Text
e) = [Key
"on" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
e]
selectionProperties (Clear Text
e) =
  let t :: Text
t = Text -> Text
T.strip Text
e
  in [Key
"clear" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= if Text -> Bool
T.null Text
t then Bool -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON Bool
False else Text -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON Text
t]

selectionProperties SelectionProperty
Empty = [Key
"empty" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> VLSpec
fromT Text
"none"]
selectionProperties (ResolveSelections SelectionResolution
res) = [Key
"resolve" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SelectionResolution -> Text
selectionResolutionLabel SelectionResolution
res]
selectionProperties (SelectionMark [SelectionMarkProperty]
markProps) = [Key
"mark" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> VLSpec
object ((SelectionMarkProperty -> Pair)
-> [SelectionMarkProperty] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map SelectionMarkProperty -> Pair
selectionMarkProperty [SelectionMarkProperty]
markProps)]
selectionProperties SelectionProperty
BindScales = [Key
"bind" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> VLSpec
fromT Text
"scales"]
selectionProperties (BindLegend BindLegendProperty
blp) = BindLegendProperty -> [Pair]
bindLegendProperty BindLegendProperty
blp
selectionProperties (Bind [Binding]
binds) = [Key
"bind" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> VLSpec
object ((Binding -> Pair) -> [Binding] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map Binding -> Pair
bindingSpec [Binding]
binds)]
selectionProperties (Nearest Bool
b) = [Key
"nearest" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b]
selectionProperties (Toggle Text
expr) = [Key
"toggle" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
expr]
selectionProperties (Translate Text
e) = [Key
"translate" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= if Text -> Bool
T.null Text
e then Bool -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON Bool
False else Text -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON Text
e]
selectionProperties (Zoom Text
e) = [Key
"zoom" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= if Text -> Bool
T.null Text
e then Bool -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON Bool
False else Text -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON Text
e]


{-|

Determines how selections in faceted or repeated views are resolved. See the
<https://vega.github.io/vega-lite/docs/selection.html#resolve Vega-Lite documentation>
for details.

For use with 'ResolveSelections'.

-}
data SelectionResolution
    = Global
      -- ^ One selection available across all subviews (default).
    | Union
      -- ^ Each subview contains its own brush and marks are selected if they lie
      --   within /any/ of these individual selections.
    | Intersection
      -- ^  Each subview contains its own brush and marks are selected if they lie
      --    within /all/ of these individual selections.


selectionResolutionLabel :: SelectionResolution -> T.Text
selectionResolutionLabel :: SelectionResolution -> Text
selectionResolutionLabel SelectionResolution
Global = Text
"global"
selectionResolutionLabel SelectionResolution
Union = Text
"union"
selectionResolutionLabel SelectionResolution
Intersection = Text
"intersect"


{-|

Properties for customising the appearance of an interval selection
mark (a dragged rectangle). For details see the
<https://vega.github.io/vega-lite/docs/selection.html#interval-mark Vega-Lite documentation>.

-}
data SelectionMarkProperty
    = SMCursor Cursor
      -- ^ Cursor type to appear when pointer is over an interval selection mark
      --   (dragged rectangular area).
      --
      --   @since 0.6.0.0
    | SMFill Color
      -- ^ Fill color.
    | SMFillOpacity Opacity
      -- ^ Fill opacity.
    | SMStroke Color
      -- ^ The stroke color.
    | SMStrokeOpacity Opacity
      -- ^ The stroke opacity.
    | SMStrokeWidth Double
      -- ^ The line width of the stroke.
    | SMStrokeDash DashStyle
      -- ^ The dash pattern for the stroke.
    | SMStrokeDashOffset DashOffset
      -- ^ The offset at which to start the dash pattern.


selectionMarkProperty :: SelectionMarkProperty -> Pair
selectionMarkProperty :: SelectionMarkProperty -> Pair
selectionMarkProperty (SMCursor Cursor
c) = Key
"cursor" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Cursor -> Text
cursorLabel Cursor
c
selectionMarkProperty (SMFill Text
colour) = Key
"fill" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> VLSpec
fromColor Text
colour
selectionMarkProperty (SMFillOpacity Opacity
x) = Key
"fillOpacity" Key -> Opacity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Opacity
x
selectionMarkProperty (SMStroke Text
colour) = Key
"stroke" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> VLSpec
fromColor Text
colour
selectionMarkProperty (SMStrokeOpacity Opacity
x) = Key
"strokeOpacity" Key -> Opacity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Opacity
x
selectionMarkProperty (SMStrokeWidth Opacity
x) = Key
"strokeWidth" Key -> Opacity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Opacity
x
selectionMarkProperty (SMStrokeDash DashStyle
xs) = Key
"strokeDash" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DashStyle -> VLSpec
fromDS DashStyle
xs
selectionMarkProperty (SMStrokeDashOffset Opacity
x) = Key
"strokeDashOffset" Key -> Opacity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Opacity
x


{-|

GUI Input properties. The type of relevant property will depend on the type of
input element selected. For example an @InRange@ (slider) can have numeric min,
max and step values; @InSelect@ (selector) has a list of selection label options.
For details see the
<https://vega.github.io/vega/docs/signals/#bind Vega input element binding documentation>.

-}

-- based on schema 3.3.0 #/definitions/BindRange
--       or              #/definitions/InputBinding

-- placeholder is in InputBinding
-- debounce is in BindCheckbox / BindRadioSelect / BindRange / InputBinding
-- element is in BindCheckbox / BindRadioSelect / BindRange / InputBinding

-- but InputBinding doesn't have min/max/others

data InputProperty
    = Debounce Double
      -- ^ The delay to introduce when processing input events to avoid
      --   unnescessary event broadcasting.
    | Element T.Text
      -- ^ CSS selector indicating the parent element to which an input
      --   element should be added. This allows for interacting with
      --   elements outside the visualization container.
    | InOptions [T.Text]
      -- ^ The options for a radio or select input element.
    | InMin Double
      -- ^ The minimum slider value for a range input element.
    | InMax Double
      -- ^ The maximum slider value for a range input element.
    | InName T.Text
      -- ^ Custom label for a radio or select input element.
    | InStep Double
      -- ^ The minimum increment for a range sliders.
    | InPlaceholder T.Text
      -- ^ The initial text for input elements such as text fields.


inputProperty :: InputProperty -> Pair
inputProperty :: InputProperty -> Pair
inputProperty (Debounce Opacity
x) = Key
"debounce" Key -> Opacity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Opacity
x
inputProperty (Element Text
el) = Key
"element" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
el -- #/definitions/Element
inputProperty (InOptions [Text]
opts) = Key
"options" Key -> [VLSpec] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text -> VLSpec) -> [Text] -> [VLSpec]
forall a b. (a -> b) -> [a] -> [b]
map Text -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON [Text]
opts  -- don't need the map
inputProperty (InMin Opacity
x) = Key
"min" Key -> Opacity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Opacity
x
inputProperty (InMax Opacity
x) = Key
"max" Key -> Opacity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Opacity
x
inputProperty (InName Text
s) = Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s
inputProperty (InStep Opacity
x) = Key
"step" Key -> Opacity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Opacity
x
inputProperty (InPlaceholder Text
el) = Key
"placeholder" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON Text
el


{-|

Describes the binding property of a selection based on some HTML input element
such as a checkbox or radio button. For details see the
<https://vega.github.io/vega-lite/docs/bind.html#scale-binding Vega-Lite documentation>
and the
<https://vega.github.io/vega/docs/signals/#bind Vega input binding documentation>.
-}
data Binding
    = IRange T.Text [InputProperty]
      -- ^ Range slider input element that can bound to a named field value.
    | ICheckbox T.Text [InputProperty]
      -- ^ Checkbox input element that can bound to a named field value.
    | IRadio T.Text [InputProperty]
      -- ^ Radio box input element that can bound to a named field value.
    | ISelect T.Text [InputProperty]
      -- ^ Select input element that can bound to a named field value.
    | IText T.Text [InputProperty]
      -- ^ Text input element that can bound to a named field value.
    | INumber T.Text [InputProperty]
      -- ^ Number input element that can bound to a named field value.
    | IDate T.Text [InputProperty]
      -- ^ Date input element that can bound to a named field value.
    | ITime T.Text [InputProperty]
      -- ^ Time input element that can bound to a named field value.
    | IMonth T.Text [InputProperty]
      -- ^ Month input element that can bound to a named field value.
    | IWeek T.Text [InputProperty]
      -- ^ Week input element that can bound to a named field value.
    | IDateTimeLocal T.Text [InputProperty]
      -- ^ Local time input element that can bound to a named field value.
    | ITel T.Text [InputProperty]
      -- ^ Telephone number input element that can bound to a named field value.
    | IColor T.Text [InputProperty]
      -- ^ Color input element that can bound to a named field value.


bindingSpec :: Binding -> Pair
bindingSpec :: Binding -> Pair
bindingSpec Binding
bnd =
  let (Text
lbl, VLSpec
input, [InputProperty]
ps) = case Binding
bnd of
        IRange Text
label [InputProperty]
props -> (Text
label, Text -> VLSpec
fromT Text
"range", [InputProperty]
props)
        ICheckbox Text
label [InputProperty]
props -> (Text
label, VLSpec
"checkbox", [InputProperty]
props)
        IRadio Text
label [InputProperty]
props -> (Text
label, VLSpec
"radio", [InputProperty]
props)
        ISelect Text
label [InputProperty]
props -> (Text
label, VLSpec
"select", [InputProperty]
props)
        IText Text
label [InputProperty]
props -> (Text
label, VLSpec
"text", [InputProperty]
props)
        INumber Text
label [InputProperty]
props -> (Text
label, VLSpec
"number", [InputProperty]
props)
        IDate Text
label [InputProperty]
props -> (Text
label, VLSpec
"date", [InputProperty]
props)
        ITime Text
label [InputProperty]
props -> (Text
label, VLSpec
"time", [InputProperty]
props)
        IMonth Text
label [InputProperty]
props -> (Text
label, VLSpec
"month", [InputProperty]
props)
        IWeek Text
label [InputProperty]
props -> (Text
label, VLSpec
"week", [InputProperty]
props)
        IDateTimeLocal Text
label [InputProperty]
props -> (Text
label, VLSpec
"datetimelocal", [InputProperty]
props)
        ITel Text
label [InputProperty]
props -> (Text
label, VLSpec
"tel", [InputProperty]
props)
        IColor Text
label [InputProperty]
props -> (Text
label, VLSpec
"color", [InputProperty]
props)

  in LabelledSpec -> Pair
toKey (Text
lbl, [Pair] -> VLSpec
object ((Key
"input" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= VLSpec
input) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: (InputProperty -> Pair) -> [InputProperty] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map InputProperty -> Pair
inputProperty [InputProperty]
ps))


{-|

Control the interactivity of the legend. This is used with 'BindLegend'.

@since 0.5.0.0

-}
data BindLegendProperty
  = BLField FieldName
    -- ^ The data field which should be made interactive in the legend
    --   on a single click.
  | BLChannel Channel
    -- ^ Which channel should be made interactive in a legend
    --   on a single click.
  | BLFieldEvent FieldName T.Text
    -- ^ The data field which should be made interactive in the legend and the
    --   <https://vega.github.io/vega/docs/event-streams Vega event stream>
    --   that should trigger the selection.
  | BLChannelEvent Channel T.Text
    -- ^ Which channel should be made interactive in a legend and the
    --   <https://vega.github.io/vega/docs/event-streams Vega event stream>
    --   that should trigger the selection.


bindLegendProperty :: BindLegendProperty -> [Pair]
bindLegendProperty :: BindLegendProperty -> [Pair]
bindLegendProperty (BLField Text
f) = [ Maybe Text -> Pair
toLBind Maybe Text
forall a. Maybe a
Nothing
                                 , Key
"fields" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text
f]
                                 ]
bindLegendProperty (BLChannel Channel
ch) = [ Maybe Text -> Pair
toLBind Maybe Text
forall a. Maybe a
Nothing
                                    , Key
"encodings" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Channel -> Text
channelLabel Channel
ch]
                                    ]
bindLegendProperty (BLFieldEvent Text
f Text
es) = [ Maybe Text -> Pair
toLBind (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
es)
                                         , Key
"fields" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text
f]
                                         ]
bindLegendProperty (BLChannelEvent Channel
ch Text
es) = [ Maybe Text -> Pair
toLBind (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
es)
                                            , Key
"encodings" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Channel -> Text
channelLabel Channel
ch]
                                            ]

toLBind :: Maybe T.Text -> Pair
toLBind :: Maybe Text -> Pair
toLBind Maybe Text
Nothing = Key
"bind" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> VLSpec
fromT Text
"legend"
toLBind (Just Text
es) = Key
"bind" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> VLSpec
object [Key
"legend" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
es]


{-|

Create a full selection specification from a list of selections. For details
see the
<https://vega.github.io/vega-lite/docs/selection.html Vega-Lite documentation>.

@
sel =
   'selection'
       . 'select' \"view\" 'Interval' ['BindScales'] []
       . 'select' \"myBrush\" 'Interval' []
       . 'select' \"myPaintbrush\" 'Multi' ['On' \"mouseover\", 'Nearest' True]
@

-}

selection ::
  [SelectSpec]
  -- ^ The arguments created by 'Graphics.Vega.VegaLite.select'.
  --
  --   Prior to @0.5.0.0@ this argument was @['LabelledSpec']@.
  -> PropertySpec
selection :: [SelectSpec] -> PropertySpec
selection [SelectSpec]
sels = (VLProperty
VLSelection, [LabelledSpec] -> VLSpec
toObject ((SelectSpec -> LabelledSpec) -> [SelectSpec] -> [LabelledSpec]
forall a b. (a -> b) -> [a] -> [b]
map SelectSpec -> LabelledSpec
unS [SelectSpec]
sels))


{-|

Create a single named selection that may be applied to a data query or
transformation.

@
sel =
    'selection'
        . 'select' "view" 'Interval' [ 'BindScales' ] []
        . 'select' "myBrush" 'Interval' []
        . 'select' "myPaintbrush" 'Multi' [ 'On' "mouseover", 'Nearest' True ]
@

-}
select ::
  SelectionLabel
  -- ^ The name given to the selection.
  -> Selection
  -- ^ The type of the selection.
  -> [SelectionProperty]
  -- ^ What options are applied to the selection.
  -> BuildSelectSpecs
  -- ^ Prior to @0.5.0.0@ this was @BuildLabelledSpecs@.
select :: Text -> Selection -> [SelectionProperty] -> BuildSelectSpecs
select Text
nme Selection
sType [SelectionProperty]
options [SelectSpec]
ols =
  -- TODO: elm filters out those properties that are set to A.Null
  let selProps :: [Pair]
selProps = (Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Selection -> Text
selectionLabel Selection
sType) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: (SelectionProperty -> [Pair]) -> [SelectionProperty] -> [Pair]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SelectionProperty -> [Pair]
selectionProperties [SelectionProperty]
options
  in LabelledSpec -> SelectSpec
S (Text
nme Text -> VLSpec -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> VLSpec
object [Pair]
selProps) SelectSpec -> BuildSelectSpecs
forall a. a -> [a] -> [a]
: [SelectSpec]
ols