Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
G
gargantext-ihaskell
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
gargantext-ihaskell
Commits
1ab66f35
Commit
1ab66f35
authored
Jun 02, 2015
by
Sumit Sahrawat
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Basic framework for widgets
parent
388d819e
Changes
7
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
272 additions
and
106 deletions
+272
-106
ihaskell.cabal
ihaskell.cabal
+1
-0
Main.hs
main/Main.hs
+83
-17
Display.hs
src/IHaskell/Display.hs
+1
-6
Evaluate.hs
src/IHaskell/Eval/Evaluate.hs
+38
-37
Util.hs
src/IHaskell/Eval/Util.hs
+9
-0
Widgets.hs
src/IHaskell/Eval/Widgets.hs
+53
-0
Types.hs
src/IHaskell/Types.hs
+87
-46
No files found.
ihaskell.cabal
View file @
1ab66f35
...
...
@@ -106,6 +106,7 @@ library
IHaskell.Eval.Parser
IHaskell.Eval.Hoogle
IHaskell.Eval.ParseShell
IHaskell.Eval.Widgets
IHaskell.Eval.Util
IHaskell.IPython
IHaskell.IPython.Stdin
...
...
main/Main.hs
View file @
1ab66f35
...
...
@@ -124,11 +124,12 @@ runKernel kernelOpts profileSrc = do
-- Initialize the context by evaluating everything we got from the command line flags.
let
noPublish
_
=
return
()
noWidget
s
_
=
return
s
evaluator
line
=
void
$
do
-- Create a new state each time.
stateVar
<-
liftIO
initialKernelState
state
<-
liftIO
$
takeMVar
stateVar
evaluate
state
line
noPublish
evaluate
state
line
noPublish
noWidget
confFile
<-
liftIO
$
kernelSpecConfFile
kernelOpts
case
confFile
of
...
...
@@ -260,18 +261,7 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
DisplayData
MimeHtml
$
mconcat
[
"<style>"
,
T
.
pack
ihaskellCSS
,
"</style>"
,
html
]
prependCss
x
=
x
startComm
::
CommInfo
->
IO
()
startComm
(
CommInfo
widget
uuid
target
)
=
do
-- Send the actual comm open.
header
<-
dupHeader
replyHeader
CommOpenMessage
send
$
CommOpen
header
target
uuid
(
Object
mempty
)
-- Send anything else the widget requires.
let
communicate
value
=
do
head
<-
dupHeader
replyHeader
CommDataMessage
writeChan
(
iopubChannel
interface
)
$
CommData
head
uuid
value
open
widget
communicate
-- Publish outputs, ignore any CommMsgs
publish
::
EvaluationResult
->
IO
()
publish
result
=
do
let
final
=
...
...
@@ -296,9 +286,6 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
when
final
$
do
modifyMVar_
displayed
(
return
.
(
outs
:
))
-- Start all comms that need to be started.
mapM_
startComm
$
startComms
result
-- If this has some pager output, store it for later.
let
pager
=
pagerOut
result
unless
(
null
pager
)
$
...
...
@@ -306,13 +293,92 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
then
modifyMVar_
pagerOutput
(
return
.
(
++
pager
))
else
sendOutput
$
Display
pager
handleMessage
::
KernelState
->
WidgetMsg
->
IO
KernelState
handleMessage
state
(
Open
widget
value
)
=
do
-- Check whether the widget is already present in the state
let
oldComms
=
openComms
state
uuid
=
getCommUUID
widget
present
=
isJust
$
Map
.
lookup
uuid
oldComms
newComms
=
Map
.
insert
uuid
widget
$
openComms
state
newState
=
state
{
openComms
=
newComms
}
target
=
targetName
widget
communicate
value
=
do
head
<-
dupHeader
replyHeader
CommDataMessage
writeChan
(
iopubChannel
interface
)
$
CommData
head
uuid
value
if
present
then
return
state
else
do
-- Send the comm open
header
<-
dupHeader
replyHeader
CommOpenMessage
send
$
CommOpen
header
target
uuid
value
-- Send anything else the widget requires.
open
widget
communicate
-- Store the widget in the kernelState
return
newState
handleMessage
state
(
Close
widget
value
)
=
do
let
oldComms
=
openComms
state
present
=
isJust
$
Map
.
lookup
(
getCommUUID
widget
)
oldComms
target
=
targetName
widget
uuid
=
getCommUUID
widget
newComms
=
Map
.
delete
uuid
$
openComms
state
newState
=
state
{
openComms
=
newComms
}
if
present
then
do
header
<-
dupHeader
replyHeader
CommCloseMessage
send
$
CommClose
header
uuid
value
return
newState
else
return
state
handleMessage
state
(
View
widget
)
=
do
let
oldComms
=
openComms
state
uuid
=
getCommUUID
widget
present
=
isJust
$
Map
.
lookup
(
getCommUUID
widget
)
oldComms
when
present
$
do
header
<-
dupHeader
replyHeader
CommDataMessage
send
.
CommData
header
uuid
$
toJSON
DisplayWidget
return
state
-- Assume that a state update means that it is time the stored widget also gets updated.
-- Thus replace the stored widget with the copy passed in the CommMsg.
handleMessage
state
(
Update
widget
value
)
=
do
let
oldComms
=
openComms
state
present
=
isJust
$
Map
.
lookup
(
getCommUUID
widget
)
oldComms
target
=
targetName
widget
uuid
=
getCommUUID
widget
newComms
=
Map
.
insert
uuid
widget
$
openComms
state
newState
=
state
{
openComms
=
newComms
}
if
present
then
do
header
<-
dupHeader
replyHeader
CommDataMessage
send
.
CommData
header
uuid
.
toJSON
$
UpdateState
value
return
newState
else
return
state
widgetHandler
::
KernelState
->
[
WidgetMsg
]
->
IO
KernelState
widgetHandler
state
[]
=
return
state
widgetHandler
state
(
x
:
xs
)
=
do
newState
<-
handleMessage
state
x
widgetHandler
newState
xs
let
execCount
=
getExecutionCounter
state
-- Let all frontends know the execution count and code that's about to run
inputHeader
<-
liftIO
$
dupHeader
replyHeader
InputMessage
send
$
PublishInput
inputHeader
(
T
.
unpack
code
)
execCount
-- Run code and publish to the frontend as we go.
updatedState
<-
evaluate
state
(
T
.
unpack
code
)
publish
updatedState
<-
evaluate
state
(
T
.
unpack
code
)
publish
widgetHandler
-- Notify the frontend that we're done computing.
idleHeader
<-
liftIO
$
dupHeader
replyHeader
StatusMessage
...
...
src/IHaskell/Display.hs
View file @
1ab66f35
...
...
@@ -68,6 +68,7 @@ import System.IO.Unsafe (unsafePerformIO)
import
qualified
Data.Text.Encoding
as
E
import
IHaskell.Types
import
IHaskell.Eval.Util
(
unfoldM
)
import
StringUtils
(
rstrip
)
type
Base64
=
Text
...
...
@@ -154,12 +155,6 @@ displayFromChan :: IO (Maybe Display)
displayFromChan
=
Just
.
many
<$>
unfoldM
(
atomically
$
tryReadTChan
displayChan
)
-- | This is unfoldM from monad-loops. It repeatedly runs an IO action until it return Nothing, and
-- puts all the Justs in a list. If you find yourself using more functionality from monad-loops,
-- just add the package dependency instead of copying more code from it.
unfoldM
::
IO
(
Maybe
a
)
->
IO
[
a
]
unfoldM
f
=
maybe
(
return
[]
)
(
\
r
->
(
r
:
)
<$>
unfoldM
f
)
=<<
f
-- | Write to the display channel. The contents will be displayed in the notebook once the current
-- execution call ends.
printDisplay
::
IHaskellDisplay
a
=>
a
->
IO
()
...
...
src/IHaskell/Eval/Evaluate.hs
View file @
1ab66f35
...
...
@@ -84,6 +84,7 @@ import qualified IHaskell.Eval.Hoogle as Hoogle
import
IHaskell.Eval.Util
import
IHaskell.BrokenPackages
import
qualified
IHaskell.IPython.Message.UUID
as
UUID
import
IHaskell.Eval.Widgets
import
StringUtils
(
replace
,
split
,
strip
,
rstrip
)
import
Paths_ihaskell
(
version
)
...
...
@@ -251,9 +252,9 @@ data EvalOut =
EvalOut
{
evalStatus
::
ErrorOccurred
,
evalResult
::
Display
,
evalState
::
KernelState
,
evalPager
::
String
,
eval
Comms
::
[
CommInfo
]
,
evalState
::
KernelState
,
evalPager
::
String
,
eval
Msgs
::
[
WidgetMsg
]
}
cleanString
::
String
->
String
...
...
@@ -275,8 +276,9 @@ cleanString x = if allBrackets
evaluate
::
KernelState
-- ^ The kernel state.
->
String
-- ^ Haskell code or other interpreter commands.
->
(
EvaluationResult
->
IO
()
)
-- ^ Function used to publish data outputs.
->
(
KernelState
->
[
WidgetMsg
]
->
IO
KernelState
)
-- ^ Function to handle widget messages
->
Interpreter
KernelState
evaluate
kernelState
code
output
=
do
evaluate
kernelState
code
output
widgetHandler
=
do
cmds
<-
parseString
(
cleanString
code
)
let
execCount
=
getExecutionCounter
kernelState
...
...
@@ -321,13 +323,18 @@ evaluate kernelState code output = do
Just
disps
->
evalResult
evalOut
<>
disps
helpStr
=
evalPager
evalOut
-- Capture all widget messages queued during code execution
messagesIO
<-
extractValue
"IHaskell.Eval.Widgets.relayWidgetMessages"
messages
<-
liftIO
messagesIO
let
commMessages
=
evalMsgs
evalOut
++
messages
-- Output things only if they are non-empty.
let
empty
=
noResults
result
&&
null
helpStr
&&
null
(
evalComms
evalOut
)
let
empty
=
noResults
result
&&
null
helpStr
unless
empty
$
liftIO
$
output
$
FinalResult
result
[
plain
helpStr
]
(
evalComms
evalOut
)
liftIO
$
output
$
FinalResult
result
[
plain
helpStr
]
[]
--
Make sure to clear all comms we've started.
let
newState
=
evalState
evalOut
{
evalComms
=
[]
}
--
Handle all the widget messages
newState
<-
liftIO
$
widgetHandler
(
evalState
evalOut
)
commMessages
case
evalStatus
evalOut
of
Success
->
runUntilFailure
newState
rest
...
...
@@ -353,7 +360,7 @@ safely state = ghandle handler . ghandle sourceErrorHandler
,
evalResult
=
displayError
$
show
exception
,
evalState
=
state
,
evalPager
=
""
,
eval
Comm
s
=
[]
,
eval
Msg
s
=
[]
}
sourceErrorHandler
::
SourceError
->
Interpreter
EvalOut
...
...
@@ -372,7 +379,7 @@ safely state = ghandle handler . ghandle sourceErrorHandler
,
evalResult
=
displayError
fullErr
,
evalState
=
state
,
evalPager
=
""
,
eval
Comm
s
=
[]
,
eval
Msg
s
=
[]
}
wrapExecution
::
KernelState
...
...
@@ -386,7 +393,7 @@ wrapExecution state exec = safely state $
,
evalResult
=
res
,
evalState
=
state
,
evalPager
=
""
,
eval
Comm
s
=
[]
,
eval
Msg
s
=
[]
}
-- | Return the display data for this command, as well as whether it resulted in an error.
...
...
@@ -476,7 +483,7 @@ evalCommand output (Directive SetDynFlag flagsStr) state = safely state $ do
]
,
evalState
=
state
,
evalPager
=
""
,
eval
Comm
s
=
[]
,
eval
Msg
s
=
[]
}
else
do
-- Apply all IHaskell flag updaters to the state to get the new state
...
...
@@ -502,7 +509,7 @@ evalCommand output (Directive SetDynFlag flagsStr) state = safely state $ do
,
evalResult
=
display
,
evalState
=
state'
,
evalPager
=
""
,
eval
Comm
s
=
[]
,
eval
Msg
s
=
[]
}
evalCommand
output
(
Directive
SetExtension
opts
)
state
=
do
...
...
@@ -536,7 +543,7 @@ evalCommand a (Directive SetOption opts) state = do
,
evalResult
=
displayError
err
,
evalState
=
state
,
evalPager
=
""
,
eval
Comm
s
=
[]
,
eval
Msg
s
=
[]
}
else
let
options
=
mapMaybe
findOption
$
words
opts
updater
=
foldl'
(
.
)
id
$
map
getUpdateKernelState
options
...
...
@@ -546,7 +553,7 @@ evalCommand a (Directive SetOption opts) state = do
,
evalResult
=
mempty
,
evalState
=
updater
state
,
evalPager
=
""
,
eval
Comm
s
=
[]
,
eval
Msg
s
=
[]
}
where
...
...
@@ -680,7 +687,7 @@ evalCommand _ (Directive GetHelp _) state = do
,
evalResult
=
Display
[
out
]
,
evalState
=
state
,
evalPager
=
""
,
eval
Comm
s
=
[]
,
eval
Msg
s
=
[]
}
where
...
...
@@ -729,7 +736,7 @@ evalCommand _ (Directive GetInfo str) state = safely state $ do
,
evalResult
=
mempty
,
evalState
=
state
,
evalPager
=
output
,
eval
Comm
s
=
[]
,
eval
Msg
s
=
[]
}
evalCommand
_
(
Directive
SearchHoogle
query
)
state
=
safely
state
$
do
...
...
@@ -814,7 +821,7 @@ evalCommand output (Expression expr) state = do
,
evalResult
=
mempty
,
evalState
=
state
,
evalPager
=
""
,
eval
Comm
s
=
[]
,
eval
Msg
s
=
[]
}
else
do
if
canRunDisplay
...
...
@@ -822,9 +829,8 @@ evalCommand output (Expression expr) state = do
-- Use the display. As a result, `it` is set to the output.
out
<-
useDisplay
displayExpr
-- Register the `it` object as a widget.
if
isWidget
then
register
Widget
out
then
display
Widget
out
else
return
out
else
do
-- Evaluate this expression as though it's just a statement. The output is bound to 'it', so we can
...
...
@@ -897,27 +903,22 @@ evalCommand output (Expression expr) state = do
then
display
::
Display
else
removeSvg
display
register
Widget
::
EvalOut
->
Ghc
EvalOut
register
Widget
evalOut
=
display
Widget
::
EvalOut
->
Ghc
EvalOut
display
Widget
evalOut
=
case
evalStatus
evalOut
of
Failure
->
return
evalOut
Success
->
do
element
<-
dynCompileExpr
"IHaskell.Display.Widget it"
case
fromDynamic
element
of
Nothing
->
error
"Expecting widget"
Just
widget
->
do
-- Stick the widget in the kernel state.
uuid
<-
liftIO
UUID
.
random
let
state
=
evalState
evalOut
newComms
=
Map
.
insert
uuid
widget
$
openComms
state
state'
=
state
{
openComms
=
newComms
}
-- Store the fact that we should start this comm.
return
evalOut
{
evalComms
=
CommInfo
widget
uuid
(
targetName
widget
)
:
evalComms
evalOut
,
evalState
=
state'
}
Just
(
Widget
widget
)
->
do
let
oldComms
=
openComms
state
uuid
=
getCommUUID
widget
case
Map
.
lookup
uuid
oldComms
of
Nothing
->
error
"Unregistered widget"
Just
w
->
do
liftIO
$
widgetSendView
widget
return
evalOut
isIO
expr
=
attempt
$
exprType
$
printf
"((
\\
x -> x) :: IO a -> IO a) (%s)"
expr
...
...
@@ -987,7 +988,7 @@ evalCommand _ (ParseError loc err) state = do
,
evalResult
=
displayError
$
formatParseError
loc
err
,
evalState
=
state
,
evalPager
=
""
,
eval
Comm
s
=
[]
,
eval
Msg
s
=
[]
}
evalCommand
_
(
Pragma
(
PragmaUnsupported
pragmaType
)
pragmas
)
state
=
wrapExecution
state
$
...
...
@@ -1004,7 +1005,7 @@ hoogleResults state results =
,
evalResult
=
mempty
,
evalState
=
state
,
evalPager
=
output
,
eval
Comm
s
=
[]
,
eval
Msg
s
=
[]
}
where
-- TODO: Make pager work with plaintext
...
...
src/IHaskell/Eval/Util.hs
View file @
1ab66f35
...
...
@@ -21,6 +21,9 @@ module IHaskell.Eval.Util (
doc
,
pprDynFlags
,
pprLanguages
,
-- * Monad-loops
unfoldM
,
)
where
import
IHaskellPrelude
...
...
@@ -385,3 +388,9 @@ getDescription str = do
if
fixity
==
GHC
.
defaultFixity
then
O
.
empty
else
O
.
ppr
fixity
O
.<+>
pprInfixName
(
getName
thing
)
-- | This is unfoldM from monad-loops. It repeatedly runs an IO action until it return Nothing, and
-- puts all the Justs in a list. If you find yourself using more functionality from monad-loops,
-- just add the package dependency instead of copying more code from it.
unfoldM
::
IO
(
Maybe
a
)
->
IO
[
a
]
unfoldM
f
=
maybe
(
return
[]
)
(
\
r
->
(
r
:
)
<$>
unfoldM
f
)
=<<
f
src/IHaskell/Eval/Widgets.hs
0 → 100644
View file @
1ab66f35
module
IHaskell.Eval.Widgets
(
widgetSendOpen
,
widgetSendUpdate
,
widgetSendView
,
widgetSendClose
)
where
import
IHaskellPrelude
import
Data.Aeson
(
Value
)
import
Control.Concurrent.STM
(
atomically
)
import
Control.Concurrent.STM.TChan
import
System.IO.Unsafe
(
unsafePerformIO
)
import
IHaskell.Display
import
IHaskell.Types
(
Message
(
..
),
WidgetMsg
(
..
))
import
IHaskell.IPython.Message.UUID
import
IHaskell.Eval.Util
(
unfoldM
)
-- All comm_open messages go here
widgetMessages
::
TChan
WidgetMsg
{-# NOINLINE widgetMessages #-}
widgetMessages
=
unsafePerformIO
newTChanIO
-- | Return all pending comm_close messages
relayWidgetMessages
::
IO
[
WidgetMsg
]
relayWidgetMessages
=
relayMessages
widgetMessages
-- | Extract all messages from a TChan and wrap them in a list
relayMessages
::
TChan
a
->
IO
[
a
]
relayMessages
=
unfoldM
.
atomically
.
tryReadTChan
-- | Write a widget message to the chan
queue
::
WidgetMsg
->
IO
()
queue
=
atomically
.
writeTChan
widgetMessages
-- | Send a message
widgetSend
::
IHaskellWidget
a
=>
(
Widget
->
Value
->
WidgetMsg
)
->
a
->
Value
->
IO
()
widgetSend
msgType
widget
value
=
queue
$
msgType
(
Widget
widget
)
value
widgetSendOpen
::
IHaskellWidget
a
=>
a
->
Value
->
IO
()
widgetSendOpen
=
widgetSend
Open
widgetSendUpdate
::
IHaskellWidget
a
=>
a
->
Value
->
IO
()
widgetSendUpdate
=
widgetSend
Update
widgetSendView
::
IHaskellWidget
a
=>
a
->
IO
()
widgetSendView
=
queue
.
View
.
Widget
widgetSendClose
::
IHaskellWidget
a
=>
a
->
Value
->
IO
()
widgetSendClose
=
widgetSend
Close
src/IHaskell/Types.hs
View file @
1ab66f35
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, DeriveDataTypeable, DeriveGeneric, ExistentialQuantification #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Description : All message type definitions.
module
IHaskell.Types
(
...
...
@@ -26,29 +30,33 @@ module IHaskell.Types (
IHaskellDisplay
(
..
),
IHaskellWidget
(
..
),
Widget
(
..
),
CommInfo
(
..
),
WidgetMsg
(
..
),
WidgetMethod
(
..
),
KernelSpec
(
..
),
)
where
import
IHaskellPrelude
import
qualified
Data.Text
as
T
import
qualified
Data.Text.Lazy
as
LT
import
qualified
Data.ByteString
as
BS
import
qualified
Data.ByteString.Lazy
as
LBS
import
qualified
Data.ByteString.Char8
as
CBS
import
qualified
Data.ByteString.Char8
as
Char
import
qualified
Data.ByteString
as
BS
import
qualified
Data.ByteString.Char8
as
CBS
import
qualified
Data.ByteString.Lazy
as
LBS
import
qualified
Data.Text
as
T
import
qualified
Data.Text.Lazy
as
LT
import
Data.Aeson
(
Value
,
(
.=
),
object
)
import
Data.Aeson.Types
(
emptyObject
)
import
qualified
Data.ByteString.Char8
as
Char
import
Data.Function
(
on
)
import
Data.Serialize
import
GHC.Generics
import
Data.Aeson
(
Value
)
import
IHaskell.IPython.Kernel
-- | A class for displayable Haskell types.
--
-- IHaskell's displaying of results behaves as if these two
overlapping/undecidable instances also
-- existed:
--
-- IHaskell's displaying of results behaves as if these two
--
overlapping/undecidable instances also
existed:
--
-- > instance (Show a) => IHaskellDisplay a
-- > instance Show a where shows _ = id
class
IHaskellDisplay
a
where
...
...
@@ -56,25 +64,34 @@ class IHaskellDisplay a where
-- | Display as an interactive widget.
class
IHaskellDisplay
a
=>
IHaskellWidget
a
where
-- | Output target name for this widget. The actual input parameter should be ignored.
-- | Output target name for this widget. The actual input parameter
-- should be ignored. By default evaluate to "ipython.widget", which
-- is used by IPython for its backbone widgets.
targetName
::
a
->
String
targetName
_
=
"ipython.widget"
-- | Called when the comm is opened. Allows additional messages to be sent after comm open.
open
::
a
-- ^ Widget to open a comm port with.
->
(
Value
->
IO
()
)
-- ^ Way to respond to the message.
-- | Get the uuid for comm associated with this widget. The widget
-- is responsible for storing the UUID during initialization.
getCommUUID
::
a
->
UUID
-- | Called when the comm is opened. Allows additional messages to
-- be sent after comm open.
open
::
a
-- ^ Widget to open a comm port with.
->
(
Value
->
IO
()
)
-- ^ A function for sending messages.
->
IO
()
open
_
_
=
return
()
-- | Respond to a comm data message.
comm
::
a
-- ^ Widget which is being communicated with.
->
Value
-- ^ Sent data.
-- | Respond to a comm data message. Called when a message is
-- recieved on the comm associated with the widget.
comm
::
a
-- ^ Widget which is being communicated with.
->
Value
-- ^ Data recieved from the frontend.
->
(
Value
->
IO
()
)
-- ^ Way to respond to the message.
->
IO
()
comm
_
_
_
=
return
()
-- | C
lose the comm, releasing any resources we might need to
.
-- | C
alled when a comm_close is recieved from the frontend
.
close
::
a
-- ^ Widget to close comm port with.
->
Value
-- ^
Sent data
.
->
Value
-- ^
Data recieved from the frontend
.
->
IO
()
close
_
_
=
return
()
...
...
@@ -85,16 +102,20 @@ instance IHaskellDisplay Widget where
display
(
Widget
widget
)
=
display
widget
instance
IHaskellWidget
Widget
where
targetName
(
Widget
widget
)
=
targetName
widget
open
(
Widget
widget
)
=
open
widget
comm
(
Widget
widget
)
=
comm
widget
close
(
Widget
widget
)
=
close
widget
targetName
(
Widget
widget
)
=
targetName
widget
getCommUUID
(
Widget
widget
)
=
getCommUUID
widget
open
(
Widget
widget
)
=
open
widget
comm
(
Widget
widget
)
=
comm
widget
close
(
Widget
widget
)
=
close
widget
instance
Show
Widget
where
show
_
=
"<Widget>"
-- | Wrapper for ipython-kernel's DisplayData which allows sending multiple results from the same
-- expression.
instance
Eq
Widget
where
(
==
)
=
(
==
)
`
on
`
getCommUUID
-- | Wrapper for ipython-kernel's DisplayData which allows sending
-- multiple results from the same expression.
data
Display
=
Display
[
DisplayData
]
|
ManyDisplay
[
Display
]
deriving
(
Show
,
Typeable
,
Generic
)
...
...
@@ -112,13 +133,13 @@ instance Monoid Display where
data
KernelState
=
KernelState
{
getExecutionCounter
::
Int
,
getLintStatus
::
LintStatus
-- Whether to use hlint, and what arguments to pass it.
,
useSvg
::
Bool
,
useShowErrors
::
Bool
,
useShowTypes
::
Bool
,
usePager
::
Bool
,
openComms
::
Map
UUID
Widget
,
kernelDebug
::
Bool
,
getLintStatus
::
LintStatus
-- Whether to use hlint, and what arguments to pass it.
,
useSvg
::
Bool
,
useShowErrors
::
Bool
,
useShowTypes
::
Bool
,
usePager
::
Bool
,
openComms
::
Map
UUID
Widget
,
kernelDebug
::
Bool
}
deriving
Show
...
...
@@ -137,10 +158,9 @@ defaultKernelState = KernelState
-- | Kernel options to be set via `:set` and `:option`.
data
KernelOpt
=
KernelOpt
{
getOptionName
::
[
String
]
-- ^ Ways to set this option via `:option`
,
getSetName
::
[
String
]
-- ^ Ways to set this option via `:set`
,
getUpdateKernelState
::
KernelState
->
KernelState
-- ^ Function to update the kernel
-- state.
{
getOptionName
::
[
String
]
-- ^ Ways to set this option via `:option`
,
getSetName
::
[
String
]
-- ^ Ways to set this option via `:set`
,
getUpdateKernelState
::
KernelState
->
KernelState
-- ^ Function to update the kernel state.
}
kernelOpts
::
[
KernelOpt
]
...
...
@@ -162,21 +182,42 @@ data LintStatus = LintOn
|
LintOff
deriving
(
Eq
,
Show
)
data
CommInfo
=
CommInfo
Widget
UUID
String
data
WidgetMsg
=
Open
Widget
Value
-- ^ Cause the interpreter to open a new comm, and
-- register the associated widget in the
-- kernelState.
|
Update
Widget
Value
-- ^ Cause the interpreter to send a comm_msg
-- containing a state update for the widget.
-- Can be used to send fragments of state for update.
-- Also updates the value of widget stored in the kernelState
|
View
Widget
-- ^ Cause the interpreter to send a comm_msg
-- containing a display command for the frontend.
|
Close
Widget
Value
-- ^ Cause the interpreter to close the comm
-- associated with the widget. Also sends data with
-- comm_close.
deriving
Show
data
WidgetMethod
=
UpdateState
Value
|
DisplayWidget
instance
ToJSON
WidgetMethod
where
toJSON
DisplayWidget
=
object
[
"method"
.=
"display"
]
toJSON
(
UpdateState
v
)
=
object
[
"method"
.=
"update"
,
"state"
.=
v
]
-- | Output of evaluation.
data
EvaluationResult
=
-- | An intermediate result which communicates what has been printed thus
-- far.
-- | An intermediate result which communicates what has been printed thus far.
IntermediateResult
{
outputs
::
Display
-- ^ Display outputs.
{
outputs
::
Display
-- ^ Display outputs.
}
|
FinalResult
{
outputs
::
Display
-- ^ Display outputs.
,
pagerOut
::
[
DisplayData
]
-- ^ Mimebundles to display in the IPython
-- pager.
,
startComms
::
[
CommInfo
]
-- ^ Comms to start.
{
outputs
::
Display
-- ^ Display outputs.
,
pagerOut
::
[
DisplayData
]
-- ^ Mimebundles to display in the IPython pager.
,
commMsgs
::
[
WidgetMsg
]
-- ^ Comm operations
}
deriving
Show
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment