Commit 8eaf1aa6 authored by Andrew Gibiansky's avatar Andrew Gibiansky

Merging jupyter branch into master

parents 7c242ca4 05dd79dc
...@@ -504,11 +504,7 @@ parseStringTests = describe "Parser" $ do ...@@ -504,11 +504,7 @@ parseStringTests = describe "Parser" $ do
it "breaks without data kinds" $ it "breaks without data kinds" $
parses "data X = 3" `like` [ parses "data X = 3" `like` [
#if MIN_VERSION_ghc(7, 8, 0)
ParseError (Loc 1 10) "Illegal literal in type (use DataKinds to enable): 3" ParseError (Loc 1 10) "Illegal literal in type (use DataKinds to enable): 3"
#else
ParseError (Loc 1 10) "Illegal literal in type (use -XDataKinds to enable): 3"
#endif
] ]
it "parses statements after imports" $ do it "parses statements after imports" $ do
......
import Distribution.Simple import Distribution.Simple
main = defaultMain
import Control.Applicative ((<$>))
import Data.List (isInfixOf)
import Codec.Archive.Tar (create)
import System.Directory (getDirectoryContents)
-- This is currently *not used*. build-type is Simple.
-- This is because it breaks installing from Hackage.
main = defaultMainWithHooks simpleUserHooks {
preBuild = makeProfileTar
}
makeProfileTar args flags = do
putStrLn "Building profile.tar."
let profileDir = "profile"
tarFile = profileDir ++ "/profile.tar"
files <- filter realFile <$> filter notProfileTar <$> getDirectoryContents profileDir
print files
create tarFile profileDir files
preBuild simpleUserHooks args flags
where
notProfileTar str = not $ "profile.tar" `isInfixOf` str
realFile str = str /= "." && str /= ".."
...@@ -13,14 +13,8 @@ fi ...@@ -13,14 +13,8 @@ fi
# What to install. # What to install.
INSTALLS="" INSTALLS=""
# Make the profile # Remove my kernelspec
cd profile rm -rf ~/.ipython/kernels/haskell
rm -f profile.tar
tar -cvf profile.tar * .profile_version
cd ..
# Remove my profile
rm -rf ~/.ipython/profile_haskell
# Compile dependencies. # Compile dependencies.
if [ $# -gt 0 ]; then if [ $# -gt 0 ]; then
......
define(['require',
'codemirror/lib/codemirror',
'codemirror/addon/mode/loadmode',
'base/js/namespace',
'base/js/events',
'base/js/utils'],
function(require, CodeMirror, CodemirrorLoadmode, IPython, events, utils){
var onload = function(){
console.log('Kernel haskell kernel.js is loading.');
// add here logic that shoudl be run once per **page load**
// like adding specific UI, or changing the default value
// of codecell highlight.
// Set tooltips to be triggered after 800ms
IPython.tooltip.time_before_tooltip = 800;
// IPython keycodes.
var space = 32;
var downArrow = 40;
IPython.keyboard.keycodes.down = downArrow; // space
IPython.CodeCell.options_default['cm_config']['mode'] = 'haskell';
utils.requireCodeMirrorMode('haskell', function(){
// Create a multiplexing mode that uses Haskell highlighting by default but
// doesn't highlight command-line directives.
CodeMirror.defineMode("ihaskell", function(config) {
return CodeMirror.multiplexingMode(
CodeMirror.getMode(config, "haskell"),
{
open: /:(?=!)/, // Matches : followed by !, but doesn't consume !
close: /^(?!!)/, // Matches start of line not followed by !, doesn't consume character
mode: CodeMirror.getMode(config, "text/plain"),
delimStyle: "delimit"
}
);
});
cells = IPython.notebook.get_cells();
for(var i in cells){
c = cells[i];
if (c.cell_type === 'code') {
// Force the mode to be Haskell
// This is necessary, otherwise sometimes highlighting just doesn't happen.
// This may be an IPython bug.
c.code_mirror.setOption('mode', 'ihaskell');
c.auto_highlight();
}
}
});
// Prevent the pager from surrounding everything with a <pre>
IPython.Pager.prototype.append_text = function (text) {
this.pager_element.find(".container").append($('<div/>').html(IPython.utils.autoLinkUrls(text)));
};
events.on('shell_reply.Kernel', function() {
// Add logic here that should be run once per reply.
// Highlight things with a .highlight-code class
// The id is the mode with with to highlight
$('.highlight-code').each(function() {
var $this = $(this),
$code = $this.html(),
$unescaped = $('<div/>').html($code).text();
$this.empty();
// Never highlight this block again.
this.className = "";
CodeMirror(this, {
value: $unescaped,
mode: this.id,
lineNumbers: false,
readOnly: true
});
});
});
console.log('IHaskell kernel.js should have been loaded.')
} // end def of onload
return {onload:onload};
}
);
...@@ -43,10 +43,8 @@ build-type: Simple ...@@ -43,10 +43,8 @@ build-type: Simple
cabal-version: >=1.16 cabal-version: >=1.16
data-files: data-files:
installation/ipython.sh html/kernel.js
installation/virtualenv.sh html/logo-64x64.png
installation/run.sh
profile/profile.tar
flag binPkgDb flag binPkgDb
default: True default: True
...@@ -145,6 +143,7 @@ executable IHaskell ...@@ -145,6 +143,7 @@ executable IHaskell
ghc >=7.6 && < 7.11, ghc >=7.6 && < 7.11,
ihaskell -any, ihaskell -any,
MissingH >=1.2, MissingH >=1.2,
here ==1.2.*,
text -any, text -any,
ipython-kernel >= 0.2, ipython-kernel >= 0.2,
unix >= 2.6 unix >= 2.6
......
#!/bin/bash
set -e
# Which virtualenv to use.
VIRTUALENV=$1
# Activate the virtualenv.
source $VIRTUALENV/bin/activate
# Upgrade pip.
echo "Upgrading pip."
pip install --upgrade "pip>=1.4.1"
# Install all necessary dependencies with Pip.
echo "Installing dependency (pyzmq)."
pip install pyzmq==14.0.1
echo "Installing dependency (markupsafe)."
pip install markupsafe==0.18
echo "Installing dependency (jinja2)."
pip install jinja2==2.7.1
echo "Installing dependency (tornado)."
pip install tornado==3.1.1
echo "Installing dependency (pygments)."
pip install pygments==1.6
# Install IPython itself.
echo "Installing IPython (this may take a while)."
pip install ipython
#!/bin/bash
set -e
# Which virtualenv to use.
VIRTUALENV=$1
shift
# Activate the virtualenv, if it exists.
if [[ -f $VIRTUALENV/bin/activate ]]; then
source $VIRTUALENV/bin/activate;
fi
# Run IPython.
# Quotes around $@ are necessary to deal properly with spaces.
# Only add IHASKELL_IPYTHON_ARGS to notebook.
if [[ $1 == "notebook" ]]; then
ipython "$@" $IHASKELL_IPYTHON_ARGS
else
ipython "$@"
fi
#!/bin/bash
set -e
# Which version of virtualenv to use.
VIRTUALENV=virtualenv-1.9.1
# Where to install the virtualenv.
DESTINATION=$1
# Download virtualenv.
echo "Downloading virtualenv."
curl -O https://pypi.python.org/packages/source/v/virtualenv/$VIRTUALENV.tar.gz
tar xvfz $VIRTUALENV.tar.gz
cd $VIRTUALENV
# Create a virtualenv.
echo "Creating a virtualenv."
python virtualenv.py $DESTINATION
...@@ -49,7 +49,8 @@ library ...@@ -49,7 +49,8 @@ library
transformers >=0.3, transformers >=0.3,
unix >=2.6, unix >=2.6,
uuid >=1.3, uuid >=1.3,
zeromq4-haskell >=0.1 zeromq4-haskell >=0.1,
SHA >=1.6
-- Example program -- Example program
......
...@@ -173,7 +173,7 @@ easyKernel :: (MonadIO m) ...@@ -173,7 +173,7 @@ easyKernel :: (MonadIO m)
-> m () -> m ()
easyKernel profileFile config = do easyKernel profileFile config = do
prof <- liftIO $ getProfile profileFile prof <- liftIO $ getProfile profileFile
zmq@(Channels shellReqChan shellRepChan ctrlReqChan ctrlRepChan iopubChan) <- zmq@(Channels shellReqChan shellRepChan ctrlReqChan ctrlRepChan iopubChan _) <-
liftIO $ serveProfile prof liftIO $ serveProfile prof
execCount <- liftIO $ newMVar 0 execCount <- liftIO $ newMVar 0
forever $ do forever $ do
......
...@@ -2,15 +2,11 @@ ...@@ -2,15 +2,11 @@
-- IPython language kernel that supports the @ipython console@ and @ipython -- IPython language kernel that supports the @ipython console@ and @ipython
-- notebook@ frontends. -- notebook@ frontends.
module IHaskell.IPython.Kernel ( module IHaskell.IPython.Kernel (
module IHaskell.IPython.Types, module X,
module IHaskell.IPython.Message.Writer,
module IHaskell.IPython.Message.Parser,
module IHaskell.IPython.Message.UUID,
module IHaskell.IPython.ZeroMQ,
) where ) where
import IHaskell.IPython.Types import IHaskell.IPython.Types as X
import IHaskell.IPython.Message.Writer import IHaskell.IPython.Message.Writer as X
import IHaskell.IPython.Message.Parser import IHaskell.IPython.Message.Parser as X
import IHaskell.IPython.Message.UUID import IHaskell.IPython.Message.UUID as X
import IHaskell.IPython.ZeroMQ import IHaskell.IPython.ZeroMQ as X
...@@ -103,6 +103,11 @@ instance ToJSON Message where ...@@ -103,6 +103,11 @@ instance ToJSON Message where
"data" .= commData req "data" .= commData req
] ]
toJSON req@HistoryReply{} = object [ "history" .= map tuplify (historyReply req) ]
where tuplify (HistoryReplyElement sess linum res) = (sess, linum, case res of
Left inp -> toJSON inp
Right (inp, out) -> toJSON out)
toJSON body = error $ "Do not know how to convert to JSON for message " ++ show body toJSON body = error $ "Do not know how to convert to JSON for message " ++ show body
......
...@@ -11,30 +11,35 @@ module IHaskell.IPython.ZeroMQ ( ...@@ -11,30 +11,35 @@ module IHaskell.IPython.ZeroMQ (
serveStdin, serveStdin,
) where ) where
import qualified Data.ByteString.Lazy as ByteString import qualified Data.ByteString.Lazy as LBS
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Control.Concurrent import qualified Data.ByteString.Char8 as Char
import Control.Monad import Control.Concurrent
import System.IO.Unsafe import Control.Monad
import Data.Aeson (encode) import System.IO.Unsafe
import System.ZMQ4 hiding (stdin) import Data.Aeson (encode)
import System.ZMQ4 hiding (stdin)
import IHaskell.IPython.Types import Data.Digest.Pure.SHA as SHA
import IHaskell.IPython.Message.Parser import Data.Monoid ((<>))
import IHaskell.IPython.Message.Writer
import IHaskell.IPython.Types
import IHaskell.IPython.Message.Parser
import IHaskell.IPython.Message.Writer
-- | The channel interface to the ZeroMQ sockets. All communication is done via -- | The channel interface to the ZeroMQ sockets. All communication is done via
-- Messages, which are encoded and decoded into a lower level form before being -- Messages, which are encoded and decoded into a lower level form before being
-- transmitted to IPython. These channels should functionally serve as -- transmitted to IPython. These channels should functionally serve as
-- high-level sockets which speak Messages instead of ByteStrings. -- high-level sockets which speak Messages instead of ByteStrings.
data ZeroMQInterface = Channels { data ZeroMQInterface =
shellRequestChannel :: Chan Message, -- ^ A channel populated with requests from the frontend. Channels {
shellReplyChannel :: Chan Message, -- ^ Writing to this channel causes a reply to be sent to the frontend. shellRequestChannel :: Chan Message, -- ^ A channel populated with requests from the frontend.
controlRequestChannel :: Chan Message, -- ^ This channel is a duplicate of the shell request channel, shellReplyChannel :: Chan Message, -- ^ Writing to this channel causes a reply to be sent to the frontend.
-- ^ though using a different backend socket. controlRequestChannel :: Chan Message, -- ^ This channel is a duplicate of the shell request channel,
controlReplyChannel :: Chan Message, -- ^ This channel is a duplicate of the shell reply channel, -- though using a different backend socket.
-- ^ though using a different backend socket. controlReplyChannel :: Chan Message, -- ^ This channel is a duplicate of the shell reply channel,
iopubChannel :: Chan Message -- ^ Writing to this channel sends an iopub message to the frontend. -- though using a different backend socket.
iopubChannel :: Chan Message, -- ^ Writing to this channel sends an iopub message to the frontend.
hmacKey :: ByteString -- ^ Key used to sign messages.
} }
data ZeroMQStdin = StdinChannel { data ZeroMQStdin = StdinChannel {
...@@ -54,7 +59,7 @@ serveProfile profile = do ...@@ -54,7 +59,7 @@ serveProfile profile = do
controlReqChan <- dupChan shellReqChan controlReqChan <- dupChan shellReqChan
controlRepChan <- dupChan shellRepChan controlRepChan <- dupChan shellRepChan
iopubChan <- newChan iopubChan <- newChan
let channels = Channels shellReqChan shellRepChan controlReqChan controlRepChan iopubChan let channels = Channels shellReqChan shellRepChan controlReqChan controlRepChan iopubChan (signatureKey profile)
-- Create the context in a separate thread that never finishes. If -- Create the context in a separate thread that never finishes. If
-- withContext or withSocket complete, the context or socket become invalid. -- withContext or withSocket complete, the context or socket become invalid.
...@@ -83,7 +88,7 @@ serveStdin profile = do ...@@ -83,7 +88,7 @@ serveStdin profile = do
-- Serve on all sockets. -- Serve on all sockets.
serveSocket context Router (stdinPort profile) $ \socket -> do serveSocket context Router (stdinPort profile) $ \socket -> do
-- Read the request from the interface channel and send it. -- Read the request from the interface channel and send it.
readChan reqChannel >>= sendMessage socket readChan reqChannel >>= sendMessage (signatureKey profile) socket
-- Receive a response and write it to the interface channel. -- Receive a response and write it to the interface channel.
receiveMessage socket >>= writeChan repChannel receiveMessage socket >>= writeChan repChannel
...@@ -117,7 +122,7 @@ shell channels socket = do ...@@ -117,7 +122,7 @@ shell channels socket = do
receiveMessage socket >>= writeChan requestChannel receiveMessage socket >>= writeChan requestChannel
-- Read the reply from the interface channel and send it. -- Read the reply from the interface channel and send it.
readChan replyChannel >>= sendMessage socket readChan replyChannel >>= sendMessage (hmacKey channels) socket
where where
requestChannel = shellRequestChannel channels requestChannel = shellRequestChannel channels
...@@ -132,7 +137,7 @@ control channels socket = do ...@@ -132,7 +137,7 @@ control channels socket = do
receiveMessage socket >>= writeChan requestChannel receiveMessage socket >>= writeChan requestChannel
-- Read the reply from the interface channel and send it. -- Read the reply from the interface channel and send it.
readChan replyChannel >>= sendMessage socket readChan replyChannel >>= sendMessage (hmacKey channels) socket
where where
requestChannel = controlRequestChannel channels requestChannel = controlRequestChannel channels
...@@ -143,7 +148,7 @@ control channels socket = do ...@@ -143,7 +148,7 @@ control channels socket = do
-- | and then writes the messages to the socket. -- | and then writes the messages to the socket.
iopub :: ZeroMQInterface -> Socket Pub -> IO () iopub :: ZeroMQInterface -> Socket Pub -> IO ()
iopub channels socket = iopub channels socket =
readChan (iopubChannel channels) >>= sendMessage socket readChan (iopubChannel channels) >>= sendMessage (hmacKey channels) socket
-- | Receive and parse a message from a socket. -- | Receive and parse a message from a socket.
receiveMessage :: Receiver a => Socket a -> IO Message receiveMessage :: Receiver a => Socket a -> IO Message
...@@ -177,21 +182,15 @@ receiveMessage socket = do ...@@ -177,21 +182,15 @@ receiveMessage socket = do
else return [] else return []
-- | Encode a message in the IPython ZeroMQ communication protocol -- | Encode a message in the IPython ZeroMQ communication protocol
-- | and send it through the provided socket. -- and send it through the provided socket. Sign it using HMAC
sendMessage :: Sender a => Socket a -> Message -> IO () -- with SHA-256 using the provided key.
sendMessage _ SendNothing = return () sendMessage :: Sender a => ByteString -> Socket a -> Message -> IO ()
sendMessage socket message = do sendMessage _ _ SendNothing = return ()
let head = header message sendMessage hmacKey socket message = do
parentHeaderStr = maybe "{}" encodeStrict $ parentHeader head
idents = identifiers head
metadata = "{}"
content = encodeStrict message
headStr = encodeStrict head
-- Send all pieces of the message. -- Send all pieces of the message.
mapM_ sendPiece idents mapM_ sendPiece idents
sendPiece "<IDS|MSG>" sendPiece "<IDS|MSG>"
sendPiece "" sendPiece signature
sendPiece headStr sendPiece headStr
sendPiece parentHeaderStr sendPiece parentHeaderStr
sendPiece metadata sendPiece metadata
...@@ -205,4 +204,20 @@ sendMessage socket message = do ...@@ -205,4 +204,20 @@ sendMessage socket message = do
-- Encode to a strict bytestring. -- Encode to a strict bytestring.
encodeStrict :: ToJSON a => a -> ByteString encodeStrict :: ToJSON a => a -> ByteString
encodeStrict = ByteString.toStrict . encode encodeStrict = LBS.toStrict . encode
-- Signature for the message using HMAC SHA-256.
signature :: ByteString
signature = hmac $ headStr <> parentHeaderStr <> metadata <> content
-- Compute the HMAC SHA-256 signature of a bytestring message.
hmac :: ByteString -> ByteString
hmac = Char.pack . SHA.showDigest . SHA.hmacSha256 (LBS.fromStrict hmacKey) . LBS.fromStrict
-- Pieces of the message.
head = header message
parentHeaderStr = maybe "{}" encodeStrict $ parentHeader head
idents = identifiers head
metadata = "{}"
content = encodeStrict message
headStr = encodeStrict head
This diff is collapsed.
# Available Variables:
# exe: Path to IHaskell kernel.
c = get_config()
c.KernelManager.kernel_cmd = [exe, 'kernel', '{connection_file}']
c.Session.key = b''
c.Session.keyfile = b''
# Syntax highlight properly in Haskell notebooks.
c.NbConvertBase.default_language = "haskell"
# Where to look for templates.
template_path = "/".join(__file__.split("/")[:-1] + ["templates"])
c.TemplateExporter.template_path = [template_path]
# Empty.
c = get_config()
c.TerminalIPythonApp.display_banner = False
c.TerminalInteractiveShell.confirm_exit = False
c = get_config()
c.NotebookApp.port = 8778
c = get_config()
# QtConsole try to guess base on Python lexing when the input is done to auto
# execute. This Fails on Haskell, and while it is not possible to do the
# lexing in the kernel just deactivate functionality
c.IPythonWidget.execute_on_complete_input = False
// Implement Haskell-Conceal for IPython notebook with IHaskell.
"using strict";
var concealExtension = (function() {
var Pos = CodeMirror.Pos;
// Concealable elements
var conceals = {
"\\": "λ",
".": "",
"/=": "",
"::": "",
">>": "»",
"<<": "«",
"->": "",
"<-": "",
"<>": "",
"!!": "",
"=>": "",
">>=": ">>=",
"forall": "",
"<=": "",
">=": "",
};
// Concealable infix elements
var infixConceals = {
"intersect": "",
"intersection": "",
"union": "",
"elem": "",
"notElem": "",
};
// Return the previous CodeMirror token
function prevToken(editor, token, line) {
var before = editor.getTokenAt(Pos(line, token.start));
return before;
};
// Return the next CodeMirror token
function nextToken(editor, token, line) {
var after = editor.getTokenAt(Pos(line, token.end + 1));
return after;
};
// Create a DOM element for a given conceal element
function concealDOM(data) {
var span = document.createElement("span");
span.innerHTML = data;
return span;
}
// Process a non-infix conceal token.
function markNonInfixToken(editor, line, token) {
// We have a special case for the dot operator. We only want to
// convert it to a fancy composition if there is a space before it.
// This preserves things like [1..1000] which CodeMirror parses
// incorrectly and also lets you write with lenses as record^.a.b.c,
// which looks better.
if (token.string == ".") {
var handle = editor.getLineHandle(line);
var ch = token.start;
if (handle.text[ch - 1] != ' ') {
return false;
}
}
// Check if this is a normal concealable element. (non-infix)
for (var str in conceals) {
if (conceals.hasOwnProperty(str)) {
if (token.string == str) {
editor.markText(Pos(line, token.start), Pos(line, token.end), {
replacedWith: concealDOM(conceals[str]),
});
return true;
}
}
}
return false;
}
function markInfixToken(editor, line, prev, token, next) {
if (prev.string != "`" || next.string != "`") {
return false;
}
for (var str in infixConceals) {
if (infixConceals.hasOwnProperty(str)) {
if (token.string == str) {
editor.markText(Pos(line, prev.start), Pos(line, next.end), {
replacedWith: concealDOM(infixConceals[str]),
});
return true;
}
}
}
return true;
}
// Mark a token if necessary (mark means change how it looks).
function markToken(editor, line, token) {
// If it's a backtick, it might be the end of an infix conceal.
if (token.string == "`") {
var prev = prevToken(editor, token, line);
var prev2 = prevToken(editor, prev, line);
return markInfixToken(editor, line, prev2, prev, token);
}
// Otherwise, try it as a normal non-infix token
// Or as the center of an infix token.
else {
var marked = markNonInfixToken(editor, line, token);
if (marked) {
return true;
}
// Try it as the middle of an infix set
var prev = prevToken(editor, token, line);
var next = nextToken(editor, token, line);
return markInfixToken(editor, line, prev, token, next);
}
}
/**
* Activate conceal in CodeMirror options, don't overwrite other settings
*/
function concealCell(editor) {
// Initialize all tokens. Just look at the token at every character.
editor.eachLine(function (handle) {
var l = editor.getLineNumber(handle);
for (var c = 0; c < handle.text.length; c++) {
var token = editor.getTokenAt(Pos(l, c), true);
markToken(editor, l, token);
}
});
editor.on("change", function() {
var cursor = editor.getCursor();
var token = editor.getTokenAt(cursor, true);
markToken(editor, cursor.line, token);
});
}
/**
* Add conceal to new cell
*
*/
createCell = function (event,nbcell,nbindex) {
var cell = nbcell.cell;
if ((cell instanceof IPython.CodeCell)) {
var editor = cell.code_mirror;
concealCell(editor)
}
};
/**
* Add conceal to existing cells
*/
initExtension = function(event) {
var cells = IPython.notebook.get_cells();
for(var i in cells){
var cell = cells[i];
if ((cell instanceof IPython.CodeCell)) {
var editor = cell.code_mirror;
concealCell(editor);
}
}
$([IPython.events]).on('create.Cell',createCell);
}
IPython.concealCell = concealCell;
require([], initExtension);
})();
$([IPython.events]).on('notebook_loaded.Notebook', function(){
// add here logic that should be run once per **notebook load**
// (!= page load), like restarting a checkpoint
var md = IPython.notebook.metadata;
if(md.language){
console.log('language already defined and is :', md.language);
} else {
md.language = 'haskell' ;
console.log('add metadata hint that language is haskell...');
}
});
$([IPython.events]).on('app_initialized.NotebookApp', function(){
// add here logic that shoudl be run once per **page load**
// like adding specific UI, or changing the default value
// of codecell highlight.
// Set tooltips to be triggered after 800ms
IPython.tooltip.time_before_tooltip = 800;
// IPython keycodes.
var space = 32;
var downArrow = 40;
IPython.keyboard.keycodes.down = downArrow; // space
IPython.CodeCell.options_default['cm_config']['mode'] = 'haskell';
CodeMirror.requireMode('haskell', function(){
// Create a multiplexing mode that uses Haskell highlighting by default but
// doesn't highlight command-line directives.
CodeMirror.defineMode("ihaskell", function(config) {
return CodeMirror.multiplexingMode(
CodeMirror.getMode(config, "haskell"),
{
open: /:(?=!)/, // Matches : followed by !, but doesn't consume !
close: /^(?!!)/, // Matches start of line not followed by !, doesn't consume character
mode: CodeMirror.getMode(config, "text/plain"),
delimStyle: "delimit"
}
);
});
cells = IPython.notebook.get_cells();
for(var i in cells){
c = cells[i];
if (c.cell_type === 'code') {
// Force the mode to be Haskell
// This is necessary, otherwise sometimes highlighting just doesn't happen.
// This may be an IPython bug.
c.code_mirror.setOption('mode', 'ihaskell');
c.auto_highlight()
}
}
// We can only load the conceal scripts once all cells have mode 'haskell'
require(['/static/custom/conceal/conceal.js']);
});
// Prevent the pager from surrounding everything with a <pre>
IPython.Pager.prototype.append_text = function (text) {
this.pager_element.find(".container").append($('<div/>').html(IPython.utils.autoLinkUrls(text)));
};
require(['/static/custom/hide_input.js']);
});
$([IPython.events]).on('shell_reply.Kernel', function() {
// Add logic here that should be run once per reply.
// Highlight things with a .highlight-code class
// The id is the mode with with to highlight
$('.highlight-code').each(function() {
var $this = $(this),
$code = $this.html(),
$unescaped = $('<div/>').html($code).text();
$this.empty();
// Never highlight this block again.
this.className = "";
CodeMirror(this, {
value: $unescaped,
mode: this.id,
lineNumbers: false,
readOnly: true
});
});
});
// This is an extension that enables hiding input cells. It adds a button to
// the cell toolbars to hide and unhide cells, as well as command-mode
// keybindings to left and right arrow keys. Whether or not a cell is hidden is
// stored in the metadata and thus is saved in the notebook. A custom template
// which checks for the "hidden" field in cell metadata could be used to have
// nbconvert ignore hidden cells.
"using strict";
var hideInputCellExtension = (function(){
var Pos = CodeMirror.Pos;
// What text to show for hidden cells. This has to be created every time,
// otherwise you wouldn't be able to hide more than one cell.
var createHiding = function() {
var hiding = document.createElement("span");
hiding.innerHTML = "…";
return hiding;
}
// UI Generator for a simple toggle button. The model for this code is
// taken from IPython.CellToolbar.utils.checkbox_ui_Generator.
IPython.CellToolbar.utils.button_ui_generator = function(name, handler, textfun){
return function(div, cell, celltoolbar) {
var button_container = $(div);
var initText = textfun(cell);
var button = $('<input/>').attr('type', 'button')
.attr('value', initText)
.css('height', '1.1em')
.css('font-size', 20);
var lbl = $('<label/>').append($('<span/>').text(name));
lbl.append(button);
button.click(function() {
handler(cell);
var newText = textfun(cell);
button.attr('value', newText);
});
cell.hide_button = button;
cell.button_container = button_container;
button_container.append($('<div/>').append(lbl));
};
};
// Ensure a cell has the metadata object. Sometimes they don't for unknown reasons.
// Might have something to do with ordering of cell initialization, so this is a hack.
var requireMetadata = function(cell) {
if(cell.metadata === undefined) {
cell.metadata = {};
cell.metadata.hidden = false;
}
}
// Return the text to show in the button for this cell.
var textToShow = function(cell) {
// What text to show on buttons when concealed or shown.
var concealedButton = "⇦";
var shownButton = "⇩";
requireMetadata(cell);
if(cell.metadata.hidden) {
return concealedButton;
} else {
return shownButton;
}
};
// Update whether a cell is visible.
var updateCellVisibility = function(cell, visible) {
cell.metadata.hidden = visible;
if(cell.metadata.hidden) {
if (cell.mark === undefined) {
var editor = cell.code_mirror;
var nLines = editor.lineCount();
var firstLineLen = editor.getLine(0).length;
var lastLineLen = editor.getLine(nLines - 1).length;
var mark = editor.markText(Pos(0, firstLineLen), Pos(nLines, lastLineLen + 1), {
replacedWith: createHiding(),
});
cell.mark = mark;
}
} else if (cell.mark !== undefined) {
cell.mark.clear();
cell.mark = undefined;
}
cell.hide_button.attr('value', textToShow(cell));
}
// Create and register the method that creates the hide arrow.
var flag_name = 'hide_input';
var cell_flag_init = IPython.CellToolbar.utils.button_ui_generator("", function(cell) {
// Toggle cell visibility.
updateCellVisibility(cell, !cell.metadata.hidden);
}, textToShow);
IPython.CellToolbar.register_callback(flag_name, cell_flag_init);
// Create and register the toolbar with IPython.
IPython.CellToolbar.register_preset('Hiding', [flag_name]);
var updateCellToolbar = function(cell) {
var type = cell.cell_type;
if(type != 'code') {
// Set cell to visible.
updateCellVisibility(cell, false);
// Hide the toolbar on Markdown and other non-code cells.
cell.celltoolbar.hide();
} else {
// Show toolbar on code cells.
cell.celltoolbar.show();
}
};
var initExtension = function(event) {
IPython.CellToolbar.activate_preset("Hiding");
IPython.keyboard_manager.command_shortcuts.add_shortcuts({
"left": {
help: "Hide an input cell.",
help_index: "zz",
handler: function(event) {
var cell = IPython.notebook.get_selected_cell();
updateCellVisibility(cell, true);
}
},
"right": {
help: "Unhide an input cell.",
help_index: "zz",
handler: function(event) {
var cell = IPython.notebook.get_selected_cell();
updateCellVisibility(cell, false);
}
}
});
var cells = IPython.notebook.get_cells();
for(var i in cells){
var cell = cells[i];
if ((cell instanceof IPython.CodeCell)) {
updateCellVisibility(cell);
}
updateCellToolbar(cell);
}
$([IPython.events]).on('create.Cell', requireMetadata);
}
// When enetering edit mode, unhide the current cell so you can edit it.
$([IPython.events]).on('edit_mode.Cell',function () {
var cell = IPython.notebook.get_selected_cell();
if(cell.cell_type != "markdown") {
updateCellVisibility(cell, false);
}
});
require([], initExtension);
$([IPython.events]).on('selected_cell_type_changed.Notebook', function (event, data) {
var cell = IPython.notebook.get_selected_cell();
updateCellToolbar(cell);
});
console.log("Loaded input cell hiding extension.")
})();
{%- extends 'full.tpl' -%}
{%- block header -%}
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8" />
<title>{{resources['metadata']['name']}}</title>
{% for css in resources.inlining.css -%}
<style type="text/css">
{{ css }}
</style>
{% endfor %}
<style type="text/css">
/* Overrides of notebook CSS for static HTML export */
body {
overflow: visible;
padding: 8px;
}
.input_area {
padding: 0.2em;
}
pre {
padding: 0.2em;
border: none;
margin: 0px;
font-size: 13px;
}
</style>
<!-- Our custom CSS -->
<style type="text/css">
/*
Custom IHaskell CSS.
*/
/* Styles used for the Hoogle display in the pager */
.hoogle-doc {
display: block;
padding-bottom: 1.3em;
padding-left: 0.4em;
}
.hoogle-code {
display: block;
font-family: monospace;
white-space: pre;
}
.hoogle-text {
display: block;
}
.hoogle-name {
color: green;
font-weight: bold;
}
.hoogle-head {
font-weight: bold;
}
.hoogle-sub {
display: block;
margin-left: 0.4em;
}
.hoogle-package {
font-weight: bold;
font-style: italic;
}
.hoogle-module {
font-weight: bold;
}
/* Styles used for basic displays */
.get-type {
color: green;
font-weight: bold;
font-family: monospace;
display: block;
white-space: pre;
}
.show-type {
color: green;
font-weight: bold;
font-family: monospace;
margin-left: 1em;
}
.mono {
font-family: monospace;
display: block;
}
.err-msg {
color: red;
font-style: italic;
font-family: monospace;
white-space: pre;
display: block;
}
#unshowable {
color: red;
font-weight: bold;
}
.err-msg.in.collapse {
padding-top: 0.7em;
}
/* Code that will get highlighted before it is highlighted */
.highlight-code {
white-space: pre;
font-family: monospace;
}
/* Hlint styles */
.suggestion-warning {
font-weight: bold;
color: rgb(200, 130, 0);
}
.suggestion-error {
font-weight: bold;
color: red;
}
.suggestion-name {
font-weight: bold;
}
</style>
<script src="https://c328740.ssl.cf1.rackcdn.com/mathjax/latest/MathJax.js?config=TeX-AMS_HTML" type="text/javascript"></script>
<script type="text/javascript">
init_mathjax = function() {
if (window.MathJax) {
// MathJax loaded
MathJax.Hub.Config({
tex2jax: {
inlineMath: [ ['$','$'], ["\\(","\\)"] ],
displayMath: [ ['$$','$$'], ["\\[","\\]"] ]
},
displayAlign: 'left', // Change this to 'center' to center equations.
"HTML-CSS": {
styles: {'.MathJax_Display': {"margin": 0}}
}
});
MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
}
}
init_mathjax();
</script>
</head>
{%- endblock header -%}
{% block body %}
<body>
{{ super() }}
</body>
{%- endblock body %}
This diff is collapsed.
...@@ -14,7 +14,9 @@ import Network.HTTP.Client.TLS ...@@ -14,7 +14,9 @@ import Network.HTTP.Client.TLS
import Data.Aeson import Data.Aeson
import Data.String.Utils import Data.String.Utils
import Data.List (elemIndex, (!!), last) import Data.List (elemIndex, (!!), last)
import Data.Char (isAscii, isAlphaNum)
import qualified Data.ByteString.Lazy.Char8 as Char import qualified Data.ByteString.Lazy.Char8 as Char
import qualified Prelude as P
import IHaskell.IPython import IHaskell.IPython
...@@ -58,7 +60,7 @@ instance FromJSON HoogleResponse where ...@@ -58,7 +60,7 @@ instance FromJSON HoogleResponse where
-- message or the successful JSON result. -- message or the successful JSON result.
query :: String -> IO (Either String String) query :: String -> IO (Either String String)
query str = do query str = do
request <- parseUrl $ queryUrl str request <- parseUrl $ queryUrl $ urlEncode str
response <- try $ withManager tlsManagerSettings $ httpLbs request response <- try $ withManager tlsManagerSettings $ httpLbs request
return $ case response of return $ case response of
Left err -> Left $ show (err :: SomeException) Left err -> Left $ show (err :: SomeException)
...@@ -67,6 +69,30 @@ query str = do ...@@ -67,6 +69,30 @@ query str = do
queryUrl :: String -> String queryUrl :: String -> String
queryUrl = printf "https://www.haskell.org/hoogle/?hoogle=%s&mode=json" queryUrl = printf "https://www.haskell.org/hoogle/?hoogle=%s&mode=json"
-- | Copied from the HTTP package.
urlEncode :: String -> String
urlEncode [] = []
urlEncode (ch:t)
| (isAscii ch && isAlphaNum ch) || ch `P.elem` "-_.~" = ch : urlEncode t
| not (isAscii ch) = P.foldr escape (urlEncode t) (eightBs [] (P.fromEnum ch))
| otherwise = escape (P.fromEnum ch) (urlEncode t)
where
escape :: Int -> String -> String
escape b rs = '%':showH (b `P.div` 16) (showH (b `mod` 16) rs)
showH :: Int -> String -> String
showH x xs
| x <= 9 = toEnum (o_0 + x) : xs
| otherwise = toEnum (o_A + (x-10)) : xs
where
o_0 = P.fromEnum '0'
o_A = P.fromEnum 'A'
eightBs :: [Int] -> Int -> [Int]
eightBs acc x
| x <= 0xff = (x:acc)
| otherwise = eightBs ((x `mod` 256) : acc) (x `P.div` 256)
-- | Search for a query on Hoogle. -- | Search for a query on Hoogle.
-- Return all search results. -- Return all search results.
search :: String -> IO [HoogleResult] search :: String -> IO [HoogleResult]
......
...@@ -24,7 +24,6 @@ data Args = Args IHaskellMode [Argument] ...@@ -24,7 +24,6 @@ data Args = Args IHaskellMode [Argument]
data Argument = ServeFrom String -- ^ Which directory to serve notebooks from. data Argument = ServeFrom String -- ^ Which directory to serve notebooks from.
| Extension String -- ^ An extension to load at startup. | Extension String -- ^ An extension to load at startup.
| ConfFile String -- ^ A file with commands to load at startup. | ConfFile String -- ^ A file with commands to load at startup.
| IPythonFrom String -- ^ Which executable to use for IPython.
| OverwriteFiles -- ^ Present when output should overwrite existing files. | OverwriteFiles -- ^ Present when output should overwrite existing files.
| ConvertFrom String | ConvertFrom String
| ConvertTo String | ConvertTo String
...@@ -32,6 +31,7 @@ data Argument = ServeFrom String -- ^ Which directory to serve notebooks from ...@@ -32,6 +31,7 @@ data Argument = ServeFrom String -- ^ Which directory to serve notebooks from
| ConvertToFormat NotebookFormat | ConvertToFormat NotebookFormat
| ConvertLhsStyle (LhsStyle String) | ConvertLhsStyle (LhsStyle String)
| GhcLibDir String -- ^ Where to find the GHC libraries. | GhcLibDir String -- ^ Where to find the GHC libraries.
| KernelDebug -- ^ Spew debugging output from the kernel.
| Help -- ^ Display help text. | Help -- ^ Display help text.
deriving (Eq, Show) deriving (Eq, Show)
...@@ -51,6 +51,7 @@ data NotebookFormat = LhsMarkdown ...@@ -51,6 +51,7 @@ data NotebookFormat = LhsMarkdown
-- Which mode IHaskell is being invoked in. -- Which mode IHaskell is being invoked in.
-- `None` means no mode was specified. -- `None` means no mode was specified.
data IHaskellMode = ShowHelp String data IHaskellMode = ShowHelp String
| InstallKernelSpec
| Notebook | Notebook
| Console | Console
| ConvertLhs | ConvertLhs
...@@ -61,38 +62,43 @@ data IHaskellMode = ShowHelp String ...@@ -61,38 +62,43 @@ data IHaskellMode = ShowHelp String
-- | Given a list of command-line arguments, return the IHaskell mode and -- | Given a list of command-line arguments, return the IHaskell mode and
-- arguments to process. -- arguments to process.
parseFlags :: [String] -> Either String Args parseFlags :: [String] -> Either String Args
parseFlags flags = parseFlags flags =
let modeIndex = findIndex (`elem` modeFlags) flags in let modeIndex = findIndex (`elem` modeFlags) flags
case modeIndex of in case modeIndex of
Nothing -> Left $ "No mode provided. Modes available are: " ++ show modeFlags ++ "\n" ++ Nothing ->
pack (showText (Wrap 100) $ helpText [] HelpFormatAll ihaskellArgs) -- Treat no mode as 'console'.
Just 0 -> process ihaskellArgs flags if "--help" `elem` flags
then Left $ pack (showText (Wrap 100) $ helpText [] HelpFormatAll ihaskellArgs)
else process ihaskellArgs $ "console" : flags
Just 0 -> process ihaskellArgs flags
Just idx ->
-- If mode not first, move it to be first. -- If mode not first, move it to be first.
Just idx -> let (start, first:end) = splitAt idx flags
let (start, first:end) = splitAt idx flags in in process ihaskellArgs $ first : start ++ end
process ihaskellArgs $ first:start ++ end
where where
modeFlags = concatMap modeNames allModes modeFlags = concatMap modeNames allModes
allModes :: [Mode Args] allModes :: [Mode Args]
allModes = [console, notebook, view, kernel, convert] allModes = [installKernelSpec, console, notebook, view, kernel, convert]
-- | Get help text for a given IHaskell ode. -- | Get help text for a given IHaskell ode.
help :: IHaskellMode -> String help :: IHaskellMode -> String
help mode = showText (Wrap 100) $ helpText [] HelpFormatAll $ chooseMode mode help mode = showText (Wrap 100) $ helpText [] HelpFormatAll $ chooseMode mode
where where
chooseMode Console = console chooseMode Console = console
chooseMode InstallKernelSpec = installKernelSpec
chooseMode Notebook = notebook chooseMode Notebook = notebook
chooseMode (Kernel _) = kernel chooseMode (Kernel _) = kernel
chooseMode ConvertLhs = convert chooseMode ConvertLhs = convert
ipythonFlag :: Flag Args
ipythonFlag = flagReq ["ipython", "i"] (store IPythonFrom) "<path>" "Executable for IPython."
ghcLibFlag :: Flag Args ghcLibFlag :: Flag Args
ghcLibFlag = flagReq ["ghclib", "l"] (store GhcLibDir) "<path>" "Library directory for GHC." ghcLibFlag = flagReq ["ghclib", "l"] (store GhcLibDir) "<path>" "Library directory for GHC."
kernelDebugFlag :: Flag Args
kernelDebugFlag = flagNone ["debug"] addDebug "Print debugging output from the kernel."
where addDebug (Args mode prev) = Args mode (KernelDebug : prev)
universalFlags :: [Flag Args] universalFlags :: [Flag Args]
universalFlags = [ flagReq ["extension", "e", "X"] (store Extension) "<ghc-extension>" universalFlags = [ flagReq ["extension", "e", "X"] (store Extension) "<ghc-extension>"
"Extension to enable at start." "Extension to enable at start."
...@@ -109,14 +115,16 @@ store constructor str (Args mode prev) = Right $ Args mode $ constructor str : p ...@@ -109,14 +115,16 @@ store constructor str (Args mode prev) = Right $ Args mode $ constructor str : p
notebook :: Mode Args notebook :: Mode Args
notebook = mode "notebook" (Args Notebook []) "Browser-based notebook interface." noArgs $ notebook = mode "notebook" (Args Notebook []) "Browser-based notebook interface." noArgs $
flagReq ["serve","s"] (store ServeFrom) "<dir>" "Directory to serve notebooks from.": flagReq ["serve","s"] (store ServeFrom) "<dir>" "Directory to serve notebooks from.":
ipythonFlag:
universalFlags universalFlags
console :: Mode Args console :: Mode Args
console = mode "console" (Args Console []) "Console-based interactive repl." noArgs $ ipythonFlag : universalFlags console = mode "console" (Args Console []) "Console-based interactive repl." noArgs universalFlags
installKernelSpec :: Mode Args
installKernelSpec = mode "install" (Args InstallKernelSpec []) "Install the Jupyter kernelspec." noArgs []
kernel :: Mode Args kernel :: Mode Args
kernel = mode "kernel" (Args (Kernel Nothing) []) "Invoke the IHaskell kernel." kernelArg [ghcLibFlag] kernel = mode "kernel" (Args (Kernel Nothing) []) "Invoke the IHaskell kernel." kernelArg [ghcLibFlag, kernelDebugFlag]
where where
kernelArg = flagArg update "<json-kernel-file>" kernelArg = flagArg update "<json-kernel-file>"
update filename (Args _ flags) = Right $ Args (Kernel $ Just filename) flags update filename (Args _ flags) = Right $ Args (Kernel $ Just filename) flags
...@@ -186,7 +194,7 @@ view = ...@@ -186,7 +194,7 @@ view =
} }
where where
flags = [ipythonFlag, flagHelpSimple (add Help)] flags = [flagHelpSimple (add Help)]
formatArg = flagArg updateFmt "<format>" formatArg = flagArg updateFmt "<format>"
filenameArg = flagArg updateFile "<name>[.ipynb]" filenameArg = flagArg updateFile "<name>[.ipynb]"
updateFmt fmtStr (Args (View _ s) flags) = updateFmt fmtStr (Args (View _ s) flags) =
......
This diff is collapsed.
...@@ -29,6 +29,7 @@ module IHaskell.Types ( ...@@ -29,6 +29,7 @@ module IHaskell.Types (
IHaskellWidget(..), IHaskellWidget(..),
Widget(..), Widget(..),
CommInfo(..), CommInfo(..),
KernelSpec(..),
) where ) where
import ClassyPrelude import ClassyPrelude
...@@ -141,29 +142,29 @@ instance Semigroup Display where ...@@ -141,29 +142,29 @@ instance Semigroup Display where
a <> b = a `mappend` b a <> b = a `mappend` b
-- | All state stored in the kernel between executions. -- | All state stored in the kernel between executions.
data KernelState = KernelState data KernelState = KernelState { getExecutionCounter :: Int
{ getExecutionCounter :: Int, , getLintStatus :: LintStatus -- Whether to use hlint, and what arguments to pass it.
getLintStatus :: LintStatus, -- Whether to use hlint, and what arguments to pass it. , getFrontend :: FrontendType
getFrontend :: FrontendType, , useSvg :: Bool
useSvg :: Bool, , useShowErrors :: Bool
useShowErrors :: Bool, , useShowTypes :: Bool
useShowTypes :: Bool, , usePager :: Bool
usePager :: Bool, , openComms :: Map UUID Widget
openComms :: Map UUID Widget , kernelDebug :: Bool
} }
deriving Show deriving Show
defaultKernelState :: KernelState defaultKernelState :: KernelState
defaultKernelState = KernelState defaultKernelState = KernelState { getExecutionCounter = 1
{ getExecutionCounter = 1, , getLintStatus = LintOn
getLintStatus = LintOn, , getFrontend = IPythonConsole
getFrontend = IPythonConsole, , useSvg = True
useSvg = True, , useShowErrors = False
useShowErrors = False, , useShowTypes = False
useShowTypes = False, , usePager = True
usePager = True, , openComms = empty
openComms = empty , kernelDebug = False
} }
data FrontendType data FrontendType
= IPythonConsole = IPythonConsole
......
{-# LANGUAGE NoImplicitPrelude, CPP, OverloadedStrings, ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude, CPP, OverloadedStrings, ScopedTypeVariables, QuasiQuotes #-}
-- | Description : Argument parsing and basic messaging loop, using Haskell -- | Description : Argument parsing and basic messaging loop, using Haskell
-- Chans to communicate with the ZeroMQ sockets. -- Chans to communicate with the ZeroMQ sockets.
module Main where module Main where
...@@ -17,6 +17,7 @@ import System.Exit (exitSuccess) ...@@ -17,6 +17,7 @@ import System.Exit (exitSuccess)
import Text.Printf import Text.Printf
import System.Posix.Signals import System.Posix.Signals
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.String.Here (hereFile)
-- IHaskell imports. -- IHaskell imports.
import IHaskell.Convert (convert) import IHaskell.Convert (convert)
...@@ -44,6 +45,13 @@ ghcVersionInts = map read . words . map dotToSpace $ VERSION_ghc ...@@ -44,6 +45,13 @@ ghcVersionInts = map read . words . map dotToSpace $ VERSION_ghc
dotToSpace '.' = ' ' dotToSpace '.' = ' '
dotToSpace x = x dotToSpace x = x
ihaskellCSS :: String
ihaskellCSS = [hereFile|html/custom.css|]
consoleBanner :: Text
consoleBanner =
"Welcome to IHaskell! Run `IHaskell --help` for more information.\n" ++
"Enter `:help` to learn more about IHaskell built-ins."
main :: IO () main :: IO ()
main = do main = do
...@@ -52,35 +60,23 @@ main = do ...@@ -52,35 +60,23 @@ main = do
Left errorMessage -> hPutStrLn stderr errorMessage Left errorMessage -> hPutStrLn stderr errorMessage
Right args -> ihaskell args Right args -> ihaskell args
chooseIPython [] = return DefaultIPython
chooseIPython (IPythonFrom path:_) = ExplicitIPython <$> subHome path
chooseIPython (_:xs) = chooseIPython xs
ihaskell :: Args -> IO () ihaskell :: Args -> IO ()
-- If no mode is specified, print help text.
ihaskell (Args (ShowHelp help) _) = putStrLn $ pack help ihaskell (Args (ShowHelp help) _) = putStrLn $ pack help
ihaskell (Args ConvertLhs args) = showingHelp ConvertLhs args $ convert args ihaskell (Args ConvertLhs args) = showingHelp ConvertLhs args $ convert args
ihaskell (Args InstallKernelSpec args) = showingHelp InstallKernelSpec args replaceIPythonKernelspec
ihaskell (Args Console flags) = showingHelp Console flags $ do ihaskell (Args Console flags) = showingHelp Console flags $ do
ipython <- chooseIPython flags putStrLn consoleBanner
setupIPython ipython withIPython $ do
flags <- addDefaultConfFile flags
flags <- addDefaultConfFile flags info <- initInfo IPythonConsole flags
info <- initInfo IPythonConsole flags runConsole info
runConsole ipython info ihaskell (Args mode@(View (Just fmt) (Just name)) args) = showingHelp mode args $ withIPython $
nbconvert fmt name
ihaskell (Args mode@(View (Just fmt) (Just name)) args) = showingHelp mode args $ do ihaskell (Args Notebook flags) = showingHelp Notebook flags $ withIPython $ do
ipython <- chooseIPython args let server =
nbconvert ipython fmt name case mapMaybe serveDir flags of
[] -> Nothing
ihaskell (Args Notebook flags) = showingHelp Notebook flags $ do xs -> Just $ last xs
ipython <- chooseIPython flags
setupIPython ipython
let server = case mapMaybe serveDir flags of
[] -> Nothing
xs -> Just $ last xs
flags <- addDefaultConfFile flags flags <- addDefaultConfFile flags
...@@ -88,20 +84,19 @@ ihaskell (Args Notebook flags) = showingHelp Notebook flags $ do ...@@ -88,20 +84,19 @@ ihaskell (Args Notebook flags) = showingHelp Notebook flags $ do
curdir <- getCurrentDirectory curdir <- getCurrentDirectory
let info = undirInfo { initDir = curdir } let info = undirInfo { initDir = curdir }
runNotebook ipython info server runNotebook info (pack <$> server)
where where
serveDir (ServeFrom dir) = Just dir serveDir (ServeFrom dir) = Just dir
serveDir _ = Nothing serveDir _ = Nothing
ihaskell (Args (Kernel (Just filename)) flags) = do ihaskell (Args (Kernel (Just filename)) flags) = do
initInfo <- readInitInfo initInfo <- readInitInfo
runKernel libdir filename initInfo runKernel debug libdir filename initInfo
where where
libdir = case flags of (debug, libdir) = foldl' processFlag (False, GHC.Paths.libdir) flags
[] -> GHC.Paths.libdir processFlag (debug, libdir) (GhcLibDir libdir') = (debug, libdir')
[GhcLibDir dir] -> dir processFlag (debug, libdir) KernelDebug = (True, libdir)
processFlag x _ = x
-- | Add a conf file to the arguments if none exists. -- | Add a conf file to the arguments if none exists.
addDefaultConfFile :: [Argument] -> IO [Argument] addDefaultConfFile :: [Argument] -> IO [Argument]
...@@ -135,11 +130,12 @@ initInfo front (flag:flags) = do ...@@ -135,11 +130,12 @@ initInfo front (flag:flags) = do
_ -> return info _ -> return info
-- | Run the IHaskell language kernel. -- | Run the IHaskell language kernel.
runKernel :: String -- ^ GHC libdir. runKernel :: Bool -- ^ Spew debugging output?
-> String -- ^ GHC libdir.
-> String -- ^ Filename of profile JSON file. -> String -- ^ Filename of profile JSON file.
-> InitInfo -- ^ Initialization information from the invocation. -> InitInfo -- ^ Initialization information from the invocation.
-> IO () -> IO ()
runKernel libdir profileSrc initInfo = do runKernel debug libdir profileSrc initInfo = do
setCurrentDirectory $ initDir initInfo setCurrentDirectory $ initDir initInfo
-- Parse the profile file. -- Parse the profile file.
...@@ -155,7 +151,7 @@ runKernel libdir profileSrc initInfo = do ...@@ -155,7 +151,7 @@ runKernel libdir profileSrc initInfo = do
-- Create initial state in the directory the kernel *should* be in. -- Create initial state in the directory the kernel *should* be in.
state <- initialKernelState state <- initialKernelState
modifyMVar_ state $ \kernelState -> return $ modifyMVar_ state $ \kernelState -> return $
kernelState { getFrontend = frontend initInfo } kernelState { getFrontend = frontend initInfo, kernelDebug = debug }
-- Receive and reply to all messages on the shell socket. -- Receive and reply to all messages on the shell socket.
interpret libdir True $ do interpret libdir True $ do
...@@ -189,30 +185,31 @@ runKernel libdir profileSrc initInfo = do ...@@ -189,30 +185,31 @@ runKernel libdir profileSrc initInfo = do
-- The normal ones are a standard request/response style, while comms -- The normal ones are a standard request/response style, while comms
-- can be anything, and don't necessarily require a response. -- can be anything, and don't necessarily require a response.
if isCommMessage request if isCommMessage request
then liftIO $ do then liftIO $ do
oldState <- takeMVar state oldState <- takeMVar state
let replier = writeChan (iopubChannel interface) let replier = writeChan (iopubChannel interface)
newState <- handleComm replier oldState request replyHeader newState <- handleComm replier oldState request replyHeader
putMVar state newState putMVar state newState
writeChan (shellReplyChannel interface) SendNothing writeChan (shellReplyChannel interface) SendNothing
else do else do
-- Create the reply, possibly modifying kernel state. -- Create the reply, possibly modifying kernel state.
oldState <- liftIO $ takeMVar state oldState <- liftIO $ takeMVar state
(newState, reply) <- replyTo interface request replyHeader oldState (newState, reply) <- replyTo interface request replyHeader oldState
liftIO $ putMVar state newState liftIO $ putMVar state newState
-- Write the reply to the reply channel. -- Write the reply to the reply channel.
liftIO $ writeChan (shellReplyChannel interface) reply liftIO $ writeChan (shellReplyChannel interface) reply
where where
ignoreCtrlC = ignoreCtrlC =
installHandler keyboardSignal (CatchOnce $ putStrLn "Press Ctrl-C again to quit kernel.") Nothing installHandler keyboardSignal (CatchOnce $ putStrLn "Press Ctrl-C again to quit kernel.")
Nothing
isCommMessage req = msgType (header req) `elem` [CommDataMessage, CommCloseMessage] isCommMessage req = msgType (header req) `elem` [CommDataMessage, CommCloseMessage]
-- Initial kernel state. -- Initial kernel state.
initialKernelState :: IO (MVar KernelState) initialKernelState :: IO (MVar KernelState)
initialKernelState = initialKernelState = newMVar defaultKernelState
newMVar defaultKernelState
-- | Duplicate a message header, giving it a new UUID and message type. -- | Duplicate a message header, giving it a new UUID and message type.
dupHeader :: MessageHeader -> MessageType -> IO MessageHeader dupHeader :: MessageHeader -> MessageType -> IO MessageHeader
...@@ -292,12 +289,15 @@ replyTo interface req@ExecuteRequest{ getCode = code } replyHeader state = do ...@@ -292,12 +289,15 @@ replyTo interface req@ExecuteRequest{ getCode = code } replyHeader state = do
sendOutput (ManyDisplay manyOuts) = mapM_ sendOutput manyOuts sendOutput (ManyDisplay manyOuts) = mapM_ sendOutput manyOuts
sendOutput (Display outs) = do sendOutput (Display outs) = do
header <- dupHeader replyHeader DisplayDataMessage header <- dupHeader replyHeader DisplayDataMessage
send $ PublishDisplayData header "haskell" $ map convertSvgToHtml outs send $ PublishDisplayData header "haskell" $ map (convertSvgToHtml . prependCss) outs
convertSvgToHtml (DisplayData MimeSvg svg) = html $ makeSvgImg $ base64 $ encodeUtf8 svg convertSvgToHtml (DisplayData MimeSvg svg) = html $ makeSvgImg $ base64 $ encodeUtf8 svg
convertSvgToHtml x = x convertSvgToHtml x = x
makeSvgImg base64data = unpack $ "<img src=\"data:image/svg+xml;base64," ++ base64data ++ "\"/>" makeSvgImg base64data = unpack $ "<img src=\"data:image/svg+xml;base64," ++ base64data ++ "\"/>"
prependCss (DisplayData MimeHtml html) = DisplayData MimeHtml $ concat ["<style>", pack ihaskellCSS, "</style>", html]
prependCss x = x
startComm :: CommInfo -> IO () startComm :: CommInfo -> IO ()
startComm (CommInfo widget uuid target) = do startComm (CommInfo widget uuid target) = do
-- Send the actual comm open. -- Send the actual comm open.
...@@ -375,8 +375,8 @@ replyTo _ req@CompleteRequest{} replyHeader state = do ...@@ -375,8 +375,8 @@ replyTo _ req@CompleteRequest{} replyHeader state = do
let reply = CompleteReply replyHeader (map pack completions) (pack matchedText) line True let reply = CompleteReply replyHeader (map pack completions) (pack matchedText) line True
return (state, reply) return (state, reply)
-- | Reply to the object_info_request message. Given an object name, return -- Reply to the object_info_request message. Given an object name, return
-- | the associated type calculated by GHC. -- the associated type calculated by GHC.
replyTo _ ObjectInfoRequest{objectName = oname} replyHeader state = do replyTo _ ObjectInfoRequest{objectName = oname} replyHeader state = do
docs <- pack <$> info (unpack oname) docs <- pack <$> info (unpack oname)
let reply = ObjectInfoReply { let reply = ObjectInfoReply {
...@@ -388,6 +388,14 @@ replyTo _ ObjectInfoRequest{objectName = oname} replyHeader state = do ...@@ -388,6 +388,14 @@ replyTo _ ObjectInfoRequest{objectName = oname} replyHeader state = do
} }
return (state, reply) return (state, reply)
-- TODO: Implement history_reply.
replyTo _ HistoryRequest{} replyHeader state = do
let reply = HistoryReply {
header = replyHeader,
historyReply = [] -- FIXME
}
return (state, reply)
handleComm :: (Message -> IO ()) -> KernelState -> Message -> MessageHeader -> IO KernelState handleComm :: (Message -> IO ()) -> KernelState -> Message -> MessageHeader -> IO KernelState
handleComm replier kernelState req replyHeader = do handleComm replier kernelState req replyHeader = do
let widgets = openComms kernelState let widgets = openComms kernelState
......
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