{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE AutoDeriveTypeable #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- | This module houses all the type-trickery needed to make widgets happen.
--
-- All widgets have a corresponding 'WidgetType', and some fields/attributes/properties as defined
-- by the 'WidgetFields' type-family.
--
-- Each widget field corresponds to a concrete haskell type, as given by the 'FieldType'
-- type-family.
--
-- Vinyl records are used to wrap together widget fields into a single 'WidgetState'.
--
-- Singletons are used as a way to represent the promoted types of kind Field. For example:
--
-- @
-- SViewName :: SField ViewName
-- @
--
-- This allows the user to pass the type 'ViewName' without using Data.Proxy. In essence, a
-- singleton is the only inhabitant (other than bottom) of a promoted type. Single element set/type
-- == singleton.
--
-- It also allows the record to wrap values of properties with information about their Field type. A
-- vinyl record is represented as @Rec f ts@, which means that a record is a list of @f x@, where
-- @x@ is a type present in the type-level list @ts@. Thus a 'WidgetState' is essentially a list of
-- field properties wrapped together with the corresponding promoted Field type. See ('=::') for
-- more.
--
-- The properties function can be used to view all the @Field@s associated with a widget object.
--
-- Attributes are represented by the @Attr@ data type, which holds the value of a field, along with
-- the actual @Field@ object and a function to verify validity of changes to the value.
--
-- The IPython widgets expect state updates of the form {"property": value}, where an empty string
-- for numeric values is ignored by the frontend and the default value is used instead. Some numbers
-- need to be sent as numbers (represented by @Integer@), whereas some (css lengths) need to be sent
-- as Strings (@PixCount@).
--
-- Child widgets are expected to be sent as strings of the form "IPY_MODEL_<uuid>", where @<uuid>@
-- represents the uuid of the widget's comm.
--
-- To know more about the IPython messaging specification (as implemented in this package) take a
-- look at the supplied MsgSpec.md.
--
-- Widgets are not able to do console input, the reason for that can be found in the messaging
-- specification.
module IHaskell.Display.Widgets.Types where

import           Control.Monad (unless, join, when, void,mzero)
import           Control.Applicative ((<$>))
import qualified Control.Exception as Ex
import           Data.Typeable (Typeable, TypeRep, typeOf)
import           Data.IORef (IORef, readIORef, modifyIORef)
import           Data.String
import           Data.Text (Text, pack)
import           System.IO.Error
import           System.Posix.IO
import           Text.Printf (printf)

import           Data.Aeson hiding (pairs)
import           Data.Aeson.Types (Pair)
import           Data.ByteString (ByteString)
import           Data.Int (Int16)
#if MIN_VERSION_vinyl(0,9,0)
import           Data.Vinyl (Rec(..), Dict(..))
import           Data.Vinyl.Recursive ((<+>), recordToList, reifyConstraint, rmap)
#else
import           Data.Vinyl (Rec(..), (<+>), recordToList, reifyConstraint, rmap, Dict(..))
#endif
import           Data.Vinyl.Functor (Compose(..), Const(..))
import           Data.Vinyl.Lens (rget, rput, type (∈))
import           Data.Vinyl.TypeLevel (RecAll)

#if MIN_VERSION_singletons(3,0,0)
import           Data.List.Singletons
#elif MIN_VERSION_singletons(2,4,0)
import           Data.Singletons.Prelude.List
#else
import           Data.Singletons.Prelude ((:++))
#endif

#if MIN_VERSION_singletons(3,0,0)
import           Data.Singletons.Base.TH
#else
import           Data.Singletons.TH
#endif

import           Data.Text.Lazy (unpack)
import           Data.Text.Lazy.Encoding

import           GHC.IO.Exception

import           IHaskell.Eval.Widgets (widgetSendUpdate, widgetSendView)
import           IHaskell.Display (IHaskellWidget(..), IHaskellDisplay(..), Display(..), widgetdisplay, base64)
import           IHaskell.IPython.Types (StreamType(..))
import           IHaskell.IPython.Message.UUID

import           IHaskell.Display.Widgets.Singletons (Field, SField, toKey, HasKey)
import qualified IHaskell.Display.Widgets.Singletons as S
import           IHaskell.Display.Widgets.Common

#if MIN_VERSION_singletons(2,4,0)
-- Versions of the "singletons" package are tightly tied to the GHC version.
-- Singletons versions 2.3.* and earlier used the type level operator ':++'
-- for appending type level lists while 2.4.* and latter use the normal value
-- level list append operator '++'.
-- To maintain compatibility across GHC versions we keep using the ':++'
-- operator for now.
type (a :++ b) = a ++ b
#endif

-- Classes from IPython's widget hierarchy. Defined as such to reduce code duplication.
type CoreWidgetClass = ['S.ViewModule, 'S.ViewModuleVersion, 'S.ModelModule, 'S.ModelModuleVersion ]

type DOMWidgetClass = ['S.ModelName, 'S.ViewName, 'S.DOMClasses, 'S.Tooltip, 'S.Layout, 'S.DisplayHandler]

type StyleWidgetClass = ['S.ModelName, 'S.ViewName] :++ CoreWidgetClass

type DescriptionWidgetClass = CoreWidgetClass :++ DOMWidgetClass :++ ['S.Description,'S.Style]

type StringClass = DescriptionWidgetClass :++ ['S.StringValue, 'S.Placeholder]

type TextClass = StringClass :++ [ 'S.Disabled, 'S.ContinuousUpdate, 'S.SubmitHandler, 'S.ChangeHandler]

type BoolClass = DescriptionWidgetClass :++ ['S.BoolValue, 'S.Disabled, 'S.ChangeHandler]

type SelectionClass = DescriptionWidgetClass :++ ['S.OptionsLabels, 'S.OptionalIndex, 'S.Disabled, 'S.SelectionHandler]

type SelectionNonemptyClass = DescriptionWidgetClass :++ ['S.OptionsLabels, 'S.Index, 'S.Disabled, 'S.SelectionHandler]

type MultipleSelectionClass = DescriptionWidgetClass :++ ['S.OptionsLabels, 'S.Indices, 'S.Disabled, 'S.SelectionHandler]

type IntClass = DescriptionWidgetClass :++ [ 'S.IntValue, 'S.ChangeHandler ]

type BoundedIntClass = IntClass :++ ['S.MaxInt, 'S.MinInt]

type IntRangeClass = IntClass :++ ['S.IntPairValue, 'S.LowerInt, 'S.UpperInt]

type BoundedIntRangeClass = IntRangeClass :++ ['S.MaxInt, 'S.MinInt]

type FloatClass = DescriptionWidgetClass :++ [ 'S.FloatValue, 'S.ChangeHandler ]

type BoundedFloatClass = FloatClass :++ ['S.MinFloat, 'S.MaxFloat]

type BoundedLogFloatClass = FloatClass :++ [ 'S.MinFloat, 'S.MaxFloat, 'S.BaseFloat ]

type FloatRangeClass = FloatClass :++ '[ 'S.FloatPairValue ]

type BoundedFloatRangeClass = FloatRangeClass :++ ['S.StepFloat, 'S.MinFloat, 'S.MaxFloat]

type BoxClass = CoreWidgetClass :++ DOMWidgetClass :++ ['S.Children, 'S.BoxStyle]

type SelectionContainerClass = BoxClass :++ ['S.Titles, 'S.SelectedIndex, 'S.ChangeHandler]

type MediaClass = CoreWidgetClass :++ DOMWidgetClass :++ '[ 'S.BSValue ]

type DescriptionStyleClass = StyleWidgetClass :++ '[ 'S.DescriptionWidth ]

type LinkClass = CoreWidgetClass :++ ['S.ModelName, 'S.Target, 'S.Source]

-- Types associated with Fields.
type family FieldType (f :: Field) :: *

type instance FieldType 'S.ViewModule = Text
type instance FieldType 'S.ViewModuleVersion = Text
type instance FieldType 'S.ViewName = Text
type instance FieldType 'S.ModelModule = Text
type instance FieldType 'S.ModelModuleVersion = Text
type instance FieldType 'S.ModelName = Text
type instance FieldType 'S.Layout = IPythonWidget 'LayoutType
type instance FieldType 'S.DisplayHandler = IO ()
type instance FieldType 'S.DOMClasses = [Text]
type instance FieldType 'S.Width = PixCount
type instance FieldType 'S.Height = PixCount
type instance FieldType 'S.Description = Text
type instance FieldType 'S.ClickHandler = IO ()
type instance FieldType 'S.SubmitHandler = IO ()
type instance FieldType 'S.Disabled = Bool
type instance FieldType 'S.StringValue = Text
type instance FieldType 'S.Placeholder = Text
type instance FieldType 'S.Tooltip = Maybe Text
type instance FieldType 'S.Icon = Text
type instance FieldType 'S.ButtonStyle = ButtonStyleValue
type instance FieldType 'S.BSValue = JSONByteString
type instance FieldType 'S.ImageFormat = ImageFormatValue
type instance FieldType 'S.BoolValue = Bool
type instance FieldType 'S.OptionsLabels = [Text]
type instance FieldType 'S.Index = Integer
type instance FieldType 'S.OptionalIndex = Maybe Integer
type instance FieldType 'S.SelectionHandler = IO ()
type instance FieldType 'S.Tooltips = [Text]
type instance FieldType 'S.Icons = [Text]
type instance FieldType 'S.Indices = [Integer]
type instance FieldType 'S.IntValue = Integer
type instance FieldType 'S.StepInt = Maybe Integer
type instance FieldType 'S.MinInt = Integer
type instance FieldType 'S.MaxInt = Integer
type instance FieldType 'S.LowerInt = Integer
type instance FieldType 'S.UpperInt = Integer
type instance FieldType 'S.IntPairValue = (Integer, Integer)
type instance FieldType 'S.Orientation = OrientationValue
type instance FieldType 'S.BaseFloat = Double
type instance FieldType 'S.ReadOut = Bool
type instance FieldType 'S.ReadOutFormat = Text
type instance FieldType 'S.BarStyle = BarStyleValue
type instance FieldType 'S.FloatValue = Double
type instance FieldType 'S.StepFloat = Maybe Double
type instance FieldType 'S.MinFloat = Double
type instance FieldType 'S.MaxFloat = Double
type instance FieldType 'S.LowerFloat = Double
type instance FieldType 'S.UpperFloat = Double
type instance FieldType 'S.FloatPairValue = (Double, Double)
type instance FieldType 'S.ChangeHandler = IO ()
type instance FieldType 'S.Children = [ChildWidget]
type instance FieldType 'S.BoxStyle = BoxStyleValue
type instance FieldType 'S.Titles = [Text]
type instance FieldType 'S.SelectedIndex = Maybe Integer
type instance FieldType 'S.ReadOutMsg = Text
type instance FieldType 'S.Indent = Bool
type instance FieldType 'S.ContinuousUpdate = Bool
type instance FieldType 'S.Rows = Maybe Integer
type instance FieldType 'S.AudioFormat = AudioFormatValue
type instance FieldType 'S.VideoFormat = VideoFormatValue
type instance FieldType 'S.AutoPlay = Bool
type instance FieldType 'S.Loop = Bool
type instance FieldType 'S.Controls = Bool
type instance FieldType 'S.Options = [Text]
type instance FieldType 'S.EnsureOption = Bool
type instance FieldType 'S.Playing = Bool
type instance FieldType 'S.Repeat = Bool
type instance FieldType 'S.Interval = Integer
type instance FieldType 'S.ShowRepeat = Bool
type instance FieldType 'S.Concise = Bool
type instance FieldType 'S.DateValue = Date
type instance FieldType 'S.Pressed = Bool
type instance FieldType 'S.Name = Text
type instance FieldType 'S.Mapping = Text
type instance FieldType 'S.Connected = Bool
type instance FieldType 'S.Timestamp = Double
type instance FieldType 'S.Buttons = [IPythonWidget 'ControllerButtonType]
type instance FieldType 'S.Axes = [IPythonWidget 'ControllerAxisType]
type instance FieldType 'S.ButtonColor = Maybe String
type instance FieldType 'S.FontWeight = FontWeightValue
type instance FieldType 'S.DescriptionWidth = String
type instance FieldType 'S.BarColor = Maybe String
type instance FieldType 'S.HandleColor = Maybe String
type instance FieldType 'S.ButtonWidth = String
type instance FieldType 'S.Target = WidgetFieldPair
type instance FieldType 'S.Source = WidgetFieldPair
type instance FieldType 'S.MsgID = Text
type instance FieldType 'S.Outputs = [OutputMsg]
type instance FieldType 'S.Style = StyleWidget

-- | Can be used to put different widgets in a list. Useful for dealing with children widgets.
data ChildWidget = forall w. RecAll Attr (WidgetFields w) ToPairs => ChildWidget (IPythonWidget w)

-- | Can be used to put different styles in a same FieldType.
data StyleWidget = forall w. RecAll Attr (WidgetFields w) ToPairs => StyleWidget (IPythonWidget w)

instance ToJSON (IPythonWidget w) where
  toJSON :: IPythonWidget w -> Value
toJSON IPythonWidget w
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
$ [Char]
"IPY_MODEL_" forall a. [a] -> [a] -> [a]
++ UUID -> [Char]
uuidToString (forall (w :: WidgetType). IPythonWidget w -> UUID
uuid IPythonWidget w
x)

instance ToJSON ChildWidget where
  toJSON :: ChildWidget -> Value
toJSON (ChildWidget IPythonWidget w
x) = forall a. ToJSON a => a -> Value
toJSON IPythonWidget w
x

instance ToJSON StyleWidget where
  toJSON :: StyleWidget -> Value
toJSON (StyleWidget IPythonWidget w
x) = forall a. ToJSON a => a -> Value
toJSON IPythonWidget w
x

-- Will use a custom class rather than a newtype wrapper with an orphan instance. The main issue is
-- the need of a Bounded instance for Float / Double.
class CustomBounded a where
  lowerBound :: a
  upperBound :: a

-- Set according to what IPython widgets use
instance CustomBounded PixCount where
  lowerBound :: PixCount
lowerBound = - forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int16)
  upperBound :: PixCount
upperBound = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int16)

instance CustomBounded Integer where
  lowerBound :: Integer
lowerBound = - forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int16)
  upperBound :: Integer
upperBound = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int16)

instance CustomBounded Double where
  lowerBound :: Double
lowerBound = - forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int16)
  upperBound :: Double
upperBound = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int16)

-- | This type only fits if the field is among the widget's fields, and it has a key
data WidgetFieldPair = forall w f. (f ∈ WidgetFields w, HasKey f ~ 'True, RecAll Attr (WidgetFields w) ToPairs) => WidgetFieldPair (IPythonWidget w) (SField f) | EmptyWT

instance ToJSON WidgetFieldPair where
  toJSON :: WidgetFieldPair -> Value
toJSON WidgetFieldPair
EmptyWT = Value
Null
  toJSON (WidgetFieldPair IPythonWidget w
w SField f
f) = forall a. ToJSON a => a -> Value
toJSON [forall a. ToJSON a => a -> Value
toJSON IPythonWidget w
w, forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ Field -> [Char]
toKey forall a b. (a -> b) -> a -> b
$ forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing SField f
f]

-- Different types of widgets. Every widget in IPython has a corresponding WidgetType
data WidgetType = ButtonType
                | ColorPickerType
                | DatePickerType
                | AudioType
                | ImageType
                | VideoType
                | OutputType
                | ComboboxType
                | HTMLType
                | HTMLMathType
                | LabelType
                | PasswordType
                | TextType
                | TextAreaType
                | CheckBoxType
                | ToggleButtonType
                | ValidType
                | DropdownType
                | RadioButtonsType
                | SelectType
                | SelectionSliderType
                | SelectionRangeSliderType
                | ToggleButtonsType
                | SelectMultipleType
                | IntTextType
                | BoundedIntTextType
                | IntSliderType
                | PlayType
                | IntProgressType
                | IntRangeSliderType
                | FloatTextType
                | BoundedFloatTextType
                | FloatSliderType
                | FloatLogSliderType
                | FloatProgressType
                | FloatRangeSliderType
                | BoxType
                | GridBoxType
                | HBoxType
                | VBoxType
                | AccordionType
                | TabType
                | StackedType
                | ControllerButtonType
                | ControllerAxisType
                | ControllerType
                | LinkType
                | DirectionalLinkType
                | LayoutType
                | ButtonStyleType
                | DescriptionStyleType
                | ProgressStyleType
                | SliderStyleType
                | ToggleButtonsStyleType

-- Fields associated with a widget

type family WidgetFields (w :: WidgetType) :: [Field]
type instance WidgetFields 'ButtonType =
                DescriptionWidgetClass :++
                  ['S.Disabled, 'S.Icon, 'S.ButtonStyle,'S.ClickHandler]
type instance WidgetFields 'ColorPickerType =
                DescriptionWidgetClass :++
                  ['S.StringValue, 'S.Concise, 'S.Disabled, 'S.ChangeHandler]
type instance WidgetFields 'DatePickerType =
                DescriptionWidgetClass :++
                  ['S.DateValue, 'S.Disabled, 'S.ChangeHandler]

type instance WidgetFields 'AudioType =
                MediaClass :++ ['S.AudioFormat, 'S.AutoPlay, 'S.Loop, 'S.Controls]
type instance WidgetFields 'ImageType =
                MediaClass :++ ['S.ImageFormat, 'S.Width, 'S.Height]
type instance WidgetFields 'VideoType =
                MediaClass :++ ['S.VideoFormat, 'S.Width, 'S.Height, 'S.AutoPlay, 'S.Loop, 'S.Controls]

type instance WidgetFields 'OutputType = DOMWidgetClass :++ ['S.ViewModule,'S.ModelModule,'S.ViewModuleVersion,'S.ModelModuleVersion,'S.MsgID,'S.Outputs]
type instance WidgetFields 'HTMLType = StringClass
type instance WidgetFields 'HTMLMathType = StringClass
type instance WidgetFields 'ComboboxType = TextClass :++ [ 'S.Options, 'S.EnsureOption ]
type instance WidgetFields 'LabelType = StringClass
type instance WidgetFields 'PasswordType = TextClass
type instance WidgetFields 'TextType = TextClass

-- Type level lists with a single element need both the list and the
-- constructor ticked, and a space between the open square bracket and
-- the first constructor. See https://ghc.haskell.org/trac/ghc/ticket/15601
type instance WidgetFields 'TextAreaType =
                StringClass :++
                  [ 'S.Rows, 'S.Disabled, 'S.ContinuousUpdate, 'S.ChangeHandler]

type instance WidgetFields 'CheckBoxType = BoolClass :++ '[ 'S.Indent ]
type instance WidgetFields 'ToggleButtonType = BoolClass :++ ['S.Icon, 'S.ButtonStyle]
type instance WidgetFields 'ValidType = BoolClass :++ '[ 'S.ReadOutMsg ]
type instance WidgetFields 'DropdownType = SelectionClass
type instance WidgetFields 'RadioButtonsType = SelectionClass
type instance WidgetFields 'SelectType = SelectionClass :++ '[ 'S.Rows ]
type instance WidgetFields 'SelectionSliderType = SelectionNonemptyClass :++ '[ 'S.Orientation, 'S.ReadOut, 'S.ContinuousUpdate ]
type instance WidgetFields 'SelectionRangeSliderType = MultipleSelectionClass :++ '[ 'S.Orientation, 'S.ReadOut, 'S.ContinuousUpdate ]
type instance WidgetFields 'ToggleButtonsType =
                SelectionClass :++ ['S.Tooltips, 'S.Icons, 'S.ButtonStyle]
type instance WidgetFields 'SelectMultipleType = MultipleSelectionClass :++ '[ 'S.Rows ]
type instance WidgetFields 'IntTextType = IntClass :++ [ 'S.Disabled, 'S.ContinuousUpdate, 'S.StepInt ]
type instance WidgetFields 'BoundedIntTextType = BoundedIntClass :++ [ 'S.Disabled, 'S.ContinuousUpdate, 'S.StepInt ]
type instance WidgetFields 'IntSliderType =
                BoundedIntClass :++
                  [ 'S.StepInt, 'S.Orientation, 'S.ReadOut, 'S.ReadOutFormat, 'S.ContinuousUpdate, 'S.Disabled ]
type instance WidgetFields 'PlayType =
                BoundedIntClass :++
                  [ 'S.Playing, 'S.Repeat, 'S.Interval, 'S.StepInt, 'S.Disabled, 'S.ShowRepeat ]
type instance WidgetFields 'IntProgressType =
                BoundedIntClass :++ ['S.Orientation, 'S.BarStyle]
type instance WidgetFields 'IntRangeSliderType =
                BoundedIntRangeClass :++
                  ['S.StepInt, 'S.Orientation, 'S.ReadOut, 'S.ReadOutFormat, 'S.ContinuousUpdate, 'S.Disabled ]
type instance WidgetFields 'FloatTextType = FloatClass :++ '[ 'S.Disabled, 'S.ContinuousUpdate, 'S.StepFloat ]
type instance WidgetFields 'BoundedFloatTextType = BoundedFloatClass :++ '[ 'S.Disabled, 'S.ContinuousUpdate, 'S.StepFloat ]
type instance WidgetFields 'FloatSliderType =
                BoundedFloatClass :++
                  ['S.StepFloat, 'S.Orientation, 'S.ReadOut, 'S.ReadOutFormat, 'S.ContinuousUpdate, 'S.Disabled ]
type instance WidgetFields 'FloatLogSliderType =
                BoundedLogFloatClass :++
                  ['S.StepFloat, 'S.Orientation, 'S.ReadOut, 'S.ReadOutFormat, 'S.ContinuousUpdate, 'S.Disabled, 'S.BaseFloat]
type instance WidgetFields 'FloatProgressType =
                BoundedFloatClass :++ ['S.Orientation, 'S.BarStyle]
type instance WidgetFields 'FloatRangeSliderType =
                BoundedFloatRangeClass :++
                  ['S.StepFloat, 'S.Orientation, 'S.ReadOut, 'S.ReadOutFormat, 'S.ContinuousUpdate, 'S.Disabled ]
type instance WidgetFields 'BoxType = BoxClass
type instance WidgetFields 'GridBoxType = BoxClass
type instance WidgetFields 'HBoxType = BoxClass
type instance WidgetFields 'VBoxType = BoxClass
type instance WidgetFields 'AccordionType = SelectionContainerClass
type instance WidgetFields 'TabType = SelectionContainerClass
type instance WidgetFields 'StackedType = SelectionContainerClass
type instance WidgetFields 'ControllerType =
  CoreWidgetClass :++ DOMWidgetClass :++
    ['S.Index, 'S.Name, 'S.Mapping, 'S.Connected, 'S.Timestamp, 'S.Buttons, 'S.Axes, 'S.ChangeHandler ]
type instance WidgetFields 'ControllerAxisType = CoreWidgetClass :++ DOMWidgetClass :++ '[ 'S.FloatValue, 'S.ChangeHandler ]
type instance WidgetFields 'ControllerButtonType = CoreWidgetClass :++ DOMWidgetClass :++ [ 'S.FloatValue, 'S.Pressed, 'S.ChangeHandler ]
type instance WidgetFields 'LinkType = LinkClass
type instance WidgetFields 'DirectionalLinkType = LinkClass

type instance WidgetFields 'ButtonStyleType = StyleWidgetClass :++ ['S.ButtonColor, 'S.FontWeight]
type instance WidgetFields 'DescriptionStyleType = DescriptionStyleClass
type instance WidgetFields 'ProgressStyleType = DescriptionStyleClass :++ '[ 'S.BarColor ]
type instance WidgetFields 'SliderStyleType = DescriptionStyleClass :++ '[ 'S.HandleColor ]
type instance WidgetFields 'ToggleButtonsStyleType = DescriptionStyleClass :++ ['S.ButtonWidth,'S.FontWeight]

-- Wrapper around a field's value. A dummy value is sent as an empty string to the frontend.
data AttrVal a = Dummy a
               | Real a

unwrap :: AttrVal a -> a
unwrap :: forall a. AttrVal a -> a
unwrap (Dummy a
x) = a
x
unwrap (Real a
x) = a
x

-- Wrapper around a field.
data Attr (f :: Field) where
  Attr :: Typeable (FieldType f)
       => { forall (f :: Field). Attr f -> AttrVal (FieldType f)
_value :: AttrVal (FieldType f)
          , forall (f :: Field). Attr f -> FieldType f -> IO (FieldType f)
_verify :: FieldType f -> IO (FieldType f)
          , forall (f :: Field). Attr f -> Field
_field :: Field
          , forall (f :: Field). Attr f -> Bool
_ro :: Bool
          } -> Attr f

getFieldType :: Attr f -> TypeRep
getFieldType :: forall (f :: Field). Attr f -> TypeRep
getFieldType Attr { _value :: forall (f :: Field). Attr f -> AttrVal (FieldType f)
_value = AttrVal (FieldType f)
attrval } = forall a. Typeable a => a -> TypeRep
typeOf forall a b. (a -> b) -> a -> b
$ forall a. AttrVal a -> a
unwrap AttrVal (FieldType f)
attrval

instance ToJSON (FieldType f) => ToJSON (Attr f) where
  toJSON :: Attr f -> Value
toJSON Attr f
attr =
    case forall (f :: Field). Attr f -> AttrVal (FieldType f)
_value Attr f
attr of
      Dummy FieldType f
_ -> [Pair] -> Value
object []
      Real FieldType f
x  -> forall a. ToJSON a => a -> Value
toJSON FieldType f
x

-- Types that can be converted to Aeson Pairs.
class ToPairs a where
  toPairs :: a -> [Pair]

-- From https://stackoverflow.com/questions/68648670/duplicate-instance-declaration-using-haskell-singletons
-- TODO: Check if it can be done with something from Singletons
instance ToPairs' (HasKey f) f => ToPairs (Attr f) where
  toPairs :: Attr f -> [Pair]
toPairs = forall (hk :: Bool) (a :: Field). ToPairs' hk a => Attr a -> [Pair]
toPairs'

class hk ~ HasKey a => ToPairs' hk a where
  toPairs' :: Attr a -> [Pair]

instance HasKey f ~ 'False => ToPairs' 'False f where
  toPairs' :: Attr f -> [Pair]
toPairs' Attr f
_ = []

instance (ToJSON (FieldType f), HasKey f ~ 'True) => ToPairs' 'True f where
  toPairs' :: Attr f -> [Pair]
toPairs' Attr f
x = [ forall a. IsString a => [Char] -> a
fromString (Field -> [Char]
toKey forall a b. (a -> b) -> a -> b
$ forall (f :: Field). Attr f -> Field
_field Attr f
x) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Attr f
x ]

newtype JSONByteString = JSONByteString ByteString
  deriving (JSONByteString -> JSONByteString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONByteString -> JSONByteString -> Bool
$c/= :: JSONByteString -> JSONByteString -> Bool
== :: JSONByteString -> JSONByteString -> Bool
$c== :: JSONByteString -> JSONByteString -> Bool
Eq,Eq JSONByteString
JSONByteString -> JSONByteString -> Bool
JSONByteString -> JSONByteString -> Ordering
JSONByteString -> JSONByteString -> JSONByteString
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 :: JSONByteString -> JSONByteString -> JSONByteString
$cmin :: JSONByteString -> JSONByteString -> JSONByteString
max :: JSONByteString -> JSONByteString -> JSONByteString
$cmax :: JSONByteString -> JSONByteString -> JSONByteString
>= :: JSONByteString -> JSONByteString -> Bool
$c>= :: JSONByteString -> JSONByteString -> Bool
> :: JSONByteString -> JSONByteString -> Bool
$c> :: JSONByteString -> JSONByteString -> Bool
<= :: JSONByteString -> JSONByteString -> Bool
$c<= :: JSONByteString -> JSONByteString -> Bool
< :: JSONByteString -> JSONByteString -> Bool
$c< :: JSONByteString -> JSONByteString -> Bool
compare :: JSONByteString -> JSONByteString -> Ordering
$ccompare :: JSONByteString -> JSONByteString -> Ordering
Ord)

instance ToJSON JSONByteString where
  toJSON :: JSONByteString -> Value
toJSON (JSONByteString ByteString
x) = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ ByteString -> Text
base64 ByteString
x

instance IsString JSONByteString where
  fromString :: [Char] -> JSONByteString
fromString = ByteString -> JSONByteString
JSONByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => [Char] -> a
fromString

-- | Store the value for a field, as an object parametrized by the Field. No verification is done
-- for these values.
(=::) :: (SingI f, Typeable (FieldType f)) => Sing f -> FieldType f -> Attr f
Sing f
s =:: :: forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: FieldType f
x = Attr { _value :: AttrVal (FieldType f)
_value = forall a. a -> AttrVal a
Real FieldType f
x, _verify :: FieldType f -> IO (FieldType f)
_verify = forall (m :: * -> *) a. Monad m => a -> m a
return, _field :: Field
_field = forall (f :: Field). SingI f => Sing f -> Field
reflect Sing f
s, _ro :: Bool
_ro = Bool
False }

-- | Store the value for a field, with a custom verification
(=:.) :: (SingI f, Typeable (FieldType f)) => Sing f -> (FieldType f, FieldType f -> IO (FieldType f) ) -> Attr f
Sing f
s =:. :: forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> (FieldType f, FieldType f -> IO (FieldType f)) -> Attr f
=:. (FieldType f
x,FieldType f -> IO (FieldType f)
v) = Attr { _value :: AttrVal (FieldType f)
_value = forall a. a -> AttrVal a
Real FieldType f
x, _verify :: FieldType f -> IO (FieldType f)
_verify = FieldType f -> IO (FieldType f)
v, _field :: Field
_field = forall (f :: Field). SingI f => Sing f -> Field
reflect Sing f
s, _ro :: Bool
_ro = Bool
False }

-- | Store the value for a field, making it read only from the frontend
(=:!) :: (SingI f, Typeable (FieldType f)) => Sing f -> FieldType f -> Attr f
Sing f
s =:! :: forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! FieldType f
x = Attr { _value :: AttrVal (FieldType f)
_value = forall a. a -> AttrVal a
Real FieldType f
x, _verify :: FieldType f -> IO (FieldType f)
_verify = forall (m :: * -> *) a. Monad m => a -> m a
return, _field :: Field
_field = forall (f :: Field). SingI f => Sing f -> Field
reflect Sing f
s, _ro :: Bool
_ro = Bool
True}

-- | If the number is in the range, return it. Otherwise raise the appropriate (over/under)flow
-- exception.
rangeCheck :: (Num a, Ord a) => (a, a) -> a -> IO a
rangeCheck :: forall a. (Num a, Ord a) => (a, a) -> a -> IO a
rangeCheck (a
l, a
u) a
x
  | a
l forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x forall a. Ord a => a -> a -> Bool
<= a
u = forall (m :: * -> *) a. Monad m => a -> m a
return a
x
  | a
l forall a. Ord a => a -> a -> Bool
> a
x = forall a e. Exception e => e -> a
Ex.throw ArithException
Ex.Underflow
  | a
u forall a. Ord a => a -> a -> Bool
< a
x = forall a e. Exception e => e -> a
Ex.throw ArithException
Ex.Overflow
  | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"The impossible happened in IHaskell.Display.Widgets.Types.rangeCheck"

rangeSliderVerification :: [Integer] -> IO [Integer]
rangeSliderVerification :: [Integer] -> IO [Integer]
rangeSliderVerification xs :: [Integer]
xs@[Integer
a,Integer
b]
  | Integer
a forall a. Ord a => a -> a -> Bool
<= Integer
b    = forall (m :: * -> *) a. Monad m => a -> m a
return [Integer]
xs
  | Bool
otherwise = forall a e. Exception e => e -> a
Ex.throw forall a b. (a -> b) -> a -> b
$ [Char] -> AssertionFailed
Ex.AssertionFailed [Char]
"The first index should be smaller than the second"
rangeSliderVerification [Integer]
_ = forall a e. Exception e => e -> a
Ex.throw forall a b. (a -> b) -> a -> b
$ [Char] -> AssertionFailed
Ex.AssertionFailed [Char]
"There should be two indices"

-- | Store a numeric value, with verification mechanism for its range.
ranged :: (SingI f, Num (FieldType f), Ord (FieldType f), Typeable (FieldType f))
       => Sing f -> (FieldType f, FieldType f) -> AttrVal (FieldType f) -> Attr f
ranged :: forall (f :: Field).
(SingI f, Num (FieldType f), Ord (FieldType f),
 Typeable (FieldType f)) =>
Sing f
-> (FieldType f, FieldType f) -> AttrVal (FieldType f) -> Attr f
ranged Sing f
s (FieldType f, FieldType f)
range AttrVal (FieldType f)
x = forall (f :: Field).
Typeable (FieldType f) =>
AttrVal (FieldType f)
-> (FieldType f -> IO (FieldType f)) -> Field -> Bool -> Attr f
Attr AttrVal (FieldType f)
x (forall a. (Num a, Ord a) => (a, a) -> a -> IO a
rangeCheck (FieldType f, FieldType f)
range) (forall (f :: Field). SingI f => Sing f -> Field
reflect Sing f
s) Bool
False

-- | Store a numeric value, with the invariant that it stays non-negative. The value set is set as a
-- dummy value if it's equal to zero.
(=:+) :: (SingI f, Num (FieldType f), CustomBounded (FieldType f), Ord (FieldType f), Typeable (FieldType f))
      => Sing f -> FieldType f -> Attr f
Sing f
s =:+ :: forall (f :: Field).
(SingI f, Num (FieldType f), CustomBounded (FieldType f),
 Ord (FieldType f), Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:+ FieldType f
val = forall (f :: Field).
Typeable (FieldType f) =>
AttrVal (FieldType f)
-> (FieldType f -> IO (FieldType f)) -> Field -> Bool -> Attr f
Attr
              ((if FieldType f
val forall a. Eq a => a -> a -> Bool
== FieldType f
0
                  then forall a. a -> AttrVal a
Dummy
                  else forall a. a -> AttrVal a
Real)
                 FieldType f
val)
              (forall a. (Num a, Ord a) => (a, a) -> a -> IO a
rangeCheck (FieldType f
0, forall a. CustomBounded a => a
upperBound))
              (forall (f :: Field). SingI f => Sing f -> Field
reflect Sing f
s)
              Bool
False

-- | Get a field from a singleton Adapted from: http://stackoverflow.com/a/28033250/2388535
reflect :: forall (f :: Field). (SingI f) => Sing f -> Field
reflect :: forall (f :: Field). SingI f => Sing f -> Field
reflect = forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing

-- | A record representing a Widget class from IPython from the controls modules
defaultCoreWidget :: Rec Attr CoreWidgetClass
defaultCoreWidget :: Rec Attr CoreWidgetClass
defaultCoreWidget = (forall {a :: Field}. (a ~ 'ViewModule) => SField a
ViewModule forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"@jupyter-widgets/controls")
                    forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ViewModuleVersion) => SField a
ViewModuleVersion forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"1.4.0")
                    forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ModelModule) => SField a
ModelModule forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"@jupyter-widgets/controls")
                    forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ModelModuleVersion) => SField a
ModelModuleVersion forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"1.4.0")
                    forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing an object of the DOMWidget class from IPython
defaultDOMWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> IPythonWidget 'LayoutType -> Rec Attr DOMWidgetClass
defaultDOMWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> Rec Attr DOMWidgetClass
defaultDOMWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
layout = (forall {a :: Field}. (a ~ 'ModelName) => SField a
ModelName forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! FieldType 'ModelName
modelName)
                                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ViewName) => SField a
ViewName forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! FieldType 'ViewName
viewName)
                                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'DOMClasses) => SField a
DOMClasses forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: [])
                                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'Tooltip) => SField a
Tooltip forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'Layout) => SField a
Layout forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: IPythonWidget 'LayoutType
layout)
                                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'DisplayHandler) => SField a
DisplayHandler forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall (m :: * -> *) a. Monad m => a -> m a
return ())
                                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing an object of the DescriptionWidget class from IPython
defaultDescriptionWidget :: FieldType 'S.ViewName
                         -> FieldType 'S.ModelName
                         -> IPythonWidget 'LayoutType
                         -> StyleWidget
                         -> Rec Attr DescriptionWidgetClass
defaultDescriptionWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr DescriptionWidgetClass
defaultDescriptionWidget FieldType 'ViewName
v FieldType 'ModelName
m IPythonWidget 'LayoutType
l StyleWidget
d = Rec Attr CoreWidgetClass
defaultCoreWidget forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> Rec Attr DOMWidgetClass
defaultDOMWidget FieldType 'ViewName
v FieldType 'ModelName
m IPythonWidget 'LayoutType
l forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'Description, 'Style]
descriptionAttrs
  where
    descriptionAttrs :: Rec Attr '[ 'Description, 'Style]
descriptionAttrs = (forall {a :: Field}. (a ~ 'Description) => SField a
Description forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Text
"")
                       forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'Style) => SField a
Style forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: StyleWidget
d)
                       forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _String class from IPython
defaultStringWidget :: FieldType 'S.ViewName
                    -> FieldType 'S.ModelName
                    -> IPythonWidget 'LayoutType
                    -> StyleWidget
                    -> Rec Attr StringClass
defaultStringWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr StringClass
defaultStringWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr DescriptionWidgetClass
defaultDescriptionWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'StringValue, 'Placeholder]
strAttrs
  where
    strAttrs :: Rec Attr '[ 'StringValue, 'Placeholder]
strAttrs = (forall {a :: Field}. (a ~ 'StringValue) => SField a
StringValue forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Text
"")
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'Placeholder) => SField a
Placeholder forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Text
"")
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the Text class from IPython
defaultTextWidget :: FieldType 'S.ViewName
                  -> FieldType 'S.ModelName
                  -> IPythonWidget 'LayoutType
                  -> StyleWidget
                  -> Rec Attr TextClass
defaultTextWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr TextClass
defaultTextWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr StringClass
defaultStringWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec
  Attr
  '[ 'Disabled, 'ContinuousUpdate, 'SubmitHandler, 'ChangeHandler]
txtAttrs
  where
    txtAttrs :: Rec
  Attr
  '[ 'Disabled, 'ContinuousUpdate, 'SubmitHandler, 'ChangeHandler]
txtAttrs = (forall {a :: Field}. (a ~ 'Disabled) => SField a
Disabled forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Bool
False)
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ContinuousUpdate) => SField a
ContinuousUpdate forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Bool
True)
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'SubmitHandler) => SField a
SubmitHandler forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall (m :: * -> *) a. Monad m => a -> m a
return ())
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ChangeHandler) => SField a
ChangeHandler forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall (m :: * -> *) a. Monad m => a -> m a
return ())
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _Bool class from IPython
defaultBoolWidget :: FieldType 'S.ViewName
                  -> FieldType 'S.ModelName
                  -> IPythonWidget 'LayoutType
                  -> StyleWidget
                  -> Rec Attr BoolClass
defaultBoolWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr BoolClass
defaultBoolWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr DescriptionWidgetClass
defaultDescriptionWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'BoolValue, 'Disabled, 'ChangeHandler]
boolAttrs
  where
    boolAttrs :: Rec Attr '[ 'BoolValue, 'Disabled, 'ChangeHandler]
boolAttrs = (forall {a :: Field}. (a ~ 'BoolValue) => SField a
BoolValue forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Bool
False)
                forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'Disabled) => SField a
Disabled forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Bool
False)
                forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ChangeHandler) => SField a
ChangeHandler forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall (m :: * -> *) a. Monad m => a -> m a
return ())
                forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _Selection class from IPython
defaultSelectionWidget :: FieldType 'S.ViewName
                       -> FieldType 'S.ModelName
                       -> IPythonWidget 'LayoutType
                       -> StyleWidget
                       -> Rec Attr SelectionClass
defaultSelectionWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr SelectionClass
defaultSelectionWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr DescriptionWidgetClass
defaultDescriptionWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec
  Attr
  '[ 'OptionsLabels, 'OptionalIndex, 'Disabled, 'SelectionHandler]
selectionAttrs
  where
    selectionAttrs :: Rec
  Attr
  '[ 'OptionsLabels, 'OptionalIndex, 'Disabled, 'SelectionHandler]
selectionAttrs = (forall {a :: Field}. (a ~ 'OptionsLabels) => SField a
OptionsLabels forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: [])
                     forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'OptionalIndex) => SField a
OptionalIndex forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                     forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'Disabled) => SField a
Disabled forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Bool
False)
                     forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'SelectionHandler) => SField a
SelectionHandler forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall (m :: * -> *) a. Monad m => a -> m a
return ())
                     forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _SelectionNonempty class from IPython
defaultSelectionNonemptyWidget :: FieldType 'S.ViewName
                               -> FieldType 'S.ModelName
                               -> IPythonWidget 'LayoutType
                               -> StyleWidget
                               -> Rec Attr SelectionNonemptyClass
defaultSelectionNonemptyWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr SelectionNonemptyClass
defaultSelectionNonemptyWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr DescriptionWidgetClass
defaultDescriptionWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'OptionsLabels, 'Index, 'Disabled, 'SelectionHandler]
selectionAttrs
  where
    selectionAttrs :: Rec Attr '[ 'OptionsLabels, 'Index, 'Disabled, 'SelectionHandler]
selectionAttrs = (forall {a :: Field}. (a ~ 'OptionsLabels) => SField a
OptionsLabels forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: [])
                     forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'Index) => SField a
Index forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Integer
0)
                     forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'Disabled) => SField a
Disabled forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Bool
False)
                     forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'SelectionHandler) => SField a
SelectionHandler forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall (m :: * -> *) a. Monad m => a -> m a
return ())
                     forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _MultipleSelection class from IPython
defaultMultipleSelectionWidget :: FieldType 'S.ViewName
                               -> FieldType 'S.ModelName
                               -> IPythonWidget 'LayoutType
                               -> StyleWidget
                               -> Rec Attr MultipleSelectionClass
defaultMultipleSelectionWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr MultipleSelectionClass
defaultMultipleSelectionWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr DescriptionWidgetClass
defaultDescriptionWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'OptionsLabels, 'Indices, 'Disabled, 'SelectionHandler]
mulSelAttrs
  where
    mulSelAttrs :: Rec Attr '[ 'OptionsLabels, 'Indices, 'Disabled, 'SelectionHandler]
mulSelAttrs = (forall {a :: Field}. (a ~ 'OptionsLabels) => SField a
OptionsLabels forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: [])
                  forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'Indices) => SField a
Indices forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: [])
                  forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'Disabled) => SField a
Disabled forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Bool
False)
                  forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'SelectionHandler) => SField a
SelectionHandler forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall (m :: * -> *) a. Monad m => a -> m a
return ())
                  forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _Int class from IPython
defaultIntWidget :: FieldType 'S.ViewName
                 -> FieldType 'S.ModelName
                 -> IPythonWidget 'LayoutType
                 -> StyleWidget
                 -> Rec Attr IntClass
defaultIntWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr IntClass
defaultIntWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr DescriptionWidgetClass
defaultDescriptionWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'IntValue, 'ChangeHandler]
intAttrs
  where
    intAttrs :: Rec Attr '[ 'IntValue, 'ChangeHandler]
intAttrs = (forall {a :: Field}. (a ~ 'IntValue) => SField a
IntValue forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Integer
0)
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ChangeHandler) => SField a
ChangeHandler forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall (m :: * -> *) a. Monad m => a -> m a
return ())
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _BoundedInt class from IPython
defaultBoundedIntWidget :: FieldType 'S.ViewName
                        -> FieldType 'S.ModelName
                        -> IPythonWidget 'LayoutType
                        -> StyleWidget
                        -> Rec Attr BoundedIntClass
defaultBoundedIntWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr BoundedIntClass
defaultBoundedIntWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr IntClass
defaultIntWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'MaxInt, 'MinInt]
boundedIntAttrs
  where
    boundedIntAttrs :: Rec Attr '[ 'MaxInt, 'MinInt]
boundedIntAttrs = (forall {a :: Field}. (a ~ 'MaxInt) => SField a
MaxInt forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Integer
100)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'MinInt) => SField a
MinInt forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Integer
0)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _BoundedInt class from IPython
defaultIntRangeWidget :: FieldType 'S.ViewName
                      -> FieldType 'S.ModelName
                      -> IPythonWidget 'LayoutType
                      -> StyleWidget
                      -> Rec Attr IntRangeClass
defaultIntRangeWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr IntRangeClass
defaultIntRangeWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr IntClass
defaultIntWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'IntPairValue, 'LowerInt, 'UpperInt]
rangeAttrs
  where
    rangeAttrs :: Rec Attr '[ 'IntPairValue, 'LowerInt, 'UpperInt]
rangeAttrs = (forall {a :: Field}. (a ~ 'IntPairValue) => SField a
IntPairValue forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: (Integer
25, Integer
75))
                 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LowerInt) => SField a
LowerInt forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Integer
0)
                 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'UpperInt) => SField a
UpperInt forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Integer
100)
                 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _BoundedIntRange class from IPython
defaultBoundedIntRangeWidget :: FieldType 'S.ViewName
                             -> FieldType 'S.ModelName
                             -> IPythonWidget 'LayoutType
                             -> StyleWidget
                             -> Rec Attr BoundedIntRangeClass
defaultBoundedIntRangeWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr BoundedIntRangeClass
defaultBoundedIntRangeWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr IntRangeClass
defaultIntRangeWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'MaxInt, 'MinInt]
boundedIntRangeAttrs
  where
    boundedIntRangeAttrs :: Rec Attr '[ 'MaxInt, 'MinInt]
boundedIntRangeAttrs = (forall {a :: Field}. (a ~ 'MaxInt) => SField a
MaxInt forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Integer
100)
                           forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'MinInt) => SField a
MinInt forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Integer
0)
                           forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _Float class from IPython
defaultFloatWidget :: FieldType 'S.ViewName
                   -> FieldType 'S.ModelName
                   -> IPythonWidget 'LayoutType
                   -> StyleWidget
                   -> Rec Attr FloatClass
defaultFloatWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr FloatClass
defaultFloatWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr DescriptionWidgetClass
defaultDescriptionWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'FloatValue, 'ChangeHandler]
floatAttrs
  where
    floatAttrs :: Rec Attr '[ 'FloatValue, 'ChangeHandler]
floatAttrs = (forall {a :: Field}. (a ~ 'FloatValue) => SField a
FloatValue forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Double
0.0)
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ChangeHandler) => SField a
ChangeHandler forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall (m :: * -> *) a. Monad m => a -> m a
return ())
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _BoundedFloat class from IPython
defaultBoundedFloatWidget :: FieldType 'S.ViewName
                          -> FieldType 'S.ModelName
                          -> IPythonWidget 'LayoutType
                          -> StyleWidget
                          -> Rec Attr BoundedFloatClass
defaultBoundedFloatWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr BoundedFloatClass
defaultBoundedFloatWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr FloatClass
defaultFloatWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'MinFloat, 'MaxFloat]
boundedFloatAttrs
  where
    boundedFloatAttrs :: Rec Attr '[ 'MinFloat, 'MaxFloat]
boundedFloatAttrs = (forall {a :: Field}. (a ~ 'MinFloat) => SField a
MinFloat forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Double
0)
                        forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'MaxFloat) => SField a
MaxFloat forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Double
100)
                        forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _BoundedLogFloat class from IPython
defaultBoundedLogFloatWidget :: FieldType 'S.ViewName
                             -> FieldType 'S.ModelName
                             -> IPythonWidget 'LayoutType
                             -> StyleWidget
                             -> Rec Attr BoundedLogFloatClass
defaultBoundedLogFloatWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr BoundedLogFloatClass
defaultBoundedLogFloatWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = Rec Attr FloatClass
floatAttrs forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'MinFloat, 'MaxFloat, 'BaseFloat]
boundedLogFloatAttrs
  where
    floatAttrs :: Rec Attr FloatClass
floatAttrs = forall k (r :: k) (rs :: [k]) (record :: (k -> *) -> [k] -> *)
       (f :: k -> *).
(RecElem record r r rs rs (RIndex r rs), RecElemFCtx record f) =>
f r -> record f rs -> record f rs
rput (forall {a :: Field}. (a ~ 'FloatValue) => SField a
FloatValue forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Double
1.0) forall a b. (a -> b) -> a -> b
$ FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr FloatClass
defaultFloatWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d
    boundedLogFloatAttrs :: Rec Attr '[ 'MinFloat, 'MaxFloat, 'BaseFloat]
boundedLogFloatAttrs = (forall {a :: Field}. (a ~ 'MinFloat) => SField a
MinFloat forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Double
0.0)
                           forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'MaxFloat) => SField a
MaxFloat forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Double
4.0)
                           forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'BaseFloat) => SField a
BaseFloat forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Double
10.0)
                           forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _BoundedFloat class from IPython
defaultFloatRangeWidget :: FieldType 'S.ViewName
                        -> FieldType 'S.ModelName
                        -> IPythonWidget 'LayoutType
                        -> StyleWidget
                        -> Rec Attr FloatRangeClass
defaultFloatRangeWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr FloatRangeClass
defaultFloatRangeWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr FloatClass
defaultFloatWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'FloatPairValue]
rangeAttrs
  where
    rangeAttrs :: Rec Attr '[ 'FloatPairValue]
rangeAttrs = (forall {a :: Field}. (a ~ 'FloatPairValue) => SField a
FloatPairValue forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: (Double
0.0, Double
1.0))
                 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _BoundedFloatRange class from IPython
defaultBoundedFloatRangeWidget :: FieldType 'S.ViewName
                               -> FieldType 'S.ModelName
                               -> IPythonWidget 'LayoutType
                               -> StyleWidget
                               -> Rec Attr BoundedFloatRangeClass
defaultBoundedFloatRangeWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr BoundedFloatRangeClass
defaultBoundedFloatRangeWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> StyleWidget
-> Rec Attr FloatRangeClass
defaultFloatRangeWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
l StyleWidget
d forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'StepFloat, 'MinFloat, 'MaxFloat]
boundedFloatRangeAttrs
  where
    boundedFloatRangeAttrs :: Rec Attr '[ 'StepFloat, 'MinFloat, 'MaxFloat]
boundedFloatRangeAttrs = (forall {a :: Field}. (a ~ 'StepFloat) => SField a
StepFloat forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. a -> Maybe a
Just Double
1)
                             forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'MinFloat) => SField a
MinFloat forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Double
0)
                             forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'MaxFloat) => SField a
MaxFloat forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: Double
100)
                             forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _Box class from IPython
defaultBoxWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> IPythonWidget 'LayoutType -> Rec Attr BoxClass
defaultBoxWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> Rec Attr BoxClass
defaultBoxWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
layout = Rec Attr CoreWidgetClass
defaultCoreWidget forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> Rec Attr DOMWidgetClass
defaultDOMWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
layout forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'Children, 'BoxStyle]
intAttrs
  where
    intAttrs :: Rec Attr '[ 'Children, 'BoxStyle]
intAttrs = (forall {a :: Field}. (a ~ 'Children) => SField a
Children forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: [])
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'BoxStyle) => SField a
BoxStyle forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: BoxStyleValue
DefaultBox)
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _SelectionContainer class from IPython
defaultSelectionContainerWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> IPythonWidget 'LayoutType -> Rec Attr SelectionContainerClass
defaultSelectionContainerWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> Rec Attr SelectionContainerClass
defaultSelectionContainerWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
layout = FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> Rec Attr BoxClass
defaultBoxWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
layout forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'Titles, 'SelectedIndex, 'ChangeHandler]
selAttrs
  where
    selAttrs :: Rec Attr '[ 'Titles, 'SelectedIndex, 'ChangeHandler]
selAttrs = (forall {a :: Field}. (a ~ 'Titles) => SField a
Titles forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: [])
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'SelectedIndex) => SField a
SelectedIndex forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ChangeHandler) => SField a
ChangeHandler forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall (m :: * -> *) a. Monad m => a -> m a
return ())
               forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the _Media class from IPython
defaultMediaWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> IPythonWidget 'LayoutType -> Rec Attr MediaClass
defaultMediaWidget :: FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> Rec Attr MediaClass
defaultMediaWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
layout = Rec Attr CoreWidgetClass
defaultCoreWidget forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> FieldType 'ViewName
-> FieldType 'ModelName
-> IPythonWidget 'LayoutType
-> Rec Attr DOMWidgetClass
defaultDOMWidget FieldType 'ViewName
viewName FieldType 'ModelName
modelName IPythonWidget 'LayoutType
layout forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'BSValue]
mediaAttrs
  where
    mediaAttrs :: Rec Attr '[ 'BSValue]
mediaAttrs = (forall {a :: Field}. (a ~ 'BSValue) => SField a
BSValue forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: JSONByteString
"")
                 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

defaultLinkWidget :: FieldType 'S.ModelName -> Rec Attr LinkClass
defaultLinkWidget :: FieldType 'ModelName -> Rec Attr LinkClass
defaultLinkWidget FieldType 'ModelName
modelName = Rec Attr CoreWidgetClass
defaultCoreWidget forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'ModelName, 'Target, 'Source]
linkAttrs
  where
    linkAttrs :: Rec Attr '[ 'ModelName, 'Target, 'Source]
linkAttrs = (forall {a :: Field}. (a ~ 'ModelName) => SField a
ModelName forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! FieldType 'ModelName
modelName)
                forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'Target) => SField a
Target forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: WidgetFieldPair
EmptyWT)
                forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'Source) => SField a
Source forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: WidgetFieldPair
EmptyWT)
                forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the Style class from IPython
defaultStyleWidget :: FieldType 'S.ModelName -> Rec Attr StyleWidgetClass
defaultStyleWidget :: FieldType 'ModelName -> Rec Attr StyleWidgetClass
defaultStyleWidget FieldType 'ModelName
modelName = (forall {a :: Field}. (a ~ 'ModelName) => SField a
ModelName forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! FieldType 'ModelName
modelName)
                              forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ViewName) => SField a
ViewName forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"StyleView")
                              forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ViewModule) => SField a
ViewModule forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"@jupyter-widgets/base")
                              forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ViewModuleVersion) => SField a
ViewModuleVersion forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"1.1.0")
                              forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ModelModule) => SField a
ModelModule forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"@jupyter-widgets/controls")
                              forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'ModelModuleVersion) => SField a
ModelModuleVersion forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"1.4.0")
                              forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

-- | A record representing a widget of the DescriptionStyle class from IPython
defaultDescriptionStyleWidget :: FieldType 'S.ModelName -> Rec Attr DescriptionStyleClass
defaultDescriptionStyleWidget :: FieldType 'ModelName -> Rec Attr DescriptionStyleClass
defaultDescriptionStyleWidget FieldType 'ModelName
modelName = FieldType 'ModelName -> Rec Attr StyleWidgetClass
defaultStyleWidget FieldType 'ModelName
modelName forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec Attr '[ 'DescriptionWidth]
dstyle
  where
    dstyle :: Rec Attr '[ 'DescriptionWidth]
dstyle = (forall {a :: Field}. (a ~ 'DescriptionWidth) => SField a
DescriptionWidth forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: [Char]
"")
            forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

newtype WidgetState w = WidgetState { forall (w :: WidgetType).
WidgetState w -> Rec Attr (WidgetFields w)
_getState :: Rec Attr (WidgetFields w) }

-- All records with ToPair instances for their Attrs will automatically have a toJSON instance now.
instance RecAll Attr (WidgetFields w) ToPairs => ToJSON (WidgetState w) where
  toJSON :: WidgetState w -> Value
toJSON WidgetState w
record =
    [Pair] -> Value
object
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {u} a (rs :: [u]). Rec (Const a) rs -> [a]
recordToList
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {u} (f :: u -> *) (g :: u -> *) (rs :: [u]).
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap (\(Compose (Dict Attr x
x)) -> forall k a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ forall a. ToPairs a => a -> [Pair]
toPairs Attr x
x) forall a b. (a -> b) -> a -> b
$ forall {u} (f :: u -> *) (rs :: [u]) (c :: * -> Constraint)
       (proxy :: (* -> Constraint) -> *).
RecAll f rs c =>
proxy c -> Rec f rs -> Rec (Dict c :. f) rs
reifyConstraint (forall {k} (t :: k). Proxy t
Proxy :: Proxy ToPairs) forall a b. (a -> b) -> a -> b
$ forall (w :: WidgetType).
WidgetState w -> Rec Attr (WidgetFields w)
_getState
                                                                                                         WidgetState w
record

data IPythonWidget (w :: WidgetType) =
       IPythonWidget
         { forall (w :: WidgetType). IPythonWidget w -> UUID
uuid :: UUID
         , forall (w :: WidgetType). IPythonWidget w -> IORef (WidgetState w)
state :: IORef (WidgetState w)
         }

-- | Change the value for a field, and notify the frontend about it. Doesn't work if the field is read only.
setField :: (f ∈ WidgetFields w, IHaskellWidget (IPythonWidget w), ToPairs (Attr f))
         => IPythonWidget w -> SField f -> FieldType f -> IO ()
setField :: forall (f :: Field) (w :: WidgetType).
(f ∈ WidgetFields w, IHaskellWidget (IPythonWidget w),
 ToPairs (Attr f)) =>
IPythonWidget w -> SField f -> FieldType f -> IO ()
setField IPythonWidget w
widget SField f
sfield FieldType f
fval = do
  Attr f
attr <- forall (f :: Field) (w :: WidgetType).
(f ∈ WidgetFields w) =>
IPythonWidget w -> SField f -> IO (Attr f)
getAttr IPythonWidget w
widget SField f
sfield
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (f :: Field). Attr f -> Bool
_ro Attr f
attr) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error ([Char]
"The field " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing SField f
sfield) forall a. [a] -> [a] -> [a]
++ [Char]
" is read only")
  !Attr f
newattr <- forall (f :: Field) (w :: WidgetType).
(f ∈ WidgetFields w, IHaskellWidget (IPythonWidget w)) =>
IPythonWidget w -> SField f -> FieldType f -> IO (Attr f)
setField' IPythonWidget w
widget SField f
sfield FieldType f
fval
  let pairs :: [Pair]
pairs = forall a. ToPairs a => a -> [Pair]
toPairs Attr f
newattr
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pair]
pairs) forall a b. (a -> b) -> a -> b
$ forall a. IHaskellWidget a => a -> Value -> IO ()
widgetSendUpdate IPythonWidget w
widget ([Pair] -> Value
object [Pair]
pairs)

-- | Change the value of a field, without notifying the frontend and without checking if is read only. For internal use.
setField' :: (f ∈ WidgetFields w, IHaskellWidget (IPythonWidget w))
          => IPythonWidget w -> SField f -> FieldType f -> IO (Attr f)
setField' :: forall (f :: Field) (w :: WidgetType).
(f ∈ WidgetFields w, IHaskellWidget (IPythonWidget w)) =>
IPythonWidget w -> SField f -> FieldType f -> IO (Attr f)
setField' IPythonWidget w
widget SField f
sfield FieldType f
val = do
  Attr f
attr <- forall (f :: Field) (w :: WidgetType).
(f ∈ WidgetFields w) =>
IPythonWidget w -> SField f -> IO (Attr f)
getAttr IPythonWidget w
widget SField f
sfield
  FieldType f
newval <- forall (f :: Field). Attr f -> FieldType f -> IO (FieldType f)
_verify Attr f
attr FieldType f
val
  let newattr :: Attr f
newattr = Attr f
attr { _value :: AttrVal (FieldType f)
_value = forall a. a -> AttrVal a
Real FieldType f
newval }
  forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (forall (w :: WidgetType). IPythonWidget w -> IORef (WidgetState w)
state IPythonWidget w
widget) (forall (w :: WidgetType).
Rec Attr (WidgetFields w) -> WidgetState w
WidgetState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (r :: k) (rs :: [k]) (record :: (k -> *) -> [k] -> *)
       (f :: k -> *).
(RecElem record r r rs rs (RIndex r rs), RecElemFCtx record f) =>
f r -> record f rs -> record f rs
rput Attr f
newattr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: WidgetType).
WidgetState w -> Rec Attr (WidgetFields w)
_getState)
  forall (m :: * -> *) a. Monad m => a -> m a
return Attr f
newattr

-- | Pluck an attribute from a record
getAttr :: (f ∈ WidgetFields w) => IPythonWidget w -> SField f -> IO (Attr f)
#if MIN_VERSION_vinyl(0,9,0)
getAttr :: forall (f :: Field) (w :: WidgetType).
(f ∈ WidgetFields w) =>
IPythonWidget w -> SField f -> IO (Attr f)
getAttr IPythonWidget w
widget SField f
_ = forall {k} (r :: k) (rs :: [k]) (f :: k -> *)
       (record :: (k -> *) -> [k] -> *).
(RecElem record r r rs rs (RIndex r rs), RecElemFCtx record f) =>
record f rs -> f r
rget forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (w :: WidgetType).
WidgetState w -> Rec Attr (WidgetFields w)
_getState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef (forall (w :: WidgetType). IPythonWidget w -> IORef (WidgetState w)
state IPythonWidget w
widget)
#else
getAttr widget sfield = rget sfield <$> _getState <$> readIORef (state widget)
#endif

-- | Get the value of a field.
getField :: (f ∈ WidgetFields w) => IPythonWidget w -> SField f -> IO (FieldType f)
getField :: forall (f :: Field) (w :: WidgetType).
(f ∈ WidgetFields w) =>
IPythonWidget w -> SField f -> IO (FieldType f)
getField IPythonWidget w
widget SField f
sfield = forall a. AttrVal a -> a
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Field). Attr f -> AttrVal (FieldType f)
_value forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Field) (w :: WidgetType).
(f ∈ WidgetFields w) =>
IPythonWidget w -> SField f -> IO (Attr f)
getAttr IPythonWidget w
widget SField f
sfield

-- | Useful with toJSON and OverloadedStrings
str :: String -> String
str :: [Char] -> [Char]
str = forall a. a -> a
id

-- | Displays on stdout the properties (and its types) of a given widget
properties :: IPythonWidget w -> IO ()
properties :: forall (w :: WidgetType). IPythonWidget w -> IO ()
properties IPythonWidget w
widget = do
  WidgetState w
st <- forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ forall (w :: WidgetType). IPythonWidget w -> IORef (WidgetState w)
state IPythonWidget w
widget
  let convert :: Attr f -> Const (Field, TypeRep) f
      convert :: forall (f :: Field). Attr f -> Const (Field, TypeRep) f
convert Attr f
attr = forall k a (b :: k). a -> Const a b
Const (forall (f :: Field). Attr f -> Field
_field Attr f
attr, forall (f :: Field). Attr f -> TypeRep
getFieldType Attr f
attr)

      renderRow :: (a, a) -> t
renderRow (a
fname, a
ftype) = forall r. PrintfType r => [Char] -> r
printf [Char]
"%s ::: %s" (forall a. Show a => a -> [Char]
show a
fname) (forall a. Show a => a -> [Char]
show a
ftype)
      rows :: [[Char]]
rows = forall a b. (a -> b) -> [a] -> [b]
map forall {t} {a} {a}. (PrintfType t, Show a, Show a) => (a, a) -> t
renderRow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {u} a (rs :: [u]). Rec (Const a) rs -> [a]
recordToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {u} (f :: u -> *) (g :: u -> *) (rs :: [u]).
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap forall (f :: Field). Attr f -> Const (Field, TypeRep) f
convert forall a b. (a -> b) -> a -> b
$ forall (w :: WidgetType).
WidgetState w -> Rec Attr (WidgetFields w)
_getState WidgetState w
st
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn [[Char]]
rows

-- Helper function for widget to enforce their inability to fetch console input
noStdin :: IO a -> IO ()
noStdin :: forall a. IO a -> IO ()
noStdin IO a
action =
  let handler :: IOException -> IO ()
      handler :: IOException -> IO ()
handler IOException
e = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IOException -> IOErrorType
ioeGetErrorType IOException
e forall a. Eq a => a -> a -> Bool
== IOErrorType
InvalidArgument)
                    (forall a. HasCallStack => [Char] -> a
error [Char]
"Widgets cannot do console input, sorry :)")
  in forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Ex.handle IOException -> IO ()
handler forall a b. (a -> b) -> a -> b
$ do
    Fd
nullFd <- [Char] -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
openFd [Char]
"/dev/null" OpenMode
WriteOnly forall a. Maybe a
Nothing OpenFileFlags
defaultFileFlags
    Fd
oldStdin <- Fd -> IO Fd
dup Fd
stdInput
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Fd -> Fd -> IO Fd
dupTo Fd
nullFd Fd
stdInput
    Fd -> IO ()
closeFd Fd
nullFd
    forall (f :: * -> *) a. Functor f => f a -> f ()
void IO a
action
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Fd -> Fd -> IO Fd
dupTo Fd
oldStdin Fd
stdInput

-- | Common function for the different trigger events
triggerEvent :: (FieldType f ~ IO (), f ∈ WidgetFields w) => SField f -> IPythonWidget w -> IO ()
triggerEvent :: forall (f :: Field) (w :: WidgetType).
(FieldType f ~ IO (), f ∈ WidgetFields w) =>
SField f -> IPythonWidget w -> IO ()
triggerEvent SField f
sfield IPythonWidget w
w = forall a. IO a -> IO ()
noStdin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (f :: Field) (w :: WidgetType).
(f ∈ WidgetFields w) =>
IPythonWidget w -> SField f -> IO (FieldType f)
getField IPythonWidget w
w SField f
sfield

-- | Called when the value of an attribute is changed on the front-end
triggerChange :: ('S.ChangeHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
triggerChange :: forall (w :: WidgetType).
('ChangeHandler ∈ WidgetFields w) =>
IPythonWidget w -> IO ()
triggerChange = forall (f :: Field) (w :: WidgetType).
(FieldType f ~ IO (), f ∈ WidgetFields w) =>
SField f -> IPythonWidget w -> IO ()
triggerEvent forall {a :: Field}. (a ~ 'ChangeHandler) => SField a
ChangeHandler

-- | Called when the button is clicked
triggerClick :: ('S.ClickHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
triggerClick :: forall (w :: WidgetType).
('ClickHandler ∈ WidgetFields w) =>
IPythonWidget w -> IO ()
triggerClick = forall (f :: Field) (w :: WidgetType).
(FieldType f ~ IO (), f ∈ WidgetFields w) =>
SField f -> IPythonWidget w -> IO ()
triggerEvent forall {a :: Field}. (a ~ 'ClickHandler) => SField a
ClickHandler

-- | Called when a selection is made in a selection widget
triggerSelection :: ('S.SelectionHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
triggerSelection :: forall (w :: WidgetType).
('SelectionHandler ∈ WidgetFields w) =>
IPythonWidget w -> IO ()
triggerSelection = forall (f :: Field) (w :: WidgetType).
(FieldType f ~ IO (), f ∈ WidgetFields w) =>
SField f -> IPythonWidget w -> IO ()
triggerEvent forall {a :: Field}. (a ~ 'SelectionHandler) => SField a
SelectionHandler

-- | Called when the text is submited in a text widget (or combobox/password)
triggerSubmit :: ('S.SubmitHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
triggerSubmit :: forall (w :: WidgetType).
('SubmitHandler ∈ WidgetFields w) =>
IPythonWidget w -> IO ()
triggerSubmit = forall (f :: Field) (w :: WidgetType).
(FieldType f ~ IO (), f ∈ WidgetFields w) =>
SField f -> IPythonWidget w -> IO ()
triggerEvent forall {a :: Field}. (a ~ 'SubmitHandler) => SField a
SubmitHandler

-- | Called when the widget is displayed on the notebook
triggerDisplay :: ('S.DisplayHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
triggerDisplay :: forall (w :: WidgetType).
('DisplayHandler ∈ WidgetFields w) =>
IPythonWidget w -> IO ()
triggerDisplay = forall (f :: Field) (w :: WidgetType).
(FieldType f ~ IO (), f ∈ WidgetFields w) =>
SField f -> IPythonWidget w -> IO ()
triggerEvent forall {a :: Field}. (a ~ 'DisplayHandler) => SField a
DisplayHandler

-- | Every IHaskellWidget widget has the same IHaskellDisplay instance, for this
-- reason we need to use FlexibleContexts. The display implementation can still
-- be overriden per widget
instance IHaskellWidget (IPythonWidget w) => IHaskellDisplay (IPythonWidget w) where
  display :: IPythonWidget w -> IO Display
display IPythonWidget w
b = do
    forall a. IHaskellWidget a => a -> IO ()
widgetSendView IPythonWidget w
b -- Keeping compatibility with classic notebook
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [DisplayData] -> Display
Display [ [Char] -> DisplayData
widgetdisplay forall a b. (a -> b) -> a -> b
$ Text -> [Char]
unpack forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [
      Key
"model_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. IHaskellWidget a => a -> UUID
getCommUUID IPythonWidget w
b,
      Key
"version_major" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
version_major,
      Key
"version_minor" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
version_minor] ]
    where
      version_major :: Int
version_major = Int
2 :: Int
      version_minor :: Int
version_minor = Int
0 :: Int

-- | The date class from IPython
data Date
  -- | No date specified. used by default
  = NullDate
  -- | Date year month day
  | Date Integer Integer Integer deriving (Date -> Date -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Date -> Date -> Bool
$c/= :: Date -> Date -> Bool
== :: Date -> Date -> Bool
$c== :: Date -> Date -> Bool
Eq,Eq Date
Date -> Date -> Bool
Date -> Date -> Ordering
Date -> Date -> Date
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 :: Date -> Date -> Date
$cmin :: Date -> Date -> Date
max :: Date -> Date -> Date
$cmax :: Date -> Date -> Date
>= :: Date -> Date -> Bool
$c>= :: Date -> Date -> Bool
> :: Date -> Date -> Bool
$c> :: Date -> Date -> Bool
<= :: Date -> Date -> Bool
$c<= :: Date -> Date -> Bool
< :: Date -> Date -> Bool
$c< :: Date -> Date -> Bool
compare :: Date -> Date -> Ordering
$ccompare :: Date -> Date -> Ordering
Ord)

defaultDate :: Date
defaultDate :: Date
defaultDate = Date
NullDate

instance Show Date where
  show :: Date -> [Char]
show Date
NullDate = [Char]
"NullDate"
  show (Date Integer
y Integer
m Integer
d) = forall r. PrintfType r => [Char] -> r
printf [Char]
"%04d-%02d-%02d" Integer
y Integer
m Integer
d

instance ToJSON Date where
  toJSON :: Date -> Value
toJSON Date
NullDate = [Pair] -> Value
object []
  toJSON (Date Integer
y Integer
m Integer
d) = [Pair] -> Value
object [ Key
"year" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Integer
y
                               , Key
"month" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON (Integer
mforall a. Num a => a -> a -> a
-Integer
1) -- In the frontend months go from 0 to 11
                               , Key
"date" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Integer
d
                               ]

instance FromJSON Date where
  parseJSON :: Value -> Parser Date
parseJSON (Object Object
v) = Integer -> Integer -> Integer -> Date
Date
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"year"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. Num a => a -> a -> a
+Integer
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"month")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"date"
  parseJSON Value
Null = forall (f :: * -> *) a. Applicative f => a -> f a
pure Date
NullDate
  parseJSON Value
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Allows you to unlink a jslink
unlink :: ('S.Source ∈ WidgetFields w, 'S.Target ∈ WidgetFields w, IHaskellWidget (IPythonWidget w))
       => IPythonWidget w
       -> IO (IPythonWidget w)
unlink :: forall (w :: WidgetType).
('Source ∈ WidgetFields w, 'Target ∈ WidgetFields w,
 IHaskellWidget (IPythonWidget w)) =>
IPythonWidget w -> IO (IPythonWidget w)
unlink IPythonWidget w
w = do
  Attr 'Source
_ <- forall (f :: Field) (w :: WidgetType).
(f ∈ WidgetFields w, IHaskellWidget (IPythonWidget w)) =>
IPythonWidget w -> SField f -> FieldType f -> IO (Attr f)
setField' IPythonWidget w
w forall {a :: Field}. (a ~ 'Source) => SField a
Source WidgetFieldPair
EmptyWT
  Attr 'Target
_ <- forall (f :: Field) (w :: WidgetType).
(f ∈ WidgetFields w, IHaskellWidget (IPythonWidget w)) =>
IPythonWidget w -> SField f -> FieldType f -> IO (Attr f)
setField' IPythonWidget w
w forall {a :: Field}. (a ~ 'Target) => SField a
Target WidgetFieldPair
EmptyWT
  forall (m :: * -> *) a. Monad m => a -> m a
return IPythonWidget w
w

data OutputMsg = OutputStream StreamType Text | OutputData Display deriving (Int -> OutputMsg -> [Char] -> [Char]
[OutputMsg] -> [Char] -> [Char]
OutputMsg -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [OutputMsg] -> [Char] -> [Char]
$cshowList :: [OutputMsg] -> [Char] -> [Char]
show :: OutputMsg -> [Char]
$cshow :: OutputMsg -> [Char]
showsPrec :: Int -> OutputMsg -> [Char] -> [Char]
$cshowsPrec :: Int -> OutputMsg -> [Char] -> [Char]
Show)

instance ToJSON OutputMsg where
  toJSON :: OutputMsg -> Value
toJSON (OutputStream StreamType
n Text
t) = [Pair] -> Value
object [ Key
"output_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Char] -> [Char]
str [Char]
"stream"
                                     , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON StreamType
n
                                     , Key
"text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Text
t
                                     ]
  toJSON (OutputData Display
d)     = [Pair] -> Value
object [ Key
"output_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Char] -> [Char]
str [Char]
"display_data"
                                     , Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Display
d
                                     , Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object []
                                     ]