From bf631b913f424df49fade0e0fb17f746fab3473c Mon Sep 17 00:00:00 2001
From: Alexander Vershilov <alexander.vershilov@gmail.com>
Date: Fri, 16 Nov 2018 23:11:28 +0300
Subject: [PATCH] Use Aeson.Object for metadata.

The IPython specification for the metadata does not
define that all fields in metadata must be textual.
Latest Jupyters lab uses that feature so the parsing
mechanism became incomplatible with the protocol.
We change Metadata to be an Aeson.Object and introduce
a 'Metadata' newtype in order to keep that explicit
and open for the later changes if needed.

Fixes #912.
---
 ihaskell.cabal                                        | 3 ++-
 ipython-kernel/src/IHaskell/IPython/EasyKernel.hs     | 5 +++--
 ipython-kernel/src/IHaskell/IPython/Message/Parser.hs | 3 +--
 ipython-kernel/src/IHaskell/IPython/Types.hs          | 7 ++++---
 main/Main.hs                                          | 3 ++-
 5 files changed, 12 insertions(+), 9 deletions(-)

diff --git a/ihaskell.cabal b/ihaskell.cabal
index 751bd83b..43da5494 100644
--- a/ihaskell.cabal
+++ b/ihaskell.cabal
@@ -148,7 +148,8 @@ executable ihaskell
                        strict               >=0.3,
                        unix                 >= 2.6,
                        directory            -any,
-                       ipython-kernel       >=0.7
+                       ipython-kernel       >=0.7,
+                       unordered-containers -any
 
 Test-Suite hspec
     Type: exitcode-stdio-1.0
diff --git a/ipython-kernel/src/IHaskell/IPython/EasyKernel.hs b/ipython-kernel/src/IHaskell/IPython/EasyKernel.hs
index 3c2cd044..c9f6d987 100644
--- a/ipython-kernel/src/IHaskell/IPython/EasyKernel.hs
+++ b/ipython-kernel/src/IHaskell/IPython/EasyKernel.hs
@@ -34,6 +34,7 @@ import           Control.Concurrent (MVar, readChan, writeChan, newMVar, readMVa
 import           Control.Monad.IO.Class (MonadIO(..))
 import           Control.Monad (forever, when, void)
 
+import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Map as Map
 import           Data.Maybe (fromMaybe)
 import qualified Data.Text as T
@@ -123,7 +124,7 @@ createReplyHeader parent = do
   let repType = fromMaybe err (replyType $ mhMsgType parent)
       err = error $ "No reply for message " ++ show (mhMsgType parent)
 
-  return $ MessageHeader (mhIdentifiers parent) (Just parent) (Map.fromList [])
+  return $ MessageHeader (mhIdentifiers parent) (Just parent) (Metadata (HashMap.fromList []))
             newMessageId (mhSessionId parent) (mhUsername parent) repType
 
 
@@ -219,7 +220,7 @@ replyTo config _ _ req@CompleteRequest{} replyHeader = do
 
   let start = pos - T.length matchedText
       end = pos
-      reply = CompleteReply replyHeader completions start end Map.empty True
+      reply = CompleteReply replyHeader completions start end (Metadata HashMap.empty) True
   return reply
 
 replyTo config _ _ req@InspectRequest{} replyHeader = do
diff --git a/ipython-kernel/src/IHaskell/IPython/Message/Parser.hs b/ipython-kernel/src/IHaskell/IPython/Message/Parser.hs
index 6aa949d1..04f0a3b6 100644
--- a/ipython-kernel/src/IHaskell/IPython/Message/Parser.hs
+++ b/ipython-kernel/src/IHaskell/IPython/Message/Parser.hs
@@ -14,7 +14,6 @@ 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, unpack)
 import           Debug.Trace
@@ -59,7 +58,7 @@ parseHeader idents headerData parentHeader metadata =
       return (messType, username, message, session)
 
     -- Get metadata as a simple map.
-    Just metadataMap = decode $ Lazy.fromStrict metadata :: Maybe (Map Text Text)
+    Just metadataMap = fmap Metadata $ decode $ Lazy.fromStrict metadata
 
 noHeader :: MessageHeader
 noHeader = error "No header created"
diff --git a/ipython-kernel/src/IHaskell/IPython/Types.hs b/ipython-kernel/src/IHaskell/IPython/Types.hs
index 353abb1c..8485a22a 100644
--- a/ipython-kernel/src/IHaskell/IPython/Types.hs
+++ b/ipython-kernel/src/IHaskell/IPython/Types.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric, GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-name-shadowing -fno-warn-unused-matches #-}
 
 -- | This module contains all types used to create an IPython language kernel.
@@ -16,7 +16,6 @@ module IHaskell.IPython.Types (
     Message(..),
     MessageHeader(..),
     Username,
-    Metadata,
     MessageType(..),
     CodeReview(..),
     Width,
@@ -27,6 +26,7 @@ module IHaskell.IPython.Types (
     HistoryAccessType(..),
     HistoryReplyElement(..),
     LanguageInfo(..),
+    Metadata(..),
     replyType,
     showMessageType,
 
@@ -169,7 +169,8 @@ instance ToJSON MessageHeader where
 type Username = Text
 
 -- | A metadata dictionary.
-type Metadata = Map Text Text
+newtype Metadata = Metadata Object
+  deriving (Show, Read, ToJSON, Monoid)
 
 -- | The type of a message, corresponding to IPython message types.
 data MessageType = KernelInfoReplyMessage
diff --git a/main/Main.hs b/main/Main.hs
index 28c341b6..d353c646 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -20,6 +20,7 @@ import           System.Environment (getArgs)
 import           System.Environment (setEnv)
 import           System.Posix.Signals
 import qualified Data.Map as Map
+import qualified Data.HashMap.Strict as HashMap
 import           Data.List (break, last)
 import           Data.Version (showVersion)
 
@@ -328,7 +329,7 @@ replyTo _ req@CompleteRequest{} replyHeader state = do
 
   let start = pos - length matchedText
       end = pos
-      reply = CompleteReply replyHeader (map T.pack completions) start end Map.empty True
+      reply = CompleteReply replyHeader (map T.pack completions) start end (Metadata HashMap.empty) True
   return (state, reply)
 
 replyTo _ req@InspectRequest{} replyHeader state = do