Fix #456 -- Update pager for message spec v5

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

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
       }

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) =

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

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 = [] }

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

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