ipython-kernel: Switch on -Wall and fix all warnings

Fixing these warnings required changes to the file names of the `MessageHeader`
struct which makes this commit an API change. The version in the cabal file
has been bumped accordingly.

ipython-kernel/ipython-kernel.cabal

 name:                ipython-kernel
-version:             0.9.1.0
+version:             0.10.0.0
 synopsis:            A library for creating kernels for IPython frontends
 
 description:         ipython-kernel is a library for communicating with frontends for the interactive IPython framework. It is used extensively in IHaskell, the interactive Haskell environment.
@@ -24,10 +24,11 @@ flag examples
 
 
 library
+  ghc-options:         -Wall
+
   exposed-modules: IHaskell.IPython.Kernel
                    IHaskell.IPython.Types
                    IHaskell.IPython.ZeroMQ
-                   IHaskell.IPython.Message.Writer
                    IHaskell.IPython.Message.Parser
                    IHaskell.IPython.Message.UUID
                    IHaskell.IPython.EasyKernel
@@ -38,6 +39,7 @@ library
                        aeson           ,
                        bytestring      ,
                        cereal          ,
+                       cereal-text     ,
                        containers      ,
                        cryptonite      ,
                        directory       ,

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

@@ -23,7 +23,7 @@
 -- logos, help text, and so forth.
 module IHaskell.IPython.EasyKernel (easyKernel, installKernelspec, KernelConfig(..)) where
 
-import           Data.Aeson (decode, encode)
+import           Data.Aeson (decode, encode, toJSON)
 
 import qualified Data.ByteString.Lazy as BL
 
@@ -32,7 +32,7 @@ import           System.Process (rawSystem)
 
 import           Control.Concurrent (MVar, readChan, writeChan, newMVar, readMVar, modifyMVar_)
 import           Control.Monad.IO.Class (MonadIO(..))
-import           Control.Monad (forever, when, unless, void)
+import           Control.Monad (forever, when, void)
 
 import qualified Data.Map as Map
 import           Data.Maybe (fromMaybe)
@@ -40,10 +40,8 @@ import qualified Data.Text as T
 
 import           IHaskell.IPython.Kernel
 import           IHaskell.IPython.Message.UUID as UUID
-import           IHaskell.IPython.Types
 
-import           System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist,
-                                   getHomeDirectory, getTemporaryDirectory)
+import           System.Directory (createDirectoryIfMissing, getTemporaryDirectory)
 import           System.FilePath ((</>))
 import           System.Exit (exitSuccess)
 import           System.IO (openFile, IOMode(ReadMode))
@@ -53,7 +51,7 @@ import           System.IO (openFile, IOMode(ReadMode))
 -- running cells, and the type of final results of cells, respectively.
 data KernelConfig m output result =
        KernelConfig
-         { 
+         {
          -- | Info on the language of the kernel.
          kernelLanguageInfo :: LanguageInfo
          -- | Write all the files into the kernel directory, including `kernel.js`, `logo-64x64.svg`, and any
@@ -122,19 +120,12 @@ createReplyHeader :: MonadIO m => MessageHeader -> m MessageHeader
 createReplyHeader parent = do
   -- Generate a new message UUID.
   newMessageId <- liftIO UUID.random
-  let repType = fromMaybe err (replyType $ msgType parent)
-      err = error $ "No reply for message " ++ show (msgType parent)
+  let repType = fromMaybe err (replyType $ mhMsgType parent)
+      err = error $ "No reply for message " ++ show (mhMsgType parent)
+
+  return $ MessageHeader (mhIdentifiers parent) (Just parent) (Map.fromList [])
+            newMessageId (mhSessionId parent) (mhUsername parent) repType
 
-  return
-    MessageHeader
-      { identifiers = identifiers parent
-      , parentHeader = Just parent
-      , metadata = Map.fromList []
-      , messageId = newMessageId
-      , sessionId = sessionId parent
-      , username = username parent
-      , msgType = repType
-      }
 
 -- | Execute an IPython kernel for a config. Your 'main' action should call this as the last thing
 -- it does.
@@ -145,16 +136,14 @@ easyKernel :: MonadIO m
            -> m ()
 easyKernel profileFile config = do
   prof <- liftIO $ getProfile profileFile
-  zmq@(Channels shellReqChan shellRepChan ctrlReqChan ctrlRepChan iopubChan _) <- liftIO $ serveProfile
-                                                                                             prof
-                                                                                             False
+  zmq <- liftIO $ serveProfile prof False
   execCount <- liftIO $ newMVar 0
   forever $ do
-    req <- liftIO $ readChan shellReqChan
+    req <- liftIO $ readChan (shellRequestChannel zmq)
     repHeader <- createReplyHeader (header req)
     when (debug config) . liftIO $ print req
     reply <- replyTo config execCount zmq req repHeader
-    liftIO $ writeChan shellRepChan reply
+    liftIO $ writeChan (shellRequestChannel zmq) reply
 
 replyTo :: MonadIO m
         => KernelConfig m output result
@@ -180,17 +169,17 @@ replyTo config _ interface KernelInfoRequest{} replyHeader = do
       , status = Ok
       }
 
-replyTo config _ _ CommInfoRequest{} replyHeader =
+replyTo _ _ _ CommInfoRequest{} replyHeader =
   return
     CommInfoReply
       { header = replyHeader
       , commInfo = Map.empty }
 
-replyTo config _ interface ShutdownRequest { restartPending = pending } replyHeader = do
+replyTo _ _ interface ShutdownRequest { restartPending = pending } replyHeader = do
   liftIO $ writeChan (shellReplyChannel interface) $ ShutdownReply replyHeader pending
   liftIO exitSuccess
 
-replyTo config execCount interface req@ExecuteRequest { getCode = code } replyHeader = do
+replyTo config execCount interface req@ExecuteRequest{} replyHeader = do
   let send = writeChan (iopubChannel interface)
 
   busyHeader <- dupHeader replyHeader StatusMessage
@@ -205,7 +194,7 @@ replyTo config execCount interface req@ExecuteRequest { getCode = code } replyHe
                                                       send $ PublishDisplayData
                                                                outputHeader
                                                                (displayOutput config x)
-                                  in run config code clearOutput sendOutput
+                                  in run config (getCode req) clearOutput sendOutput
   liftIO . send $ PublishDisplayData outputHeader (displayResult config res)
 
 
@@ -254,4 +243,4 @@ dupHeader :: MonadIO m => MessageHeader -> MessageType -> m MessageHeader
 dupHeader hdr mtype =
   do
     uuid <- liftIO UUID.random
-    return hdr { messageId = uuid, msgType = mtype }
+    return hdr { mhMessageId = uuid, mhMsgType = mtype }

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

@@ -3,7 +3,6 @@
 module IHaskell.IPython.Kernel (module X) where
 
 import           IHaskell.IPython.Types as X
-import           IHaskell.IPython.Message.Writer as X
 import           IHaskell.IPython.Message.Parser as X
 import           IHaskell.IPython.Message.UUID as X
 import           IHaskell.IPython.ZeroMQ as X

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

@@ -8,15 +8,14 @@
 -- the low-level 0MQ interface.
 module IHaskell.IPython.Message.Parser (parseMessage) where
 
-import           Control.Applicative ((<|>), (<$>), (<*>))
-import           Data.Aeson ((.:), (.:?), (.!=), decode, Result(..), Object, Value(..))
-import           Data.Aeson.Types (parse, parseEither)
+import           Control.Applicative ((<$>), (<*>))
+import           Data.Aeson ((.:), (.:?), (.!=), decode, FromJSON, Result(..), Object, Value(..))
+import           Data.Aeson.Types (Parser, parse, parseEither)
 import           Data.ByteString hiding (unpack)
 import qualified Data.ByteString.Lazy as Lazy
 import           Data.HashMap.Strict as HM
 import           Data.Map (Map)
 import           Data.Maybe (fromMaybe)
-import           Data.Text (Text)
 import           Data.Text (Text, unpack)
 import           Debug.Trace
 import           IHaskell.IPython.Types
@@ -32,7 +31,7 @@ parseMessage :: [ByteString] -- ^ The list of identifiers sent with the message.
              -> Message      -- ^ A parsed message.
 parseMessage idents headerData parentHeader metadata content =
   let header = parseHeader idents headerData parentHeader metadata
-      messageType = msgType header
+      messageType = mhMsgType header
       messageWithoutHeader = parser messageType $ Lazy.fromStrict content
   in messageWithoutHeader { header = header }
 
@@ -43,15 +42,7 @@ parseHeader :: [ByteString]  -- ^ The list of identifiers.
             -> ByteString    -- ^ The metadata, or "{}" for an empty map.
             -> MessageHeader -- The resulting message header.
 parseHeader idents headerData parentHeader metadata =
-  MessageHeader
-    { identifiers = idents
-    , parentHeader = parentResult
-    , metadata = metadataMap
-    , messageId = messageUUID
-    , sessionId = sessionUUID
-    , username = username
-    , msgType = messageType
-    }
+  MessageHeader idents parentResult metadataMap messageUUID sessionUUID username messageType
   where
     -- Decode the header data and the parent header data into JSON objects. If the parent header data is
     -- absent, just have Nothing instead.
@@ -180,6 +171,7 @@ displayDataParser = requestParser $ \obj -> do
   let displayDatas = makeDisplayDatas dataDict
   return $ PublishDisplayData noHeader displayDatas
 
+requestParser :: FromJSON a => (a -> Parser Message) -> LByteString -> Message
 requestParser parser content =
   case parseEither parser decoded of
     Right parsed -> parsed
@@ -218,6 +210,7 @@ inputMessageParser = requestParser $ \obj -> do
   executionCount <- obj .: "execution_count"
   return $ Input noHeader code executionCount
 
+getDisplayDatas :: Maybe Object -> [DisplayData]
 getDisplayDatas Nothing = []
 getDisplayDatas (Just dataDict) = makeDisplayDatas dataDict
 

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

@@ -3,7 +3,7 @@
 -- Generate, parse, and pretty print UUIDs for use with IPython.
 module IHaskell.IPython.Message.UUID (UUID, random, randoms, uuidToString) where
 
-import           Control.Applicative ((<$>), (<*>))
+import           Control.Applicative ((<$>))
 import           Control.Monad (mzero, replicateM)
 import           Data.Aeson
 import           Data.Text (pack)

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

-{-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-name-shadowing -fno-warn-unused-matches #-}
-
--- | Description : @ToJSON@ for Messages
---
--- This module contains the @ToJSON@ instance for @Message@.
-module IHaskell.IPython.Message.Writer (ToJSON(..)) where
-
-import           Data.Aeson
-import           Data.Aeson.Types (Pair)
-import           Data.Aeson.Parser (json)
-import           Data.Map (Map)
-import           Data.Monoid (mempty)
-import           Data.Text (Text, pack)
-import           Data.Text.Encoding (encodeUtf8)
-import qualified Data.Map               as Map
-import           IHaskell.IPython.Types
-import           Data.Maybe (fromMaybe)
-
-instance ToJSON LanguageInfo where
-  toJSON info = object
-                  [ "name" .= languageName info
-                  , "version" .= languageVersion info
-                  , "file_extension" .= languageFileExtension info
-                  , "codemirror_mode" .= languageCodeMirrorMode info
-                  , "pygments_lexer" .= languagePygmentsLexer info
-                  ]
-
--- Convert message bodies into JSON.
-instance ToJSON Message where
-  toJSON rep@KernelInfoReply{} =
-    object
-      [ "protocol_version" .= protocolVersion rep
-      , "banner" .= banner rep
-      , "implementation" .= implementation rep
-      , "implementation_version" .= implementationVersion rep
-      , "language_info" .= languageInfo rep
-      , "status" .= show (status rep)
-      ]
-
-  toJSON CommInfoReply
-    { header = header
-    , commInfo = commInfo
-    } =
-    object
-      [ "comms" .= Map.map (\comm -> object ["target_name" .= comm]) commInfo
-      , "status" .= string "ok"
-      ]
-
-  toJSON ExecuteRequest
-    { getCode = code
-    , getSilent = silent
-    , getStoreHistory = storeHistory
-    , getAllowStdin = allowStdin
-    , getUserExpressions = userExpressions
-    } =
-    object
-      [ "code" .= code
-      , "silent" .= silent
-      , "store_history" .= storeHistory
-      , "allow_stdin" .= allowStdin
-      , "user_expressions" .= userExpressions
-      ]
-
-  toJSON ExecuteReply { status = status, executionCounter = counter, pagerOutput = pager } =
-    object
-      [ "status" .= show status
-      , "execution_count" .= counter
-      , "payload" .=
-        if null pager
-          then []
-          else mkPayload pager
-      , "user_expressions" .= emptyMap
-      ]
-    where
-      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 } =
-    object ["data" .= content, "name" .= streamType]
-  toJSON PublishDisplayData { displayData = datas } =
-    object
-      ["metadata" .= object [], "data" .= object (map displayDataToJson datas)]
-
-  toJSON PublishOutput { executionCount = execCount, reprText = reprText } =
-    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) =
-    object
-      [ "matches" .= matches
-      , "cursor_start" .= start
-      , "cursor_end" .= end
-      , "metadata" .= metadata
-      , "status" .= if status
-                      then string "ok"
-                      else "error"
-      ]
-  toJSON i@InspectReply{} =
-    object
-      [ "status" .= if inspectStatus i
-                      then string "ok"
-                      else "error"
-      , "data" .= object (map displayDataToJson . inspectData $ i)
-      , "metadata" .= object []
-      , "found" .= inspectStatus i
-      ]
-
-  toJSON ShutdownReply { restartPending = restart } =
-    object ["restart" .= restart
-           , "status" .= string "ok"
-           ]
-
-  toJSON ClearOutput { wait = wait } =
-    object ["wait" .= wait]
-
-  toJSON RequestInput { inputPrompt = prompt } =
-    object ["prompt" .= prompt]
-
-  toJSON req@CommOpen{} =
-    object
-      [ "comm_id" .= commUuid req
-      , "target_name" .= commTargetName req
-      , "target_module" .= commTargetModule req
-      , "data" .= commData req
-      ]
-
-  toJSON req@CommData{} =
-    object ["comm_id" .= commUuid req, "data" .= commData req]
-
-  toJSON req@CommClose{} =
-    object ["comm_id" .= commUuid req, "data" .= commData req]
-
-  toJSON req@HistoryReply{} =
-    object ["history" .= map tuplify (historyReply req)
-           , "status" .= string "ok"
-           ]
-    where
-      tuplify (HistoryReplyElement sess linum res) = (sess, linum, case res of
-                                                                     Left inp         -> toJSON inp
-                                                                     Right (inp, out) -> toJSON out)
-
-  toJSON req@IsCompleteReply{} =
-    object pairs
-    where
-      pairs =
-        case reviewResult req of
-          CodeComplete       -> status "complete"
-          CodeIncomplete ind -> status "incomplete" ++ indent ind
-          CodeInvalid        -> status "invalid"
-          CodeUnknown        -> status "unknown"
-      status x = ["status" .= pack x]
-      indent x = ["indent" .= pack x]
-
-  toJSON body = error $ "Do not know how to convert to JSON for message " ++ show body
-
--- | Print an execution state as "busy", "idle", or "starting".
-instance ToJSON ExecutionState where
-  toJSON Busy = String "busy"
-  toJSON Idle = String "idle"
-  toJSON Starting = String "starting"
-
--- | Print a stream as "stdin" or "stdout" strings.
-instance ToJSON StreamType where
-  toJSON Stdin = String "stdin"
-  toJSON Stdout = String "stdout"
-
--- | Convert a MIME type and value into a JSON dictionary pair.
-displayDataToJson :: DisplayData -> (Text, Value)
-displayDataToJson (DisplayData MimeJson dataStr) = 
-    pack (show MimeJson) .= fromMaybe (String "") (decodeStrict (encodeUtf8 dataStr) :: Maybe Value)
-displayDataToJson (DisplayData MimeVegalite dataStr) = 
-    pack (show MimeVegalite) .= fromMaybe (String "") (decodeStrict (encodeUtf8 dataStr) :: Maybe Value)
-displayDataToJson (DisplayData MimeVega dataStr) = 
-    pack (show MimeVega) .= fromMaybe (String "") (decodeStrict (encodeUtf8 dataStr) :: Maybe Value)
-displayDataToJson (DisplayData mimeType dataStr) =
-  pack (show mimeType) .= String dataStr
-
------ Constants -----
-emptyMap :: Map String String
-emptyMap = mempty
-
-emptyList :: [Int]
-emptyList = []
-
-ints :: [Int] -> [Int]
-ints = id
-
-string :: String -> String
-string = id

main/Main.hs

@@ -195,7 +195,7 @@ runKernel kOpts profileSrc = do
       installHandler keyboardSignal (CatchOnce $ putStrLn "Press Ctrl-C again to quit kernel.")
         Nothing
 
-    isCommMessage req = msgType (header req) `elem` [CommDataMessage, CommCloseMessage]
+    isCommMessage req = mhMsgType (header req) `elem` [CommDataMessage, CommCloseMessage]
 
 -- Initial kernel state.
 initialKernelState :: IO (MVar KernelState)
@@ -206,19 +206,11 @@ createReplyHeader :: MessageHeader -> Interpreter MessageHeader
 createReplyHeader parent = do
   -- Generate a new message UUID.
   newMessageId <- liftIO UUID.random
-  let repType = fromMaybe err (replyType $ msgType parent)
-      err = error $ "No reply for message " ++ show (msgType parent)
+  let repType = fromMaybe err (replyType $ mhMsgType parent)
+      err = error $ "No reply for message " ++ show (mhMsgType parent)
 
-  return
-    MessageHeader
-      { identifiers = identifiers parent
-      , parentHeader = Just parent
-      , metadata = Map.fromList []
-      , messageId = newMessageId
-      , sessionId = sessionId parent
-      , username = username parent
-      , msgType = repType
-      }
+  return $ MessageHeader (mhIdentifiers parent) (Just parent) mempty
+            newMessageId (mhSessionId parent) (mhUsername parent) repType
 
 -- | Compute a reply to a message.
 replyTo :: ZeroMQInterface -> Message -> MessageHeader -> KernelState -> Interpreter (KernelState, Message)
@@ -432,7 +424,7 @@ handleComm send kernelState req replyHeader = do
   newState <- case Map.lookup uuid widgets of
     Nothing -> return kernelState
     Just (Widget widget) ->
-      case msgType $ header req of
+      case mhMsgType $ header req of
         CommDataMessage -> do
           disp <- run $ comm widget dat communicate
           pgrOut <- liftIO $ readMVar pOut

src/IHaskell/IPython/Stdin.hs

@@ -33,7 +33,6 @@ import           GHC.IO.Handle
 import           GHC.IO.Handle.Types
 import           System.Posix.IO
 import           System.IO.Unsafe
-import qualified Data.Map as Map
 
 import           IHaskell.IPython.Types
 import           IHaskell.IPython.ZeroMQ
@@ -88,15 +87,8 @@ getInputLine dir = do
   -- Send a request for input.
   uuid <- UUID.random
   parentHdr <- fromJust . readMay <$> readFile (dir ++ "/.last-req-header")
-  let hdr = MessageHeader
-        { username = username parentHdr
-        , identifiers = identifiers parentHdr
-        , parentHeader = Just parentHdr
-        , messageId = uuid
-        , sessionId = sessionId parentHdr
-        , metadata = Map.fromList []
-        , msgType = InputRequestMessage
-        }
+  let hdr = MessageHeader (mhIdentifiers parentHdr) (Just parentHdr) mempty
+              uuid (mhSessionId parentHdr) (mhUsername parentHdr) InputRequestMessage
   let msg = RequestInput hdr ""
   writeChan req msg
 

src/IHaskell/Types.hs

@@ -39,7 +39,7 @@ module IHaskell.Types (
 
 import           IHaskellPrelude
 
-import           Data.Aeson (ToJSON, Value, (.=), object)
+import           Data.Aeson (ToJSON (..), Value, (.=), object)
 import           Data.Function (on)
 import           Data.Serialize
 import           GHC.Generics
@@ -268,4 +268,4 @@ dupHeader :: MessageHeader -> MessageType -> IO MessageHeader
 dupHeader hdr messageType = do
   uuid <- liftIO random
 
-  return hdr { messageId = uuid, msgType = messageType }
+  return hdr { mhMessageId = uuid, mhMsgType = messageType }