diff --git a/Hspec.hs b/Hspec.hs index a18aece0..e38d242d 100644 --- a/Hspec.hs +++ b/Hspec.hs @@ -62,7 +62,7 @@ eval string = do interpret libdir False $ Eval.evaluate state string publish out <- readIORef outputAccum pagerOut <- readIORef pagerAccum - return (reverse out, unlines $ reverse pagerOut) + return (reverse out, unlines . map extractPlain . reverse $ pagerOut) evaluationComparing comparison string = do let indent (' ':x) = 1 + indent x diff --git a/ipython-kernel/src/IHaskell/IPython/EasyKernel.hs b/ipython-kernel/src/IHaskell/IPython/EasyKernel.hs index 5f0ef5bb..c10ce980 100644 --- a/ipython-kernel/src/IHaskell/IPython/EasyKernel.hs +++ b/ipython-kernel/src/IHaskell/IPython/EasyKernel.hs @@ -53,6 +53,7 @@ import Control.Monad (forever, when, unless) import qualified Data.Map as Map import Data.Maybe (fromMaybe) import qualified Data.Text as T +import Data.String (IsString(..)) import IHaskell.IPython.Kernel import IHaskell.IPython.Message.UUID as UUID @@ -155,7 +156,7 @@ createReplyHeader parent = do -- | Execute an IPython kernel for a config. Your 'main' action should call this as the last thing -- it does. -easyKernel :: (MonadIO m) +easyKernel :: (MonadIO m, IsString output) => FilePath -- ^ The connection file provided by the IPython frontend -> KernelConfig m output result -- ^ The kernel configuration specifying how to react to -- messages @@ -173,7 +174,7 @@ easyKernel profileFile config = do reply <- replyTo config execCount zmq req repHeader liftIO $ writeChan shellRepChan reply -replyTo :: MonadIO m +replyTo :: (MonadIO m, IsString output) => KernelConfig m output result -> MVar Integer -> ZeroMQInterface @@ -220,7 +221,7 @@ replyTo config execCount interface req@ExecuteRequest { getCode = code } replyHe return ExecuteReply { header = replyHeader - , pagerOutput = pagerOut + , pagerOutput = [fromString pagerOut] , executionCounter = fromIntegral counter , status = replyStatus } diff --git a/ipython-kernel/src/IHaskell/IPython/Message/Writer.hs b/ipython-kernel/src/IHaskell/IPython/Message/Writer.hs index ec289cea..ad13fc70 100644 --- a/ipython-kernel/src/IHaskell/IPython/Message/Writer.hs +++ b/ipython-kernel/src/IHaskell/IPython/Message/Writer.hs @@ -29,25 +29,30 @@ instance ToJSON Message where , "payload" .= if null pager then [] - else [object ["source" .= string "page", "text" .= pager]] + else map mkObj pager , "user_variables" .= emptyMap , "user_expressions" .= emptyMap ] + where + mkObj o = object + [ "source" .= string "page" + , "line" .= Number 0 + , "data" .= object [displayDataToJson o] + ] toJSON PublishStatus { executionState = executionState } = object ["execution_state" .= executionState] toJSON PublishStream { streamType = streamType, streamContent = content } = object ["data" .= content, "name" .= streamType] toJSON PublishDisplayData { source = src, displayData = datas } = object - ["source" .= src, "metadata" .= - object [], "data" .= - object (map displayDataToJson datas)] + ["source" .= src, "metadata" .= object [], "data" .= object (map displayDataToJson datas)] toJSON PublishOutput { executionCount = execCount, reprText = reprText } = object - ["data" .= - object ["text/plain" .= reprText], "execution_count" .= execCount, "metadata" .= - object []] + [ "data" .= object ["text/plain" .= reprText] + , "execution_count" .= execCount + , "metadata" .= object [] + ] toJSON PublishInput { executionCount = execCount, inCode = code } = object ["execution_count" .= execCount, "code" .= code] toJSON (CompleteReply _ matches start end metadata status) = @@ -125,4 +130,4 @@ ints :: [Int] -> [Int] ints = id string :: String -> String -string = id +string = id \ 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 5e2889e4..9062c8be 100644 --- a/ipython-kernel/src/IHaskell/IPython/Types.hs +++ b/ipython-kernel/src/IHaskell/IPython/Types.hs @@ -38,6 +38,7 @@ import Data.ByteString (ByteString) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.Text (Text) +import qualified Data.String as S import Data.Serialize import IHaskell.IPython.Message.UUID import GHC.Generics (Generic) @@ -272,7 +273,7 @@ data Message = ExecuteReply { header :: MessageHeader , status :: ExecuteReplyStatus -- ^ The status of the output. - , pagerOutput :: String -- ^ The help string to show in the pager. + , pagerOutput :: [DisplayData] -- ^ The mimebundles to display in the pager. , executionCounter :: Int -- ^ The execution count, i.e. which output this is. } | @@ -430,6 +431,9 @@ replyType _ = Nothing data DisplayData = DisplayData MimeType Text deriving (Typeable, Generic) +instance S.IsString DisplayData where + fromString = DisplayData PlainText . Text.strip . Text.pack + -- We can't print the actual data, otherwise this will be printed every time it gets computed -- because of the way the evaluator is structured. See how `displayExpr` is computed. instance Show DisplayData where diff --git a/src/IHaskell/Eval/Evaluate.hs b/src/IHaskell/Eval/Evaluate.hs index 50d55555..7bdd4a1f 100644 --- a/src/IHaskell/Eval/Evaluate.hs +++ b/src/IHaskell/Eval/Evaluate.hs @@ -283,14 +283,14 @@ evaluate kernelState code output = do when (getLintStatus kernelState /= LintOff) $ liftIO $ do lintSuggestions <- lint cmds unless (noResults lintSuggestions) $ - output $ FinalResult lintSuggestions "" [] + output $ FinalResult lintSuggestions [] [] runUntilFailure kernelState (map unloc cmds ++ [storeItCommand execCount]) -- Print all parse errors. errs -> do forM_ errs $ \err -> do out <- evalCommand output err kernelState - liftIO $ output $ FinalResult (evalResult out) "" [] + liftIO $ output $ FinalResult (evalResult out) [] [] return kernelState return updated { getExecutionCounter = execCount + 1 } @@ -316,7 +316,7 @@ evaluate kernelState code output = do -- Output things only if they are non-empty. let empty = noResults result && null helpStr && null (evalComms evalOut) unless empty $ - liftIO $ output $ FinalResult result helpStr (evalComms evalOut) + liftIO $ output $ FinalResult result [plain helpStr] (evalComms evalOut) -- Make sure to clear all comms we've started. let newState = evalState evalOut { evalComms = [] } diff --git a/src/IHaskell/Types.hs b/src/IHaskell/Types.hs index 9531ba2d..ce8340bc 100644 --- a/src/IHaskell/Types.hs +++ b/src/IHaskell/Types.hs @@ -127,7 +127,7 @@ defaultKernelState = KernelState , useSvg = True , useShowErrors = False , useShowTypes = False - , usePager = False + , usePager = True , openComms = empty , kernelDebug = False } @@ -173,7 +173,8 @@ data EvaluationResult = | FinalResult { outputs :: Display -- ^ Display outputs. - , pagerOut :: String -- ^ Text to display in the IPython pager. + , pagerOut :: [DisplayData] -- ^ Mimebundles to display in the IPython + -- pager. , startComms :: [CommInfo] -- ^ Comms to start. } - deriving Show + deriving Show \ No newline at end of file diff --git a/src/Main.hs b/src/Main.hs index 1786f484..310035df 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -235,7 +235,7 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do -- re-display with the updated output. displayed <- liftIO $ newMVar [] updateNeeded <- liftIO $ newMVar False - pagerOutput <- liftIO $ newMVar "" + pagerOutput <- liftIO $ newMVar [] let clearOutput = do header <- dupHeader replyHeader ClearOutputMessage send $ ClearOutput header True @@ -296,8 +296,8 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do let pager = pagerOut result unless (null pager) $ if usePager state - then modifyMVar_ pagerOutput (return . (++ pager ++ "\n")) - else sendOutput $ Display [html pager] + then modifyMVar_ pagerOutput (return . (++ pager)) + else sendOutput $ Display pager let execCount = getExecutionCounter state -- Let all frontends know the execution count and code that's about to run @@ -314,7 +314,7 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do -- Take pager output if we're using the pager. pager <- if usePager state then liftIO $ readMVar pagerOutput - else return "" + else return [] return (updatedState, ExecuteReply { header = replyHeader