{-# LANGUAGE OverloadedStrings #-}
module Graphics.Vega.VegaLite.Selection
( selection
, select
, Selection(..)
, SelectionProperty(..)
, Binding(..)
, BindLegendProperty(..)
, InputProperty(..)
, SelectionMarkProperty(..)
, SelectionResolution(..)
, 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
)
data Selection
= Single
| Multi
| Interval
selectionLabel :: Selection -> T.Text
selectionLabel :: Selection -> Text
selectionLabel Selection
Single = Text
"single"
selectionLabel Selection
Multi = Text
"multi"
selectionLabel Selection
Interval = Text
"interval"
data SelectionProperty
= Empty
| BindScales
| BindLegend BindLegendProperty
| On T.Text
| Clear T.Text
| Translate T.Text
| Zoom T.Text
| Fields [FieldName]
| Encodings [Channel]
| SInit [(FieldName, DataValue)]
| SInitInterval (Maybe (DataValue, DataValue)) (Maybe (DataValue, DataValue))
| ResolveSelections SelectionResolution
| SelectionMark [SelectionMarkProperty]
| Bind [Binding]
| Nearest Bool
| Toggle T.Text
selectionProperties :: SelectionProperty -> [LabelledSpec]
selectionProperties :: SelectionProperty -> [LabelledSpec]
selectionProperties (Fields [Text]
fNames) = [Text
"fields" Text -> [Text] -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
fNames]
selectionProperties (Encodings [Channel]
channels) = [Text
"encodings" Text -> [Text] -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Channel -> Text) -> [Channel] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Channel -> Text
channelLabel [Channel]
channels]
selectionProperties (SInit [(Text, DataValue)]
iVals) = [Text
"init" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [LabelledSpec] -> Value
object (((Text, DataValue) -> LabelledSpec)
-> [(Text, DataValue)] -> [LabelledSpec]
forall a b. (a -> b) -> [a] -> [b]
map ((DataValue -> Value) -> (Text, DataValue) -> LabelledSpec
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second DataValue -> Value
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 :: (Text, Maybe (DataValue, DataValue)) -> Maybe a
conv (Text
_, Maybe (DataValue, DataValue)
Nothing) = Maybe a
forall a. Maybe a
Nothing
conv (Text
lbl, Just (DataValue
lo, DataValue
hi)) = a -> Maybe a
forall a. a -> Maybe a
Just (Text
lbl Text -> [Value] -> a
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [ DataValue -> Value
dataValueSpec DataValue
lo, DataValue -> Value
dataValueSpec DataValue
hi ])
in [Text
"init" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [LabelledSpec] -> Value
object (((Text, Maybe (DataValue, DataValue)) -> Maybe LabelledSpec)
-> [(Text, Maybe (DataValue, DataValue))] -> [LabelledSpec]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, Maybe (DataValue, DataValue)) -> Maybe LabelledSpec
forall a.
KeyValue a =>
(Text, Maybe (DataValue, DataValue)) -> Maybe a
conv ([Text]
-> [Maybe (DataValue, DataValue)]
-> [(Text, Maybe (DataValue, DataValue))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text
"x", Text
"y"] [Maybe (DataValue, DataValue)
mx, Maybe (DataValue, DataValue)
my]))]
selectionProperties (On Text
e) = [Text
"on" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
e]
selectionProperties (Clear Text
e) =
let t :: Text
t = Text -> Text
T.strip Text
e
in [Text
"clear" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= if Text -> Bool
T.null Text
t then Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
False else Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t]
selectionProperties SelectionProperty
Empty = [Text
"empty" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
fromT Text
"none"]
selectionProperties (ResolveSelections SelectionResolution
res) = [Text
"resolve" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SelectionResolution -> Text
selectionResolutionLabel SelectionResolution
res]
selectionProperties (SelectionMark [SelectionMarkProperty]
markProps) = [Text
"mark" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [LabelledSpec] -> Value
object ((SelectionMarkProperty -> LabelledSpec)
-> [SelectionMarkProperty] -> [LabelledSpec]
forall a b. (a -> b) -> [a] -> [b]
map SelectionMarkProperty -> LabelledSpec
selectionMarkProperty [SelectionMarkProperty]
markProps)]
selectionProperties SelectionProperty
BindScales = [Text
"bind" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
fromT Text
"scales"]
selectionProperties (BindLegend BindLegendProperty
blp) = BindLegendProperty -> [LabelledSpec]
bindLegendProperty BindLegendProperty
blp
selectionProperties (Bind [Binding]
binds) = [Text
"bind" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [LabelledSpec] -> Value
object ((Binding -> LabelledSpec) -> [Binding] -> [LabelledSpec]
forall a b. (a -> b) -> [a] -> [b]
map Binding -> LabelledSpec
bindingSpec [Binding]
binds)]
selectionProperties (Nearest Bool
b) = [Text
"nearest" Text -> Bool -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
b]
selectionProperties (Toggle Text
expr) = [Text
"toggle" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
expr]
selectionProperties (Translate Text
e) = [Text
"translate" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= if Text -> Bool
T.null Text
e then Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
False else Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
e]
selectionProperties (Zoom Text
e) = [Text
"zoom" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= if Text -> Bool
T.null Text
e then Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
False else Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
e]
data SelectionResolution
= Global
| Union
| Intersection
selectionResolutionLabel :: SelectionResolution -> T.Text
selectionResolutionLabel :: SelectionResolution -> Text
selectionResolutionLabel SelectionResolution
Global = Text
"global"
selectionResolutionLabel SelectionResolution
Union = Text
"union"
selectionResolutionLabel SelectionResolution
Intersection = Text
"intersect"
data SelectionMarkProperty
= SMCursor Cursor
| SMFill Color
| SMFillOpacity Opacity
| SMStroke Color
| SMStrokeOpacity Opacity
| SMStrokeWidth Double
| SMStrokeDash DashStyle
| SMStrokeDashOffset DashOffset
selectionMarkProperty :: SelectionMarkProperty -> LabelledSpec
selectionMarkProperty :: SelectionMarkProperty -> LabelledSpec
selectionMarkProperty (SMCursor Cursor
c) = Text
"cursor" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Cursor -> Text
cursorLabel Cursor
c
selectionMarkProperty (SMFill Text
colour) = Text
"fill" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
fromColor Text
colour
selectionMarkProperty (SMFillOpacity Opacity
x) = Text
"fillOpacity" Text -> Opacity -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Opacity
x
selectionMarkProperty (SMStroke Text
colour) = Text
"stroke" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
fromColor Text
colour
selectionMarkProperty (SMStrokeOpacity Opacity
x) = Text
"strokeOpacity" Text -> Opacity -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Opacity
x
selectionMarkProperty (SMStrokeWidth Opacity
x) = Text
"strokeWidth" Text -> Opacity -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Opacity
x
selectionMarkProperty (SMStrokeDash DashStyle
xs) = Text
"strokeDash" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DashStyle -> Value
fromDS DashStyle
xs
selectionMarkProperty (SMStrokeDashOffset Opacity
x) = Text
"strokeDashOffset" Text -> Opacity -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Opacity
x
data InputProperty
= Debounce Double
| Element T.Text
| InOptions [T.Text]
| InMin Double
| InMax Double
| InName T.Text
| InStep Double
| InPlaceholder T.Text
inputProperty :: InputProperty -> LabelledSpec
inputProperty :: InputProperty -> LabelledSpec
inputProperty (Debounce Opacity
x) = Text
"debounce" Text -> Opacity -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Opacity
x
inputProperty (Element Text
el) = Text
"element" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
el
inputProperty (InOptions [Text]
opts) = Text
"options" Text -> [Value] -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text -> Value) -> [Text] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Value
forall a. ToJSON a => a -> Value
toJSON [Text]
opts
inputProperty (InMin Opacity
x) = Text
"min" Text -> Opacity -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Opacity
x
inputProperty (InMax Opacity
x) = Text
"max" Text -> Opacity -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Opacity
x
inputProperty (InName Text
s) = Text
"name" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
s
inputProperty (InStep Opacity
x) = Text
"step" Text -> Opacity -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Opacity
x
inputProperty (InPlaceholder Text
el) = Text
"placeholder" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
el
data Binding
= IRange T.Text [InputProperty]
| ICheckbox T.Text [InputProperty]
| IRadio T.Text [InputProperty]
| ISelect T.Text [InputProperty]
| IText T.Text [InputProperty]
| INumber T.Text [InputProperty]
| IDate T.Text [InputProperty]
| ITime T.Text [InputProperty]
| IMonth T.Text [InputProperty]
| IWeek T.Text [InputProperty]
| IDateTimeLocal T.Text [InputProperty]
| ITel T.Text [InputProperty]
| IColor T.Text [InputProperty]
bindingSpec :: Binding -> LabelledSpec
bindingSpec :: Binding -> LabelledSpec
bindingSpec Binding
bnd =
let (Text
lbl, Value
input, [InputProperty]
ps) = case Binding
bnd of
IRange Text
label [InputProperty]
props -> (Text
label, Text -> Value
fromT Text
"range", [InputProperty]
props)
ICheckbox Text
label [InputProperty]
props -> (Text
label, Value
"checkbox", [InputProperty]
props)
IRadio Text
label [InputProperty]
props -> (Text
label, Value
"radio", [InputProperty]
props)
ISelect Text
label [InputProperty]
props -> (Text
label, Value
"select", [InputProperty]
props)
IText Text
label [InputProperty]
props -> (Text
label, Value
"text", [InputProperty]
props)
INumber Text
label [InputProperty]
props -> (Text
label, Value
"number", [InputProperty]
props)
IDate Text
label [InputProperty]
props -> (Text
label, Value
"date", [InputProperty]
props)
ITime Text
label [InputProperty]
props -> (Text
label, Value
"time", [InputProperty]
props)
IMonth Text
label [InputProperty]
props -> (Text
label, Value
"month", [InputProperty]
props)
IWeek Text
label [InputProperty]
props -> (Text
label, Value
"week", [InputProperty]
props)
IDateTimeLocal Text
label [InputProperty]
props -> (Text
label, Value
"datetimelocal", [InputProperty]
props)
ITel Text
label [InputProperty]
props -> (Text
label, Value
"tel", [InputProperty]
props)
IColor Text
label [InputProperty]
props -> (Text
label, Value
"color", [InputProperty]
props)
in (Text
lbl, [LabelledSpec] -> Value
object ((Text
"input" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
input) LabelledSpec -> [LabelledSpec] -> [LabelledSpec]
forall a. a -> [a] -> [a]
: (InputProperty -> LabelledSpec)
-> [InputProperty] -> [LabelledSpec]
forall a b. (a -> b) -> [a] -> [b]
map InputProperty -> LabelledSpec
inputProperty [InputProperty]
ps))
data BindLegendProperty
= BLField FieldName
| BLChannel Channel
| BLFieldEvent FieldName T.Text
| BLChannelEvent Channel T.Text
bindLegendProperty :: BindLegendProperty -> [LabelledSpec]
bindLegendProperty :: BindLegendProperty -> [LabelledSpec]
bindLegendProperty (BLField Text
f) = [ Maybe Text -> LabelledSpec
toLBind Maybe Text
forall a. Maybe a
Nothing
, Text
"fields" Text -> [Text] -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text
f]
]
bindLegendProperty (BLChannel Channel
ch) = [ Maybe Text -> LabelledSpec
toLBind Maybe Text
forall a. Maybe a
Nothing
, Text
"encodings" Text -> [Text] -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Channel -> Text
channelLabel Channel
ch]
]
bindLegendProperty (BLFieldEvent Text
f Text
es) = [ Maybe Text -> LabelledSpec
toLBind (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
es)
, Text
"fields" Text -> [Text] -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text
f]
]
bindLegendProperty (BLChannelEvent Channel
ch Text
es) = [ Maybe Text -> LabelledSpec
toLBind (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
es)
, Text
"encodings" Text -> [Text] -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Channel -> Text
channelLabel Channel
ch]
]
toLBind :: Maybe T.Text -> LabelledSpec
toLBind :: Maybe Text -> LabelledSpec
toLBind Maybe Text
Nothing = Text
"bind" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
fromT Text
"legend"
toLBind (Just Text
es) = Text
"bind" Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [LabelledSpec] -> Value
object [Text
"legend" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
es]
selection ::
[SelectSpec]
-> PropertySpec
selection :: [SelectSpec] -> PropertySpec
selection [SelectSpec]
sels = (VLProperty
VLSelection, [LabelledSpec] -> Value
object ((SelectSpec -> LabelledSpec) -> [SelectSpec] -> [LabelledSpec]
forall a b. (a -> b) -> [a] -> [b]
map SelectSpec -> LabelledSpec
unS [SelectSpec]
sels))
select ::
SelectionLabel
-> Selection
-> [SelectionProperty]
-> BuildSelectSpecs
select :: Text -> Selection -> [SelectionProperty] -> BuildSelectSpecs
select Text
nme Selection
sType [SelectionProperty]
options [SelectSpec]
ols =
let selProps :: [LabelledSpec]
selProps = (Text
"type" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Selection -> Text
selectionLabel Selection
sType) LabelledSpec -> [LabelledSpec] -> [LabelledSpec]
forall a. a -> [a] -> [a]
: (SelectionProperty -> [LabelledSpec])
-> [SelectionProperty] -> [LabelledSpec]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SelectionProperty -> [LabelledSpec]
selectionProperties [SelectionProperty]
options
in LabelledSpec -> SelectSpec
S (Text
nme Text -> Value -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [LabelledSpec] -> Value
object [LabelledSpec]
selProps) SelectSpec -> BuildSelectSpecs
forall a. a -> [a] -> [a]
: [SelectSpec]
ols