Skip to content

G
gargantext-ihaskell
Commit 8c37c422 authored by Erik de Castro Lopo's avatar Erik de Castro Lopo
Browse files
Options

ihaskell-widgets: Turn on -Wall and fix all warnings

parent 64d54a7a
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 808 additions and 743 deletions
ihaskell-display/ihaskell-widgets/ihaskell-widgets.cabal
View file @ 8c37c422
......@@ -50,6 +50,11 @@ extra-source-files: README.md, MsgSpec.md
cabal-version: >=1.10
library
ghc-options: -Wall
if impl (ghc >= 8.4)
ghc-options: -Wpartial-fields
-- Modules exported by the library.
exposed-modules: IHaskell.Display.Widgets
IHaskell.Display.Widgets.Interactive
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Bool/CheckBox.hs
View file @ 8c37c422
......@@ -3,19 +3,21 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Bool.CheckBox (
-- * The CheckBox Widget
CheckBox,
-- * Constructor
mkCheckBox) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Bool.CheckBox
( -- * The CheckBox Widget
CheckBox
-- * Constructor
, mkCheckBox
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import Data.Text (Text)
import IHaskell.Display
import IHaskell.Eval.Widgets
......@@ -25,19 +27,19 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'CheckBox' represents a Checkbox widget from IPython.html.widgets.
type CheckBox = IPythonWidget CheckBoxType
type CheckBox = IPythonWidget 'CheckBoxType
-- | Create a new output widget
mkCheckBox :: IO CheckBox
mkCheckBox = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultBoolWidget "CheckboxView" "CheckboxModel"
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -52,10 +54,9 @@ instance IHaskellDisplay CheckBox where
instance IHaskellWidget CheckBox where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Bool value) = HM.lookup key2 dict2
setField' widget BoolValue value
triggerChange widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "value"] of
Just (Bool value) -> do
void $ setField' widget BoolValue value
triggerChange widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Bool/ToggleButton.hs
View file @ 8c37c422
......@@ -3,19 +3,21 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Bool.ToggleButton (
-- * The ToggleButton Widget
ToggleButton,
-- * Constructor
mkToggleButton) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Bool.ToggleButton
( -- * The ToggleButton Widget
ToggleButton
-- * Constructor
, mkToggleButton
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import Data.Text (Text)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display
......@@ -26,13 +28,13 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'ToggleButton' represents a ToggleButton widget from IPython.html.widgets.
type ToggleButton = IPythonWidget ToggleButtonType
type ToggleButton = IPythonWidget 'ToggleButtonType
-- | Create a new output widget
mkToggleButton :: IO ToggleButton
mkToggleButton = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let boolState = defaultBoolWidget "ToggleButtonView" "ToggleButtonModel"
toggleState = (Tooltip =:: "")
......@@ -43,7 +45,7 @@ mkToggleButton = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -58,10 +60,9 @@ instance IHaskellDisplay ToggleButton where
instance IHaskellWidget ToggleButton where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Bool value) = HM.lookup key2 dict2
setField' widget BoolValue value
triggerChange widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "value"] of
Just (Bool value) -> do
void $ setField' widget BoolValue value
triggerChange widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Bool/Valid.hs
View file @ 8c37c422
......@@ -3,11 +3,14 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Bool.Valid (
-- * The Valid Widget
ValidWidget,
-- * Constructor
mkValidWidget) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Bool.Valid
( -- * The Valid Widget
ValidWidget
-- * Constructor
, mkValidWidget
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
......@@ -24,13 +27,13 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'ValidWidget' represents a Valid widget from IPython.html.widgets.
type ValidWidget = IPythonWidget ValidType
type ValidWidget = IPythonWidget 'ValidType
-- | Create a new output widget
mkValidWidget :: IO ValidWidget
mkValidWidget = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let boolState = defaultBoolWidget "ValidView" "ValidModel"
validState = (ReadOutMsg =:: "") :& RNil
......@@ -38,7 +41,7 @@ mkValidWidget = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Box/Box.hs
View file @ 8c37c422
......@@ -3,11 +3,14 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Box.Box (
-- * The Box widget
Box,
-- * Constructor
mkBox) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Box.Box
( -- * The Box widget
Box
-- * Constructor
, mkBox
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
......@@ -22,19 +25,19 @@ import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Types
-- | A 'Box' represents a Box widget from IPython.html.widgets.
type Box = IPythonWidget BoxType
type Box = IPythonWidget 'BoxType
-- | Create a new box
mkBox :: IO Box
mkBox = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultBoxWidget "BoxView" "BoxModel"
stateIO <- newIORef widgetState
let box = IPythonWidget uuid stateIO
let box = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen box $ toJSON widgetState
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Box/SelectionContainer/Accordion.hs
View file @ 8c37c422
......@@ -3,20 +3,22 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Box.SelectionContainer.Accordion (
-- * The Accordion widget
Accordion,
-- * Constructor
mkAccordion) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Box.SelectionContainer.Accordion
( -- * The Accordion widget
Accordion
-- * Constructor
, mkAccordion
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
import IHaskell.Display
import IHaskell.Eval.Widgets
......@@ -26,19 +28,19 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'Accordion' represents a Accordion widget from IPython.html.widgets.
type Accordion = IPythonWidget AccordionType
type Accordion = IPythonWidget 'AccordionType
-- | Create a new box
mkAccordion :: IO Accordion
mkAccordion = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultSelectionContainerWidget "AccordionView" "AccordionModel"
stateIO <- newIORef widgetState
let box = IPythonWidget uuid stateIO
let box = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen box $ toJSON widgetState
......@@ -53,10 +55,9 @@ instance IHaskellDisplay Accordion where
instance IHaskellWidget Accordion where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "selected_index" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number num) = HM.lookup key2 dict2
setField' widget SelectedIndex (Sci.coefficient num)
triggerChange widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "selected_index"] of
Just (Number num) -> do
void $ setField' widget SelectedIndex (Sci.coefficient num)
triggerChange widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Box/SelectionContainer/Tab.hs
View file @ 8c37c422
......@@ -3,20 +3,21 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Box.SelectionContainer.Tab (
-- * The Tab widget
TabWidget,
-- * Constructor
mkTabWidget) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Box.SelectionContainer.Tab
( -- * The Tab widget
TabWidget
-- * Constructor
, mkTabWidget
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Data.Aeson
import Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
import IHaskell.Display
import IHaskell.Eval.Widgets
......@@ -26,19 +27,19 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'TabWidget' represents a Tab widget from IPython.html.widgets.
type TabWidget = IPythonWidget TabType
type TabWidget = IPythonWidget 'TabType
-- | Create a new box
mkTabWidget :: IO TabWidget
mkTabWidget = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultSelectionContainerWidget "TabView" "TabModel"
stateIO <- newIORef widgetState
let box = IPythonWidget uuid stateIO
let box = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen box $ toJSON widgetState
......@@ -53,10 +54,9 @@ instance IHaskellDisplay TabWidget where
instance IHaskellWidget TabWidget where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "selected_index" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number num) = HM.lookup key2 dict2
setField' widget SelectedIndex (Sci.coefficient num)
triggerChange widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "selected_index"] of
Just (Number num) -> do
_ <- setField' widget SelectedIndex (Sci.coefficient num)
triggerChange widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Button.hs
View file @ 8c37c422
......@@ -3,20 +3,20 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Button (
-- * The Button Widget
Button,
-- * Create a new button
mkButton) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Button
( -- * The Button Widget
Button
-- * Create a new button
, mkButton
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when)
import Data.Aeson
import Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import Data.Text (Text)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display
......@@ -27,13 +27,13 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'Button' represents a Button from IPython.html.widgets.
type Button = IPythonWidget ButtonType
type Button = IPythonWidget 'ButtonType
-- | Create a new button
mkButton :: IO Button
mkButton = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let dom = defaultDOMWidget "ButtonView" "ButtonModel"
but = (Description =:: "")
......@@ -47,7 +47,7 @@ mkButton = do
stateIO <- newIORef buttonState
let button = IPythonWidget uuid stateIO
let button = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen button $ toJSON buttonState
......@@ -62,9 +62,7 @@ instance IHaskellDisplay Button where
instance IHaskellWidget Button where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "content" :: Text
key2 = "event" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (String event) = HM.lookup key2 dict2
when (event == "click") $ triggerClick widget
comm widget val _ =
case nestedObjectLookup val ["content", "event"] of
Just (String "click") -> triggerClick widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Common.hs
View file @ 8c37c422
......@@ -7,10 +7,16 @@
{-# 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.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)
......@@ -268,3 +274,11 @@ instance ToJSON LocationValue where
toJSON EndLocation = "end"
toJSON BaselineLocation = "baseline"
toJSON StretchLocation = "stretch"
-- Could use 'lens-aeson' here but this is easier to read.
nestedObjectLookup :: Value -> [Text] -> Maybe Value
nestedObjectLookup val [] = Just val
nestedObjectLookup val (x:xs) =
case val of
Object o -> maybe Nothing (`nestedObjectLookup` xs) $ HM.lookup x o
_ -> Nothing
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloat/BoundedFloatText.hs
View file @ 8c37c422
......@@ -3,21 +3,22 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Float.BoundedFloat.BoundedFloatText (
-- * The BoundedFloatText
-- Widget
BoundedFloatText,
-- * Constructor
mkBoundedFloatText) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Float.BoundedFloat.BoundedFloatText
( -- * The BoundedFloatText Widget
BoundedFloatText
-- * Constructor
, mkBoundedFloatText
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
import IHaskell.Display
import IHaskell.Eval.Widgets
......@@ -27,19 +28,19 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | 'BoundedFloatText' represents an BoundedFloatText widget from IPython.html.widgets.
type BoundedFloatText = IPythonWidget BoundedFloatTextType
type BoundedFloatText = IPythonWidget 'BoundedFloatTextType
-- | Create a new widget
mkBoundedFloatText :: IO BoundedFloatText
mkBoundedFloatText = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultBoundedFloatWidget "FloatTextView" "FloatTextModel"
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -54,10 +55,9 @@ instance IHaskellDisplay BoundedFloatText where
instance IHaskellWidget BoundedFloatText where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2
setField' widget FloatValue (Sci.toRealFloat value)
triggerChange widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "value"] of
Just (Number value) -> do
void $ setField' widget FloatValue (Sci.toRealFloat value)
triggerChange widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatProgress.hs
View file @ 8c37c422
......@@ -3,11 +3,14 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Float.BoundedFloat.FloatProgress (
-- * The FloatProgress Widget
FloatProgress,
-- * Constructor
mkFloatProgress) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Float.BoundedFloat.FloatProgress
( -- * The FloatProgress Widget
FloatProgress
-- * Constructor
, mkFloatProgress
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
......@@ -24,13 +27,13 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | 'FloatProgress' represents an FloatProgress widget from IPython.html.widgets.
type FloatProgress = IPythonWidget FloatProgressType
type FloatProgress = IPythonWidget 'FloatProgressType
-- | Create a new widget
mkFloatProgress :: IO FloatProgress
mkFloatProgress = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let boundedFloatAttrs = defaultBoundedFloatWidget "ProgressView" "ProgressModel"
progressAttrs = (Orientation =:: HorizontalOrientation)
......@@ -40,7 +43,7 @@ mkFloatProgress = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatSlider.hs
View file @ 8c37c422
......@@ -3,20 +3,22 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider (
-- * The FloatSlider Widget
FloatSlider,
-- * Constructor
mkFloatSlider) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider
( -- * The FloatSlider Widget
FloatSlider
-- * Constructor
, mkFloatSlider
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display
......@@ -27,13 +29,13 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | 'FloatSlider' represents an FloatSlider widget from IPython.html.widgets.
type FloatSlider = IPythonWidget FloatSliderType
type FloatSlider = IPythonWidget 'FloatSliderType
-- | Create a new widget
mkFloatSlider :: IO FloatSlider
mkFloatSlider = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let boundedFloatAttrs = defaultBoundedFloatWidget "FloatSliderView" "FloatSliderModel"
sliderAttrs = (Orientation =:: HorizontalOrientation)
......@@ -45,7 +47,7 @@ mkFloatSlider = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -60,10 +62,9 @@ instance IHaskellDisplay FloatSlider where
instance IHaskellWidget FloatSlider where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2
setField' widget FloatValue (Sci.toRealFloat value)
triggerChange widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "value"] of
Just (Number value) -> do
void $ setField' widget FloatValue (Sci.toRealFloat value)
triggerChange widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloatRange/FloatRangeSlider.hs
View file @ 8c37c422
......@@ -3,21 +3,22 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Float.BoundedFloatRange.FloatRangeSlider (
-- * The FloatRangeSlider
-- Widget
FloatRangeSlider,
-- * Constructor
mkFloatRangeSlider) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Float.BoundedFloatRange.FloatRangeSlider
( -- * The FloatRangeSlider Widget
FloatRangeSlider
-- * Constructor
, mkFloatRangeSlider
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
import qualified Data.Vector as V
import Data.Vinyl (Rec(..), (<+>))
......@@ -29,13 +30,13 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | 'FloatRangeSlider' represents an FloatRangeSlider widget from IPython.html.widgets.
type FloatRangeSlider = IPythonWidget FloatRangeSliderType
type FloatRangeSlider = IPythonWidget 'FloatRangeSliderType
-- | Create a new widget
mkFloatRangeSlider :: IO FloatRangeSlider
mkFloatRangeSlider = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let boundedFloatAttrs = defaultBoundedFloatRangeWidget "FloatSliderView" "FloatSliderModel"
sliderAttrs = (Orientation =:: HorizontalOrientation)
......@@ -47,7 +48,7 @@ mkFloatRangeSlider = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -62,11 +63,12 @@ instance IHaskellDisplay FloatRangeSlider where
instance IHaskellWidget FloatRangeSlider where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Array values) = HM.lookup key2 dict2
[x, y] = map (\(Number x) -> Sci.toRealFloat x) $ V.toList values
setField' widget FloatPairValue (x, y)
triggerChange widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "value"] of
Just (Array values) ->
case map (\(Number x) -> Sci.toRealFloat x) $ V.toList values of
[x, y] -> do
void $ setField' widget FloatPairValue (x, y)
triggerChange widget
_ -> pure ()
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/FloatText.hs
View file @ 8c37c422
......@@ -3,20 +3,22 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Float.FloatText (
-- * The FloatText Widget
FloatText,
-- * Constructor
mkFloatText) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Float.FloatText
( -- * The FloatText Widget
FloatText
-- * Constructor
, mkFloatText
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
import IHaskell.Display
import IHaskell.Eval.Widgets
......@@ -26,19 +28,19 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | 'FloatText' represents an FloatText widget from IPython.html.widgets.
type FloatText = IPythonWidget FloatTextType
type FloatText = IPythonWidget 'FloatTextType
-- | Create a new widget
mkFloatText :: IO FloatText
mkFloatText = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultFloatWidget "FloatTextView" "FloatTextModel"
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -53,10 +55,9 @@ instance IHaskellDisplay FloatText where
instance IHaskellWidget FloatText where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2
setField' widget FloatValue (Sci.toRealFloat value)
triggerChange widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "value"] of
Just (Number value) -> do
void $ setField' widget FloatValue (Sci.toRealFloat value)
triggerChange widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Image.hs
View file @ 8c37c422
......@@ -3,11 +3,14 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Image (
-- * The Image Widget
ImageWidget,
-- * Constructor
mkImageWidget) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Image
( -- * The Image Widget
ImageWidget
-- * Constructor
, mkImageWidget
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
......@@ -25,13 +28,13 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | An 'ImageWidget' represents a Image widget from IPython.html.widgets.
type ImageWidget = IPythonWidget ImageType
type ImageWidget = IPythonWidget 'ImageType
-- | Create a new image widget
mkImageWidget :: IO ImageWidget
mkImageWidget = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let dom = defaultDOMWidget "ImageView" "ImageModel"
img = (ImageFormat =:: PNG)
......@@ -43,7 +46,7 @@ mkImageWidget = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/BoundedIntText.hs
View file @ 8c37c422
......@@ -3,20 +3,22 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText (
-- * The BoundedIntText Widget
BoundedIntText,
-- * Constructor
mkBoundedIntText) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText
( -- * The BoundedIntText Widget
BoundedIntText
-- * Constructor
, mkBoundedIntText
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
import IHaskell.Display
import IHaskell.Eval.Widgets
......@@ -26,19 +28,19 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | 'BoundedIntText' represents an BoundedIntText widget from IPython.html.widgets.
type BoundedIntText = IPythonWidget BoundedIntTextType
type BoundedIntText = IPythonWidget 'BoundedIntTextType
-- | Create a new widget
mkBoundedIntText :: IO BoundedIntText
mkBoundedIntText = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultBoundedIntWidget "IntTextView" "IntTextModel"
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -53,10 +55,9 @@ instance IHaskellDisplay BoundedIntText where
instance IHaskellWidget BoundedIntText where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2
setField' widget IntValue (Sci.coefficient value)
triggerChange widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "value"] of
Just (Number value) -> do
void $ setField' widget IntValue (Sci.coefficient value)
triggerChange widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/IntProgress.hs
View file @ 8c37c422
......@@ -3,11 +3,14 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Int.BoundedInt.IntProgress (
-- * The IntProgress Widget
IntProgress,
-- * Constructor
mkIntProgress) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Int.BoundedInt.IntProgress
( -- * The IntProgress Widget
IntProgress
-- * Constructor
, mkIntProgress
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
......@@ -24,13 +27,13 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | 'IntProgress' represents an IntProgress widget from IPython.html.widgets.
type IntProgress = IPythonWidget IntProgressType
type IntProgress = IPythonWidget 'IntProgressType
-- | Create a new widget
mkIntProgress :: IO IntProgress
mkIntProgress = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let boundedIntAttrs = defaultBoundedIntWidget "ProgressView" "ProgressModel"
progressAttrs = (Orientation =:: HorizontalOrientation)
......@@ -40,7 +43,7 @@ mkIntProgress = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/IntSlider.hs
View file @ 8c37c422
......@@ -3,20 +3,22 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Int.BoundedInt.IntSlider (
-- * The IntSlider Widget
IntSlider,
-- * Constructor
mkIntSlider) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Int.BoundedInt.IntSlider
( -- * The IntSlider Widget
IntSlider
-- * Constructor
, mkIntSlider
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display
......@@ -27,13 +29,13 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | 'IntSlider' represents an IntSlider widget from IPython.html.widgets.
type IntSlider = IPythonWidget IntSliderType
type IntSlider = IPythonWidget 'IntSliderType
-- | Create a new widget
mkIntSlider :: IO IntSlider
mkIntSlider = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let boundedIntAttrs = defaultBoundedIntWidget "IntSliderView" "IntSliderModel"
sliderAttrs = (Orientation =:: HorizontalOrientation)
......@@ -45,7 +47,7 @@ mkIntSlider = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -60,10 +62,9 @@ instance IHaskellDisplay IntSlider where
instance IHaskellWidget IntSlider where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2
setField' widget IntValue (Sci.coefficient value)
triggerChange widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "value"] of
Just (Number value) -> do
void $ setField' widget IntValue (Sci.coefficient value)
triggerChange widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedIntRange/IntRangeSlider.hs
View file @ 8c37c422
......@@ -3,20 +3,22 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Int.BoundedIntRange.IntRangeSlider (
-- * The IntRangeSlider Widget
IntRangeSlider,
-- * Constructor
mkIntRangeSlider) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Int.BoundedIntRange.IntRangeSlider
( -- * The IntRangeSlider Widget
IntRangeSlider
-- * Constructor
, mkIntRangeSlider
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
import qualified Data.Vector as V
import Data.Vinyl (Rec(..), (<+>))
......@@ -28,13 +30,13 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | 'IntRangeSlider' represents an IntRangeSlider widget from IPython.html.widgets.
type IntRangeSlider = IPythonWidget IntRangeSliderType
type IntRangeSlider = IPythonWidget 'IntRangeSliderType
-- | Create a new widget
mkIntRangeSlider :: IO IntRangeSlider
mkIntRangeSlider = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let boundedIntAttrs = defaultBoundedIntRangeWidget "IntSliderView" "IntSliderModel"
sliderAttrs = (Orientation =:: HorizontalOrientation)
......@@ -46,7 +48,7 @@ mkIntRangeSlider = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -61,11 +63,12 @@ instance IHaskellDisplay IntRangeSlider where
instance IHaskellWidget IntRangeSlider where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Array values) = HM.lookup key2 dict2
[x, y] = map (\(Number x) -> Sci.coefficient x) $ V.toList values
setField' widget IntPairValue (x, y)
triggerChange widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "value"] of
Just (Array values) ->
case map (\(Number x) -> Sci.coefficient x) $ V.toList values of
[x, y] -> do
void $ setField' widget IntPairValue (x, y)
triggerChange widget
_ -> pure ()
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/IntText.hs
View file @ 8c37c422
......@@ -3,20 +3,22 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Int.IntText (
-- * The IntText Widget
IntText,
-- * Constructor
mkIntText) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Int.IntText
( -- * The IntText Widget
IntText
-- * Constructor
, mkIntText
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
import IHaskell.Display
import IHaskell.Eval.Widgets
......@@ -26,19 +28,19 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | 'IntText' represents an IntText widget from IPython.html.widgets.
type IntText = IPythonWidget IntTextType
type IntText = IPythonWidget 'IntTextType
-- | Create a new widget
mkIntText :: IO IntText
mkIntText = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultIntWidget "IntTextView" "IntTextModel"
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -53,10 +55,9 @@ instance IHaskellDisplay IntText where
instance IHaskellWidget IntText where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2
setField' widget IntValue (Sci.coefficient value)
triggerChange widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "value"] of
Just (Number value) -> do
void $ setField' widget IntValue (Sci.coefficient value)
triggerChange widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Interactive.hs
View file @ 8c37c422
......@@ -8,7 +8,12 @@
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE PolyKinds #-}
module IHaskell.Display.Widgets.Interactive (interactive, uncurryHList, Rec(..), Argument(..)) where
module IHaskell.Display.Widgets.Interactive
( interactive
, uncurryHList
, Rec (..)
, Argument(..)
) where
import Data.Text
import Data.Proxy
......@@ -32,7 +37,7 @@ import IHaskell.Display.Widgets.Int.BoundedInt.IntSlider
import IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider
import IHaskell.Display.Widgets.Output
data WidgetConf a where
WidgetConf ::
(RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs,
......@@ -42,7 +47,7 @@ data WidgetConf a where
a
-> WidgetConf a
type family WithTypes (ts :: [*]) (r :: *) :: * where
WithTypes '[] r = r
WithTypes (x ': xs) r = (x -> WithTypes xs r)
......@@ -52,7 +57,7 @@ uncurryHList f RNil = f
uncurryHList f (Identity x :& xs) = uncurryHList (f x) xs
-- Consistent type variables are required to make things play nicely with vinyl
data Constructor a where
Constructor ::
RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs =>
......@@ -64,7 +69,7 @@ newtype EventSetter a = EventSetter (IPythonWidget (SuitableWidget a) -> IO () -
newtype Initializer a = Initializer (IPythonWidget (SuitableWidget a) -> Argument a -> IO ())
data RequiredWidget a where
RequiredWidget ::
RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs =>
......@@ -86,8 +91,8 @@ applyEventSetters (EventSetter setter :& xs) (RequiredWidget widget :& ws) handl
setInitialValues :: Rec Initializer ts -> Rec RequiredWidget ts -> Rec Argument ts -> IO ()
setInitialValues RNil RNil RNil = return ()
setInitialValues (Initializer initializer :& fs) (RequiredWidget widget :& ws) (argument :& vs) = do
initializer widget argument
setInitialValues (Initializer initialize :& fs) (RequiredWidget widget :& ws) (argument :& vs) = do
initialize widget argument
setInitialValues fs ws vs
extractConstructor :: WidgetConf x -> Constructor x
......@@ -163,7 +168,7 @@ liftToWidgets func rc initvals = do
return bx
data WrappedWidget w h f a where
WrappedWidget ::
(FieldType h ~ IO (), FieldType f ~ a, h ∈ WidgetFields w,
......@@ -173,7 +178,7 @@ data WrappedWidget w h f a where
S.SField h -> S.SField f -> WrappedWidget w h f a
construct :: WrappedWidget w h f a -> IO (IPythonWidget w)
construct (WrappedWidget cons _ _) = cons
construct (WrappedWidget cs _ _) = cs
getValue :: WrappedWidget w h f a -> IPythonWidget w -> IO a
getValue (WrappedWidget _ _ field) widget = getField widget field
......@@ -190,25 +195,25 @@ class RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs => FromWidget a wher
wrapped :: WrappedWidget (SuitableWidget a) (SuitableHandler a) (SuitableField a) a
instance FromWidget Bool where
type SuitableWidget Bool = CheckBoxType
type SuitableHandler Bool = S.ChangeHandler
type SuitableField Bool = S.BoolValue
type SuitableWidget Bool = 'CheckBoxType
type SuitableHandler Bool = 'S.ChangeHandler
type SuitableField Bool = 'S.BoolValue
data Argument Bool = BoolVal Bool
initializer w (BoolVal b) = setField w BoolValue b
wrapped = WrappedWidget mkCheckBox ChangeHandler BoolValue
instance FromWidget Text where
type SuitableWidget Text = TextType
type SuitableHandler Text = S.SubmitHandler
type SuitableField Text = S.StringValue
type SuitableWidget Text = 'TextType
type SuitableHandler Text = 'S.SubmitHandler
type SuitableField Text = 'S.StringValue
data Argument Text = TextVal Text
initializer w (TextVal txt) = setField w StringValue txt
wrapped = WrappedWidget mkTextWidget SubmitHandler StringValue
instance FromWidget Integer where
type SuitableWidget Integer = IntSliderType
type SuitableHandler Integer = S.ChangeHandler
type SuitableField Integer = S.IntValue
type SuitableWidget Integer = 'IntSliderType
type SuitableHandler Integer = 'S.ChangeHandler
type SuitableField Integer = 'S.IntValue
data Argument Integer = IntVal Integer
| IntRange (Integer, Integer, Integer)
wrapped = WrappedWidget mkIntSlider ChangeHandler IntValue
......@@ -219,9 +224,9 @@ instance FromWidget Integer where
setField w MaxInt u
instance FromWidget Double where
type SuitableWidget Double = FloatSliderType
type SuitableHandler Double = S.ChangeHandler
type SuitableField Double = S.FloatValue
type SuitableWidget Double = 'FloatSliderType
type SuitableHandler Double = 'S.ChangeHandler
type SuitableField Double = 'S.FloatValue
data Argument Double = FloatVal Double
| FloatRange (Double, Double, Double)
wrapped = WrappedWidget mkFloatSlider ChangeHandler FloatValue
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Output.hs
View file @ 8c37c422
......@@ -3,17 +3,19 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Output (
-- * The Output Widget
OutputWidget,
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Output
( -- * The Output Widget
OutputWidget
-- * Constructor
mkOutputWidget,
, mkOutputWidget
-- * Using the output widget
appendOutput,
clearOutput,
clearOutput_,
replaceOutput,
) where
, appendOutput
, clearOutput
, clearOutput_
, replaceOutput
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
......@@ -28,19 +30,19 @@ import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Types
-- | An 'OutputWidget' represents a Output widget from IPython.html.widgets.
type OutputWidget = IPythonWidget OutputType
type OutputWidget = IPythonWidget 'OutputType
-- | Create a new output widget
mkOutputWidget :: IO OutputWidget
mkOutputWidget = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultDOMWidget "OutputView" "OutputModel"
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/Dropdown.hs
View file @ 8c37c422
......@@ -3,20 +3,21 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Selection.Dropdown (
-- * The Dropdown Widget
Dropdown,
-- * Constructor
mkDropdown) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Selection.Dropdown
( -- * The Dropdown Widget
Dropdown
-- * Constructor
, mkDropdown
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import Data.Text (Text)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display
......@@ -27,20 +28,20 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'Dropdown' represents a Dropdown widget from IPython.html.widgets.
type Dropdown = IPythonWidget DropdownType
type Dropdown = IPythonWidget 'DropdownType
-- | Create a new Dropdown widget
mkDropdown :: IO Dropdown
mkDropdown = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let selectionAttrs = defaultSelectionWidget "DropdownView" "DropdownModel"
dropdownAttrs = (ButtonStyle =:: DefaultButton) :& RNil
widgetState = WidgetState $ selectionAttrs <+> dropdownAttrs
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -55,20 +56,19 @@ instance IHaskellDisplay Dropdown where
instance IHaskellWidget Dropdown where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "selected_label" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (String label) = HM.lookup key2 dict2
opts <- getField widget Options
case opts of
OptionLabels _ -> void $ do
setField' widget SelectedLabel label
setField' widget SelectedValue label
OptionDict ps ->
case lookup label ps of
Nothing -> return ()
Just value -> void $ do
setField' widget SelectedLabel label
setField' widget SelectedValue value
triggerSelection widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "selected_label"] of
Just (String label) -> do
opts <- getField widget Options
case opts of
OptionLabels _ -> do
void $ setField' widget SelectedLabel label
void $ setField' widget SelectedValue label
OptionDict ps ->
case lookup label ps of
Nothing -> return ()
Just value -> do
void $ setField' widget SelectedLabel label
void $ setField' widget SelectedValue value
triggerSelection widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/RadioButtons.hs
View file @ 8c37c422
......@@ -3,20 +3,21 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Selection.RadioButtons (
-- * The RadioButtons Widget
RadioButtons,
-- * Constructor
mkRadioButtons) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Selection.RadioButtons
( -- * The RadioButtons Widget
RadioButtons
-- * Constructor
, mkRadioButtons
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, void)
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import Data.Text (Text)
import IHaskell.Display
import IHaskell.Eval.Widgets
......@@ -26,18 +27,18 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'RadioButtons' represents a RadioButtons widget from IPython.html.widgets.
type RadioButtons = IPythonWidget RadioButtonsType
type RadioButtons = IPythonWidget 'RadioButtonsType
-- | Create a new RadioButtons widget
mkRadioButtons :: IO RadioButtons
mkRadioButtons = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultSelectionWidget "RadioButtonsView" "RadioButtonsModel"
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -52,20 +53,19 @@ instance IHaskellDisplay RadioButtons where
instance IHaskellWidget RadioButtons where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "selected_label" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (String label) = HM.lookup key2 dict2
opts <- getField widget Options
case opts of
OptionLabels _ -> void $ do
setField' widget SelectedLabel label
setField' widget SelectedValue label
OptionDict ps ->
case lookup label ps of
Nothing -> return ()
Just value -> void $ do
setField' widget SelectedLabel label
setField' widget SelectedValue value
triggerSelection widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "selected_label"] of
Just (String label) -> do
opts <- getField widget Options
case opts of
OptionLabels _ -> do
void $ setField' widget SelectedLabel label
void $ setField' widget SelectedValue label
OptionDict ps ->
case lookup label ps of
Nothing -> pure ()
Just value -> do
void $ setField' widget SelectedLabel label
void $ setField' widget SelectedValue value
triggerSelection widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/Select.hs
View file @ 8c37c422
......@@ -3,21 +3,21 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Selection.Select (
-- * The Select Widget
Select,
-- * Constructor
mkSelect) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Selection.Select
( -- * The Select Widget
Select
-- * Constructor
, mkSelect
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join, void)
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import Data.Text (Text)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display
import IHaskell.Eval.Widgets
......@@ -27,18 +27,18 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'Select' represents a Select widget from IPython.html.widgets.
type Select = IPythonWidget SelectType
type Select = IPythonWidget 'SelectType
-- | Create a new Select widget
mkSelect :: IO Select
mkSelect = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultSelectionWidget "SelectView" "SelectModel"
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -53,20 +53,19 @@ instance IHaskellDisplay Select where
instance IHaskellWidget Select where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "selected_label" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (String label) = HM.lookup key2 dict2
opts <- getField widget Options
case opts of
OptionLabels _ -> void $ do
setField' widget SelectedLabel label
setField' widget SelectedValue label
OptionDict ps ->
case lookup label ps of
Nothing -> return ()
Just value -> void $ do
setField' widget SelectedLabel label
setField' widget SelectedValue value
triggerSelection widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "selected_label"] of
Just (String label) -> do
opts <- getField widget Options
case opts of
OptionLabels _ -> do
void $ setField' widget SelectedLabel label
void $ setField' widget SelectedValue label
OptionDict ps ->
case lookup label ps of
Nothing -> pure ()
Just value -> do
void $ setField' widget SelectedLabel label
void $ setField' widget SelectedValue value
triggerSelection widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/SelectMultiple.hs
View file @ 8c37c422
......@@ -3,20 +3,21 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Selection.SelectMultiple (
-- * The SelectMultiple Widget
SelectMultiple,
-- * Constructor
mkSelectMultiple) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Selection.SelectMultiple
( -- * The SelectMultiple Widget
SelectMultiple
-- * Constructor
, mkSelectMultiple
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import Data.Text (Text)
import qualified Data.Vector as V
import IHaskell.Display
......@@ -27,18 +28,18 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'SelectMultiple' represents a SelectMultiple widget from IPython.html.widgets.
type SelectMultiple = IPythonWidget SelectMultipleType
type SelectMultiple = IPythonWidget 'SelectMultipleType
-- | Create a new SelectMultiple widget
mkSelectMultiple :: IO SelectMultiple
mkSelectMultiple = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultMultipleSelectionWidget "SelectMultipleView" "SelectMultipleModel"
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -53,21 +54,20 @@ instance IHaskellDisplay SelectMultiple where
instance IHaskellWidget SelectMultiple where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "selected_labels" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Array labels) = HM.lookup key2 dict2
labelList = map (\(String x) -> x) $ V.toList labels
opts <- getField widget Options
case opts of
OptionLabels _ -> void $ do
setField' widget SelectedLabels labelList
setField' widget SelectedValues labelList
OptionDict ps ->
case sequence $ map (`lookup` ps) labelList of
Nothing -> return ()
Just valueList -> void $ do
setField' widget SelectedLabels labelList
setField' widget SelectedValues valueList
triggerSelection widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "selected_labels"] of
Just (Array labels) -> do
let labelList = map (\(String x) -> x) $ V.toList labels
opts <- getField widget Options
case opts of
OptionLabels _ -> do
void $ setField' widget SelectedLabels labelList
void $ setField' widget SelectedValues labelList
OptionDict ps ->
case mapM (`lookup` ps) labelList of
Nothing -> pure ()
Just valueList -> do
void $ setField' widget SelectedLabels labelList
void $ setField' widget SelectedValues valueList
triggerSelection widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/ToggleButtons.hs
View file @ 8c37c422
......@@ -3,20 +3,21 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Selection.ToggleButtons (
-- * The ToggleButtons Widget
ToggleButtons,
-- * Constructor
mkToggleButtons) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.Selection.ToggleButtons
( -- * The ToggleButtons Widget
ToggleButtons
-- * Constructor
, mkToggleButtons
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import Data.Text (Text)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display
......@@ -27,13 +28,13 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'ToggleButtons' represents a ToggleButtons widget from IPython.html.widgets.
type ToggleButtons = IPythonWidget ToggleButtonsType
type ToggleButtons = IPythonWidget 'ToggleButtonsType
-- | Create a new ToggleButtons widget
mkToggleButtons :: IO ToggleButtons
mkToggleButtons = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let selectionAttrs = defaultSelectionWidget "ToggleButtonsView" "ToggleButtonsModel"
toggleButtonsAttrs = (Tooltips =:: [])
:& (Icons =:: [])
......@@ -43,7 +44,7 @@ mkToggleButtons = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -58,20 +59,19 @@ instance IHaskellDisplay ToggleButtons where
instance IHaskellWidget ToggleButtons where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "selected_label" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (String label) = HM.lookup key2 dict2
opts <- getField widget Options
case opts of
OptionLabels _ -> void $ do
setField' widget SelectedLabel label
setField' widget SelectedValue label
OptionDict ps ->
case lookup label ps of
Nothing -> return ()
Just value -> void $ do
setField' widget SelectedLabel label
setField' widget SelectedValue value
triggerSelection widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "selected_label"] of
Just (String label) -> do
opts <- getField widget Options
case opts of
OptionLabels _ -> void $ do
void $ setField' widget SelectedLabel label
void $ setField' widget SelectedValue label
OptionDict ps ->
case lookup label ps of
Nothing -> pure ()
Just value -> do
void $ setField' widget SelectedLabel label
void $ setField' widget SelectedValue value
triggerSelection widget
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Singletons.hs
View file @ 8c37c422
......@@ -8,11 +8,16 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE CPP #-}
module IHaskell.Display.Widgets.Singletons where
import Data.Singletons.TH
#if MIN_VERSION_singletons(2,4,0)
#else
import Data.Singletons.Prelude.Ord
#endif
-- Widget properties
singletons
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/HTML.hs
View file @ 8c37c422
......@@ -3,11 +3,14 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.String.HTML (
-- * The HTML Widget
HTMLWidget,
-- * Constructor
mkHTMLWidget) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.String.HTML
( -- * The HTML Widget
HTMLWidget
-- * Constructor
, mkHTMLWidget
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
......@@ -22,18 +25,18 @@ import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Types
-- | A 'HTMLWidget' represents a HTML widget from IPython.html.widgets.
type HTMLWidget = IPythonWidget HTMLType
type HTMLWidget = IPythonWidget 'HTMLType
-- | Create a new HTML widget
mkHTMLWidget :: IO HTMLWidget
mkHTMLWidget = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultStringWidget "HTMLView" "HTMLModel"
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/Label.hs
View file @ 8c37c422
......@@ -3,11 +3,14 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.String.Label (
-- * The Label Widget
LabelWidget,
-- * Constructor
mkLabelWidget) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.String.Label
( -- * The Label Widget
LabelWidget
-- * Constructor
, mkLabelWidget
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
......@@ -22,18 +25,18 @@ import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Types
-- | A 'LabelWidget' represents a Label widget from IPython.html.widgets.
type LabelWidget = IPythonWidget LabelType
type LabelWidget = IPythonWidget 'LabelType
-- | Create a new Label widget
mkLabelWidget :: IO LabelWidget
mkLabelWidget = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let widgetState = WidgetState $ defaultStringWidget "LabelView" "LabelModel"
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/Text.hs
View file @ 8c37c422
......@@ -3,18 +3,20 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.String.Text (
-- * The Text Widget
TextWidget,
-- * Constructor
mkTextWidget) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.String.Text
( -- * The Text Widget
TextWidget
-- * Constructor
, mkTextWidget
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when)
import Data.Aeson
import qualified Data.HashMap.Strict as Map
import Data.IORef (newIORef)
import Data.Vinyl (Rec(..), (<+>))
......@@ -26,20 +28,20 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'TextWidget' represents a Text widget from IPython.html.widgets.
type TextWidget = IPythonWidget TextType
type TextWidget = IPythonWidget 'TextType
-- | Create a new Text widget
mkTextWidget :: IO TextWidget
mkTextWidget = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let strWidget = defaultStringWidget "TextView" "TextModel"
txtWidget = (SubmitHandler =:: return ()) :& (ChangeHandler =:: return ()) :& RNil
widgetState = WidgetState $ strWidget <+> txtWidget
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -55,16 +57,10 @@ instance IHaskellDisplay TextWidget where
instance IHaskellWidget TextWidget where
getCommUUID = uuid
-- Two possibilities: 1. content -> event -> "submit" 2. sync_data -> value -> <new_value>
comm tw (Object dict1) _ =
case Map.lookup "sync_data" dict1 of
Just (Object dict2) ->
case Map.lookup "value" dict2 of
Just (String val) -> setField' tw StringValue val >> triggerChange tw
Nothing -> return ()
Nothing ->
case Map.lookup "content" dict1 of
Just (Object dict2) ->
case Map.lookup "event" dict2 of
Just (String event) -> when (event == "submit") $ triggerSubmit tw
Nothing -> return ()
Nothing -> return ()
comm tw val _ = do
case nestedObjectLookup val ["sync_data", "value"] of
Just (String value) -> setField' tw StringValue value >> triggerChange tw
_ -> pure ()
case nestedObjectLookup val ["content", "event"] of
Just (String event) -> when (event == "submit") $ triggerSubmit tw
_ -> pure ()
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/TextArea.hs
View file @ 8c37c422
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.String.TextArea (
-- * The TextArea Widget
TextArea,
-- * Constructor
mkTextArea) where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module IHaskell.Display.Widgets.String.TextArea
( -- * The TextArea Widget
TextArea
-- * Constructor
, mkTextArea
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import Data.Text (Text)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display
......@@ -26,20 +27,20 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'TextArea' represents a Textarea widget from IPython.html.widgets.
type TextArea = IPythonWidget TextAreaType
type TextArea = IPythonWidget 'TextAreaType
-- | Create a new TextArea widget
mkTextArea :: IO TextArea
mkTextArea = do
-- Default properties, with a random uuid
uuid <- U.random
wid <- U.random
let strAttrs = defaultStringWidget "TextareaView" "TextareaModel"
wgtAttrs = (ChangeHandler =:: return ()) :& RNil
widgetState = WidgetState $ strAttrs <+> wgtAttrs
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
let widget = IPythonWidget wid stateIO
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget $ toJSON widgetState
......@@ -54,10 +55,9 @@ instance IHaskellDisplay TextArea where
instance IHaskellWidget TextArea where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (String value) = HM.lookup key2 dict2
setField' widget StringValue value
triggerChange widget
comm widget val _ =
case nestedObjectLookup val ["sync_data", "value"] of
Just (String value) -> do
void $ setField' widget StringValue value
triggerChange widget
_ -> pure ()
stack-8.0.yaml
View file @ 8c37c422
......@@ -23,6 +23,7 @@ ghc-options:
# Eventually we want "$locals": -Wall -Werror
ghc-parser: -Wall -Werror
ihaskell: -Wall -Werror
ihaskell-widgets: -Wall -Werror
nix:
enable: false
......
stack-8.4.yaml
View file @ 8c37c422
......@@ -24,9 +24,10 @@ extra-deps:
- plot-0.2.3.9
ghc-options:
# Eventually we want "$locals": -Wall -Werror
ghc-parser: -Wall -Werror
# Eventually we want "$locals": -Wall -Wpartial-fields -Werror
ghc-parser: -Wall -Wpartial-fields -Werror
ihaskell: -Wall -Werror
ihaskell-widgets: -Wall -Wpartial-fields -Werror
nix:
enable: false
......
stack.yaml
View file @ 8c37c422
......@@ -21,6 +21,7 @@ ghc-options:
# Eventually we want "$locals": -Wall -Werror
ghc-parser: -Wall -Werror
ihaskell: -Wall -Werror
ihaskell-widgets: -Wall -Werror
allow-newer: true
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment