Commit bf631b91 authored by Alexander Vershilov's avatar Alexander Vershilov

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.
parent db8b7c1b
...@@ -148,7 +148,8 @@ executable ihaskell ...@@ -148,7 +148,8 @@ executable ihaskell
strict >=0.3, strict >=0.3,
unix >= 2.6, unix >= 2.6,
directory -any, directory -any,
ipython-kernel >=0.7 ipython-kernel >=0.7,
unordered-containers -any
Test-Suite hspec Test-Suite hspec
Type: exitcode-stdio-1.0 Type: exitcode-stdio-1.0
......
...@@ -34,6 +34,7 @@ import Control.Concurrent (MVar, readChan, writeChan, newMVar, readMVa ...@@ -34,6 +34,7 @@ import Control.Concurrent (MVar, readChan, writeChan, newMVar, readMVa
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad (forever, when, void) import Control.Monad (forever, when, void)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import qualified Data.Text as T import qualified Data.Text as T
...@@ -123,7 +124,7 @@ createReplyHeader parent = do ...@@ -123,7 +124,7 @@ createReplyHeader parent = do
let repType = fromMaybe err (replyType $ mhMsgType parent) let repType = fromMaybe err (replyType $ mhMsgType parent)
err = error $ "No reply for message " ++ show (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 newMessageId (mhSessionId parent) (mhUsername parent) repType
...@@ -219,7 +220,7 @@ replyTo config _ _ req@CompleteRequest{} replyHeader = do ...@@ -219,7 +220,7 @@ replyTo config _ _ req@CompleteRequest{} replyHeader = do
let start = pos - T.length matchedText let start = pos - T.length matchedText
end = pos end = pos
reply = CompleteReply replyHeader completions start end Map.empty True reply = CompleteReply replyHeader completions start end (Metadata HashMap.empty) True
return reply return reply
replyTo config _ _ req@InspectRequest{} replyHeader = do replyTo config _ _ req@InspectRequest{} replyHeader = do
......
...@@ -14,7 +14,6 @@ import Data.Aeson.Types (Parser, parse, parseEither) ...@@ -14,7 +14,6 @@ import Data.Aeson.Types (Parser, parse, parseEither)
import Data.ByteString hiding (unpack) import Data.ByteString hiding (unpack)
import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString.Lazy as Lazy
import Data.HashMap.Strict as HM import Data.HashMap.Strict as HM
import Data.Map (Map)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Text (Text, unpack) import Data.Text (Text, unpack)
import Debug.Trace import Debug.Trace
...@@ -59,7 +58,7 @@ parseHeader idents headerData parentHeader metadata = ...@@ -59,7 +58,7 @@ parseHeader idents headerData parentHeader metadata =
return (messType, username, message, session) return (messType, username, message, session)
-- Get metadata as a simple map. -- 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 :: MessageHeader
noHeader = error "No header created" noHeader = error "No header created"
......
{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric #-} {-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric, GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-name-shadowing -fno-warn-unused-matches #-} {-# 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. -- | This module contains all types used to create an IPython language kernel.
...@@ -16,7 +16,6 @@ module IHaskell.IPython.Types ( ...@@ -16,7 +16,6 @@ module IHaskell.IPython.Types (
Message(..), Message(..),
MessageHeader(..), MessageHeader(..),
Username, Username,
Metadata,
MessageType(..), MessageType(..),
CodeReview(..), CodeReview(..),
Width, Width,
...@@ -27,6 +26,7 @@ module IHaskell.IPython.Types ( ...@@ -27,6 +26,7 @@ module IHaskell.IPython.Types (
HistoryAccessType(..), HistoryAccessType(..),
HistoryReplyElement(..), HistoryReplyElement(..),
LanguageInfo(..), LanguageInfo(..),
Metadata(..),
replyType, replyType,
showMessageType, showMessageType,
...@@ -169,7 +169,8 @@ instance ToJSON MessageHeader where ...@@ -169,7 +169,8 @@ instance ToJSON MessageHeader where
type Username = Text type Username = Text
-- | A metadata dictionary. -- | 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. -- | The type of a message, corresponding to IPython message types.
data MessageType = KernelInfoReplyMessage data MessageType = KernelInfoReplyMessage
......
...@@ -20,6 +20,7 @@ import System.Environment (getArgs) ...@@ -20,6 +20,7 @@ import System.Environment (getArgs)
import System.Environment (setEnv) import System.Environment (setEnv)
import System.Posix.Signals import System.Posix.Signals
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.HashMap.Strict as HashMap
import Data.List (break, last) import Data.List (break, last)
import Data.Version (showVersion) import Data.Version (showVersion)
...@@ -328,7 +329,7 @@ replyTo _ req@CompleteRequest{} replyHeader state = do ...@@ -328,7 +329,7 @@ replyTo _ req@CompleteRequest{} replyHeader state = do
let start = pos - length matchedText let start = pos - length matchedText
end = pos 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) return (state, reply)
replyTo _ req@InspectRequest{} replyHeader state = do replyTo _ req@InspectRequest{} replyHeader state = do
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment