mirror of
https://github.com/IHaskell/IHaskell.git
synced 2025-04-19 12:56:08 +00:00
Added layout widget
This commit is contained in:
David Davó
parent
97d1719b9a
commit
6fa862320b
@ -19,4 +19,8 @@ jupyter nbconvert *.ipynb --to notebook --inplace --clear-output
|
||||
- [ ] Validate the JSON implementation of widgets against the MsgSpec schema
|
||||
- [ ] Create integration tests for the widgets
|
||||
- [ ] Make the `output` widget work
|
||||
- [ ] Processing of widget messages concurrently
|
||||
- [ ] Processing of widget messages concurrently
|
||||
- [ ] Make the layout widget values more 'Haskelian': Instead of checking if the string is valid at runtime, make some types so it's checked at compile-time
|
||||
- [ ] Add some "utils" work:
|
||||
- [ ] Create media widget from file
|
||||
- [ ] Get the selected label from a selection value
|
||||
@ -58,6 +58,7 @@ library
|
||||
-- Modules exported by the library.
|
||||
exposed-modules: IHaskell.Display.Widgets
|
||||
IHaskell.Display.Widgets.Interactive
|
||||
IHaskell.Display.Widgets.Layout
|
||||
|
||||
-- Modules included in this library but not exported.
|
||||
other-modules: IHaskell.Display.Widgets.Button
|
||||
@ -106,6 +107,10 @@ library
|
||||
IHaskell.Display.Widgets.String.Text
|
||||
IHaskell.Display.Widgets.String.TextArea
|
||||
|
||||
IHaskell.Display.Widgets.Layout.Common
|
||||
IHaskell.Display.Widgets.Layout.LayoutWidget
|
||||
IHaskell.Display.Widgets.Layout.Types
|
||||
|
||||
IHaskell.Display.Widgets.Types
|
||||
IHaskell.Display.Widgets.Common
|
||||
IHaskell.Display.Widgets.Singletons
|
||||
|
||||
@ -33,6 +33,7 @@ pattern ModelModuleVersion = S.SModelModuleVersion
|
||||
pattern ModelName = S.SModelName
|
||||
pattern DisplayHandler = S.SDisplayHandler
|
||||
pattern DOMClasses = S.SDOMClasses
|
||||
pattern Layout = S.SLayout
|
||||
pattern Width = S.SWidth
|
||||
pattern Height = S.SHeight
|
||||
pattern Description = S.SDescription
|
||||
@ -75,10 +76,7 @@ pattern ReadOutFormat = S.SReadOutFormat
|
||||
pattern BarStyle = S.SBarStyle
|
||||
pattern ChangeHandler = S.SChangeHandler
|
||||
pattern Children = S.SChildren
|
||||
pattern OverflowX = S.SOverflowX
|
||||
pattern OverflowY = S.SOverflowY
|
||||
pattern BoxStyle = S.SBoxStyle
|
||||
pattern Flex = S.SFlex
|
||||
pattern Pack = S.SPack
|
||||
pattern Align = S.SAlign
|
||||
pattern Titles = S.STitles
|
||||
@ -121,36 +119,6 @@ newtype PixCount = PixCount Integer
|
||||
instance ToJSON PixCount where
|
||||
toJSON (PixCount x) = toJSON . pack $ show x ++ "px"
|
||||
|
||||
-- | Pre-defined border styles
|
||||
data BorderStyleValue = NoBorder
|
||||
| HiddenBorder
|
||||
| DottedBorder
|
||||
| DashedBorder
|
||||
| SolidBorder
|
||||
| DoubleBorder
|
||||
| GrooveBorder
|
||||
| RidgeBorder
|
||||
| InsetBorder
|
||||
| OutsetBorder
|
||||
| InitialBorder
|
||||
| InheritBorder
|
||||
| DefaultBorder
|
||||
|
||||
instance ToJSON BorderStyleValue where
|
||||
toJSON NoBorder = "none"
|
||||
toJSON HiddenBorder = "hidden"
|
||||
toJSON DottedBorder = "dotted"
|
||||
toJSON DashedBorder = "dashed"
|
||||
toJSON SolidBorder = "solid"
|
||||
toJSON DoubleBorder = "double"
|
||||
toJSON GrooveBorder = "groove"
|
||||
toJSON RidgeBorder = "ridge"
|
||||
toJSON InsetBorder = "inset"
|
||||
toJSON OutsetBorder = "outset"
|
||||
toJSON InitialBorder = "initial"
|
||||
toJSON InheritBorder = "inherit"
|
||||
toJSON DefaultBorder = ""
|
||||
|
||||
-- | Font style values
|
||||
data FontStyleValue = NormalFont
|
||||
| ItalicFont
|
||||
@ -269,23 +237,6 @@ instance ToJSON OrientationValue where
|
||||
toJSON HorizontalOrientation = "horizontal"
|
||||
toJSON VerticalOrientation = "vertical"
|
||||
|
||||
data OverflowValue = VisibleOverflow
|
||||
| HiddenOverflow
|
||||
| ScrollOverflow
|
||||
| AutoOverflow
|
||||
| InitialOverflow
|
||||
| InheritOverflow
|
||||
| DefaultOverflow
|
||||
|
||||
instance ToJSON OverflowValue where
|
||||
toJSON VisibleOverflow = "visible"
|
||||
toJSON HiddenOverflow = "hidden"
|
||||
toJSON ScrollOverflow = "scroll"
|
||||
toJSON AutoOverflow = "auto"
|
||||
toJSON InitialOverflow = "initial"
|
||||
toJSON InheritOverflow = "inherit"
|
||||
toJSON DefaultOverflow = ""
|
||||
|
||||
data BoxStyleValue = SuccessBox
|
||||
| InfoBox
|
||||
| WarningBox
|
||||
|
||||
@ -0,0 +1,5 @@
|
||||
module IHaskell.Display.Widgets.Layout (module X) where
|
||||
|
||||
import IHaskell.Display.Widgets.Layout.Common as X
|
||||
import IHaskell.Display.Widgets.Layout.Types as X
|
||||
import IHaskell.Display.Widgets.Layout.LayoutWidget as X
|
||||
@ -0,0 +1,79 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE AutoDeriveTypeable #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
|
||||
-- There are lots of pattern synpnyms, and little would be gained by adding
|
||||
-- the type signatures.
|
||||
{-# OPTIONS_GHC -fno-warn-missing-pattern-synonym-signatures #-}
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
|
||||
module IHaskell.Display.Widgets.Layout.Common where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types (emptyObject)
|
||||
import Data.HashMap.Strict as HM
|
||||
import Data.Text (pack, Text)
|
||||
import Data.Typeable (Typeable)
|
||||
|
||||
import IHaskell.Display (IHaskellWidget)
|
||||
import IHaskell.Eval.Widgets (widgetSendClose)
|
||||
|
||||
import qualified IHaskell.Display.Widgets.Singletons as S
|
||||
|
||||
pattern AlignContent = S.SLAlignContent
|
||||
pattern AlignItems = S.SLAlignItems
|
||||
pattern AlignSelf = S.SLAlignSelf
|
||||
pattern Border = S.SLBorder
|
||||
pattern Bottom = S.SLBottom
|
||||
pattern Display = S.SLDisplay
|
||||
pattern Flex = S.SLFlex
|
||||
pattern FlexFlow = S.SLFlexFlow
|
||||
pattern GridArea = S.SLGridArea
|
||||
pattern GridAutoColumns = S.SLGridAutoColumns
|
||||
pattern GridAutoFlow = S.SLGridAutoFlow
|
||||
pattern GridAutoRows = S.SLGridAutoRows
|
||||
pattern GridColumn = S.SLGridColumn
|
||||
pattern GridGap = S.SLGridGap
|
||||
pattern GridRow = S.SLGridRow
|
||||
pattern GridTemplateAreas = S.SLGridTemplateAreas
|
||||
pattern GridTemplateColumns = S.SLGridTemplateColumns
|
||||
pattern GridTemplateRows = S.SLGridTemplateRows
|
||||
pattern Height = S.SLHeight
|
||||
pattern JustifyContent = S.SLJustifyContent
|
||||
pattern JustifyItems = S.SLJustifyItems
|
||||
pattern Left = S.SLLeft
|
||||
pattern Margin = S.SLMargin
|
||||
pattern MaxHeight = S.SLMaxHeight
|
||||
pattern MaxWidth = S.SLMaxWidth
|
||||
pattern MinHeight = S.SLMinHeight
|
||||
pattern MinWidth = S.SLMinWidth
|
||||
pattern Order = S.SLOrder
|
||||
pattern Overflow = S.SLOverflow
|
||||
pattern OverflowX = S.SLOverflowX
|
||||
pattern OverflowY = S.SLOverflowY
|
||||
pattern Padding = S.SLPadding
|
||||
pattern Right = S.SLRight
|
||||
pattern Top = S.SLTop
|
||||
pattern Visibility = S.SLVisibility
|
||||
pattern Width = S.SLWidth
|
||||
|
||||
-- TODO: This should be implemented with static type checking, so it's
|
||||
-- easier to verify at compile-time. "The Haskell Way".
|
||||
-- But a lot of these fields have common values. ¿Maybe doing some kind
|
||||
-- of singleton for the CSS fields? ¿Maybe appending the type like
|
||||
-- InheritOverflow / InheritVisible / InheritGrid...
|
||||
-- In the meantime we'll use arrays of strings and some runtime verification
|
||||
cssProps :: [String]
|
||||
cssProps = ["inherit", "initial", "unset"]
|
||||
alignContentProps = ["flex-start", "flex-end", "center", "space-between", "space-around", "space-evenly", "stretch"] ++ cssProps
|
||||
alignItemProps = ["flex-start", "flex-end", "center", "baseline", "stretch"] ++ cssProps
|
||||
alignSelfProps = ["auto", "flex-start", "flex-end", "center", "baseline", "stretch"] ++ cssProps
|
||||
gridAutoFlowProps = ["column", "row", "row dense", "column dense"] ++ cssProps
|
||||
justifyContentProps = ["flex-start", "flex-end", "center", "space-between", "space-around"] ++ cssProps
|
||||
justifyItemsProps = ["flex-start", "flex-end", "center"] ++ cssProps
|
||||
overflowProps = ["visible", "hidden", "scroll", "auto"] ++ cssProps
|
||||
visibilityProps = ["visible", "hidden"] ++ cssProps
|
||||
@ -0,0 +1,54 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module IHaskell.Display.Widgets.Layout.LayoutWidget
|
||||
( -- * The Layout Widget
|
||||
Layout
|
||||
-- * Create a new Layout
|
||||
, mkLayout
|
||||
) where
|
||||
|
||||
-- To keep `cabal repl` happy when running from the ihaskell repo
|
||||
import Prelude
|
||||
|
||||
import Control.Monad (void)
|
||||
|
||||
import Data.Aeson
|
||||
import Data.IORef (newIORef)
|
||||
import Data.Vinyl (Rec(..), (<+>))
|
||||
|
||||
import IHaskell.Display
|
||||
import IHaskell.Eval.Widgets
|
||||
import IHaskell.IPython.Message.UUID as U
|
||||
|
||||
import IHaskell.Display.Widgets.Types
|
||||
import IHaskell.Display.Widgets.Layout.Types
|
||||
import IHaskell.Display.Widgets.Layout.Common
|
||||
|
||||
-- | A 'Layout' represents a Layout from IPython.html.widgets.
|
||||
type Layout = IPythonWidget 'LayoutType
|
||||
|
||||
-- | Create a new Layout
|
||||
mkLayout :: IO Layout
|
||||
mkLayout = do
|
||||
-- Default properties, with a random uuid
|
||||
wid <- U.random
|
||||
|
||||
let layoutState = WidgetState defaultLayoutWidget
|
||||
|
||||
stateIO <- newIORef layoutState
|
||||
|
||||
let layout = IPythonWidget wid stateIO
|
||||
|
||||
-- Open a comm for this widget, and store it in the kernel state
|
||||
widgetSendOpen layout $ toJSON layoutState
|
||||
|
||||
-- Return the Layout widget
|
||||
return layout
|
||||
|
||||
instance IHaskellWidget Layout where
|
||||
getCommUUID = uuid
|
||||
@ -0,0 +1,299 @@
|
||||
{-# 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 #-}
|
||||
|
||||
module IHaskell.Display.Widgets.Layout.Types where
|
||||
|
||||
import Prelude hiding (Right,Left)
|
||||
|
||||
import Control.Monad (unless)
|
||||
import qualified Control.Exception as Ex
|
||||
|
||||
import Data.Aeson hiding (pairs)
|
||||
import Data.List (intercalate)
|
||||
import Data.Typeable (Typeable, TypeRep, typeOf)
|
||||
|
||||
#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.Lens (rget, rput, type (∈))
|
||||
|
||||
#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 qualified IHaskell.Display.Widgets.Singletons as S
|
||||
import IHaskell.Display.Widgets.Types
|
||||
|
||||
import IHaskell.Display.Widgets.Layout.Common
|
||||
|
||||
type LayoutClass = [ 'S.ModelModule
|
||||
, 'S.ModelModuleVersion
|
||||
, 'S.ModelName
|
||||
, 'S.ViewModule
|
||||
, 'S.ViewModuleVersion
|
||||
, 'S.ViewName
|
||||
, 'S.LAlignContent
|
||||
, 'S.LAlignItems
|
||||
, 'S.LAlignSelf
|
||||
, 'S.LBorder
|
||||
, 'S.LBottom
|
||||
, 'S.LDisplay
|
||||
, 'S.LFlex
|
||||
, 'S.LFlexFlow
|
||||
, 'S.LGridArea
|
||||
, 'S.LGridAutoColumns
|
||||
, 'S.LGridAutoFlow
|
||||
, 'S.LGridAutoRows
|
||||
, 'S.LGridColumn
|
||||
, 'S.LGridGap
|
||||
, 'S.LGridRow
|
||||
, 'S.LGridTemplateAreas
|
||||
, 'S.LGridTemplateColumns
|
||||
, 'S.LGridTemplateRows
|
||||
, 'S.LHeight
|
||||
, 'S.LJustifyContent
|
||||
, 'S.LJustifyItems
|
||||
, 'S.LLeft
|
||||
, 'S.LMargin
|
||||
, 'S.LMaxHeight
|
||||
, 'S.LMaxWidth
|
||||
, 'S.LMinHeight
|
||||
, 'S.LMinWidth
|
||||
, 'S.LOrder
|
||||
, 'S.LOverflow
|
||||
, 'S.LOverflowX
|
||||
, 'S.LOverflowY
|
||||
, 'S.LPadding
|
||||
, 'S.LRight
|
||||
, 'S.LTop
|
||||
, 'S.LVisibility
|
||||
, 'S.LWidth
|
||||
]
|
||||
|
||||
type instance FieldType 'S.LAlignContent = Maybe String
|
||||
type instance FieldType 'S.LAlignItems = Maybe String
|
||||
type instance FieldType 'S.LAlignSelf = Maybe String
|
||||
type instance FieldType 'S.LBorder = Maybe String
|
||||
type instance FieldType 'S.LBottom = Maybe String
|
||||
type instance FieldType 'S.LDisplay = Maybe String
|
||||
type instance FieldType 'S.LFlex = Maybe String
|
||||
type instance FieldType 'S.LFlexFlow = Maybe String
|
||||
type instance FieldType 'S.LGridArea = Maybe String
|
||||
type instance FieldType 'S.LGridAutoColumns = Maybe String
|
||||
type instance FieldType 'S.LGridAutoFlow = Maybe String
|
||||
type instance FieldType 'S.LGridAutoRows = Maybe String
|
||||
type instance FieldType 'S.LGridColumn = Maybe String
|
||||
type instance FieldType 'S.LGridGap = Maybe String
|
||||
type instance FieldType 'S.LGridRow = Maybe String
|
||||
type instance FieldType 'S.LGridTemplateAreas = Maybe String
|
||||
type instance FieldType 'S.LGridTemplateColumns = Maybe String
|
||||
type instance FieldType 'S.LGridTemplateRows = Maybe String
|
||||
type instance FieldType 'S.LHeight = Maybe String
|
||||
type instance FieldType 'S.LJustifyContent = Maybe String
|
||||
type instance FieldType 'S.LJustifyItems = Maybe String
|
||||
type instance FieldType 'S.LLeft = Maybe String
|
||||
type instance FieldType 'S.LMargin = Maybe String
|
||||
type instance FieldType 'S.LMaxHeight = Maybe String
|
||||
type instance FieldType 'S.LMaxWidth = Maybe String
|
||||
type instance FieldType 'S.LMinHeight = Maybe String
|
||||
type instance FieldType 'S.LMinWidth = Maybe String
|
||||
type instance FieldType 'S.LOrder = Maybe String
|
||||
type instance FieldType 'S.LOverflow = Maybe String
|
||||
type instance FieldType 'S.LOverflowX = Maybe String
|
||||
type instance FieldType 'S.LOverflowY = Maybe String
|
||||
type instance FieldType 'S.LPadding = Maybe String
|
||||
type instance FieldType 'S.LRight = Maybe String
|
||||
type instance FieldType 'S.LTop = Maybe String
|
||||
type instance FieldType 'S.LVisibility = Maybe String
|
||||
type instance FieldType 'S.LWidth = Maybe String
|
||||
|
||||
-- type family WidgetFields (w :: WidgetType) :: [Field] where
|
||||
type instance WidgetFields 'LayoutType = LayoutClass
|
||||
|
||||
instance ToPairs (Attr 'S.LAlignContent) where
|
||||
toPairs x = ["align_content" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LAlignItems) where
|
||||
toPairs x = ["align_items" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LAlignSelf) where
|
||||
toPairs x = ["align_self" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LBorder) where
|
||||
toPairs x = ["border" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LBottom) where
|
||||
toPairs x = ["bottom" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LDisplay) where
|
||||
toPairs x = ["display" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LFlex) where
|
||||
toPairs x = ["flex" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LFlexFlow) where
|
||||
toPairs x = ["flex_flow" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LGridArea) where
|
||||
toPairs x = ["grid_area" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LGridAutoColumns) where
|
||||
toPairs x = ["grid_auto_columns" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LGridAutoFlow) where
|
||||
toPairs x = ["grid_auto_flow" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LGridAutoRows) where
|
||||
toPairs x = ["grid_auto_rows" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LGridColumn) where
|
||||
toPairs x = ["grid_column" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LGridGap) where
|
||||
toPairs x = ["grid_gap" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LGridRow) where
|
||||
toPairs x = ["grid_row" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LGridTemplateAreas) where
|
||||
toPairs x = ["grid_template_areas" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LGridTemplateColumns) where
|
||||
toPairs x = ["grid_template_columns" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LGridTemplateRows) where
|
||||
toPairs x = ["grid_template_rows" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LHeight) where
|
||||
toPairs x = ["height" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LJustifyContent) where
|
||||
toPairs x = ["justify_content" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LJustifyItems) where
|
||||
toPairs x = ["justify_items" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LLeft) where
|
||||
toPairs x = ["left" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LMargin) where
|
||||
toPairs x = ["margin" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LMaxHeight) where
|
||||
toPairs x = ["max_height" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LMaxWidth) where
|
||||
toPairs x = ["max_width" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LMinHeight) where
|
||||
toPairs x = ["min_height" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LMinWidth) where
|
||||
toPairs x = ["min_width" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LOrder) where
|
||||
toPairs x = ["order" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LOverflow) where
|
||||
toPairs x = ["overflow" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LOverflowX) where
|
||||
toPairs x = ["overflow_x" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LOverflowY) where
|
||||
toPairs x = ["overflow_y" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LPadding) where
|
||||
toPairs x = ["padding" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LRight) where
|
||||
toPairs x = ["right" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LTop) where
|
||||
toPairs x = ["top" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LVisibility) where
|
||||
toPairs x = ["visibility" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.LWidth) where
|
||||
toPairs x = ["width" .= toJSON x]
|
||||
|
||||
-- | A record representing a widget of the Layour class from IPython
|
||||
defaultLayoutWidget :: Rec Attr LayoutClass
|
||||
defaultLayoutWidget = (S.SModelModule =:! "@jupyter-widgets/base")
|
||||
:& (S.SModelModuleVersion =:! "1.1.0")
|
||||
:& (S.SModelName =:! "LayoutModel")
|
||||
:& (S.SViewModule =:! "@jupyter-widgets/base")
|
||||
:& (S.SViewModuleVersion =:! "1.1.0")
|
||||
:& (S.SViewName =:! "LayoutView")
|
||||
:& (AlignContent =:. (Nothing, venum alignContentProps))
|
||||
:& (AlignItems =:. (Nothing, venum alignItemProps))
|
||||
:& (AlignSelf =:. (Nothing, venum alignSelfProps))
|
||||
:& (Border =:: Nothing)
|
||||
:& (Bottom =:: Nothing)
|
||||
:& (Display =:: Nothing)
|
||||
:& (Flex =:: Nothing)
|
||||
:& (FlexFlow =:: Nothing)
|
||||
:& (GridArea =:: Nothing)
|
||||
:& (GridAutoColumns =:: Nothing)
|
||||
:& (GridAutoFlow =:. (Nothing, venum gridAutoFlowProps))
|
||||
:& (GridAutoRows =:: Nothing)
|
||||
:& (GridColumn =:: Nothing)
|
||||
:& (GridGap =:: Nothing)
|
||||
:& (GridRow =:: Nothing)
|
||||
:& (GridTemplateAreas =:: Nothing)
|
||||
:& (GridTemplateColumns =:: Nothing)
|
||||
:& (GridTemplateRows =:: Nothing)
|
||||
:& (Height =:: Nothing)
|
||||
:& (JustifyContent =:: Nothing)
|
||||
:& (JustifyItems =:: Nothing)
|
||||
:& (Left =:: Nothing)
|
||||
:& (Margin =:: Nothing)
|
||||
:& (MaxHeight =:: Nothing)
|
||||
:& (MaxWidth =:: Nothing)
|
||||
:& (MinHeight =:: Nothing)
|
||||
:& (MinWidth =:: Nothing)
|
||||
:& (Order =:: Nothing)
|
||||
:& (Overflow =:. (Nothing, venum overflowProps))
|
||||
:& (OverflowX =:. (Nothing, venum overflowProps))
|
||||
:& (OverflowY =:. (Nothing, venum overflowProps))
|
||||
:& (Padding =:: Nothing)
|
||||
:& (Right =:: Nothing)
|
||||
:& (Top =:: Nothing)
|
||||
:& (Visibility =:. (Nothing, venum visibilityProps))
|
||||
:& (Width =:: Nothing)
|
||||
:& RNil
|
||||
where venum :: [String] -> Maybe String -> IO (Maybe String)
|
||||
venum _ Nothing = return Nothing
|
||||
venum xs (Just f) = do
|
||||
unless (f `elem` xs) (Ex.throw $ Ex.AssertionFailed ("The value should be one of: " ++ intercalate ", " xs))
|
||||
return $ Just f
|
||||
@ -18,6 +18,8 @@
|
||||
|
||||
module IHaskell.Display.Widgets.Singletons where
|
||||
|
||||
import Data.Kind
|
||||
|
||||
#if MIN_VERSION_singletons(3,0,0)
|
||||
import Data.Singletons.Base.TH
|
||||
#elif MIN_VERSION_singletons(2,4,0)
|
||||
@ -39,6 +41,7 @@ singletons
|
||||
| ModelName
|
||||
| DisplayHandler
|
||||
| DOMClasses
|
||||
| Layout
|
||||
| Width
|
||||
| Height
|
||||
| Description
|
||||
@ -81,10 +84,7 @@ singletons
|
||||
| BarStyle
|
||||
| ChangeHandler
|
||||
| Children
|
||||
| OverflowX
|
||||
| OverflowY
|
||||
| BoxStyle
|
||||
| Flex
|
||||
| Pack
|
||||
| Align
|
||||
| Titles
|
||||
@ -116,5 +116,44 @@ singletons
|
||||
| Timestamp
|
||||
| Buttons
|
||||
| Axes
|
||||
-- Now the ones for layout
|
||||
-- Every layout property comes with an L before the name to avoid conflict
|
||||
-- The patterns from Layout.Common remove that leading L
|
||||
| LAlignContent
|
||||
| LAlignItems
|
||||
| LAlignSelf
|
||||
| LBorder
|
||||
| LBottom
|
||||
| LDisplay
|
||||
| LFlex
|
||||
| LFlexFlow
|
||||
| LGridArea
|
||||
| LGridAutoColumns
|
||||
| LGridAutoFlow
|
||||
| LGridAutoRows
|
||||
| LGridColumn
|
||||
| LGridGap
|
||||
| LGridRow
|
||||
| LGridTemplateAreas
|
||||
| LGridTemplateColumns
|
||||
| LGridTemplateRows
|
||||
| LHeight
|
||||
| LJustifyContent
|
||||
| LJustifyItems
|
||||
| LLeft
|
||||
| LMargin
|
||||
| LMaxHeight
|
||||
| LMaxWidth
|
||||
| LMinHeight
|
||||
| LMinWidth
|
||||
| LOrder
|
||||
| LOverflow
|
||||
| LOverflowX
|
||||
| LOverflowY
|
||||
| LPadding
|
||||
| LRight
|
||||
| LTop
|
||||
| LVisibility
|
||||
| LWidth
|
||||
deriving (Eq, Ord, Show)
|
||||
|]
|
||||
|
||||
@ -127,7 +127,7 @@ type (a :++ b) = a ++ b
|
||||
-- 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.Tabbable, 'S.Tooltip, 'S.DisplayHandler] -- TODO: Add layout
|
||||
type DOMWidgetClass = ['S.ModelName, 'S.ViewName, 'S.DOMClasses, 'S.Tabbable, 'S.Tooltip, 'S.Layout, 'S.DisplayHandler]
|
||||
|
||||
type DescriptionWidgetClass = CoreWidgetClass :++ DOMWidgetClass :++ '[ 'S.Description ]
|
||||
|
||||
@ -168,93 +168,91 @@ type SelectionContainerClass = BoxClass :++ ['S.Titles, 'S.SelectedIndex, 'S.Cha
|
||||
type MediaClass = CoreWidgetClass :++ DOMWidgetClass :++ '[ 'S.BSValue ]
|
||||
|
||||
-- Types associated with Fields.
|
||||
type family FieldType (f :: Field) :: *
|
||||
|
||||
type family FieldType (f :: Field) :: * where
|
||||
FieldType 'S.ViewModule = Text
|
||||
FieldType 'S.ViewModuleVersion = Text
|
||||
FieldType 'S.ViewName = Text
|
||||
FieldType 'S.ModelModule = Text
|
||||
FieldType 'S.ModelModuleVersion = Text
|
||||
FieldType 'S.ModelName = Text
|
||||
FieldType 'S.DisplayHandler = IO ()
|
||||
FieldType 'S.DOMClasses = [Text]
|
||||
FieldType 'S.Width = PixCount
|
||||
FieldType 'S.Height = PixCount
|
||||
FieldType 'S.Description = Text
|
||||
FieldType 'S.ClickHandler = IO ()
|
||||
FieldType 'S.SubmitHandler = IO ()
|
||||
FieldType 'S.Disabled = Bool
|
||||
FieldType 'S.StringValue = Text
|
||||
FieldType 'S.Placeholder = Text
|
||||
FieldType 'S.Tooltip = Maybe Text
|
||||
FieldType 'S.Icon = Text
|
||||
FieldType 'S.ButtonStyle = ButtonStyleValue
|
||||
FieldType 'S.BSValue = ByteString
|
||||
FieldType 'S.ImageFormat = ImageFormatValue
|
||||
FieldType 'S.BoolValue = Bool
|
||||
FieldType 'S.OptionsLabels = [Text]
|
||||
FieldType 'S.Index = Integer
|
||||
FieldType 'S.OptionalIndex = Maybe Integer
|
||||
FieldType 'S.SelectionHandler = IO ()
|
||||
FieldType 'S.Tooltips = [Text]
|
||||
FieldType 'S.Icons = [Text]
|
||||
FieldType 'S.Indices = [Integer]
|
||||
FieldType 'S.IntValue = Integer
|
||||
FieldType 'S.StepInt = Maybe Integer
|
||||
FieldType 'S.MinInt = Integer
|
||||
FieldType 'S.MaxInt = Integer
|
||||
FieldType 'S.LowerInt = Integer
|
||||
FieldType 'S.UpperInt = Integer
|
||||
FieldType 'S.IntPairValue = (Integer, Integer)
|
||||
FieldType 'S.Orientation = OrientationValue
|
||||
FieldType 'S.BaseFloat = Double
|
||||
FieldType 'S.ReadOut = Bool
|
||||
FieldType 'S.ReadOutFormat = Text
|
||||
FieldType 'S.BarStyle = BarStyleValue
|
||||
FieldType 'S.FloatValue = Double
|
||||
FieldType 'S.StepFloat = Maybe Double
|
||||
FieldType 'S.MinFloat = Double
|
||||
FieldType 'S.MaxFloat = Double
|
||||
FieldType 'S.LowerFloat = Double
|
||||
FieldType 'S.UpperFloat = Double
|
||||
FieldType 'S.FloatPairValue = (Double, Double)
|
||||
FieldType 'S.ChangeHandler = IO ()
|
||||
FieldType 'S.Children = [ChildWidget]
|
||||
FieldType 'S.OverflowX = OverflowValue
|
||||
FieldType 'S.OverflowY = OverflowValue
|
||||
FieldType 'S.BoxStyle = BoxStyleValue
|
||||
FieldType 'S.Flex = Int
|
||||
FieldType 'S.Pack = LocationValue
|
||||
FieldType 'S.Align = LocationValue
|
||||
FieldType 'S.Titles = [Text]
|
||||
FieldType 'S.SelectedIndex = Maybe Integer
|
||||
FieldType 'S.ReadOutMsg = Text
|
||||
FieldType 'S.Indent = Bool
|
||||
FieldType 'S.Child = Maybe ChildWidget
|
||||
FieldType 'S.Selector = Text
|
||||
FieldType 'S.ContinuousUpdate = Bool
|
||||
FieldType 'S.Tabbable = Maybe Bool
|
||||
FieldType 'S.Rows = Maybe Integer
|
||||
FieldType 'S.AudioFormat = AudioFormatValue
|
||||
FieldType 'S.VideoFormat = VideoFormatValue
|
||||
FieldType 'S.AutoPlay = Bool
|
||||
FieldType 'S.Loop = Bool
|
||||
FieldType 'S.Controls = Bool
|
||||
FieldType 'S.Options = [Text]
|
||||
FieldType 'S.EnsureOption = Bool
|
||||
FieldType 'S.Playing = Bool
|
||||
FieldType 'S.Repeat = Bool
|
||||
FieldType 'S.Interval = Integer
|
||||
FieldType 'S.ShowRepeat = Bool
|
||||
FieldType 'S.Concise = Bool
|
||||
FieldType 'S.DateValue = Date
|
||||
FieldType 'S.Pressed = Bool
|
||||
FieldType 'S.Name = Text
|
||||
FieldType 'S.Mapping = Text
|
||||
FieldType 'S.Connected = Bool
|
||||
FieldType 'S.Timestamp = Double
|
||||
FieldType 'S.Buttons = [IPythonWidget 'ControllerButtonType]
|
||||
FieldType 'S.Axes = [IPythonWidget 'ControllerAxisType]
|
||||
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 = Maybe (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 = ByteString
|
||||
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.Pack = LocationValue
|
||||
type instance FieldType 'S.Align = LocationValue
|
||||
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.Child = Maybe ChildWidget
|
||||
type instance FieldType 'S.Selector = Text
|
||||
type instance FieldType 'S.ContinuousUpdate = Bool
|
||||
type instance FieldType 'S.Tabbable = Maybe 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]
|
||||
|
||||
-- | 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)
|
||||
@ -331,91 +329,92 @@ data WidgetType = ButtonType
|
||||
| ControllerButtonType
|
||||
| ControllerAxisType
|
||||
| ControllerType
|
||||
| LayoutType
|
||||
|
||||
-- Fields associated with a widget
|
||||
|
||||
type family WidgetFields (w :: WidgetType) :: [Field] where
|
||||
WidgetFields 'ButtonType =
|
||||
DescriptionWidgetClass :++
|
||||
['S.Disabled, 'S.Icon, 'S.ButtonStyle ,'S.ClickHandler]
|
||||
WidgetFields 'ColorPickerType =
|
||||
DescriptionWidgetClass :++
|
||||
['S.StringValue, 'S.Concise, 'S.Disabled]
|
||||
WidgetFields 'DatePickerType =
|
||||
DescriptionWidgetClass :++
|
||||
['S.DateValue, 'S.Disabled]
|
||||
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]
|
||||
type instance WidgetFields 'DatePickerType =
|
||||
DescriptionWidgetClass :++
|
||||
['S.DateValue, 'S.Disabled]
|
||||
|
||||
WidgetFields 'AudioType =
|
||||
MediaClass :++ ['S.AudioFormat, 'S.AutoPlay, 'S.Loop, 'S.Controls]
|
||||
WidgetFields 'ImageType =
|
||||
MediaClass :++ ['S.ImageFormat, 'S.Width, 'S.Height]
|
||||
WidgetFields 'VideoType =
|
||||
MediaClass :++ ['S.VideoFormat, 'S.Width, 'S.Height, 'S.AutoPlay, 'S.Loop, 'S.Controls]
|
||||
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]
|
||||
|
||||
WidgetFields 'OutputType = DOMWidgetClass
|
||||
WidgetFields 'HTMLType = StringClass
|
||||
WidgetFields 'HTMLMathType = StringClass
|
||||
WidgetFields 'ComboboxType = TextClass :++ [ 'S.Options, 'S.EnsureOption ]
|
||||
WidgetFields 'LabelType = StringClass
|
||||
WidgetFields 'PasswordType = TextClass
|
||||
WidgetFields 'TextType = TextClass
|
||||
type instance WidgetFields 'OutputType = DOMWidgetClass
|
||||
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
|
||||
WidgetFields 'TextAreaType =
|
||||
StringClass :++
|
||||
[ 'S.Rows, 'S.Disabled, 'S.ContinuousUpdate, 'S.ChangeHandler]
|
||||
-- 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]
|
||||
|
||||
WidgetFields 'CheckBoxType = BoolClass :++ '[ 'S.Indent ]
|
||||
WidgetFields 'ToggleButtonType = BoolClass :++ ['S.Icon, 'S.ButtonStyle]
|
||||
WidgetFields 'ValidType = BoolClass :++ '[ 'S.ReadOutMsg ]
|
||||
WidgetFields 'DropdownType = SelectionClass
|
||||
WidgetFields 'RadioButtonsType = SelectionClass
|
||||
WidgetFields 'SelectType = SelectionClass :++ '[ 'S.Rows ]
|
||||
WidgetFields 'SelectionSliderType = SelectionNonemptyClass :++ '[ 'S.Orientation, 'S.ReadOut, 'S.ContinuousUpdate ]
|
||||
WidgetFields 'SelectionRangeSliderType = MultipleSelectionClass :++ '[ 'S.Orientation, 'S.ReadOut, 'S.ContinuousUpdate ]
|
||||
WidgetFields 'ToggleButtonsType =
|
||||
SelectionClass :++ ['S.Tooltips, 'S.Icons, 'S.ButtonStyle]
|
||||
WidgetFields 'SelectMultipleType = MultipleSelectionClass :++ '[ 'S.Rows ]
|
||||
WidgetFields 'IntTextType = IntClass :++ [ 'S.Disabled, 'S.ContinuousUpdate, 'S.StepInt ]
|
||||
WidgetFields 'BoundedIntTextType = BoundedIntClass :++ [ 'S.Disabled, 'S.ContinuousUpdate, 'S.StepInt ]
|
||||
WidgetFields 'IntSliderType =
|
||||
BoundedIntClass :++
|
||||
[ 'S.StepInt, 'S.Orientation, 'S.ReadOut, 'S.ReadOutFormat, 'S.ContinuousUpdate, 'S.Disabled ]
|
||||
WidgetFields 'PlayType =
|
||||
BoundedIntClass :++
|
||||
[ 'S.Playing, 'S.Repeat, 'S.Interval, 'S.StepInt, 'S.Disabled, 'S.ShowRepeat ]
|
||||
WidgetFields 'IntProgressType =
|
||||
BoundedIntClass :++ ['S.Orientation, 'S.BarStyle]
|
||||
WidgetFields 'IntRangeSliderType =
|
||||
BoundedIntRangeClass :++
|
||||
['S.StepInt, 'S.Orientation, 'S.ReadOut, 'S.ReadOutFormat, 'S.ContinuousUpdate, 'S.Disabled ]
|
||||
WidgetFields 'FloatTextType = FloatClass :++ '[ 'S.Disabled, 'S.ContinuousUpdate, 'S.StepFloat ]
|
||||
WidgetFields 'BoundedFloatTextType = BoundedFloatClass :++ '[ 'S.Disabled, 'S.ContinuousUpdate, 'S.StepFloat ]
|
||||
WidgetFields 'FloatSliderType =
|
||||
BoundedFloatClass :++
|
||||
['S.StepFloat, 'S.Orientation, 'S.ReadOut, 'S.ReadOutFormat, 'S.ContinuousUpdate, 'S.Disabled ]
|
||||
WidgetFields 'FloatLogSliderType =
|
||||
BoundedLogFloatClass :++
|
||||
['S.StepFloat, 'S.Orientation, 'S.ReadOut, 'S.ReadOutFormat, 'S.ContinuousUpdate, 'S.Disabled, 'S.BaseFloat]
|
||||
WidgetFields 'FloatProgressType =
|
||||
BoundedFloatClass :++ ['S.Orientation, 'S.BarStyle]
|
||||
WidgetFields 'FloatRangeSliderType =
|
||||
BoundedFloatRangeClass :++
|
||||
['S.StepFloat, 'S.Orientation, 'S.ReadOut, 'S.ReadOutFormat, 'S.ContinuousUpdate, 'S.Disabled ]
|
||||
WidgetFields 'BoxType = BoxClass
|
||||
WidgetFields 'GridBoxType = BoxClass
|
||||
WidgetFields 'HBoxType = BoxClass
|
||||
WidgetFields 'VBoxType = BoxClass
|
||||
WidgetFields 'AccordionType = SelectionContainerClass
|
||||
WidgetFields 'TabType = SelectionContainerClass
|
||||
WidgetFields 'StackedType = SelectionContainerClass
|
||||
WidgetFields 'ControllerType =
|
||||
CoreWidgetClass :++ DOMWidgetClass :++
|
||||
['S.Index, 'S.Name, 'S.Mapping, 'S.Connected, 'S.Timestamp, 'S.Buttons, 'S.Axes, 'S.ChangeHandler ]
|
||||
WidgetFields 'ControllerAxisType = CoreWidgetClass :++ DOMWidgetClass :++ '[ 'S.FloatValue, 'S.ChangeHandler ]
|
||||
WidgetFields 'ControllerButtonType = CoreWidgetClass :++ DOMWidgetClass :++ [ 'S.FloatValue, 'S.Pressed, '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 ]
|
||||
|
||||
-- Wrapper around a field's value. A dummy value is sent as an empty string to the frontend.
|
||||
data AttrVal a = Dummy a
|
||||
@ -607,18 +606,9 @@ instance ToPairs (Attr 'S.ChangeHandler) where
|
||||
instance ToPairs (Attr 'S.Children) where
|
||||
toPairs x = ["children" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.OverflowX) where
|
||||
toPairs x = ["overflow_x" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.OverflowY) where
|
||||
toPairs x = ["overflow_y" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.BoxStyle) where
|
||||
toPairs x = ["box_style" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.Flex) where
|
||||
toPairs x = ["flex" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.Pack) where
|
||||
toPairs x = ["pack" .= toJSON x]
|
||||
|
||||
@ -706,6 +696,9 @@ instance ToPairs (Attr 'S.Buttons) where
|
||||
instance ToPairs (Attr 'S.Axes) where
|
||||
toPairs x = ["axes" .= toJSON x]
|
||||
|
||||
instance ToPairs (Attr 'S.Layout) where
|
||||
toPairs x = ["layout" .= toJSON x]
|
||||
|
||||
-- | 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
|
||||
@ -758,19 +751,20 @@ reflect = fromSing
|
||||
|
||||
-- | A record representing a Widget class from IPython from the controls modules
|
||||
defaultCoreWidget :: Rec Attr CoreWidgetClass
|
||||
defaultCoreWidget = (ViewModule =:: "@jupyter-widgets/controls")
|
||||
:& (ViewModuleVersion =:: "1.4.0")
|
||||
:& (ModelModule =:: "@jupyter-widgets/controls")
|
||||
:& (ModelModuleVersion =:: "1.4.0")
|
||||
defaultCoreWidget = (ViewModule =:! "@jupyter-widgets/controls")
|
||||
:& (ViewModuleVersion =:! "1.4.0")
|
||||
:& (ModelModule =:! "@jupyter-widgets/controls")
|
||||
:& (ModelModuleVersion =:! "1.4.0")
|
||||
:& RNil
|
||||
|
||||
-- | A record representing an object of the DOMWidget class from IPython
|
||||
defaultDOMWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr DOMWidgetClass
|
||||
defaultDOMWidget viewName modelName = (ModelName =:: modelName)
|
||||
:& (ViewName =:: viewName)
|
||||
defaultDOMWidget viewName modelName = (ModelName =:! modelName)
|
||||
:& (ViewName =:! viewName)
|
||||
:& (DOMClasses =:: [])
|
||||
:& (Tabbable =:: Nothing)
|
||||
:& (Tooltip =:: Nothing)
|
||||
:& (Layout =:: Nothing)
|
||||
:& (DisplayHandler =:: return ())
|
||||
:& RNil
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user