Output widget with text

ihaskell-display/ihaskell-widgets/MsgSpec.md

@@ -20,7 +20,7 @@ the widget.
 
 Any *numeric* property initialized with the empty string is provided the default value by the
 frontend. Some numbers need to be sent as actual numbers (when non-null), whereas the ones representing
-lengths in CSS units need to be sent as strings.
+lengths in CSS units need to be sent as strings specifying the size unit (px,em,cm,etc.).
 
 The initial state must *at least* have the following fields in the `data.state` value of the message:
 
@@ -40,7 +40,7 @@ the kernel.
 
 ### Buffer paths
 To display some widgets, we need to use the `buffer_paths`. It's only an array with arrays of keys on how to get to the fields that are to considered a
-byte stream. For example, in an image widget, `buffer_paths` would be the array `[ ["value"] ]`, which means that `state.value` is a buffer path. The buffers are specified in the header, so the n-th buffer corresponds to the n-th buffer path.
+byte stream. For example, in an image widget, `buffer_paths` would be the array `[ ["value"] ]`, which means that `state.value` is a buffer path. The buffers are sent in the header of the message, just before the data, so the n-th buffer corresponds to the n-th buffer path in the array.
 
 ```json
 "data": {
@@ -74,6 +74,18 @@ content = {
 }
 ```
 
+## Clear output messages
+A simple message that indicates that the output of the header message id's should be cleaned.
+
+- `wait=true` indicates that it should clean the output in the next append, while `wait=false` cleans the output inmediately.
+
+```json
+method = "clear_output",
+content = {
+  "wait": bool
+}
+```
+
 ## Custom messages
 
 * Widgets can also send a custom message, having the form:

ihaskell-display/ihaskell-widgets/README.md

@@ -16,13 +16,38 @@ jupyter nbconvert *.ipynb --to notebook --inplace --clear-output
 ```
 
 ## Things to do
-- [ ] Validate the JSON implementation of widgets against the MsgSpec schema
+- [ ] Automatic validation of the JSON implementation of widgets against the MsgSpec schema
 - [ ] Create integration tests for the widgets
-- [ ] Make the `output` widget work
-- [ ] Processing of widget messages concurrently
+- [ ] Make the `output` widget work with anything displayable
 - [ ] Make the layout widget values more 'Haskelian': Instead of checking if the string is valid at runtime, make some types so it's checked at compile-time
 - [ ] Create a serializable color data type instead of using `Maybe String`
-- [ ] Overload setField so it can be used with `Maybes` without having to put `Just` every time
+- [ ] Overload setField so it can be used with `Maybes` or other wrapper types without having to put `Just` every time.
 - [ ] Add some "utils" work:
     - [ ] Create media widget from file
-    - [ ] Get the selected label from a selection value
+    - [ ] Get the selected label from a selection value
+
+## How to...
+This is a mini-guide for developers that want to update to a more recent widgets specification, but without
+dwelling into the deeps of the project
+
+### Add a new attribute
+If you want to add a new attribute you'll have to:
+1. Create a new singleton in [Singletons.hs](./Singletons.hs) inside the type `data Field`.
+2. Write the serialization key of the field as specified in the model (see [MsgSpec.md](./MsgSpec.md)) inside the `toKey` function at [Singletons.hs](./Singletons.hs)
+3. Because we use the `singletons-th` library, you have to define an alias for the attribute at [Common.hs](./Common.hs) to be able to use it at run-time more easily.
+4. Now you have to specify the type of the field. Edit the type family `Fieldtype` at [Types.hs](./Types.hs)
+
+### Add an attribute to a widget
+First you have to check if the attribute is only for one widget, or is from a common class. You can check it at [ipywidget's repo](https://github.com/jupyter-widgets/ipywidgets/tree/master/ipywidgets/widgets).
+
+- If it's only for one widget:
+    1. Edit the `type instance WidgetFields <WidgetNameType> = ...` at [Types.hs](./Types.hs), adding the new field to the field array.
+    2. Modify the `mk<WidgetName>` at `Module/WidgetName.hs`, adding the default value of the attribute. If the widget doesn't have any attributes yet, you can check how to do it on other widgets.
+- If it's for a common class:
+    1. Edit the `type <ClassName> = ...` at [Types.hs](./Types.hs)
+    2. Edit the `default<ClassName>Widget` function from the same file, adding the default value for that attribute.
+
+> Some widgets receive messages from the frontend when a value is modified (such as sliders, text areas, buttons...). You'll have to modify the `comm` function instantiated from the class `IHaskellWidget`. You can find an example at [IntSlider.hs](./Int/BoundedInt/IntSlider.hs)
+
+## FAQ
+When using widgets in ihaskell, you'll encounter a lot of compilation errors. If you are not very familiar with Haskell, they can be a bit hard to decipher, this is a mini guide that will (hopefully) appear when you paste the error in Google.

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

@@ -116,6 +116,8 @@ pattern HandleColor = S.SHandleColor
 pattern ButtonWidth = S.SButtonWidth
 pattern Target = S.STarget
 pattern Source = S.SSource
+pattern MsgID = S.SMsgID
+pattern Outputs = S.SOutputs
 pattern Style = S.SStyle
 -- | Close a widget's comm
 closeWidget :: IHaskellWidget w => w -> IO ()

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

@@ -11,7 +11,9 @@ module IHaskell.Display.Widgets.Output
     -- * Constructor
   , mkOutputWidget
     -- * Using the output widget
-  , appendOutput
+  , appendStdout
+  , appendStderr
+  , appendDisplay
   , clearOutput
   , clearOutput_
   , replaceOutput
@@ -22,12 +24,15 @@ import           Prelude
 
 import           Data.Aeson
 import           Data.IORef (newIORef)
+import           Data.Text
+import           Data.Vinyl (Rec(..), (<+>))
 
 import           IHaskell.Display
 import           IHaskell.Eval.Widgets
 import           IHaskell.IPython.Message.UUID as U
 
 import           IHaskell.Display.Widgets.Types
+import           IHaskell.Display.Widgets.Common
 import           IHaskell.Display.Widgets.Layout.LayoutWidget
 
 -- | An 'OutputWidget' represents a Output widget from IPython.html.widgets.
@@ -40,7 +45,15 @@ mkOutputWidget = do
   wid <- U.random
   layout <- mkLayout
 
-  let widgetState = WidgetState $ defaultDOMWidget "OutputView" "OutputModel" layout
+  let domAttrs = defaultDOMWidget "OutputView" "OutputModel" layout
+      outAttrs = (ViewModule =:! "@jupyter-widgets/output")
+                 :& (ModelModule =:! "@jupyter-widgets/output")
+                 :& (ViewModuleVersion =:! "1.0.0")
+                 :& (ModelModuleVersion =:! "1.0.0")
+                 :& (MsgID =:: "")
+                 :& (Outputs =:: [])
+                 :& RNil
+      widgetState = WidgetState $ domAttrs <+> outAttrs
 
   stateIO <- newIORef widgetState
 
@@ -52,25 +65,42 @@ mkOutputWidget = do
   -- Return the image widget
   return widget
 
--- | Append to the output widget
-appendOutput :: IHaskellDisplay a => OutputWidget -> a -> IO ()
-appendOutput widget out = do
-  disp <- display out
-  widgetPublishDisplay widget disp
+appendStd :: StreamName -> OutputWidget -> Text -> IO ()
+appendStd n out t = do
+  getField out Outputs >>= setField out Outputs . updateOutputs
+  where updateOutputs :: [OutputMsg] -> [OutputMsg]
+        updateOutputs = (++[OutputStream n t])
+
+appendStdout :: OutputWidget -> Text -> IO ()
+appendStdout = appendStd STR_STDOUT
+
+appendStderr :: OutputWidget -> Text -> IO ()
+appendStderr = appendStd STR_STDERR
+
+-- | Clears the output widget
+clearOutput' :: OutputWidget -> IO ()
+clearOutput' w = do
+  _ <- setField w Outputs []
+  _ <- setField w MsgID ""
+  return ()
+
+appendDisplay :: IHaskellDisplay a => OutputWidget -> a -> IO ()
+appendDisplay a d = error "To be implemented"
 
 -- | Clear the output widget immediately
 clearOutput :: OutputWidget -> IO ()
-clearOutput widget = widgetClearOutput widget False
+clearOutput widget = widgetClearOutput False >> clearOutput' widget
 
 -- | Clear the output widget on next append
 clearOutput_ :: OutputWidget -> IO ()
-clearOutput_ widget = widgetClearOutput widget True
+clearOutput_ widget = widgetClearOutput True >> clearOutput' widget
 
 -- | Replace the currently displayed output for output widget
 replaceOutput :: IHaskellDisplay a => OutputWidget -> a -> IO ()
 replaceOutput widget d = do
-  clearOutput_ widget
-  appendOutput widget d
+    clearOutput_ widget
+    appendDisplay widget d
 
 instance IHaskellWidget OutputWidget where
   getCommUUID = uuid
+  comm widget val _ = print val

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

@@ -127,6 +127,8 @@ singletons
              | ButtonWidth
              | Target
              | Source
+             | MsgID
+             | Outputs
              | Style
              -- Now the ones for layout
              -- Every layout property comes with an L before the name to avoid conflict
@@ -265,6 +267,8 @@ promote
     toKey ButtonWidth = "button_width"
     toKey Target = "target"
     toKey Source = "source"
+    toKey MsgID = "msg_id"
+    toKey Outputs = "outputs"
     toKey Style = "style"
     toKey LAlignContent = "align_content"
     toKey LAlignItems = "align_items"

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

@@ -269,6 +269,8 @@ type instance FieldType 'S.HandleColor = Maybe String
 type instance FieldType 'S.ButtonWidth = String
 type instance FieldType 'S.Target = WidgetFieldPair
 type instance FieldType 'S.Source = WidgetFieldPair
+type instance FieldType 'S.MsgID = Text
+type instance FieldType 'S.Outputs = [OutputMsg]
 type instance FieldType 'S.Style = StyleWidget
 
 -- | Can be used to put different widgets in a list. Useful for dealing with children widgets.
@@ -386,7 +388,7 @@ type instance WidgetFields 'ImageType =
 type instance WidgetFields 'VideoType =
                 MediaClass :++ ['S.VideoFormat, 'S.Width, 'S.Height, 'S.AutoPlay, 'S.Loop, 'S.Controls]
 
-type instance WidgetFields 'OutputType = DOMWidgetClass
+type instance WidgetFields 'OutputType = DOMWidgetClass :++ ['S.ViewModule,'S.ModelModule,'S.ViewModuleVersion,'S.ModelModuleVersion,'S.MsgID,'S.Outputs]
 type instance WidgetFields 'HTMLType = StringClass
 type instance WidgetFields 'HTMLMathType = StringClass
 type instance WidgetFields 'ComboboxType = TextClass :++ [ 'S.Options, 'S.EnsureOption ]
@@ -980,4 +982,24 @@ unlink :: ('S.Source ∈ WidgetFields w, 'S.Target ∈ WidgetFields w, IHaskellW
 unlink w = do
   _ <- setField' w Source EmptyWT
   _ <- setField' w Target EmptyWT
-  return w
+  return w
+
+data StreamName = STR_STDERR
+                | STR_STDOUT
+                deriving (Eq, Show)
+
+instance ToJSON StreamName where
+  toJSON STR_STDERR = "stderr"
+  toJSON STR_STDOUT = "stdout"
+
+data OutputMsg = OutputStream
+               { name :: StreamName
+               , text :: Text
+               }
+               deriving (Eq, Show)
+
+instance ToJSON OutputMsg where
+  toJSON (OutputStream n t) = object [ "output_type" .= str "stream"
+                                     , "name" .= toJSON n
+                                     , "text" .= toJSON t
+                                     ]

ipython-kernel/src/IHaskell/IPython/Types.hs

@@ -221,8 +221,8 @@ showMessageType StatusMessage = "status"
 showMessageType StreamMessage = "stream"
 showMessageType DisplayDataMessage = "display_data"
 showMessageType UpdateDisplayDataMessage = "update_display_data"
-showMessageType OutputMessage = "pyout"
-showMessageType InputMessage = "pyin"
+showMessageType OutputMessage = "execute_result"
+showMessageType InputMessage = "execute_input"
 showMessageType IsCompleteRequestMessage = "is_complete_request"
 showMessageType IsCompleteReplyMessage = "is_complete_reply"
 showMessageType CompleteRequestMessage = "complete_request"
@@ -580,7 +580,7 @@ instance ToJSON Message where
   toJSON PublishStatus { executionState = executionState } =
     object ["execution_state" .= executionState]
   toJSON PublishStream { streamType = streamType, streamContent = content } =
-    -- Since 5.0 "data" key was renamed to "text"
+    -- Since 5.0 "data" key was renamed to "text""
     object ["text" .= content, "name" .= streamType, "output_type" .= string "stream"]
   toJSON r@PublishDisplayData { displayData = datas }
     = object

src/IHaskell/Eval/Widgets.hs

@@ -90,9 +90,9 @@ widgetSendValue widget = queue . JSONValue (Widget widget)
 widgetPublishDisplay :: (IHaskellWidget a, IHaskellDisplay b) => a -> b -> IO ()
 widgetPublishDisplay widget disp = display disp >>= queue . DispMsg (Widget widget)
 
--- | Send a `clear_output` message as a [method .= custom] message
-widgetClearOutput :: IHaskellWidget a => a -> Bool -> IO ()
-widgetClearOutput widget w = queue $ ClrOutput (Widget widget) w
+-- | Send a `clear_output` message
+widgetClearOutput :: Bool -> IO ()
+widgetClearOutput w = queue $ ClrOutput w
 
 -- | Handle a single widget message. Takes necessary actions according to the message type, such as
 -- opening comms, storing and updating widget representation in the kernel state etc.
@@ -165,10 +165,10 @@ handleMessage send replyHeader state msg = do
       let dmsg = WidgetDisplay dispHeader $ unwrap disp
       sendMessage widget (toJSON $ CustomContent $ toJSON dmsg)
 
-    ClrOutput widget w -> do
+    ClrOutput w -> do
       hdr <- dupHeader replyHeader ClearOutputMessage
-      let cmsg = WidgetClear hdr w
-      sendMessage widget (toJSON $ CustomContent $ toJSON cmsg)
+      send $ ClearOutput hdr w
+      return state
 
   where
     oldComms = openComms state
@@ -222,14 +222,6 @@ instance ToJSON WidgetDisplay where
     let pbval = toJSON $ PublishDisplayData replyHeader ddata Nothing
     in toJSON $ IPythonMessage replyHeader pbval DisplayDataMessage
 
--- Override toJSON for ClearOutput
-data WidgetClear = WidgetClear MessageHeader Bool
-
-instance ToJSON WidgetClear where
-  toJSON (WidgetClear replyHeader w) =
-    let clrVal = toJSON $ ClearOutput replyHeader w
-    in toJSON $ IPythonMessage replyHeader clrVal ClearOutputMessage
-
 data IPythonMessage = IPythonMessage MessageHeader Value MessageType
 
 instance ToJSON IPythonMessage where

src/IHaskell/Types.hs

@@ -250,8 +250,8 @@ data WidgetMsg = Open Widget Value
                 DispMsg Widget Display
                |
                -- ^ A 'display_data' message, sent as a [method .= custom] comm_msg
-                ClrOutput Widget Bool
-  -- ^ A 'clear_output' message, sent as a [method .= custom] comm_msg
+                ClrOutput Bool
+  -- ^ A 'clear_output' message, sent as a clear_output message
   deriving (Show, Typeable)
 
 data WidgetMethod = UpdateState Value [BufferPath]