Added 'shutdown_request' message.

Haskell-Notebook.ipynb

@@ -26,18 +26,12 @@
      "metadata": {},
      "outputs": [
       {
-       "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 1,
-       "text": [
-        "X 20\n",
-        "Y \"Test\"\n",
-        "Z 0.5\n"
+       "ename": "SyntaxError",
+       "evalue": "invalid syntax (<ipython-input-1-9354cdf9baf6>, line 1)",
+       "output_type": "pyerr",
+       "traceback": [
+        "\u001b[0;36m  File \u001b[0;32m\"<ipython-input-1-9354cdf9baf6>\"\u001b[0;36m, line \u001b[0;32m1\u001b[0m\n\u001b[0;31m    data Value = X Int\u001b[0m\n\u001b[0m             ^\u001b[0m\n\u001b[0;31mSyntaxError\u001b[0m\u001b[0;31m:\u001b[0m invalid syntax\n"
        ]
-      },
-      {
-       "metadata": {},
-       "output_type": "display_data"
       }
      ],
      "prompt_number": 1
@@ -54,16 +48,12 @@
      "metadata": {},
      "outputs": [
       {
-       "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 2,
-       "text": [
-        "Just 13\n"
+       "ename": "SyntaxError",
+       "evalue": "invalid syntax (<ipython-input-2-ee999d0ba8c4>, line 3)",
+       "output_type": "pyerr",
+       "traceback": [
+        "\u001b[0;36m  File \u001b[0;32m\"<ipython-input-2-ee999d0ba8c4>\"\u001b[0;36m, line \u001b[0;32m3\u001b[0m\n\u001b[0;31m    print $ (+) <$> Just 3 <*> Just 10\u001b[0m\n\u001b[0m          ^\u001b[0m\n\u001b[0;31mSyntaxError\u001b[0m\u001b[0;31m:\u001b[0m invalid syntax\n"
        ]
-      },
-      {
-       "metadata": {},
-       "output_type": "display_data"
       }
      ],
      "prompt_number": 2

IHaskell/Eval/Evaluate.hs

@@ -24,7 +24,6 @@ import InteractiveEval
 import HscTypes
 import GhcMonad (liftIO)
 import GHC hiding (Stmt)
-import GHC (exprType)
 import GHC.Paths
 import Exception hiding (evaluate)
 
@@ -90,7 +89,7 @@ interpret :: Interpreter a -> IO a
 interpret action = runGhc (Just libdir) $ do
   -- Set the dynamic session flags
   dflags <- getSessionDynFlags
-  setSessionDynFlags $ dflags { hscTarget = HscInterpreted, ghcLink = LinkInMemory }
+  void $ setSessionDynFlags $ dflags { hscTarget = HscInterpreted, ghcLink = LinkInMemory }
 
   -- Import modules.
   imports <- mapM parseImportDecl globalImports

IHaskell/IPython.hs

@@ -7,7 +7,7 @@ module IHaskell.IPython (
 ) where
 
 import ClassyPrelude
-import Prelude (reads)
+import Prelude (read, reads)
 import Shelly hiding (find, trace)
 import System.Argv0
 import System.Directory
@@ -15,7 +15,6 @@ import qualified Filesystem.Path.CurrentOS as FS
 import Data.List.Utils (split)
 import Data.String.Utils (rstrip)
 
-import Prelude (read)
 import qualified System.IO.Strict as StrictIO
 
 import qualified IHaskell.Config as Config
@@ -42,12 +41,8 @@ ipython suppress args = do
 -- Return a tuple with (major, minor, patch).
 ipythonVersion :: IO (Int, Int, Int)
 ipythonVersion = shelly $ do
-  path <- which "ipython"
-  case path of
-    Nothing -> error "Could not find `ipython` executable."
-    Just path -> do
-      [major, minor, patch] <- parseVersion <$>  ipython True ["--version"]
-      return (major, minor, patch)
+  [major, minor, patch] <- parseVersion <$>  ipython True ["--version"]
+  return (major, minor, patch)
 
 {- |
 

IHaskell/Message/Parser.hs

@@ -76,6 +76,7 @@ parser KernelInfoRequestMessage  = kernelInfoRequestParser
 parser ExecuteRequestMessage     = executeRequestParser
 parser CompleteRequestMessage    = completeRequestParser
 parser ObjectInfoRequestMessage  = objectInfoRequestParser
+parser ShutdownRequestMessage    = shutdownRequestParser
 parser other = error $ "Unknown message type " ++ show other
 
 -- | Parse a kernel info request.
@@ -132,3 +133,11 @@ objectInfoRequestParser content = parsed
     Just decoded = decode content
 
 
+shutdownRequestParser :: LByteString -> Message
+shutdownRequestParser content = parsed
+  where
+  Success parsed = flip parse decoded $ \ obj -> do
+        code     <- obj .: "restart"
+        return $ ShutdownRequest noHeader code
+
+  Just decoded = decode content

IHaskell/Types.hs

@@ -48,6 +48,8 @@ instance FromJSON Profile where
             <*> v .: "shell_port"
             <*> v .: "iopub_port"
             <*> v .: "key"
+  parseJSON _ = fail "Expecting JSON object."
+
 instance ToJSON Profile where
   toJSON profile = object [
                     "ip"          .= ip profile,
@@ -101,6 +103,8 @@ data MessageType = KernelInfoReplyMessage
                  | CompleteReplyMessage
                  | ObjectInfoRequestMessage
                  | ObjectInfoReplyMessage
+                 | ShutdownRequestMessage
+                 | ShutdownReplyMessage
 
 instance Show MessageType where
   show KernelInfoReplyMessage     = "kernel_info_reply"
@@ -116,6 +120,8 @@ instance Show MessageType where
   show CompleteReplyMessage       = "complete_reply"
   show ObjectInfoRequestMessage   = "object_info_request"
   show ObjectInfoReplyMessage     = "object_info_reply"
+  show ShutdownRequestMessage     = "shutdown_request"
+  show ShutdownReplyMessage       = "shutdown_reply"
 
 instance FromJSON MessageType where
   parseJSON (String s) = case s of
@@ -132,6 +138,9 @@ instance FromJSON MessageType where
     "complete_reply"      -> return CompleteReplyMessage
     "object_info_request" -> return ObjectInfoRequestMessage
     "object_info_reply"   -> return ObjectInfoReplyMessage
+    "shutdown_request"    -> return ShutdownRequestMessage
+    "shutdown_reply"      -> return ShutdownReplyMessage
+
     _                     -> fail ("Unknown message type: " ++ show s)
   parseJSON _ = fail "Must be a string."
 
@@ -228,18 +237,28 @@ data Message
 } -}
   | ObjectInfoRequest {
       header :: MessageHeader, 
-      objectName :: ByteString, -- ^ name of object to be searched for
-      detailLevel :: Int       -- ^ level of detail desired. default (0) 
-                                --  is equivalent to typing foo?, (1) is foo?? (don't know yet what this means for haskell)
+      objectName :: ByteString,  -- ^ Name of object being searched for.
+      detailLevel :: Int         -- ^ Level of detail desired (defaults to 0).
+                                -- 0 is equivalent to foo?, 1 is equivalent
+                                -- to foo??.
     }
   | ObjectInfoReply {
       header :: MessageHeader, 
-      objectName :: ByteString, 
-      objectFound :: Bool, -- ^ was the object found? 
-      objectTypeString :: ByteString, -- ^ type info string
+      objectName :: ByteString,       -- ^ Name of object which was searched for.
+      objectFound :: Bool,            -- ^ Whether the object was found.
+      objectTypeString :: ByteString, -- ^ Object type.
       objectDocString  :: ByteString
     }
 
+  | ShutdownRequest {
+      header :: MessageHeader,
+      restartPending :: Bool    -- ^ Whether this shutdown precedes a restart.
+    }
+  | ShutdownReply {
+      header :: MessageHeader,
+      restartPending :: Bool    -- ^ Whether this shutdown precedes a restart.
+    }
+
     deriving Show
 
 -- | Possible statuses in the execution reply messages.

Main.hs

@@ -8,6 +8,7 @@ import ClassyPrelude hiding (liftIO)
 import Control.Concurrent.Chan
 import Data.Aeson
 import Text.Printf
+import System.Exit (exitSuccess)
 
 import qualified Data.Map as Map
 
@@ -20,7 +21,6 @@ import IHaskell.IPython
 import IHaskell.Completion (makeCompletions)
 
 import GHC
-import Exception (ghandle, gcatch)
 import Outputable (showSDoc, ppr)
 
 data KernelState = KernelState
@@ -30,8 +30,8 @@ data KernelState = KernelState
 main ::  IO ()
 main = do
   (major, minor, patch) <- ipythonVersion
-  when (major /= 1) $ do
-    printf "Expecting IPython version 1.*, found version %d.%d.%d.\n" major minor patch
+  when (major < 1) $ do
+    void $ printf "Expecting IPython version 1.*, found version %d.%d.%d.\n" major minor patch
     error "Incorrect ipython --version."
 
   args <- map unpack <$> getArgs
@@ -47,8 +47,8 @@ main = do
     ["kernel", profileSrc] -> kernel profileSrc
 
     -- Bad arguments.
-    [] -> putStrLn "Provide command to run ('setup', 'kernel <profile-file.json>', \
-                                           \'notebook [args]', 'console [args]')."
+    [] -> putStrLn $ "Provide command to run ('setup', 'kernel <profile-file.json>', " ++
+                                           "'notebook [args]', 'console [args]')."
     cmd:_ -> putStrLn $ "Unknown command: " ++ pack cmd
 
 
@@ -118,6 +118,9 @@ replyTo :: ZeroMQInterface -> Message -> MessageHeader -> KernelState -> Interpr
 -- hard coded into the representation of that message type).
 replyTo _ KernelInfoRequest{} replyHeader state = return (state, KernelInfoReply { header = replyHeader })
 
+-- Reply to a shutdown request by exiting the main thread.
+replyTo _ ShutdownRequest{} _ _ = liftIO exitSuccess
+
 -- Reply to an execution request. The reply itself does not require
 -- computation, but this causes messages to be sent to the IOPub socket
 -- with the output of the code in the execution request.
@@ -171,15 +174,15 @@ replyTo _ creq@CompleteRequest{} replyHeader state = trace (show creq) $ do
 -- | the associated type calculated by GHC.
 replyTo _ ObjectInfoRequest{objectName=oname} replyHeader state = do
          dflags <- getSessionDynFlags
-         maybeDocs  <- flip gcatch (\(e::SomeException) -> return Nothing) $ do
+         maybeDocs  <- flip gcatch (\(_::SomeException) -> return Nothing) $ do
                           result <- exprType . Chars.unpack $ oname
-                          let docs = (showSDoc dflags) . ppr $ result
+                          let docs = showSDoc dflags . ppr $ result
                           return (Just docs)
-         let docs = maybe "" id maybeDocs
+         let docs = fromMaybe "" maybeDocs
          let reply = ObjectInfoReply {
                         header = replyHeader,
                         objectName = oname, 
-                        objectFound = if isNothing maybeDocs then False else True,
+                        objectFound = isJust maybeDocs,
                         objectTypeString = Chars.pack docs,
                         objectDocString  = Chars.pack docs                    
                       }