Commit ea63b65f authored by David Davó's avatar David Davó

Created common IHaskellWidget instance

parent f997f5ad
......@@ -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] ]
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