Created common IHaskellWidget instance

This commit is contained in:
David Davó 2021-06-17 11:11:11 +02:00
parent f997f5addb
commit ea63b65f1a
29 changed files with 18 additions and 145 deletions

View File

@ -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 _ =

View File

@ -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 _ =

View File

@ -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

View File

@ -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

View File

@ -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 _ =

View File

@ -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 _ =

View File

@ -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 _ =

View File

@ -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 _ =

View File

@ -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

View File

@ -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 _ =

View File

@ -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 _ =

View File

@ -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 _ =

View File

@ -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

View File

@ -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 _ =

View File

@ -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

View File

@ -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 _ =

View File

@ -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 _ =

View File

@ -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 _ =

View File

@ -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

View File

@ -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 _ =

View File

@ -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 _ =

View File

@ -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 _ =

View File

@ -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 _ =

View File

@ -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 _ =

View File

@ -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

View File

@ -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

View File

@ -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>

View File

@ -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 _ =

View File

@ -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] ]