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

Merge branch 'master' of github.com:gibiansky/IHaskell

parents b6ae5f58 04710755
...@@ -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
......
...@@ -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
......
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