Working string widgets

- All four widgets work. TextWidget still missing `on_submit`.
- Still a lot of errors in the webconsole. Don't cause trouble though.

ihaskell-display/ihaskell-widgets/ihaskell-widgets.cabal

@@ -55,6 +55,10 @@ library
   
   -- Modules included in this library but not exported.
   other-modules:       IHaskell.Display.Widgets.Button
+                       IHaskell.Display.Widgets.String.HTML
+                       IHaskell.Display.Widgets.String.Latex
+                       IHaskell.Display.Widgets.String.Text
+                       IHaskell.Display.Widgets.String.TextArea
                        IHaskell.Display.Widgets.Common
   
   -- LANGUAGE extensions used by modules in this package.

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

@@ -1,3 +1,20 @@
-module IHaskell.Display.Widgets (module IHaskell.Display.Widgets.Button) where
+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
 
 import           IHaskell.Display.Widgets.Button
+
+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.Common (ButtonStyle (..))

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

@@ -7,8 +7,12 @@ module IHaskell.Display.Widgets.String.HTML (
     mkHTMLWidget,
     -- * Set properties
     setHTMLValue,
+    setHTMLDescription,
+    setHTMLPlaceholder,
     -- * Get properties
     getHTMLValue,
+    getHTMLDescription,
+    getHTMLPlaceholder,
     ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
@@ -33,6 +37,8 @@ data HTMLWidget =
        HTMLWidget
          { uuid :: U.UUID
          , value :: IORef String
+         , description :: IORef String
+         , placeholder :: IORef String
          }
 
 -- | Create a new HTML widget
@@ -41,11 +47,15 @@ mkHTMLWidget = do
   -- Default properties, with a random uuid
   commUUID <- U.random
   val <- newIORef ""
+  des <- newIORef ""
+  plc <- newIORef ""
 
   let b = HTMLWidget
-        { uuid = commUUID
-        , value = val
-        }
+            { uuid = commUUID
+            , value = val
+            , description = des
+            , placeholder = plc
+            }
 
   let initData = object [ "model_name" .= str "WidgetModel"
                         , "widget_class" .= str "IPython.HTML"
@@ -72,10 +82,30 @@ setHTMLValue b txt = do
   modify b value txt
   update b ["value" .= txt]
 
+-- | Set the HTML description
+setHTMLDescription :: HTMLWidget -> String -> 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 b txt = do
+  modify b placeholder txt
+  update b ["placeholder" .= txt]
+
 -- | Get the HTML string value.
 getHTMLValue :: HTMLWidget -> IO String
 getHTMLValue = readIORef . value
 
+-- | Get the HTML description value.
+getHTMLDescription :: HTMLWidget -> IO String
+getHTMLDescription = readIORef . description
+
+-- | Get the HTML placeholder value.
+getHTMLPlaceholder :: HTMLWidget -> IO String
+getHTMLPlaceholder = readIORef . placeholder
+
 instance ToJSON HTMLWidget where
   toJSON b = object
                [ "_view_name" .= str "HTMLView"

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

@@ -7,9 +7,13 @@ module IHaskell.Display.Widgets.String.Latex (
     mkLatexWidget,
     -- * Set properties
     setLatexValue,
+    setLatexPlaceholder,
+    setLatexDescription,
     setLatexWidth,
     -- * Get properties
     getLatexValue,
+    getLatexPlaceholder,
+    getLatexDescription,
     getLatexWidth,
     ) where
 
@@ -35,6 +39,8 @@ data LatexWidget =
        LatexWidget
          { uuid :: U.UUID
          , value :: IORef String
+         , description :: IORef String
+         , placeholder :: IORef String
          , width :: IORef Int
          }
 
@@ -44,11 +50,15 @@ mkLatexWidget = do
   -- Default properties, with a random uuid
   commUUID <- U.random
   val <- newIORef ""
+  des <- newIORef ""
+  plc <- newIORef ""
   width <- newIORef 400
 
   let b = LatexWidget
         { uuid = commUUID
         , value = val
+        , description = des
+        , placeholder = plc
         , width = width
         }
 
@@ -77,6 +87,18 @@ setLatexValue b txt = do
   modify b value txt
   update b ["value" .= txt]
 
+-- | Set the Latex description
+setLatexDescription :: LatexWidget -> String -> 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 b txt = do
+  modify b placeholder txt
+  update b ["placeholder" .= txt]
+
 -- | Set the Latex widget width.
 setLatexWidth :: LatexWidget -> Int -> IO ()
 setLatexWidth b wid = do
@@ -87,6 +109,14 @@ setLatexWidth b wid = do
 getLatexValue :: LatexWidget -> IO String
 getLatexValue = readIORef . value
 
+-- | Get the Latex description value.
+getLatexDescription :: LatexWidget -> IO String
+getLatexDescription = readIORef . description
+
+-- | Get the Latex placeholder value.
+getLatexPlaceholder :: LatexWidget -> IO String
+getLatexPlaceholder = readIORef . placeholder
+
 -- | Get the Latex widget width.
 getLatexWidth :: LatexWidget -> IO Int
 getLatexWidth = readIORef . width

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

@@ -7,8 +7,12 @@ module IHaskell.Display.Widgets.String.Text (
     mkTextWidget,
     -- * Set properties
     setTextValue,
+    setTextDescription,
+    setTextPlaceholder,
     -- * Get properties
     getTextValue,
+    getTextDescription,
+    getTextPlaceholder,
     ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
@@ -33,6 +37,8 @@ data TextWidget =
        TextWidget
          { uuid :: U.UUID
          , value :: IORef String
+         , description :: IORef String
+         , placeholder :: IORef String
          }
 
 -- | Create a new Text widget
@@ -41,10 +47,14 @@ mkTextWidget = do
   -- Default properties, with a random uuid
   commUUID <- U.random
   val <- newIORef ""
+  des <- newIORef ""
+  plc <- newIORef ""
 
   let b = TextWidget
             { uuid = commUUID
             , value = val
+            , description = des
+            , placeholder = plc
             }
 
   let initData = object [ "model_name" .= str "WidgetModel"
@@ -72,10 +82,30 @@ setTextValue b txt = do
   modify b value txt
   update b ["value" .= txt]
 
+-- | Set the text widget "description"
+setTextDescription :: TextWidget -> String -> 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 b txt = do
+  modify b placeholder txt
+  update b ["placeholder" .= txt]
+
 -- | Get the Text string value.
 getTextValue :: TextWidget -> IO String
 getTextValue = readIORef . value
 
+-- | Get the Text widget "description" value.
+getTextDescription :: TextWidget -> IO String
+getTextDescription = readIORef . description
+
+-- | Get the Text widget placeholder value.
+getTextPlaceholder :: TextWidget -> IO String
+getTextPlaceholder = readIORef . placeholder
+
 instance ToJSON TextWidget where
   toJSON b = object
                [ "_view_name" .= str "TextView"
@@ -83,6 +113,8 @@ instance ToJSON TextWidget where
                , "_css" .= object []
                , "msg_throttle" .= (3 :: Int)
                , "value" .= get value b
+               , "description" .= get description b
+               , "placeholder" .= get placeholder b
                ]
     where
       get x y = unsafePerformIO . readIORef . x $ y

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

@@ -0,0 +1,131 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module IHaskell.Display.Widgets.String.TextArea (
+    -- * The TextArea Widget
+    TextAreaWidget,
+    -- * Constructor
+    mkTextAreaWidget,
+    -- * Set properties
+    setTextAreaValue,
+    setTextAreaDescription,
+    setTextAreaPlaceholder,
+    -- * Get properties
+    getTextAreaValue,
+    getTextAreaDescription,
+    getTextAreaPlaceholder,
+    ) where
+
+-- To keep `cabal repl` happy when running from the ihaskell repo
+import           Prelude
+
+import           Control.Monad (when)
+import           Data.Aeson (ToJSON, Value(..), object, toJSON, (.=))
+import           Data.Aeson.Types (Pair)
+import           Data.HashMap.Strict as Map
+import           Data.IORef
+import           Data.Text (Text)
+import qualified Data.Text as T
+import           System.IO.Unsafe (unsafePerformIO)
+
+import           IHaskell.Display
+import           IHaskell.Eval.Widgets
+import qualified IHaskell.IPython.Message.UUID as U
+
+import           IHaskell.Display.Widgets.Common (ButtonStyle (..))
+
+data TextAreaWidget =
+       TextAreaWidget
+         { uuid :: U.UUID
+         , value :: IORef String
+         , description :: IORef String
+         , placeholder :: IORef String
+         }
+
+-- | Create a new TextArea widget
+mkTextAreaWidget :: IO TextAreaWidget
+mkTextAreaWidget = do
+  -- Default properties, with a random uuid
+  commUUID <- U.random
+  val <- newIORef ""
+  des <- newIORef ""
+  plc <- newIORef ""
+
+  let b = TextAreaWidget
+            { uuid = commUUID
+            , value = val
+            , description = des
+            , placeholder = plc
+            }
+
+  let initData = object [ "model_name" .= str "WidgetModel"
+                        , "widget_class" .= str "IPython.Textarea"
+                        ]
+
+  -- Open a comm for this widget, and store it in the kernel state
+  widgetSendOpen b initData (toJSON b)
+
+  -- Return the string widget
+  return b
+
+-- | Send an update msg for a widget, with custom json. Make it easy to update fragments of the
+-- state, by accepting a Pair instead of a Value.
+update :: TextAreaWidget -> [Pair] -> IO ()
+update b v = widgetSendUpdate b . toJSON . object $ v
+
+-- | Modify attributes stored inside the widget as IORefs
+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 b txt = do
+  modify b value txt
+  update b ["value" .= txt]
+
+-- | Set the TextArea widget "description"
+setTextAreaDescription :: TextAreaWidget -> String -> 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 b txt = do
+  modify b placeholder txt
+  update b ["placeholder" .= txt]
+
+-- | Get the TextArea string value.
+getTextAreaValue :: TextAreaWidget -> IO String
+getTextAreaValue = readIORef . value
+
+-- | Get the TextArea widget "description" value.
+getTextAreaDescription :: TextAreaWidget -> IO String
+getTextAreaDescription = readIORef . description
+
+-- | Get the TextArea widget placeholder value.
+getTextAreaPlaceholder :: TextAreaWidget -> IO String
+getTextAreaPlaceholder = readIORef . placeholder
+
+instance ToJSON TextAreaWidget where
+  toJSON b = object
+               [ "_view_name" .= str "TextareaView"
+               , "visible" .= True
+               , "_css" .= object []
+               , "msg_throttle" .= (3 :: Int)
+               , "value" .= get value b
+               , "description" .= get description b
+               , "placeholder" .= get placeholder b
+               ]
+    where
+      get x y = unsafePerformIO . readIORef . x $ y
+
+instance IHaskellDisplay TextAreaWidget where
+  display b = do
+    widgetSendView b
+    return $ Display []
+
+instance IHaskellWidget TextAreaWidget where
+  getCommUUID = uuid
+
+str :: String -> String
+str = id