Implement on_submit handler for TextWidget

- All four string widgets complete.
- Switch to using 'Text' everywhere. How'd String crop up?

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets.hs

@@ -1,20 +1,10 @@
-module IHaskell.Display.Widgets (
-    -- * Button Widget
-    module IHaskell.Display.Widgets.Button,
-    -- * String widgets
-    module IHaskell.Display.Widgets.String.HTML,
-    module IHaskell.Display.Widgets.String.Latex,
-    module IHaskell.Display.Widgets.String.Text,
-    module IHaskell.Display.Widgets.String.TextArea,
-    -- * Common widget data
-    module IHaskell.Display.Widgets.Common
-    ) where
+module IHaskell.Display.Widgets (module X) where
 
-import           IHaskell.Display.Widgets.Button
+import           IHaskell.Display.Widgets.Button as X
 
-import           IHaskell.Display.Widgets.String.HTML
-import           IHaskell.Display.Widgets.String.Latex
-import           IHaskell.Display.Widgets.String.Text
-import           IHaskell.Display.Widgets.String.TextArea
+import           IHaskell.Display.Widgets.String.HTML as X
+import           IHaskell.Display.Widgets.String.Latex as X
+import           IHaskell.Display.Widgets.String.Text as X
+import           IHaskell.Display.Widgets.String.TextArea as X
 
-import           IHaskell.Display.Widgets.Common (ButtonStyle (..))
+import           IHaskell.Display.Widgets.Common as X (ButtonStyle (..))

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/HTML.hs

@@ -36,9 +36,9 @@ import           IHaskell.Display.Widgets.Common (ButtonStyle (..))
 data HTMLWidget =
        HTMLWidget
          { uuid :: U.UUID
-         , value :: IORef String
-         , description :: IORef String
-         , placeholder :: IORef String
+         , value :: IORef Text
+         , description :: IORef Text
+         , placeholder :: IORef Text
          }
 
 -- | Create a new HTML widget
@@ -77,33 +77,33 @@ modify :: HTMLWidget -> (HTMLWidget -> IORef a) -> a -> IO ()
 modify b attr val = writeIORef (attr b) val
 
 -- | Set the HTML string value.
-setHTMLValue :: HTMLWidget -> String -> IO ()
+setHTMLValue :: HTMLWidget -> Text -> IO ()
 setHTMLValue b txt = do
   modify b value txt
   update b ["value" .= txt]
 
 -- | Set the HTML description
-setHTMLDescription :: HTMLWidget -> String -> IO ()
+setHTMLDescription :: HTMLWidget -> Text -> IO ()
 setHTMLDescription b txt = do
   modify b description txt
   update b ["description" .= txt]
 
 -- | Set the HTML placeholder, i.e. text displayed in empty widget
-setHTMLPlaceholder :: HTMLWidget -> String -> IO ()
+setHTMLPlaceholder :: HTMLWidget -> Text -> IO ()
 setHTMLPlaceholder b txt = do
   modify b placeholder txt
   update b ["placeholder" .= txt]
 
 -- | Get the HTML string value.
-getHTMLValue :: HTMLWidget -> IO String
+getHTMLValue :: HTMLWidget -> IO Text
 getHTMLValue = readIORef . value
 
 -- | Get the HTML description value.
-getHTMLDescription :: HTMLWidget -> IO String
+getHTMLDescription :: HTMLWidget -> IO Text
 getHTMLDescription = readIORef . description
 
 -- | Get the HTML placeholder value.
-getHTMLPlaceholder :: HTMLWidget -> IO String
+getHTMLPlaceholder :: HTMLWidget -> IO Text
 getHTMLPlaceholder = readIORef . placeholder
 
 instance ToJSON HTMLWidget where

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/Latex.hs

@@ -38,9 +38,9 @@ import           IHaskell.Display.Widgets.Common (ButtonStyle (..))
 data LatexWidget =
        LatexWidget
          { uuid :: U.UUID
-         , value :: IORef String
-         , description :: IORef String
-         , placeholder :: IORef String
+         , value :: IORef Text
+         , description :: IORef Text
+         , placeholder :: IORef Text
          , width :: IORef Int
          }
 
@@ -82,19 +82,19 @@ modify :: LatexWidget -> (LatexWidget -> IORef a) -> a -> IO ()
 modify b attr val = writeIORef (attr b) val
 
 -- | Set the Latex string value.
-setLatexValue :: LatexWidget -> String -> IO ()
+setLatexValue :: LatexWidget -> Text -> IO ()
 setLatexValue b txt = do
   modify b value txt
   update b ["value" .= txt]
 
 -- | Set the Latex description
-setLatexDescription :: LatexWidget -> String -> IO ()
+setLatexDescription :: LatexWidget -> Text -> IO ()
 setLatexDescription b txt = do
   modify b description txt
   update b ["description" .= txt]
 
 -- | Set the Latex placeholder, i.e. text displayed in empty widget
-setLatexPlaceholder :: LatexWidget -> String -> IO ()
+setLatexPlaceholder :: LatexWidget -> Text -> IO ()
 setLatexPlaceholder b txt = do
   modify b placeholder txt
   update b ["placeholder" .= txt]
@@ -106,15 +106,15 @@ setLatexWidth b wid = do
   update b ["width" .= wid]
 
 -- | Get the Latex string value.
-getLatexValue :: LatexWidget -> IO String
+getLatexValue :: LatexWidget -> IO Text
 getLatexValue = readIORef . value
 
 -- | Get the Latex description value.
-getLatexDescription :: LatexWidget -> IO String
+getLatexDescription :: LatexWidget -> IO Text
 getLatexDescription = readIORef . description
 
 -- | Get the Latex placeholder value.
-getLatexPlaceholder :: LatexWidget -> IO String
+getLatexPlaceholder :: LatexWidget -> IO Text
 getLatexPlaceholder = readIORef . placeholder
 
 -- | Get the Latex widget width.

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/Text.hs

@@ -13,12 +13,16 @@ module IHaskell.Display.Widgets.String.Text (
     getTextValue,
     getTextDescription,
     getTextPlaceholder,
+    -- * Submit handling
+    setSubmitHandler,
+    getSubmitHandler,
+    triggerSubmit,
     ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
-import           Control.Monad (when)
+import           Control.Monad (when, void)
 import           Data.Aeson (ToJSON, Value(..), object, toJSON, (.=))
 import           Data.Aeson.Types (Pair)
 import           Data.HashMap.Strict as Map
@@ -36,9 +40,10 @@ import           IHaskell.Display.Widgets.Common (ButtonStyle (..))
 data TextWidget =
        TextWidget
          { uuid :: U.UUID
-         , value :: IORef String
-         , description :: IORef String
-         , placeholder :: IORef String
+         , value :: IORef Text
+         , description :: IORef Text
+         , placeholder :: IORef Text
+         , submitHandler :: IORef (TextWidget -> IO ())
          }
 
 -- | Create a new Text widget
@@ -49,12 +54,14 @@ mkTextWidget = do
   val <- newIORef ""
   des <- newIORef ""
   plc <- newIORef ""
+  sh <- newIORef $ const $ return ()
 
   let b = TextWidget
             { uuid = commUUID
             , value = val
             , description = des
             , placeholder = plc
+            , submitHandler = sh
             }
 
   let initData = object [ "model_name" .= str "WidgetModel"
@@ -77,35 +84,49 @@ modify :: TextWidget -> (TextWidget -> IORef a) -> a -> IO ()
 modify b attr val = writeIORef (attr b) val
 
 -- | Set the Text string value.
-setTextValue :: TextWidget -> String -> IO ()
+setTextValue :: TextWidget -> Text -> IO ()
 setTextValue b txt = do
   modify b value txt
   update b ["value" .= txt]
 
 -- | Set the text widget "description"
-setTextDescription :: TextWidget -> String -> IO ()
+setTextDescription :: TextWidget -> Text -> IO ()
 setTextDescription b txt = do
   modify b description txt
   update b ["description" .= txt]
 
 -- | Set the text widget "placeholder", i.e. text displayed in empty text widget
-setTextPlaceholder :: TextWidget -> String -> IO ()
+setTextPlaceholder :: TextWidget -> Text -> IO ()
 setTextPlaceholder b txt = do
   modify b placeholder txt
   update b ["placeholder" .= txt]
 
 -- | Get the Text string value.
-getTextValue :: TextWidget -> IO String
+getTextValue :: TextWidget -> IO Text
 getTextValue = readIORef . value
 
 -- | Get the Text widget "description" value.
-getTextDescription :: TextWidget -> IO String
+getTextDescription :: TextWidget -> IO Text
 getTextDescription = readIORef . description
 
 -- | Get the Text widget placeholder value.
-getTextPlaceholder :: TextWidget -> IO String
+getTextPlaceholder :: TextWidget -> IO Text
 getTextPlaceholder = readIORef . placeholder
 
+-- | Set a function to be activated on click
+setSubmitHandler :: TextWidget -> (TextWidget -> IO ()) -> IO ()
+setSubmitHandler = writeIORef . submitHandler
+
+-- | Get the click handler for a button
+getSubmitHandler :: TextWidget -> IO (TextWidget -> IO ())
+getSubmitHandler = readIORef . submitHandler
+
+-- | Artificially trigger a TextWidget submit
+triggerSubmit :: TextWidget -> IO ()
+triggerSubmit tw = do
+  handler <- getSubmitHandler tw
+  handler tw
+
 instance ToJSON TextWidget where
   toJSON b = object
                [ "_view_name" .= str "TextView"
@@ -126,6 +147,19 @@ 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) -> setTextValue tw val
+        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 ()
 
 str :: String -> String
 str = id

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/TextArea.hs

@@ -36,9 +36,9 @@ import           IHaskell.Display.Widgets.Common (ButtonStyle (..))
 data TextAreaWidget =
        TextAreaWidget
          { uuid :: U.UUID
-         , value :: IORef String
-         , description :: IORef String
-         , placeholder :: IORef String
+         , value :: IORef Text
+         , description :: IORef Text
+         , placeholder :: IORef Text
          }
 
 -- | Create a new TextArea widget
@@ -77,33 +77,33 @@ modify :: TextAreaWidget -> (TextAreaWidget -> IORef a) -> a -> IO ()
 modify b attr val = writeIORef (attr b) val
 
 -- | Set the TextArea string value.
-setTextAreaValue :: TextAreaWidget -> String -> IO ()
+setTextAreaValue :: TextAreaWidget -> Text -> IO ()
 setTextAreaValue b txt = do
   modify b value txt
   update b ["value" .= txt]
 
 -- | Set the TextArea widget "description"
-setTextAreaDescription :: TextAreaWidget -> String -> IO ()
+setTextAreaDescription :: TextAreaWidget -> Text -> IO ()
 setTextAreaDescription b txt = do
   modify b description txt
   update b ["description" .= txt]
 
 -- | Set the TextArea widget "placeholder", i.e. text displayed in empty widget
-setTextAreaPlaceholder :: TextAreaWidget -> String -> IO ()
+setTextAreaPlaceholder :: TextAreaWidget -> Text -> IO ()
 setTextAreaPlaceholder b txt = do
   modify b placeholder txt
   update b ["placeholder" .= txt]
 
 -- | Get the TextArea string value.
-getTextAreaValue :: TextAreaWidget -> IO String
+getTextAreaValue :: TextAreaWidget -> IO Text
 getTextAreaValue = readIORef . value
 
 -- | Get the TextArea widget "description" value.
-getTextAreaDescription :: TextAreaWidget -> IO String
+getTextAreaDescription :: TextAreaWidget -> IO Text
 getTextAreaDescription = readIORef . description
 
 -- | Get the TextArea widget placeholder value.
-getTextAreaPlaceholder :: TextAreaWidget -> IO String
+getTextAreaPlaceholder :: TextAreaWidget -> IO Text
 getTextAreaPlaceholder = readIORef . placeholder
 
 instance ToJSON TextAreaWidget where