Commit 0c5e162b authored by Andrew Gibiansky's avatar Andrew Gibiansky

Fix issues associated with multiple IHaskells installed.

This fix is only a halfway-fix. If there are multiple IHaskell libraries
installed, you can still end up loading an interpreted version of the
wrong one; however, now Display values are serialized to bytestring, so
this will not cause any issues with transferring those between the two
versions. Widget messages are not serializable and cannot be
serializable, so those remain a problem, but instead of crashing it will
instead emit a loud warning on stderr.
parent 18b8fd0b
......@@ -43,7 +43,7 @@ module IHaskell.Display (
switchToTmpDir,
-- * Internal only use
displayFromChan,
displayFromChanEncoded,
serializeDisplay,
Widget(..),
) where
......@@ -151,9 +151,9 @@ displayChan = unsafePerformIO newTChanIO
-- | Take everything that was put into the 'displayChan' at that point out, and make a 'Display' out
-- of it.
displayFromChan :: IO (Maybe Display)
displayFromChan =
Just . many <$> unfoldM (atomically $ tryReadTChan displayChan)
displayFromChanEncoded :: IO ByteString
displayFromChanEncoded =
Serialize.encode <$> Just . many <$> unfoldM (atomically $ tryReadTChan displayChan)
-- | Write to the display channel. The contents will be displayed in the notebook once the current
-- execution call ends.
......
......@@ -333,7 +333,15 @@ evaluate kernelState code output widgetHandler = do
-- Get displayed channel outputs. Merge them with normal display outputs.
dispsMay <- if supportLibrariesAvailable state
then extractValue "IHaskell.Display.displayFromChan" >>= liftIO
then do
getEncodedDisplays <- extractValue "IHaskell.Display.displayFromChanEncoded"
case getEncodedDisplays of
Left err -> error $ "Deserialization error (Evaluate.hs): " ++ err
Right displaysIO -> do
result <- liftIO displaysIO
case Serialize.decode result of
Left err -> error $ "Deserialization error (Evaluate.hs): " ++ err
Right res -> return res
else return Nothing
let result =
case dispsMay of
......@@ -362,12 +370,27 @@ evaluate kernelState code output widgetHandler = do
-- | Compile a string and extract a value from it. Effectively extract the result of an expression
-- from inside the notebook environment.
extractValue :: Typeable a => String -> Interpreter a
extractValue :: Typeable a => String -> Interpreter (Either String a)
extractValue expr = do
compiled <- dynCompileExpr expr
case fromDynamic compiled of
Nothing -> error "Error casting types (Evaluate.hs): multiple IHaskell copies installed?"
Just result -> return result
Nothing -> return (Left multipleIHaskells)
Just result -> return (Right result)
where
multipleIHaskells =
concat
[ "The installed IHaskell support libraries do not match"
, " the instance of IHaskell you are running.\n"
, "This *may* cause problems with functioning of widgets or rich media displays.\n"
, "This is most often caused by multiple copies of IHaskell"
, " being installed simultaneously in your environment.\n"
, "To resolve this issue, clear out your environment and reinstall IHaskell.\n"
, "If you are installing support libraries, make sure you only do so once:\n"
, " # Run this without first running `stack install ihaskell`\n"
, " stack install ihaskell-diagrams\n"
, "If you continue to have problems, please file an issue on Github."
]
flushWidgetMessages :: KernelState
-> [WidgetMsg]
......@@ -375,12 +398,19 @@ flushWidgetMessages :: KernelState
-> Interpreter KernelState
flushWidgetMessages state evalMsgs widgetHandler = do
-- Capture all widget messages queued during code execution
messagesIO <- extractValue "IHaskell.Eval.Widgets.relayWidgetMessages"
messages <- liftIO messagesIO
-- Handle all the widget messages
let commMessages = evalMsgs ++ messages
liftIO $ widgetHandler state commMessages
extracted <- extractValue "IHaskell.Eval.Widgets.relayWidgetMessages"
liftIO $
case extracted of
Left err -> do
hPutStrLn stderr "Disabling IHaskell widget support due to an encountered error:"
hPutStrLn stderr err
return state
Right messagesIO -> do
messages <- messagesIO
-- Handle all the widget messages
let commMessages = evalMsgs ++ messages
widgetHandler state commMessages
safely :: KernelState -> Interpreter EvalOut -> Interpreter EvalOut
safely state = ghandle handler . ghandle sourceErrorHandler
......
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