diff --git a/examples/Calc.hs b/examples/Calc.hs --- a/examples/Calc.hs +++ b/examples/Calc.hs @@ -8,7 +8,7 @@ import Control.Concurrent (MVar, newMVar, takeMVar, putMVar, threadDelay) import Control.Monad (guard) import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.State.Strict (StateT, get, modify, runStateT) +import Control.Monad.Trans.State.Strict (StateT, get, modify, runStateT) import Data.Char (isDigit) import Data.List (isPrefixOf) @@ -222,6 +222,7 @@ , languageFileExtension = ".txt" , languageCodeMirrorMode = "null" , languagePygmentsLexer = "Text" + , languageMimeType = "x/extended-huttons-razor" } , writeKernelspec = const $ return $ KernelSpec { kernelDisplayName = "Hutton's Razor" diff --git a/examples/Simple.hs b/examples/Simple.hs --- a/examples/Simple.hs +++ b/examples/Simple.hs @@ -62,6 +62,7 @@ , languageFileExtension = ".txt" , languageCodeMirrorMode = "null" , languagePygmentsLexer = "Text" + , languageMimeType = "x/funcalc" } languageKernelspec :: KernelSpec diff --git a/ipython-kernel.cabal b/ipython-kernel.cabal --- a/ipython-kernel.cabal +++ b/ipython-kernel.cabal @@ -1,5 +1,5 @@ name: ipython-kernel -version: 0.10.2.1 +version: 0.10.2.2 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. @@ -12,7 +12,7 @@ category: Development build-type: Simple -cabal-version: >=1.16 +cabal-version: 1.16 data-dir: example-data data-files: calc_profile.tar @@ -37,9 +37,8 @@ default-language: Haskell2010 build-depends: base >=4.9 && <5, aeson , + binary , bytestring , - cereal , - cereal-text , containers , cryptonite , directory , @@ -47,7 +46,6 @@ filepath , process , memory , - mtl , text , transformers , unordered-containers, @@ -63,7 +61,6 @@ build-depends: ipython-kernel , base , filepath , - mtl , parsec , text , transformers @@ -78,7 +75,6 @@ build-depends: ipython-kernel , base , filepath , - mtl , parsec , text , transformers diff --git a/src/IHaskell/IPython/EasyKernel.hs b/src/IHaskell/IPython/EasyKernel.hs --- a/src/IHaskell/IPython/EasyKernel.hs +++ b/src/IHaskell/IPython/EasyKernel.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, CPP #-} -- | Description : Easy IPython kernels = Overview This module provides automation for writing -- simple IPython kernels. In particular, it provides a record type that defines configurations and @@ -34,7 +34,6 @@ 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 @@ -47,6 +46,12 @@ import System.Exit (exitSuccess) import System.IO (openFile, IOMode(ReadMode)) +#if MIN_VERSION_aeson(2,0,0) +import qualified Data.Aeson.KeyMap as KeyMap +#else +import qualified Data.HashMap.Strict as HashMap +#endif + -- | The kernel configuration specifies the behavior that is specific to your language. The type -- parameters provide the monad in which your kernel will run, the type of intermediate outputs from -- running cells, and the type of final results of cells, respectively. @@ -124,8 +129,13 @@ let repType = fromMaybe err (replyType $ mhMsgType parent) err = error $ "No reply for message " ++ show (mhMsgType parent) +#if MIN_VERSION_aeson(2,0,0) + return $ MessageHeader (mhIdentifiers parent) (Just parent) (Metadata (KeyMap.fromList [])) + newMessageId (mhSessionId parent) (mhUsername parent) repType [] +#else return $ MessageHeader (mhIdentifiers parent) (Just parent) (Metadata (HashMap.fromList [])) newMessageId (mhSessionId parent) (mhUsername parent) repType [] +#endif -- | Execute an IPython kernel for a config. Your 'main' action should call this as the last thing @@ -221,7 +231,11 @@ let start = pos - T.length matchedText end = pos +#if MIN_VERSION_aeson(2,0,0) + reply = CompleteReply replyHeader completions start end (Metadata KeyMap.empty) True +#else reply = CompleteReply replyHeader completions start end (Metadata HashMap.empty) True +#endif return reply replyTo config _ _ req@InspectRequest{} replyHeader = do diff --git a/src/IHaskell/IPython/Message/Parser.hs b/src/IHaskell/IPython/Message/Parser.hs --- a/src/IHaskell/IPython/Message/Parser.hs +++ b/src/IHaskell/IPython/Message/Parser.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, CPP #-} {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-name-shadowing #-} -- | Description : Parsing messages received from IPython @@ -8,17 +8,22 @@ -- the low-level 0MQ interface. module IHaskell.IPython.Message.Parser (parseMessage) where -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.Maybe (fromMaybe) import Data.Text (unpack) import Debug.Trace import IHaskell.IPython.Types +#if MIN_VERSION_aeson(2,0,0) +import qualified Data.Aeson.KeyMap as KM +import Data.Aeson.Key +#else +import Data.HashMap.Strict as HM +#endif + type LByteString = Lazy.ByteString -- --- External interface ----- | Parse a message from its ByteString components into a Message. @@ -154,8 +159,11 @@ return $ ExecuteError noHeader traceback ename evalue makeDisplayDatas :: Object -> [DisplayData] -makeDisplayDatas dataDict = [DisplayData (read $ unpack mimeType) content | (mimeType, String content) <- HM.toList - dataDict] +#if MIN_VERSION_aeson(2,0,0) +makeDisplayDatas dataDict = [DisplayData (read $ unpack (toText mimeType)) content | (mimeType, String content) <- KM.toList dataDict] +#else +makeDisplayDatas dataDict = [DisplayData (read $ unpack mimeType) content | (mimeType, String content) <- HM.toList dataDict] +#endif -- | Parse an execute result executeResultParser :: LByteString -> Message diff --git a/src/IHaskell/IPython/Message/UUID.hs b/src/IHaskell/IPython/Message/UUID.hs --- a/src/IHaskell/IPython/Message/UUID.hs +++ b/src/IHaskell/IPython/Message/UUID.hs @@ -3,7 +3,6 @@ -- 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.Monad (mzero, replicateM) import Data.Aeson import Data.Text (pack) diff --git a/src/IHaskell/IPython/Types.hs b/src/IHaskell/IPython/Types.hs --- a/src/IHaskell/IPython/Types.hs +++ b/src/IHaskell/IPython/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric, GeneralizedNewtypeDeriving, CPP #-} {-# 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. @@ -35,9 +35,9 @@ DisplayData(..), MimeType(..), extractPlain, + displayDataToJson, ) where -import Control.Applicative ((<$>), (<*>)) import Data.Aeson import Data.Aeson.Types (typeMismatch) import Data.ByteString (ByteString) @@ -46,8 +46,7 @@ import qualified Data.Map as Map import Data.Maybe (fromMaybe) import Data.Semigroup (Semigroup) -import Data.Serialize -import Data.Serialize.Text () +import Data.Binary import Data.Text (Text, pack) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text @@ -55,6 +54,10 @@ import GHC.Generics (Generic) import IHaskell.IPython.Message.UUID +#if MIN_VERSION_aeson(2,0,0) +import Data.Aeson.Key +#endif + ------------------ IPython Kernel Profile Types ---------------------- -- -- | A TCP port. @@ -221,8 +224,8 @@ showMessageType StreamMessage = "stream" showMessageType DisplayDataMessage = "display_data" showMessageType UpdateDisplayDataMessage = "update_display_data" -showMessageType OutputMessage = "pyout" -showMessageType InputMessage = "pyin" +showMessageType OutputMessage = "execute_result" +showMessageType InputMessage = "execute_input" showMessageType IsCompleteRequestMessage = "is_complete_request" showMessageType IsCompleteReplyMessage = "is_complete_reply" showMessageType CompleteRequestMessage = "complete_request" @@ -580,7 +583,8 @@ toJSON PublishStatus { executionState = executionState } = object ["execution_state" .= executionState] toJSON PublishStream { streamType = streamType, streamContent = content } = - object ["data" .= content, "name" .= streamType] + -- Since 5.0 "data" key was renamed to "text"" + object ["text" .= content, "name" .= streamType, "output_type" .= string "stream"] toJSON r@PublishDisplayData { displayData = datas } = object $ case transient r of @@ -673,9 +677,164 @@ toJSON body = error $ "Do not know how to convert to JSON for message " ++ show body + toEncoding rep@KernelInfoReply{} = + pairs $ mconcat + [ "protocol_version" .= protocolVersion rep + , "banner" .= banner rep + , "implementation" .= implementation rep + , "implementation_version" .= implementationVersion rep + , "language_info" .= languageInfo rep + , "status" .= show (status rep) + ] + toEncoding CommInfoReply + { header = header + , commInfo = commInfo + } = + pairs $ mconcat + [ "comms" .= Map.map (\comm -> object ["target_name" .= comm]) commInfo + , "status" .= string "ok" + ] + toEncoding ExecuteRequest + { getCode = code + , getSilent = silent + , getStoreHistory = storeHistory + , getAllowStdin = allowStdin + , getUserExpressions = userExpressions + } = + pairs $ mconcat + [ "code" .= code + , "silent" .= silent + , "store_history" .= storeHistory + , "allow_stdin" .= allowStdin + , "user_expressions" .= userExpressions + ] + toEncoding ExecuteReply { status = status, executionCounter = counter, pagerOutput = pager } = + pairs $ mconcat + [ "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) + ] + ] + toEncoding ExecuteError { header = header, traceback = traceback, ename = ename, evalue = evalue } = + pairs $ mconcat + [ "header" .= show header + , "traceback" .= map toJSON traceback + , "ename" .= ename + , "evalue" .= evalue + ] + toEncoding PublishStatus { executionState = executionState } = + pairs $ mconcat ["execution_state" .= executionState] + toEncoding PublishStream { streamType = streamType, streamContent = content } = + -- Since 5.0 "data" key was renamed to "text"" + pairs $ mconcat ["text" .= content, "name" .= streamType, "output_type" .= string "stream"] + toEncoding r@PublishDisplayData { displayData = datas } + = pairs $ mconcat + $ case transient r of + Just t -> (("transient" .= toJSON (transient r)) :) + Nothing -> id + $ ["metadata" .= object [] + , "data" .= object (map displayDataToJson datas) + ] + toEncoding r@PublishUpdateDisplayData { displayData = datas } + = pairs $ mconcat + $ case transient r of + Just t -> (("transient" .= toJSON (transient r)) :) + Nothing -> id + $ ["metadata" .= object [] + , "data" .= object (map displayDataToJson datas) + ] + toEncoding PublishOutput { executionCount = execCount, reprText = reprText } = + pairs $ mconcat + [ "data" .= object ["text/plain" .= reprText] + , "execution_count" .= execCount + , "metadata" .= object [] + ] + toEncoding PublishInput { executionCount = execCount, inCode = code } = + pairs $ mconcat ["execution_count" .= execCount, "code" .= code] + toEncoding (CompleteReply _ matches start end metadata status) = + pairs $ mconcat + [ "matches" .= matches + , "cursor_start" .= start + , "cursor_end" .= end + , "metadata" .= metadata + , "status" .= if status + then string "ok" + else "error" + ] + toEncoding i@InspectReply{} = + pairs $ mconcat + [ "status" .= if inspectStatus i + then string "ok" + else "error" + , "data" .= object (map displayDataToJson . inspectData $ i) + , "metadata" .= object [] + , "found" .= inspectStatus i + ] + + toEncoding ShutdownReply { restartPending = restart } = + pairs $ mconcat ["restart" .= restart + , "status" .= string "ok" + ] + + toEncoding ClearOutput { wait = wait } = + pairs $ mconcat ["wait" .= wait] + + toEncoding RequestInput { inputPrompt = prompt } = + pairs $ mconcat ["prompt" .= prompt] + + toEncoding req@CommOpen{} = + pairs $ mconcat + [ "comm_id" .= commUuid req + , "target_name" .= commTargetName req + , "target_module" .= commTargetModule req + , "data" .= commData req + ] + + toEncoding req@CommData{} = + pairs $ mconcat ["comm_id" .= commUuid req, "data" .= commData req] + + toEncoding req@CommClose{} = + pairs $ mconcat ["comm_id" .= commUuid req, "data" .= commData req] + + toEncoding req@HistoryReply{} = + pairs $ mconcat ["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) + + toEncoding req@IsCompleteReply{} = + pairs $ mconcat replyPairs + where + replyPairs = + 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] + + toEncoding body = error $ "Do not know how to convert to JSON for message " ++ show body + + + + -- | Ways in which the frontend can request history. TODO: Implement fields as described in -- messaging spec. data HistoryAccessType = HistoryRange @@ -766,9 +925,9 @@ instance Show DisplayData where show _ = "DisplayData" -instance Serialize DisplayData +instance Binary DisplayData -instance Serialize MimeType +instance Binary MimeType -- | Possible MIME types for the display data. type Width = Int @@ -789,6 +948,7 @@ | MimeVega | MimeVegalite | MimeVdom + | MimeWidget | MimeCustom Text deriving (Eq, Typeable, Generic) @@ -817,6 +977,7 @@ show MimeVega = "application/vnd.vega.v5+json" show MimeVegalite = "application/vnd.vegalite.v4+json" show MimeVdom = "application/vdom.v1+json" + show MimeWidget = "application/vnd.jupyter.widget-view+json" show (MimeCustom custom) = Text.unpack custom instance Read MimeType where @@ -834,9 +995,23 @@ readsPrec _ "application/vnd.vega.v5+json" = [(MimeVega, "")] readsPrec _ "application/vnd.vegalite.v4+json" = [(MimeVegalite, "")] readsPrec _ "application/vdom.v1+json" = [(MimeVdom, "")] + readsPrec _ "application/vnd.jupyter.widget-view+json" = [(MimeWidget, "")] readsPrec _ t = [(MimeCustom (Text.pack t), "")] -- | Convert a MIME type and value into a JSON dictionary pair. +#if MIN_VERSION_aeson(2,0,0) +displayDataToJson :: DisplayData -> (Key, Value) +displayDataToJson (DisplayData MimeJson dataStr) = + fromText (pack (show MimeJson)) .= fromMaybe (String "") (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value) +displayDataToJson (DisplayData MimeVegalite dataStr) = + fromText (pack (show MimeVegalite)) .= fromMaybe (String "") (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value) +displayDataToJson (DisplayData MimeVega dataStr) = + fromText (pack (show MimeVega)) .= fromMaybe (String "") (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value) +displayDataToJson (DisplayData MimeWidget dataStr) = + fromText (pack (show MimeWidget)) .= fromMaybe (object []) (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value) +displayDataToJson (DisplayData mimeType dataStr) = + fromText (pack (show mimeType)) .= String dataStr +#else displayDataToJson :: DisplayData -> (Text, Value) displayDataToJson (DisplayData MimeJson dataStr) = pack (show MimeJson) .= fromMaybe (String "") (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value) @@ -844,8 +1019,11 @@ pack (show MimeVegalite) .= fromMaybe (String "") (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value) displayDataToJson (DisplayData MimeVega dataStr) = pack (show MimeVega) .= fromMaybe (String "") (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value) +displayDataToJson (DisplayData MimeWidget dataStr) = + pack (show MimeWidget) .= fromMaybe (object []) (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value) displayDataToJson (DisplayData mimeType dataStr) = - pack (show mimeType) .= String dataStr + pack (show mimeType) .= String dataStr +#endif string :: String -> String string = id diff --git a/src/IHaskell/IPython/ZeroMQ.hs b/src/IHaskell/IPython/ZeroMQ.hs --- a/src/IHaskell/IPython/ZeroMQ.hs +++ b/src/IHaskell/IPython/ZeroMQ.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, DoAndIfThenElse, FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings, DoAndIfThenElse, FlexibleContexts, CPP #-} -- | Description : Low-level ZeroMQ communication wrapper. --