mirror of
https://github.com/IHaskell/IHaskell.git
synced 2025-04-19 12:56:08 +00:00
Created common IHaskellWidget instance
This commit is contained in:
parent
f997f5addb
commit
ea63b65f1a
@ -47,11 +47,6 @@ mkCheckBox = do
|
||||
-- Return the image widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay CheckBox where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget CheckBox where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -53,11 +53,6 @@ mkToggleButton = do
|
||||
-- Return the image widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay ToggleButton where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget ToggleButton where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -49,10 +49,5 @@ mkValidWidget = do
|
||||
-- Return the image widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay ValidWidget where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget ValidWidget where
|
||||
getCommUUID = uuid
|
||||
|
@ -45,10 +45,5 @@ mkBox = do
|
||||
-- Return the widget
|
||||
return box
|
||||
|
||||
instance IHaskellDisplay Box where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget Box where
|
||||
getCommUUID = uuid
|
||||
|
@ -48,11 +48,6 @@ mkAccordion = do
|
||||
-- Return the widget
|
||||
return box
|
||||
|
||||
instance IHaskellDisplay Accordion where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget Accordion where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -47,11 +47,6 @@ mkTabWidget = do
|
||||
-- Return the widget
|
||||
return box
|
||||
|
||||
instance IHaskellDisplay TabWidget where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget TabWidget where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -55,11 +55,6 @@ mkButton = do
|
||||
-- Return the button widget
|
||||
return button
|
||||
|
||||
instance IHaskellDisplay Button where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget Button where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -48,11 +48,6 @@ mkBoundedFloatText = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay BoundedFloatText where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget BoundedFloatText where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -51,10 +51,5 @@ mkFloatProgress = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay FloatProgress where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget FloatProgress where
|
||||
getCommUUID = uuid
|
||||
|
@ -55,11 +55,6 @@ mkFloatSlider = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay FloatSlider where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget FloatSlider where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -56,11 +56,6 @@ mkFloatRangeSlider = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay FloatRangeSlider where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget FloatRangeSlider where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -48,11 +48,6 @@ mkFloatText = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay FloatText where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget FloatText where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -54,10 +54,5 @@ mkImageWidget = do
|
||||
-- Return the image widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay ImageWidget where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget ImageWidget where
|
||||
getCommUUID = uuid
|
||||
|
@ -48,11 +48,6 @@ mkBoundedIntText = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay BoundedIntText where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget BoundedIntText where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -51,10 +51,5 @@ mkIntProgress = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay IntProgress where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget IntProgress where
|
||||
getCommUUID = uuid
|
||||
|
@ -17,16 +17,14 @@ import Prelude
|
||||
|
||||
import Control.Monad (void)
|
||||
import Data.Aeson
|
||||
import Data.Text.Lazy (unpack)
|
||||
import Data.Text.Lazy.Encoding
|
||||
import Data.IORef (newIORef)
|
||||
import qualified Data.Scientific as Sci
|
||||
import Data.Vinyl (Rec(..), (<+>))
|
||||
|
||||
import IHaskell.Display
|
||||
import IHaskell.Eval.Widgets
|
||||
import IHaskell.IPython.Message.UUID as U
|
||||
|
||||
import IHaskell.Display (IHaskellWidget(..))
|
||||
import IHaskell.Display.Widgets.Types
|
||||
import IHaskell.Display.Widgets.Common
|
||||
|
||||
@ -57,11 +55,6 @@ mkIntSlider = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay IntSlider where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display [ widgetdisplay $ unpack $ decodeUtf8 $ encode $ object [ "model_id" .= getCommUUID b, "version_major" .= toInteger 2, "version_minor" .= toInteger 0] ]
|
||||
|
||||
instance IHaskellWidget IntSlider where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -56,11 +56,6 @@ mkIntRangeSlider = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay IntRangeSlider where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget IntRangeSlider where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -48,11 +48,6 @@ mkIntText = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay IntText where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget IntText where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -70,10 +70,5 @@ replaceOutput widget d = do
|
||||
clearOutput_ widget
|
||||
appendOutput widget d
|
||||
|
||||
instance IHaskellDisplay OutputWidget where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget OutputWidget where
|
||||
getCommUUID = uuid
|
||||
|
@ -49,11 +49,6 @@ mkDropdown = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay Dropdown where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget Dropdown where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -46,11 +46,6 @@ mkRadioButtons = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay RadioButtons where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget RadioButtons where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -46,11 +46,6 @@ mkSelect = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay Select where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget Select where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -47,11 +47,6 @@ mkSelectMultiple = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay SelectMultiple where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget SelectMultiple where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -52,11 +52,6 @@ mkToggleButtons = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay ToggleButtons where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget ToggleButtons where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -44,10 +44,5 @@ mkHTMLWidget = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay HTMLWidget where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget HTMLWidget where
|
||||
getCommUUID = uuid
|
||||
|
@ -44,10 +44,5 @@ mkLabelWidget = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay LabelWidget where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget LabelWidget where
|
||||
getCommUUID = uuid
|
||||
|
@ -49,11 +49,6 @@ mkTextWidget = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay TextWidget where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget TextWidget where
|
||||
getCommUUID = uuid
|
||||
-- Two possibilities: 1. content -> event -> "submit" 2. sync_data -> value -> <new_value>
|
||||
|
@ -48,11 +48,6 @@ mkTextArea = do
|
||||
-- Return the widget
|
||||
return widget
|
||||
|
||||
instance IHaskellDisplay TextArea where
|
||||
display b = do
|
||||
widgetSendView b
|
||||
return $ Display []
|
||||
|
||||
instance IHaskellWidget TextArea where
|
||||
getCommUUID = uuid
|
||||
comm widget val _ =
|
||||
|
@ -14,6 +14,7 @@
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
|
||||
-- | This module houses all the type-trickery needed to make widgets happen.
|
||||
--
|
||||
@ -90,12 +91,15 @@ import Data.Singletons.Prelude.List
|
||||
import Data.Singletons.Prelude ((:++))
|
||||
#endif
|
||||
|
||||
import Data.Text.Lazy (unpack)
|
||||
import Data.Text.Lazy.Encoding
|
||||
|
||||
import Data.Singletons.TH
|
||||
|
||||
import GHC.IO.Exception
|
||||
|
||||
import IHaskell.Eval.Widgets (widgetSendUpdate)
|
||||
import IHaskell.Display (Base64, IHaskellWidget(..))
|
||||
import IHaskell.Eval.Widgets (widgetSendUpdate, widgetSendView)
|
||||
import IHaskell.Display (Base64, IHaskellWidget(..), IHaskellDisplay(..), Display(..), widgetdisplay)
|
||||
import IHaskell.IPython.Message.UUID
|
||||
|
||||
import IHaskell.Display.Widgets.Singletons (Field, SField)
|
||||
@ -909,3 +913,14 @@ triggerSubmit = triggerEvent SubmitHandler
|
||||
|
||||
triggerDisplay :: ('S.DisplayHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
|
||||
triggerDisplay = triggerEvent DisplayHandler
|
||||
|
||||
-- | Every IHaskellWidget widget has the same IHaskellDisplay instance, for this
|
||||
-- reason we need to use FlexibleContexts. The display implementation can still
|
||||
-- be overriden per widget
|
||||
instance IHaskellWidget (IPythonWidget w) => IHaskellDisplay (IPythonWidget w) where
|
||||
display b = do
|
||||
widgetSendView b -- Keeping compatibility with classic notebook
|
||||
return $ Display [ widgetdisplay $ unpack $ decodeUtf8 $ encode $ object [
|
||||
"model_id" .= getCommUUID b,
|
||||
"version_major" .= toInteger 2,
|
||||
"version_minor" .= toInteger 0] ]
|
||||
|
Loading…
x
Reference in New Issue
Block a user