Fix pager to use display data mime bundles; remove user_variables.

ipython-kernel/src/IHaskell/IPython/Message/Writer.hs

@@ -37,7 +37,6 @@ instance ToJSON Message where
     , getSilent = silent
     , getStoreHistory = storeHistory
     , getAllowStdin = allowStdin
-    , getUserVariables = userVariables
     , getUserExpressions = userExpressions
     } =
     object
@@ -45,7 +44,6 @@ instance ToJSON Message where
       , "silent" .= silent
       , "store_history" .= storeHistory
       , "allow_stdin" .= allowStdin
-      , "user_variables" .= userVariables
       , "user_expressions" .= userExpressions
       ]
 
@@ -56,16 +54,16 @@ instance ToJSON Message where
       , "payload" .=
         if null pager
           then []
-          else map mkObj pager
-      , "user_variables" .= emptyMap
+          else mkPayload pager
       , "user_expressions" .= emptyMap
       ]
     where
-      mkObj o = object
-                  [ "source" .= string "page"
-                  , "line" .= Number 0
-                  , "data" .= object [displayDataToJson o]
-                  ]
+      mkPayload o = [ object
+                        [ "source" .= string "page"
+                        , "start" .= Number 0
+                        , "data" .= object (map displayDataToJson o)
+                        ]
+                    ]
   toJSON PublishStatus { executionState = executionState } =
     object ["execution_state" .= executionState]
   toJSON PublishStream { streamType = streamType, streamContent = content } =

notebooks/IHaskell.ipynb

@@ -6,7 +6,7 @@
     "hidden": false
    },
    "source": [
-    "![](https://raw.githubusercontent.com/gibiansky/IHaskell/master/images/ihaskell-logo-small.png)\n",
+    "![](https://camo.githubusercontent.com/f6540337202bb3b0c2545d90de0791c9196f9510/68747470733a2f2f7261772e6769746875622e636f6d2f67696269616e736b792f494861736b656c6c2f6d61737465722f68746d6c2f6c6f676f2d36347836342e706e67)\n",
     "\n",
     "IHaskell Notebook\n",
     "===\n",

src/IHaskell/Eval/Evaluate.hs

@@ -270,7 +270,7 @@ data EvalOut =
          { evalStatus :: ErrorOccurred
          , evalResult :: Display
          , evalState :: KernelState
-         , evalPager :: String
+         , evalPager :: [DisplayData]
          , evalMsgs :: [WidgetMsg]
          }
 
@@ -347,12 +347,11 @@ evaluate kernelState code output widgetHandler = do
             case dispsMay of
               Nothing    -> evalResult evalOut
               Just disps -> evalResult evalOut <> disps
-          helpStr = evalPager evalOut
 
       -- Output things only if they are non-empty.
-      let empty = noResults result && null helpStr
+      let empty = noResults result && null (evalPager evalOut)
       unless empty $
-        liftIO $ output $ FinalResult result [plain helpStr] []
+        liftIO $ output $ FinalResult result (evalPager evalOut) []
 
       let tempMsgs = evalMsgs evalOut
           tempState = evalState evalOut { evalMsgs = [] }
@@ -422,7 +421,7 @@ safely state = ghandle handler . ghandle sourceErrorHandler
           { evalStatus = Failure
           , evalResult = displayError $ show exception
           , evalState = state
-          , evalPager = ""
+          , evalPager = []
           , evalMsgs = []
           }
 
@@ -441,7 +440,7 @@ safely state = ghandle handler . ghandle sourceErrorHandler
           { evalStatus = Failure
           , evalResult = displayError fullErr
           , evalState = state
-          , evalPager = ""
+          , evalPager = []
           , evalMsgs = []
           }
 
@@ -455,7 +454,7 @@ wrapExecution state exec = safely state $
         { evalStatus = Success
         , evalResult = res
         , evalState = state
-        , evalPager = ""
+        , evalPager = []
         , evalMsgs = []
         }
 
@@ -545,7 +544,7 @@ evalCommand output (Directive SetDynFlag flagsStr) state = safely state $ do
                                                         ]
                            ]
           , evalState = state
-          , evalPager = ""
+          , evalPager = []
           , evalMsgs = []
           }
     else do
@@ -571,7 +570,7 @@ evalCommand output (Directive SetDynFlag flagsStr) state = safely state $ do
           { evalStatus = Success
           , evalResult = display
           , evalState = state'
-          , evalPager = ""
+          , evalPager = []
           , evalMsgs = []
           }
 
@@ -605,7 +604,7 @@ evalCommand a (Directive SetOption opts) state = do
                 { evalStatus = Failure
                 , evalResult = displayError err
                 , evalState = state
-                , evalPager = ""
+                , evalPager = []
                 , evalMsgs = []
                 }
     else let options = mapMaybe findOption $ words opts
@@ -615,7 +614,7 @@ evalCommand a (Directive SetOption opts) state = do
                 { evalStatus = Success
                 , evalResult = mempty
                 , evalState = updater state
-                , evalPager = ""
+                , evalPager = []
                 , evalMsgs = []
                 }
 
@@ -749,7 +748,7 @@ evalCommand _ (Directive GetHelp _) state = do
       { evalStatus = Success
       , evalResult = Display [out]
       , evalState = state
-      , evalPager = ""
+      , evalPager = []
       , evalMsgs = []
       }
 
@@ -781,24 +780,25 @@ evalCommand _ (Directive GetHelp _) state = do
 evalCommand _ (Directive GetInfo str) state = safely state $ do
   write state $ "Info: " ++ str
   -- Get all the info for all the names we're given.
-  strings <- getDescription str
-
-  -- TODO: Make pager work without html by porting to newer architecture
-  let output = unlines (map htmlify strings)
-      htmlify str =
-        printf
-          "<div style='background: rgb(247, 247, 247);'><form><textarea id='code'>%s</textarea></form></div>"
-          str
-        ++ script
-      script =
-        "<script>CodeMirror.fromTextArea(document.getElementById('code'), {mode: 'haskell', readOnly: 'nocursor'});</script>"
+  strings <- unlines <$> getDescription str
+
+  -- Make pager work without html by porting to newer architecture
+  let htmlify str =
+        html $
+          concat
+            [ "<div style='background: rgb(247, 247, 247);'><form><textarea id='code'>"
+            , str
+            , "</textarea></form></div>"
+            , "<script>CodeMirror.fromTextArea(document.getElementById('code'),"
+            , " {mode: 'haskell', readOnly: 'nocursor'});</script>"
+            ]
 
   return
     EvalOut
       { evalStatus = Success
       , evalResult = mempty
       , evalState = state
-      , evalPager = output
+      , evalPager = [plain strings, htmlify strings]
       , evalMsgs = []
       }
 
@@ -847,7 +847,7 @@ evalCommand output (Expression expr) state = do
           { evalStatus = Success
           , evalResult = mempty
           , evalState = state
-          , evalPager = ""
+          , evalPager = []
           , evalMsgs = []
           }
     else if canRunDisplay
@@ -992,7 +992,7 @@ evalCommand _ (ParseError loc err) state = do
       { evalStatus = Failure
       , evalResult = displayError $ formatParseError loc err
       , evalState = state
-      , evalPager = ""
+      , evalPager = []
       , evalMsgs = []
       }
 
@@ -1009,13 +1009,11 @@ hoogleResults state results =
     { evalStatus = Success
     , evalResult = mempty
     , evalState = state
-    , evalPager = output
+    , evalPager = [ plain $ unlines $ map (Hoogle.render Hoogle.Plain) results
+                  , html $ unlines $ map (Hoogle.render Hoogle.HTML) results
+                  ]
     , evalMsgs = []
     }
-  where
-    -- TODO: Make pager work with plaintext
-    fmt = Hoogle.HTML
-    output = unlines $ map (Hoogle.render fmt) results
 
 doLoadModule :: String -> String -> Ghc Display
 doLoadModule name modName = do

src/tests/IHaskell/Test/Eval.hs

@@ -67,7 +67,7 @@ pages :: String -> [String] -> IO ()
 pages string expected = evaluationComparing comparison string
   where
     comparison (results, pageOut) =
-      strip (stripHtml pageOut) `shouldBe` strip (unlines expected)
+      strip (stripHtml pageOut) `shouldBe` strip (fixQuotes $ unlines expected)
 
     -- A very, very hacky method for removing HTML
     stripHtml str = go str
@@ -88,6 +88,17 @@ pages string expected = evaluationComparing comparison string
             Just str -> go str
             Nothing  -> dropScriptTag $ tail str
 
+    fixQuotes :: String -> String
+#if MIN_VERSION_ghc(7, 8, 0)
+    fixQuotes = id
+#else
+    fixQuotes = map $ \char -> case char of
+      '\8216' -> '`'
+      '\8217' -> '\''
+      c       -> c
+#endif
+
+
 testEval :: Spec
 testEval =
   describe "Code Evaluation" $ do
@@ -150,8 +161,16 @@ testEval =
     it "evaluates directives" $ do
       ":typ 3" `becomes` ["3 :: forall a. Num a => a"]
       ":k Maybe" `becomes` ["Maybe :: * -> *"]
-#if MIN_VERSION_ghc(7, 8, 0)
       ":in String" `pages` ["type String = [Char] \t-- Defined in \8216GHC.Base\8217"]
-#else
-      ":in String" `pages` ["type String = [Char] \t-- Defined in `GHC.Base'"]
-#endif
+      ":info Monad" `pages` [ "class Applicative m => Monad (m :: * -> *) where"
+                            , "  (>>=) :: m a -> (a -> m b) -> m b"
+                            , "  (>>) :: m a -> m b -> m b"
+                            , "  return :: a -> m a"
+                            , "  fail :: String -> m a"
+                            , "  \t-- Defined in ‘GHC.Base’"
+                            , "instance Monad (Either e) -- Defined in ‘Data.Either’"
+                            , "instance Monad [] -- Defined in ‘GHC.Base’"
+                            , "instance Monad Maybe -- Defined in ‘GHC.Base’"
+                            , "instance Monad IO -- Defined in ‘GHC.Base’"
+                            , "instance Monad ((->) r) -- Defined in ‘GHC.Base’"
+                            ]

stack-full.yaml

+flags: {}
+packages:
+    - .
+    - ./ipython-kernel
+    - ./ghc-parser
+    - ./ihaskell-display/ihaskell-aeson
+    - ./ihaskell-display/ihaskell-blaze
+    - ./ihaskell-display/ihaskell-charts
+    - ./ihaskell-display/ihaskell-diagrams
+    - ./ihaskell-display/ihaskell-gnuplot
+    - ./ihaskell-display/ihaskell-hatex
+    - ./ihaskell-display/ihaskell-juicypixels
+    - ./ihaskell-display/ihaskell-magic
+    - ./ihaskell-display/ihaskell-plot
+    - ./ihaskell-display/ihaskell-rlangqq
+    - ./ihaskell-display/ihaskell-static-canvas
+    - ./ihaskell-display/ihaskell-widgets
+resolver: lts-6.2
+extra-deps:
+    - system-argv0-0.1.1 # Necessary for LTS 2.22 (GHC 7.8)
+    - gnuplot-0.5.4
+    - data-accessor-transformers-0.2.1.7