Add support for type inspection with shift tab (inspect_reply)

ihaskell.cabal

@@ -106,6 +106,7 @@ library
                    IHaskell.Convert.IpynbToLhs
                    IHaskell.Convert.LhsToIpynb
                    IHaskell.Eval.Completion
+                   IHaskell.Eval.Inspect
                    IHaskell.Eval.Evaluate
                    IHaskell.Eval.Info
                    IHaskell.Eval.Lint

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

@@ -72,6 +72,7 @@ instance ToJSON Message where
                       else "error"
       , "data" .= object (map displayDataToJson . inspectData $ i)
       , "metadata" .= object []
+      , "found" .= inspectStatus i
       ]
 
   toJSON ShutdownReply { restartPending = restart } =
@@ -128,4 +129,4 @@ ints :: [Int] -> [Int]
 ints = id
 
 string :: String -> String
-string = id
+string = id

ipython-kernel/src/IHaskell/IPython/ZeroMQ.hs

@@ -194,7 +194,11 @@ receiveMessage debug socket = do
 sendMessage :: Sender a => Bool -> ByteString -> Socket a -> Message -> IO ()
 sendMessage _ _ _ SendNothing = return ()
 sendMessage debug hmacKey socket message = do
-  when debug $ print message
+  when debug $ do
+    putStr "Message: "
+    print message
+    putStr "Sent: "
+    print content
 
   -- Send all pieces of the message.
   mapM_ sendPiece idents

src/IHaskell/Eval/Evaluate.hs

@@ -12,6 +12,7 @@ module IHaskell.Eval.Evaluate (
     liftIO,
     typeCleaner,
     globalImports,
+    formatType,
     ) where
 
 import           ClassyPrelude hiding (init, last, liftIO, head, hGetContents, tail, try)

src/IHaskell/Eval/Inspect.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings, DoAndIfThenElse, FlexibleContexts #-}
+
+{- |
+Description:    Generates inspections when asked for by the frontend.
+
+-}
+module IHaskell.Eval.Inspect (inspect) where
+
+import           ClassyPrelude
+import qualified Prelude as P
+
+import           Data.List.Split (splitOn)
+
+import           Exception (ghandle)
+
+import           IHaskell.Eval.Evaluate (Interpreter)
+import           IHaskell.Display
+import           IHaskell.Eval.Util (getType)
+import           IHaskell.Types
+
+-- | Characters used in Haskell operators.
+operatorChars :: String
+operatorChars = "!#$%&*+./<=>?@\\^|-~:"
+
+-- | Whitespace characters.
+whitespace :: String
+whitespace = " \t\n"
+
+-- | Compute the identifier that is being queried.
+getIdentifier :: String -> Int -> String
+getIdentifier code pos = identifier
+  where
+    chunks = splitOn whitespace code
+    lastChunk = P.last chunks :: String
+    identifier =
+      if all (`elem` operatorChars) lastChunk
+        then "(" ++ lastChunk ++ ")"
+        else lastChunk
+
+
+inspect :: String -- ^ Code in the cell
+        -> Int    -- ^ Cursor position in the cell
+        -> Interpreter (Maybe Display)
+inspect code pos = do
+  let identifier = getIdentifier code pos
+      handler :: SomeException -> Interpreter (Maybe a)
+      handler _  = return Nothing
+  response <- ghandle handler (Just <$> getType identifier)
+  let prefix = identifier ++ " :: "
+      fmt str = Display [plain $ prefix ++ str]
+  return $ fmt <$> response

src/Main.hs

@@ -24,6 +24,7 @@ import qualified Data.Text as T
 -- IHaskell imports.
 import           IHaskell.Convert (convert)
 import           IHaskell.Eval.Completion (complete)
+import           IHaskell.Eval.Inspect (inspect)
 import           IHaskell.Eval.Evaluate
 import           IHaskell.Display
 import           IHaskell.Eval.Info
@@ -335,10 +336,16 @@ replyTo _ req@CompleteRequest{} replyHeader state = do
       reply = CompleteReply replyHeader (map pack completions) start end Map.empty True
   return (state, reply)
 
--- TODO: Implement inspect_reply
-replyTo _ InspectRequest{} replyHeader state = do
-  -- FIXME
-  let reply = InspectReply { header = replyHeader, inspectStatus = False, inspectData = [] }
+replyTo _ req@InspectRequest{} replyHeader state = do
+  result <- inspect (unpack $ inspectCode req) (inspectCursorPos req)
+  let reply =
+        case result of
+          Just (Display datas) -> InspectReply
+            { header = replyHeader
+            , inspectStatus = True
+            , inspectData = datas
+            }
+          _ -> InspectReply { header = replyHeader, inspectStatus = False, inspectData = [] }
   return (state, reply)
 
 -- TODO: Implement history_reply.