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
8a37d1e6
Commit
8a37d1e6
authored
Mar 06, 2015
by
Andrew Gibiansky
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'master' of github.com:gibiansky/IHaskell
parents
b6ae5f58
04710755
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
34 additions
and
19 deletions
+34
-19
Types.hs
ipython-kernel/src/IHaskell/IPython/Types.hs
+13
-9
Evaluate.hs
src/IHaskell/Eval/Evaluate.hs
+21
-10
No files found.
ipython-kernel/src/IHaskell/IPython/Types.hs
View file @
8a37d1e6
...
@@ -70,7 +70,10 @@ data Profile = Profile { ip :: IP -- ^ The IP on which to li
...
@@ -70,7 +70,10 @@ data Profile = Profile { ip :: IP -- ^ The IP on which to li
-- Convert the kernel profile to and from JSON.
-- Convert the kernel profile to and from JSON.
instance
FromJSON
Profile
where
instance
FromJSON
Profile
where
parseJSON
(
Object
v
)
=
parseJSON
(
Object
v
)
=
do
signatureScheme
<-
v
.:
"signature_scheme"
case
signatureScheme
of
"hmac-sha256"
->
Profile
<$>
v
.:
"ip"
Profile
<$>
v
.:
"ip"
<*>
v
.:
"transport"
<*>
v
.:
"transport"
<*>
v
.:
"stdin_port"
<*>
v
.:
"stdin_port"
...
@@ -79,6 +82,7 @@ instance FromJSON Profile where
...
@@ -79,6 +82,7 @@ instance FromJSON Profile where
<*>
v
.:
"shell_port"
<*>
v
.:
"shell_port"
<*>
v
.:
"iopub_port"
<*>
v
.:
"iopub_port"
<*>
(
Text
.
encodeUtf8
<$>
v
.:
"key"
)
<*>
(
Text
.
encodeUtf8
<$>
v
.:
"key"
)
sig
->
error
$
"Unexpected signature scheme: "
++
sig
parseJSON
_
=
fail
"Expecting JSON object."
parseJSON
_
=
fail
"Expecting JSON object."
instance
ToJSON
Profile
where
instance
ToJSON
Profile
where
...
...
src/IHaskell/Eval/Evaluate.hs
View file @
8a37d1e6
...
@@ -79,10 +79,6 @@ import Data.Version (versionBranch)
...
@@ -79,10 +79,6 @@ import Data.Version (versionBranch)
data
ErrorOccurred
=
Success
|
Failure
deriving
(
Show
,
Eq
)
data
ErrorOccurred
=
Success
|
Failure
deriving
(
Show
,
Eq
)
-- | Enable debugging output
debug
::
Bool
debug
=
False
-- | Set GHC's verbosity for debugging
-- | Set GHC's verbosity for debugging
ghcVerbosity
::
Maybe
Int
ghcVerbosity
::
Maybe
Int
ghcVerbosity
=
Nothing
-- Just 5
ghcVerbosity
=
Nothing
-- Just 5
...
@@ -257,12 +253,27 @@ evaluate kernelState code output = do
...
@@ -257,12 +253,27 @@ evaluate kernelState code output = do
cmds
<-
parseString
(
cleanString
code
)
cmds
<-
parseString
(
cleanString
code
)
let
execCount
=
getExecutionCounter
kernelState
let
execCount
=
getExecutionCounter
kernelState
-- Extract all parse errors.
let
justError
x
@
ParseError
{}
=
Just
x
justError
_
=
Nothing
errs
=
mapMaybe
(
justError
.
unloc
)
cmds
updated
<-
case
errs
of
-- Only run things if there are no parse errors.
[]
->
do
when
(
getLintStatus
kernelState
/=
LintOff
)
$
liftIO
$
do
when
(
getLintStatus
kernelState
/=
LintOff
)
$
liftIO
$
do
lintSuggestions
<-
lint
cmds
lintSuggestions
<-
lint
cmds
unless
(
noResults
lintSuggestions
)
$
unless
(
noResults
lintSuggestions
)
$
output
$
FinalResult
lintSuggestions
""
[]
output
$
FinalResult
lintSuggestions
""
[]
updated
<-
runUntilFailure
kernelState
(
map
unloc
cmds
++
[
storeItCommand
execCount
])
runUntilFailure
kernelState
(
map
unloc
cmds
++
[
storeItCommand
execCount
])
-- Print all parse errors.
errs
->
do
forM_
errs
$
\
err
->
do
out
<-
evalCommand
output
err
kernelState
liftIO
$
output
$
FinalResult
(
evalResult
out
)
""
[]
return
kernelState
return
updated
{
return
updated
{
getExecutionCounter
=
execCount
+
1
getExecutionCounter
=
execCount
+
1
}
}
...
@@ -408,7 +419,7 @@ evalCommand _ (Module contents) state = wrapExecution state $ do
...
@@ -408,7 +419,7 @@ evalCommand _ (Module contents) state = wrapExecution state $ do
Nothing
->
doLoadModule
modName
modName
Nothing
->
doLoadModule
modName
modName
-- | Directives set via `:set`.
-- | Directives set via `:set`.
evalCommand
output
(
Directive
SetDynFlag
flags
)
state
=
evalCommand
output
(
Directive
SetDynFlag
flags
)
state
=
safely
state
$
case
words
flags
of
case
words
flags
of
[]
->
do
[]
->
do
flags
<-
getSessionDynFlags
flags
<-
getSessionDynFlags
...
...
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