hvega-0.6.0.0: src/Graphics/Vega/VegaLite/Selection.hs
{-# 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.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
)
import Graphics.Vega.VegaLite.Specification
( VLProperty(VLSelection)
, PropertySpec
, LabelledSpec
, 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 Single = "single"
selectionLabel Multi = "multi"
selectionLabel Interval = "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 -> [LabelledSpec]
selectionProperties (Fields fNames) = ["fields" .= fNames]
selectionProperties (Encodings channels) = ["encodings" .= map channelLabel channels]
selectionProperties (SInit iVals) = ["init" .= object (map (second dataValueSpec) iVals)]
selectionProperties (SInitInterval Nothing Nothing) = []
selectionProperties (SInitInterval mx my) =
let conv (_, Nothing) = Nothing
conv (lbl, Just (lo, hi)) = Just (lbl .= [ dataValueSpec lo, dataValueSpec hi ])
in ["init" .= object (mapMaybe conv (zip ["x", "y"] [mx, my]))]
selectionProperties (On e) = ["on" .= e]
selectionProperties (Clear e) =
let t = T.strip e
in ["clear" .= if T.null t then toJSON False else toJSON t]
selectionProperties Empty = ["empty" .= fromT "none"]
selectionProperties (ResolveSelections res) = ["resolve" .= selectionResolutionLabel res]
selectionProperties (SelectionMark markProps) = ["mark" .= object (map selectionMarkProperty markProps)]
selectionProperties BindScales = ["bind" .= fromT "scales"]
selectionProperties (BindLegend blp) = bindLegendProperty blp
selectionProperties (Bind binds) = ["bind" .= object (map bindingSpec binds)]
selectionProperties (Nearest b) = ["nearest" .= b]
selectionProperties (Toggle expr) = ["toggle" .= expr]
selectionProperties (Translate e) = ["translate" .= if T.null e then toJSON False else toJSON e]
selectionProperties (Zoom e) = ["zoom" .= if T.null e then toJSON False else toJSON 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 Global = "global"
selectionResolutionLabel Union = "union"
selectionResolutionLabel Intersection = "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 -> LabelledSpec
selectionMarkProperty (SMCursor c) = "cursor" .= cursorLabel c
selectionMarkProperty (SMFill colour) = "fill" .= fromColor colour
selectionMarkProperty (SMFillOpacity x) = "fillOpacity" .= x
selectionMarkProperty (SMStroke colour) = "stroke" .= fromColor colour
selectionMarkProperty (SMStrokeOpacity x) = "strokeOpacity" .= x
selectionMarkProperty (SMStrokeWidth x) = "strokeWidth" .= x
selectionMarkProperty (SMStrokeDash xs) = "strokeDash" .= fromDS xs
selectionMarkProperty (SMStrokeDashOffset x) = "strokeDashOffset" .= 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 -> LabelledSpec
inputProperty (Debounce x) = "debounce" .= x
inputProperty (Element el) = "element" .= el -- #/definitions/Element
inputProperty (InOptions opts) = "options" .= map toJSON opts
inputProperty (InMin x) = "min" .= x
inputProperty (InMax x) = "max" .= x
inputProperty (InName s) = "name" .= s
inputProperty (InStep x) = "step" .= x
inputProperty (InPlaceholder el) = "placeholder" .= toJSON 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 -> LabelledSpec
bindingSpec bnd =
let (lbl, input, ps) = case bnd of
IRange label props -> (label, fromT "range", props)
ICheckbox label props -> (label, "checkbox", props)
IRadio label props -> (label, "radio", props)
ISelect label props -> (label, "select", props)
IText label props -> (label, "text", props)
INumber label props -> (label, "number", props)
IDate label props -> (label, "date", props)
ITime label props -> (label, "time", props)
IMonth label props -> (label, "month", props)
IWeek label props -> (label, "week", props)
IDateTimeLocal label props -> (label, "datetimelocal", props)
ITel label props -> (label, "tel", props)
IColor label props -> (label, "color", props)
in (lbl, object (("input" .= input) : map 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 -> [LabelledSpec]
bindLegendProperty (BLField f) = [ toLBind Nothing
, "fields" .= [f]
]
bindLegendProperty (BLChannel ch) = [ toLBind Nothing
, "encodings" .= [channelLabel ch]
]
bindLegendProperty (BLFieldEvent f es) = [ toLBind (Just es)
, "fields" .= [f]
]
bindLegendProperty (BLChannelEvent ch es) = [ toLBind (Just es)
, "encodings" .= [channelLabel ch]
]
toLBind :: Maybe T.Text -> LabelledSpec
toLBind Nothing = "bind" .= fromT "legend"
toLBind (Just es) = "bind" .= object ["legend" .= 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 sels = (VLSelection, object (map unS 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 nme sType options ols =
-- TODO: elm filters out those properties that are set to A.Null
let selProps = ("type" .= selectionLabel sType) : concatMap selectionProperties options
in S (nme .= object selProps) : ols