From 6322e6b02f2219488990c265d8ceb7f6383c25d0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?David=20Dav=C3=B3?= Date: Fri, 6 Aug 2021 19:39:05 +0200 Subject: [PATCH] Output widget display anything --- ihaskell-display/ihaskell-widgets/README.md | 2 +- .../src/IHaskell/Display/Widgets/Output.hs | 14 +++++++++----- .../src/IHaskell/Display/Widgets/Types.hs | 19 ++++++------------- ipython-kernel/src/IHaskell/IPython/Types.hs | 1 + src/IHaskell/Types.hs | 4 ++++ 5 files changed, 21 insertions(+), 19 deletions(-) diff --git a/ihaskell-display/ihaskell-widgets/README.md b/ihaskell-display/ihaskell-widgets/README.md index 25d59a00..da316cbf 100644 --- a/ihaskell-display/ihaskell-widgets/README.md +++ b/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. diff --git a/ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Output.hs b/ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Output.hs index 7781e281..eeb2ab63 100644 --- a/ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Output.hs +++ b/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 diff --git a/ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Types.hs b/ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Types.hs index 7e7d5038..0ac13d73 100644 --- a/ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Types.hs +++ b/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 [] ] \ No newline at end of file diff --git a/ipython-kernel/src/IHaskell/IPython/Types.hs b/ipython-kernel/src/IHaskell/IPython/Types.hs index 7d3a32fd..d0f5f5ab 100644 --- a/ipython-kernel/src/IHaskell/IPython/Types.hs +++ b/ipython-kernel/src/IHaskell/IPython/Types.hs @@ -35,6 +35,7 @@ module IHaskell.IPython.Types ( DisplayData(..), MimeType(..), extractPlain, + displayDataToJson, ) where import Control.Applicative ((<$>), (<*>)) diff --git a/src/IHaskell/Types.hs b/src/IHaskell/Types.hs index 46fff0f8..58e4f871 100644 --- a/src/IHaskell/Types.hs +++ b/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