{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE AutoDeriveTypeable #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP #-}

-- There are lots of pattern synpnyms, and little would be gained by adding
-- the type signatures.
{-# OPTIONS_GHC -fno-warn-missing-pattern-synonym-signatures #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

module IHaskell.Display.Widgets.Common where

import           Data.Aeson
import           Data.Aeson.Types (emptyObject)
import           Data.Text (pack, Text)
import           Data.Typeable (Typeable)

import           IHaskell.Display (IHaskellWidget)
import           IHaskell.Eval.Widgets (widgetSendClose)

import qualified IHaskell.Display.Widgets.Singletons as S

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Aeson.Key    as Key
#else
import           Data.HashMap.Strict as HM
#endif

-- | The view module string
pattern $bViewModule :: forall {a :: Field}. (a ~ 'ViewModule) => SField a
$mViewModule :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ViewModule) => r) -> ((# #) -> r) -> r
ViewModule = S.SViewModule
-- | The view module version
pattern $bViewModuleVersion :: forall {a :: Field}. (a ~ 'ViewModuleVersion) => SField a
$mViewModuleVersion :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ViewModuleVersion) => r) -> ((# #) -> r) -> r
ViewModuleVersion = S.SViewModuleVersion
-- | The view name
pattern $bViewName :: forall {a :: Field}. (a ~ 'ViewName) => SField a
$mViewName :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ViewName) => r) -> ((# #) -> r) -> r
ViewName = S.SViewName
-- | The model module string
pattern $bModelModule :: forall {a :: Field}. (a ~ 'ModelModule) => SField a
$mModelModule :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ModelModule) => r) -> ((# #) -> r) -> r
ModelModule = S.SModelModule
-- | The model module version
pattern $bModelModuleVersion :: forall {a :: Field}. (a ~ 'ModelModuleVersion) => SField a
$mModelModuleVersion :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ModelModuleVersion) => r) -> ((# #) -> r) -> r
ModelModuleVersion = S.SModelModuleVersion
-- | The model name
pattern $bModelName :: forall {a :: Field}. (a ~ 'ModelName) => SField a
$mModelName :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ModelName) => r) -> ((# #) -> r) -> r
ModelName = S.SModelName
-- | A method to be called on display
pattern $bDisplayHandler :: forall {a :: Field}. (a ~ 'DisplayHandler) => SField a
$mDisplayHandler :: forall {r} {a :: Field}.
SField a -> ((a ~ 'DisplayHandler) => r) -> ((# #) -> r) -> r
DisplayHandler = S.SDisplayHandler
-- | CSS classes applied to widget DOM element
pattern $bDOMClasses :: forall {a :: Field}. (a ~ 'DOMClasses) => SField a
$mDOMClasses :: forall {r} {a :: Field}.
SField a -> ((a ~ 'DOMClasses) => r) -> ((# #) -> r) -> r
DOMClasses = S.SDOMClasses
-- | Reference to a Layout widget
pattern $bLayout :: forall {a :: Field}. (a ~ 'Layout) => SField a
$mLayout :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Layout) => r) -> ((# #) -> r) -> r
Layout = S.SLayout
-- | Width of the video/image in pixels
pattern $bWidth :: forall {a :: Field}. (a ~ 'Width) => SField a
$mWidth :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Width) => r) -> ((# #) -> r) -> r
Width = S.SWidth
-- | Height of the video/image in pixels
pattern $bHeight :: forall {a :: Field}. (a ~ 'Height) => SField a
$mHeight :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Height) => r) -> ((# #) -> r) -> r
Height = S.SHeight
-- | Description of the control
pattern $bDescription :: forall {a :: Field}. (a ~ 'Description) => SField a
$mDescription :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Description) => r) -> ((# #) -> r) -> r
Description = S.SDescription
-- | Method to be called on click
pattern $bClickHandler :: forall {a :: Field}. (a ~ 'ClickHandler) => SField a
$mClickHandler :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ClickHandler) => r) -> ((# #) -> r) -> r
ClickHandler = S.SClickHandler
-- | Method to be called on submit
pattern $bSubmitHandler :: forall {a :: Field}. (a ~ 'SubmitHandler) => SField a
$mSubmitHandler :: forall {r} {a :: Field}.
SField a -> ((a ~ 'SubmitHandler) => r) -> ((# #) -> r) -> r
SubmitHandler = S.SSubmitHandler
-- | Whether the widget appears as disabled on the frontend
pattern $bDisabled :: forall {a :: Field}. (a ~ 'Disabled) => SField a
$mDisabled :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Disabled) => r) -> ((# #) -> r) -> r
Disabled = S.SDisabled
-- | The value of the widget, of type string
pattern $bStringValue :: forall {a :: Field}. (a ~ 'StringValue) => SField a
$mStringValue :: forall {r} {a :: Field}.
SField a -> ((a ~ 'StringValue) => r) -> ((# #) -> r) -> r
StringValue = S.SStringValue
-- | Placeholder text to display if nothing has been typed yet
pattern $bPlaceholder :: forall {a :: Field}. (a ~ 'Placeholder) => SField a
$mPlaceholder :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Placeholder) => r) -> ((# #) -> r) -> r
Placeholder = S.SPlaceholder
-- | Tooltip for the description
pattern $bTooltip :: forall {a :: Field}. (a ~ 'Tooltip) => SField a
$mTooltip :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Tooltip) => r) -> ((# #) -> r) -> r
Tooltip = S.STooltip
-- | The font-awesome icon without the fa-
pattern $bIcon :: forall {a :: Field}. (a ~ 'Icon) => SField a
$mIcon :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Icon) => r) -> ((# #) -> r) -> r
Icon = S.SIcon
-- | Predefined styling for the button
pattern $bButtonStyle :: forall {a :: Field}. (a ~ 'ButtonStyle) => SField a
$mButtonStyle :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ButtonStyle) => r) -> ((# #) -> r) -> r
ButtonStyle = S.SButtonStyle
-- | Value of the widget of type bytestring
pattern $bBSValue :: forall {a :: Field}. (a ~ 'BSValue) => SField a
$mBSValue :: forall {r} {a :: Field}.
SField a -> ((a ~ 'BSValue) => r) -> ((# #) -> r) -> r
BSValue = S.SBSValue
-- | The format of the image
pattern $bImageFormat :: forall {a :: Field}. (a ~ 'ImageFormat) => SField a
$mImageFormat :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ImageFormat) => r) -> ((# #) -> r) -> r
ImageFormat = S.SImageFormat
-- | The value of the widget of type bool
pattern $bBoolValue :: forall {a :: Field}. (a ~ 'BoolValue) => SField a
$mBoolValue :: forall {r} {a :: Field}.
SField a -> ((a ~ 'BoolValue) => r) -> ((# #) -> r) -> r
BoolValue = S.SBoolValue
-- | The labels for the options
pattern $bOptionsLabels :: forall {a :: Field}. (a ~ 'OptionsLabels) => SField a
$mOptionsLabels :: forall {r} {a :: Field}.
SField a -> ((a ~ 'OptionsLabels) => r) -> ((# #) -> r) -> r
OptionsLabels = S.SOptionsLabels
-- | Selected index, can be Nothing
pattern $bOptionalIndex :: forall {a :: Field}. (a ~ 'OptionalIndex) => SField a
$mOptionalIndex :: forall {r} {a :: Field}.
SField a -> ((a ~ 'OptionalIndex) => r) -> ((# #) -> r) -> r
OptionalIndex = S.SOptionalIndex
-- | The index of the controller
pattern $bIndex :: forall {a :: Field}. (a ~ 'Index) => SField a
$mIndex :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Index) => r) -> ((# #) -> r) -> r
Index = S.SIndex
-- | Method to be called when something is chosen
pattern $bSelectionHandler :: forall {a :: Field}. (a ~ 'SelectionHandler) => SField a
$mSelectionHandler :: forall {r} {a :: Field}.
SField a -> ((a ~ 'SelectionHandler) => r) -> ((# #) -> r) -> r
SelectionHandler = S.SSelectionHandler
-- | Tooltips for each button
pattern $bTooltips :: forall {a :: Field}. (a ~ 'Tooltips) => SField a
$mTooltips :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Tooltips) => r) -> ((# #) -> r) -> r
Tooltips = S.STooltips
-- | Icons names for each button (FontAwesome names without the fa- prefix)
pattern $bIcons :: forall {a :: Field}. (a ~ 'Icons) => SField a
$mIcons :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Icons) => r) -> ((# #) -> r) -> r
Icons = S.SIcons
-- | Selected indices
pattern $bIndices :: forall {a :: Field}. (a ~ 'Indices) => SField a
$mIndices :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Indices) => r) -> ((# #) -> r) -> r
Indices = S.SIndices
-- | The value of the widget of type int
pattern $bIntValue :: forall {a :: Field}. (a ~ 'IntValue) => SField a
$mIntValue :: forall {r} {a :: Field}.
SField a -> ((a ~ 'IntValue) => r) -> ((# #) -> r) -> r
IntValue = S.SIntValue
-- | Minimum step to increment the value
pattern $bStepInt :: forall {a :: Field}. (a ~ 'StepInt) => SField a
$mStepInt :: forall {r} {a :: Field}.
SField a -> ((a ~ 'StepInt) => r) -> ((# #) -> r) -> r
StepInt = S.SStepInt
-- | Max value
pattern $bMaxInt :: forall {a :: Field}. (a ~ 'MaxInt) => SField a
$mMaxInt :: forall {r} {a :: Field}.
SField a -> ((a ~ 'MaxInt) => r) -> ((# #) -> r) -> r
MaxInt = S.SMaxInt
-- | Min value
pattern $bMinInt :: forall {a :: Field}. (a ~ 'MinInt) => SField a
$mMinInt :: forall {r} {a :: Field}.
SField a -> ((a ~ 'MinInt) => r) -> ((# #) -> r) -> r
MinInt = S.SMinInt
-- | The value of the widget as an int pair
pattern $bIntPairValue :: forall {a :: Field}. (a ~ 'IntPairValue) => SField a
$mIntPairValue :: forall {r} {a :: Field}.
SField a -> ((a ~ 'IntPairValue) => r) -> ((# #) -> r) -> r
IntPairValue = S.SIntPairValue
-- | Min value on a range widget
pattern $bLowerInt :: forall {a :: Field}. (a ~ 'LowerInt) => SField a
$mLowerInt :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LowerInt) => r) -> ((# #) -> r) -> r
LowerInt = S.SLowerInt
-- | Max value on a range widget
pattern $bUpperInt :: forall {a :: Field}. (a ~ 'UpperInt) => SField a
$mUpperInt :: forall {r} {a :: Field}.
SField a -> ((a ~ 'UpperInt) => r) -> ((# #) -> r) -> r
UpperInt = S.SUpperInt
-- | Value of the widget (float)
pattern $bFloatValue :: forall {a :: Field}. (a ~ 'FloatValue) => SField a
$mFloatValue :: forall {r} {a :: Field}.
SField a -> ((a ~ 'FloatValue) => r) -> ((# #) -> r) -> r
FloatValue = S.SFloatValue
-- | Minimum step to increment the value
pattern $bStepFloat :: forall {a :: Field}. (a ~ 'StepFloat) => SField a
$mStepFloat :: forall {r} {a :: Field}.
SField a -> ((a ~ 'StepFloat) => r) -> ((# #) -> r) -> r
StepFloat = S.SStepFloat
-- | Max value
pattern $bMaxFloat :: forall {a :: Field}. (a ~ 'MaxFloat) => SField a
$mMaxFloat :: forall {r} {a :: Field}.
SField a -> ((a ~ 'MaxFloat) => r) -> ((# #) -> r) -> r
MaxFloat = S.SMaxFloat
-- | Min value
pattern $bMinFloat :: forall {a :: Field}. (a ~ 'MinFloat) => SField a
$mMinFloat :: forall {r} {a :: Field}.
SField a -> ((a ~ 'MinFloat) => r) -> ((# #) -> r) -> r
MinFloat = S.SMinFloat
-- | Value of the widget as a float pair
pattern $bFloatPairValue :: forall {a :: Field}. (a ~ 'FloatPairValue) => SField a
$mFloatPairValue :: forall {r} {a :: Field}.
SField a -> ((a ~ 'FloatPairValue) => r) -> ((# #) -> r) -> r
FloatPairValue = S.SFloatPairValue
-- | Min value of a range widget
pattern $bLowerFloat :: forall {a :: Field}. (a ~ 'LowerFloat) => SField a
$mLowerFloat :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LowerFloat) => r) -> ((# #) -> r) -> r
LowerFloat = S.SLowerFloat
-- | Max value of a range widget
pattern $bUpperFloat :: forall {a :: Field}. (a ~ 'UpperFloat) => SField a
$mUpperFloat :: forall {r} {a :: Field}.
SField a -> ((a ~ 'UpperFloat) => r) -> ((# #) -> r) -> r
UpperFloat = S.SUpperFloat
-- | Orientation of the widget
pattern $bOrientation :: forall {a :: Field}. (a ~ 'Orientation) => SField a
$mOrientation :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Orientation) => r) -> ((# #) -> r) -> r
Orientation = S.SOrientation
-- | The logarithmic base of the widget
pattern $bBaseFloat :: forall {a :: Field}. (a ~ 'BaseFloat) => SField a
$mBaseFloat :: forall {r} {a :: Field}.
SField a -> ((a ~ 'BaseFloat) => r) -> ((# #) -> r) -> r
BaseFloat = S.SBaseFloat
-- | Whether to display the current value of the widget next to it
pattern $bReadOut :: forall {a :: Field}. (a ~ 'ReadOut) => SField a
$mReadOut :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ReadOut) => r) -> ((# #) -> r) -> r
ReadOut = S.SReadOut
-- | The format of the readout
pattern $bReadOutFormat :: forall {a :: Field}. (a ~ 'ReadOutFormat) => SField a
$mReadOutFormat :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ReadOutFormat) => r) -> ((# #) -> r) -> r
ReadOutFormat = S.SReadOutFormat
-- | Use a predefined styling for the bar
pattern $bBarStyle :: forall {a :: Field}. (a ~ 'BarStyle) => SField a
$mBarStyle :: forall {r} {a :: Field}.
SField a -> ((a ~ 'BarStyle) => r) -> ((# #) -> r) -> r
BarStyle = S.SBarStyle
-- | A method called when the value changes in the fronted
pattern $bChangeHandler :: forall {a :: Field}. (a ~ 'ChangeHandler) => SField a
$mChangeHandler :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ChangeHandler) => r) -> ((# #) -> r) -> r
ChangeHandler = S.SChangeHandler
-- | List of widget children
pattern $bChildren :: forall {a :: Field}. (a ~ 'Children) => SField a
$mChildren :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Children) => r) -> ((# #) -> r) -> r
Children = S.SChildren
-- | Use a predefined styling for the box
pattern $bBoxStyle :: forall {a :: Field}. (a ~ 'BoxStyle) => SField a
$mBoxStyle :: forall {r} {a :: Field}.
SField a -> ((a ~ 'BoxStyle) => r) -> ((# #) -> r) -> r
BoxStyle = S.SBoxStyle
-- | Titles of the pages
pattern $bTitles :: forall {a :: Field}. (a ~ 'Titles) => SField a
$mTitles :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Titles) => r) -> ((# #) -> r) -> r
Titles = S.STitles
-- | The index of the selected page. Is nothing if no widgets are selected.
pattern $bSelectedIndex :: forall {a :: Field}. (a ~ 'SelectedIndex) => SField a
$mSelectedIndex :: forall {r} {a :: Field}.
SField a -> ((a ~ 'SelectedIndex) => r) -> ((# #) -> r) -> r
SelectedIndex = S.SSelectedIndex
-- | Message displayed when the value is false
pattern $bReadOutMsg :: forall {a :: Field}. (a ~ 'ReadOutMsg) => SField a
$mReadOutMsg :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ReadOutMsg) => r) -> ((# #) -> r) -> r
ReadOutMsg = S.SReadOutMsg
-- | Indent the control to align with other controls with a description
pattern $bIndent :: forall {a :: Field}. (a ~ 'Indent) => SField a
$mIndent :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Indent) => r) -> ((# #) -> r) -> r
Indent = S.SIndent
-- | Update the value as the user types. If false, update on submission.
pattern $bContinuousUpdate :: forall {a :: Field}. (a ~ 'ContinuousUpdate) => SField a
$mContinuousUpdate :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ContinuousUpdate) => r) -> ((# #) -> r) -> r
ContinuousUpdate = S.SContinuousUpdate
-- | The number of rows to display
pattern $bRows :: forall {a :: Field}. (a ~ 'Rows) => SField a
$mRows :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Rows) => r) -> ((# #) -> r) -> r
Rows = S.SRows
-- | The format of the audio
pattern $bAudioFormat :: forall {a :: Field}. (a ~ 'AudioFormat) => SField a
$mAudioFormat :: forall {r} {a :: Field}.
SField a -> ((a ~ 'AudioFormat) => r) -> ((# #) -> r) -> r
AudioFormat = S.SAudioFormat
-- | The format of the image
pattern $bVideoFormat :: forall {a :: Field}. (a ~ 'VideoFormat) => SField a
$mVideoFormat :: forall {r} {a :: Field}.
SField a -> ((a ~ 'VideoFormat) => r) -> ((# #) -> r) -> r
VideoFormat = S.SVideoFormat
-- | When true, the video starts on display
pattern $bAutoPlay :: forall {a :: Field}. (a ~ 'AutoPlay) => SField a
$mAutoPlay :: forall {r} {a :: Field}.
SField a -> ((a ~ 'AutoPlay) => r) -> ((# #) -> r) -> r
AutoPlay = S.SAutoPlay
-- | When true, the video starts from the beginning after finishing
pattern $bLoop :: forall {a :: Field}. (a ~ 'Loop) => SField a
$mLoop :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Loop) => r) -> ((# #) -> r) -> r
Loop = S.SLoop
-- | Specifies that video controls should be displayed
pattern $bControls :: forall {a :: Field}. (a ~ 'Controls) => SField a
$mControls :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Controls) => r) -> ((# #) -> r) -> r
Controls = S.SControls
-- | Dropdown options for the combobox
pattern $bOptions :: forall {a :: Field}. (a ~ 'Options) => SField a
$mOptions :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Options) => r) -> ((# #) -> r) -> r
Options = S.SOptions
-- | If set, ensure the value is in options
pattern $bEnsureOption :: forall {a :: Field}. (a ~ 'EnsureOption) => SField a
$mEnsureOption :: forall {r} {a :: Field}.
SField a -> ((a ~ 'EnsureOption) => r) -> ((# #) -> r) -> r
EnsureOption = S.SEnsureOption
-- | Whether the control is currently playing
pattern $bPlaying :: forall {a :: Field}. (a ~ 'Playing) => SField a
$mPlaying :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Playing) => r) -> ((# #) -> r) -> r
Playing = S.SPlaying
-- | Whether the control will repeat in a continuous loop
pattern $bRepeat :: forall {a :: Field}. (a ~ 'Repeat) => SField a
$mRepeat :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Repeat) => r) -> ((# #) -> r) -> r
Repeat = S.SRepeat
-- | The maximum interval for the play control
pattern $bInterval :: forall {a :: Field}. (a ~ 'Interval) => SField a
$mInterval :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Interval) => r) -> ((# #) -> r) -> r
Interval = S.SInterval
-- | Show the repeat toggle button on the widget
pattern $bShowRepeat :: forall {a :: Field}. (a ~ 'ShowRepeat) => SField a
$mShowRepeat :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ShowRepeat) => r) -> ((# #) -> r) -> r
ShowRepeat = S.SShowRepeat
-- | Display the short version of the selector
pattern $bConcise :: forall {a :: Field}. (a ~ 'Concise) => SField a
$mConcise :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Concise) => r) -> ((# #) -> r) -> r
Concise = S.SConcise
-- | The value of the widget in date format
pattern $bDateValue :: forall {a :: Field}. (a ~ 'DateValue) => SField a
$mDateValue :: forall {r} {a :: Field}.
SField a -> ((a ~ 'DateValue) => r) -> ((# #) -> r) -> r
DateValue = S.SDateValue
-- | Whether the button is pressed
pattern $bPressed :: forall {a :: Field}. (a ~ 'Pressed) => SField a
$mPressed :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Pressed) => r) -> ((# #) -> r) -> r
Pressed = S.SPressed
-- | The name of the controller
pattern $bName :: forall {a :: Field}. (a ~ 'Name) => SField a
$mName :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Name) => r) -> ((# #) -> r) -> r
Name = S.SName
-- | The name of the control mapping
pattern $bMapping :: forall {a :: Field}. (a ~ 'Mapping) => SField a
$mMapping :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Mapping) => r) -> ((# #) -> r) -> r
Mapping = S.SMapping
-- | Whether the gamepad is connected
pattern $bConnected :: forall {a :: Field}. (a ~ 'Connected) => SField a
$mConnected :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Connected) => r) -> ((# #) -> r) -> r
Connected = S.SConnected
-- | The last time the data from this gamepad was updated
pattern $bTimestamp :: forall {a :: Field}. (a ~ 'Timestamp) => SField a
$mTimestamp :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Timestamp) => r) -> ((# #) -> r) -> r
Timestamp = S.STimestamp
-- | The button widgets on the gamepad
pattern $bButtons :: forall {a :: Field}. (a ~ 'Buttons) => SField a
$mButtons :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Buttons) => r) -> ((# #) -> r) -> r
Buttons = S.SButtons
-- | The axes on the gamepad
pattern $bAxes :: forall {a :: Field}. (a ~ 'Axes) => SField a
$mAxes :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Axes) => r) -> ((# #) -> r) -> r
Axes = S.SAxes
-- | Color of the button
pattern $bButtonColor :: forall {a :: Field}. (a ~ 'ButtonColor) => SField a
$mButtonColor :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ButtonColor) => r) -> ((# #) -> r) -> r
ButtonColor = S.SButtonColor
-- | The font weight of the text
pattern $bFontWeight :: forall {a :: Field}. (a ~ 'FontWeight) => SField a
$mFontWeight :: forall {r} {a :: Field}.
SField a -> ((a ~ 'FontWeight) => r) -> ((# #) -> r) -> r
FontWeight = S.SFontWeight
-- | Width of the description to the side of the control
pattern $bDescriptionWidth :: forall {a :: Field}. (a ~ 'DescriptionWidth) => SField a
$mDescriptionWidth :: forall {r} {a :: Field}.
SField a -> ((a ~ 'DescriptionWidth) => r) -> ((# #) -> r) -> r
DescriptionWidth = S.SDescriptionWidth
-- | Color of the progress bar
pattern $bBarColor :: forall {a :: Field}. (a ~ 'BarColor) => SField a
$mBarColor :: forall {r} {a :: Field}.
SField a -> ((a ~ 'BarColor) => r) -> ((# #) -> r) -> r
BarColor = S.SBarColor
-- | Color of the slider handle
pattern $bHandleColor :: forall {a :: Field}. (a ~ 'HandleColor) => SField a
$mHandleColor :: forall {r} {a :: Field}.
SField a -> ((a ~ 'HandleColor) => r) -> ((# #) -> r) -> r
HandleColor = S.SHandleColor
-- | The width of each button
pattern $bButtonWidth :: forall {a :: Field}. (a ~ 'ButtonWidth) => SField a
$mButtonWidth :: forall {r} {a :: Field}.
SField a -> ((a ~ 'ButtonWidth) => r) -> ((# #) -> r) -> r
ButtonWidth = S.SButtonWidth
-- | The target (widget,field) pair
pattern $bTarget :: forall {a :: Field}. (a ~ 'Target) => SField a
$mTarget :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Target) => r) -> ((# #) -> r) -> r
Target = S.STarget
-- | The source (widget,field) pair
pattern $bSource :: forall {a :: Field}. (a ~ 'Source) => SField a
$mSource :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Source) => r) -> ((# #) -> r) -> r
Source = S.SSource
-- | Parent message id of messages to capture
pattern $bMsgID :: forall {a :: Field}. (a ~ 'MsgID) => SField a
$mMsgID :: forall {r} {a :: Field}.
SField a -> ((a ~ 'MsgID) => r) -> ((# #) -> r) -> r
MsgID = S.SMsgID
-- | The output messages synced from the frontend
pattern $bOutputs :: forall {a :: Field}. (a ~ 'Outputs) => SField a
$mOutputs :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Outputs) => r) -> ((# #) -> r) -> r
Outputs = S.SOutputs
-- | Reference to a Style widget with styling customizations
pattern $bStyle :: forall {a :: Field}. (a ~ 'Style) => SField a
$mStyle :: forall {r} {a :: Field}.
SField a -> ((a ~ 'Style) => r) -> ((# #) -> r) -> r
Style = S.SStyle

-- | Close a widget's comm
closeWidget :: IHaskellWidget w => w -> IO ()
closeWidget :: forall w. IHaskellWidget w => w -> IO ()
closeWidget w
w = forall a. IHaskellWidget a => a -> Value -> IO ()
widgetSendClose w
w Value
emptyObject

-- | Transforms the Integer to a String of pixels
newtype PixCount = PixCount Integer
  deriving (Integer -> PixCount
PixCount -> PixCount
PixCount -> PixCount -> PixCount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> PixCount
$cfromInteger :: Integer -> PixCount
signum :: PixCount -> PixCount
$csignum :: PixCount -> PixCount
abs :: PixCount -> PixCount
$cabs :: PixCount -> PixCount
negate :: PixCount -> PixCount
$cnegate :: PixCount -> PixCount
* :: PixCount -> PixCount -> PixCount
$c* :: PixCount -> PixCount -> PixCount
- :: PixCount -> PixCount -> PixCount
$c- :: PixCount -> PixCount -> PixCount
+ :: PixCount -> PixCount -> PixCount
$c+ :: PixCount -> PixCount -> PixCount
Num, Eq PixCount
PixCount -> PixCount -> Bool
PixCount -> PixCount -> Ordering
PixCount -> PixCount -> PixCount
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PixCount -> PixCount -> PixCount
$cmin :: PixCount -> PixCount -> PixCount
max :: PixCount -> PixCount -> PixCount
$cmax :: PixCount -> PixCount -> PixCount
>= :: PixCount -> PixCount -> Bool
$c>= :: PixCount -> PixCount -> Bool
> :: PixCount -> PixCount -> Bool
$c> :: PixCount -> PixCount -> Bool
<= :: PixCount -> PixCount -> Bool
$c<= :: PixCount -> PixCount -> Bool
< :: PixCount -> PixCount -> Bool
$c< :: PixCount -> PixCount -> Bool
compare :: PixCount -> PixCount -> Ordering
$ccompare :: PixCount -> PixCount -> Ordering
Ord, PixCount -> PixCount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PixCount -> PixCount -> Bool
$c/= :: PixCount -> PixCount -> Bool
== :: PixCount -> PixCount -> Bool
$c== :: PixCount -> PixCount -> Bool
Eq, Int -> PixCount
PixCount -> Int
PixCount -> [PixCount]
PixCount -> PixCount
PixCount -> PixCount -> [PixCount]
PixCount -> PixCount -> PixCount -> [PixCount]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PixCount -> PixCount -> PixCount -> [PixCount]
$cenumFromThenTo :: PixCount -> PixCount -> PixCount -> [PixCount]
enumFromTo :: PixCount -> PixCount -> [PixCount]
$cenumFromTo :: PixCount -> PixCount -> [PixCount]
enumFromThen :: PixCount -> PixCount -> [PixCount]
$cenumFromThen :: PixCount -> PixCount -> [PixCount]
enumFrom :: PixCount -> [PixCount]
$cenumFrom :: PixCount -> [PixCount]
fromEnum :: PixCount -> Int
$cfromEnum :: PixCount -> Int
toEnum :: Int -> PixCount
$ctoEnum :: Int -> PixCount
pred :: PixCount -> PixCount
$cpred :: PixCount -> PixCount
succ :: PixCount -> PixCount
$csucc :: PixCount -> PixCount
Enum, Typeable)

instance ToJSON PixCount where
  toJSON :: PixCount -> Value
toJSON (PixCount Integer
x) = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Integer
x forall a. [a] -> [a] -> [a]
++ [Char]
"px"

-- | Font style values
data FontStyleValue = NormalFont
                    | ItalicFont
                    | ObliqueFont
                    | InitialFont
                    | InheritFont
                    | DefaultFont

instance ToJSON FontStyleValue where
  toJSON :: FontStyleValue -> Value
toJSON FontStyleValue
NormalFont = Value
"normal"
  toJSON FontStyleValue
ItalicFont = Value
"italic"
  toJSON FontStyleValue
ObliqueFont = Value
"oblique"
  toJSON FontStyleValue
InitialFont = Value
"initial"
  toJSON FontStyleValue
InheritFont = Value
"inherit"
  toJSON FontStyleValue
DefaultFont = Value
""

-- | Font weight values
data FontWeightValue = NormalWeight
                     | BoldWeight
                     | BolderWeight
                     | LighterWeight
                     | InheritWeight
                     | InitialWeight
                     | DefaultWeight

instance ToJSON FontWeightValue where
  toJSON :: FontWeightValue -> Value
toJSON FontWeightValue
NormalWeight = Value
"normal"
  toJSON FontWeightValue
BoldWeight = Value
"bold"
  toJSON FontWeightValue
BolderWeight = Value
"bolder"
  toJSON FontWeightValue
LighterWeight = Value
"lighter"
  toJSON FontWeightValue
InheritWeight = Value
"inherit"
  toJSON FontWeightValue
InitialWeight = Value
"initial"
  toJSON FontWeightValue
DefaultWeight = Value
""

-- | Pre-defined button styles
data ButtonStyleValue = PrimaryButton
                      | SuccessButton
                      | InfoButton
                      | WarningButton
                      | DangerButton
                      | DefaultButton

instance ToJSON ButtonStyleValue where
  toJSON :: ButtonStyleValue -> Value
toJSON ButtonStyleValue
PrimaryButton = Value
"primary"
  toJSON ButtonStyleValue
SuccessButton = Value
"success"
  toJSON ButtonStyleValue
InfoButton = Value
"info"
  toJSON ButtonStyleValue
WarningButton = Value
"warning"
  toJSON ButtonStyleValue
DangerButton = Value
"danger"
  toJSON ButtonStyleValue
DefaultButton = Value
""

-- | Pre-defined bar styles
data BarStyleValue = SuccessBar
                   | InfoBar
                   | WarningBar
                   | DangerBar
                   | DefaultBar

instance ToJSON BarStyleValue where
  toJSON :: BarStyleValue -> Value
toJSON BarStyleValue
SuccessBar = Value
"success"
  toJSON BarStyleValue
InfoBar = Value
"info"
  toJSON BarStyleValue
WarningBar = Value
"warning"
  toJSON BarStyleValue
DangerBar = Value
"danger"
  toJSON BarStyleValue
DefaultBar = Value
""

-- | Audio formats for AudioWidget
data AudioFormatValue = MP3
                      | OGG
                      | WAV
                      | AURL
  deriving (AudioFormatValue -> AudioFormatValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AudioFormatValue -> AudioFormatValue -> Bool
$c/= :: AudioFormatValue -> AudioFormatValue -> Bool
== :: AudioFormatValue -> AudioFormatValue -> Bool
$c== :: AudioFormatValue -> AudioFormatValue -> Bool
Eq, Typeable)

instance Show AudioFormatValue where
  show :: AudioFormatValue -> [Char]
show AudioFormatValue
MP3 = [Char]
"mp3"
  show AudioFormatValue
OGG = [Char]
"ogg"
  show AudioFormatValue
WAV = [Char]
"wav"
  show AudioFormatValue
AURL = [Char]
"url"

instance ToJSON AudioFormatValue where
  toJSON :: AudioFormatValue -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

-- | Image formats for ImageWidget
data ImageFormatValue = PNG
                      | SVG
                      | JPG
                      | IURL
  deriving (ImageFormatValue -> ImageFormatValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageFormatValue -> ImageFormatValue -> Bool
$c/= :: ImageFormatValue -> ImageFormatValue -> Bool
== :: ImageFormatValue -> ImageFormatValue -> Bool
$c== :: ImageFormatValue -> ImageFormatValue -> Bool
Eq, Typeable)

-- | Image formats for ImageWidget
instance Show ImageFormatValue where
  show :: ImageFormatValue -> [Char]
show ImageFormatValue
PNG = [Char]
"png"
  show ImageFormatValue
SVG = [Char]
"svg"
  show ImageFormatValue
JPG = [Char]
"jpg"
  show ImageFormatValue
IURL = [Char]
"url"

instance ToJSON ImageFormatValue where
  toJSON :: ImageFormatValue -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

-- | Video formats for VideoWidget
data VideoFormatValue = MP4
                      | WEBM
                      | VURL
  deriving (VideoFormatValue -> VideoFormatValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoFormatValue -> VideoFormatValue -> Bool
$c/= :: VideoFormatValue -> VideoFormatValue -> Bool
== :: VideoFormatValue -> VideoFormatValue -> Bool
$c== :: VideoFormatValue -> VideoFormatValue -> Bool
Eq, Typeable)

instance Show VideoFormatValue where
  show :: VideoFormatValue -> [Char]
show VideoFormatValue
MP4 = [Char]
"mp4"
  show VideoFormatValue
WEBM = [Char]
"webm"
  show VideoFormatValue
VURL = [Char]
"url"

instance ToJSON VideoFormatValue where
  toJSON :: VideoFormatValue -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

-- | Orientation values.
data OrientationValue = HorizontalOrientation
                      | VerticalOrientation

instance ToJSON OrientationValue where
  toJSON :: OrientationValue -> Value
toJSON OrientationValue
HorizontalOrientation = Value
"horizontal"
  toJSON OrientationValue
VerticalOrientation = Value
"vertical"

-- | Predefined styles for box widgets
data BoxStyleValue = SuccessBox
                   | InfoBox
                   | WarningBox
                   | DangerBox
                   | DefaultBox

instance ToJSON BoxStyleValue where
  toJSON :: BoxStyleValue -> Value
toJSON BoxStyleValue
SuccessBox = Value
"success"
  toJSON BoxStyleValue
InfoBox = Value
"info"
  toJSON BoxStyleValue
WarningBox = Value
"warning"
  toJSON BoxStyleValue
DangerBox = Value
"danger"
  toJSON BoxStyleValue
DefaultBox = Value
""

-- Could use 'lens-aeson' here but this is easier to read.
-- | Makes a lookup on a value given a path of strings to follow
nestedObjectLookup :: Value -> [Text] -> Maybe Value
nestedObjectLookup :: Value -> [Text] -> Maybe Value
nestedObjectLookup Value
val [] = forall a. a -> Maybe a
Just Value
val
nestedObjectLookup Value
val (Text
x:[Text]
xs) =
  case Value
val of
#if MIN_VERSION_aeson(2,0,0)
    Object Object
o -> (Value -> [Text] -> Maybe Value
`nestedObjectLookup` [Text]
xs) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Text -> Key
Key.fromText Text
x) Object
o
#else
    Object o -> (`nestedObjectLookup` xs) =<< HM.lookup x o
#endif
    Value
_ -> forall a. Maybe a
Nothing