Output widget display anything

ihaskell-display/ihaskell-widgets/README.md

@@ -18,7 +18,7 @@ jupyter nbconvert *.ipynb --to notebook --inplace --clear-output
 ## Things to do
 - [ ] Automatic validation of the JSON implementation of widgets against the MsgSpec schema
 - [ ] Create integration tests for the widgets
-- [ ] Make the `output` widget work with anything displayable
+- [ ] Make the output widget capture output (problem: you have to get the message id of where the output is displayed)
 - [ ] 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` or other wrapper types without having to put `Just` every time.

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

@@ -29,6 +29,7 @@ import           Data.Vinyl (Rec(..), (<+>))
 
 import           IHaskell.Display
 import           IHaskell.Eval.Widgets
+import           IHaskell.IPython.Types (StreamType(..))
 import           IHaskell.IPython.Message.UUID as U
 
 import           IHaskell.Display.Widgets.Types
@@ -65,17 +66,17 @@ mkOutputWidget = do
   -- Return the image widget
   return widget
 
-appendStd :: StreamName -> OutputWidget -> Text -> IO ()
+appendStd :: StreamType -> 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
+appendStdout = appendStd Stdout
 
 appendStderr :: OutputWidget -> Text -> IO ()
-appendStderr = appendStd STR_STDERR
+appendStderr = appendStd Stderr
 
 -- | Clears the output widget
 clearOutput' :: OutputWidget -> IO ()
@@ -85,7 +86,11 @@ clearOutput' w = do
   return ()
 
 appendDisplay :: IHaskellDisplay a => OutputWidget -> a -> IO ()
-appendDisplay a d = error "To be implemented"
+appendDisplay o d = do
+  outputs <- getField o Outputs
+  disp <- display d
+  _ <- setField o Outputs $ outputs ++ [OutputData disp]
+  return ()
 
 -- | Clear the output widget immediately
 clearOutput :: OutputWidget -> IO ()
@@ -103,4 +108,3 @@ replaceOutput widget d = do
 
 instance IHaskellWidget OutputWidget where
   getCommUUID = uuid
-  comm widget val _ = print val

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

@@ -110,6 +110,7 @@ import           GHC.IO.Exception
 
 import           IHaskell.Eval.Widgets (widgetSendUpdate, widgetSendView)
 import           IHaskell.Display (IHaskellWidget(..), IHaskellDisplay(..), Display(..), widgetdisplay, base64)
+import           IHaskell.IPython.Types (StreamType(..))
 import           IHaskell.IPython.Message.UUID
 
 import           IHaskell.Display.Widgets.Singletons (Field, SField, toKey, HasKey)
@@ -984,22 +985,14 @@ unlink w = do
   _ <- setField' w Target EmptyWT
   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)
+data OutputMsg = OutputStream StreamType Text | OutputData Display deriving (Show)
 
 instance ToJSON OutputMsg where
   toJSON (OutputStream n t) = object [ "output_type" .= str "stream"
                                      , "name" .= toJSON n
                                      , "text" .= toJSON t
+                                     ]
+  toJSON (OutputData d)     = object [ "output_type" .= str "display_data"
+                                     , "data" .= toJSON d
+                                     , "metadata" .= object []
                                      ]

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

@@ -35,6 +35,7 @@ module IHaskell.IPython.Types (
     DisplayData(..),
     MimeType(..),
     extractPlain,
+    displayDataToJson,
     ) where
 
 import           Control.Applicative ((<$>), (<*>))

src/IHaskell/Types.hs

@@ -155,6 +155,10 @@ data Display = Display [DisplayData]
              | ManyDisplay [Display]
   deriving (Show, Typeable, Generic)
 
+instance ToJSON Display where
+  toJSON (Display d) = object (map displayDataToJson d)
+  toJSON (ManyDisplay d) = toJSON d
+
 instance Serialize Display
 
 instance Semigroup Display where