Commit ac4f5522 authored by CJ East's avatar CJ East

Fix to permit use of future IHaskellDisplay instance.

See comments at https://github.com/gibiansky/IHaskell/pull/330
parent 40cb20de
...@@ -79,7 +79,7 @@ data ErrorOccurred = Success | Failure deriving (Show, Eq) ...@@ -79,7 +79,7 @@ data ErrorOccurred = Success | Failure deriving (Show, Eq)
-- | Enable debugging output -- | Enable debugging output
debug :: Bool debug :: Bool
debug = False debug = False
-- | Set GHC's verbosity for debugging -- | Set GHC's verbosity for debugging
ghcVerbosity :: Maybe Int ghcVerbosity :: Maybe Int
...@@ -699,61 +699,57 @@ evalCommand output (Expression expr) state = do ...@@ -699,61 +699,57 @@ evalCommand output (Expression expr) state = do
-- typeclass instance, this will throw an exception and thus `attempt` will -- typeclass instance, this will throw an exception and thus `attempt` will
-- return False, and we just resort to plaintext. -- return False, and we just resort to plaintext.
let displayExpr = printf "(IHaskell.Display.display (%s))" expr :: String let displayExpr = printf "(IHaskell.Display.display (%s))" expr :: String
write displayExpr
canRunDisplay <- attempt $ exprType displayExpr canRunDisplay <- attempt $ exprType displayExpr
-- Check if this is a widget. -- Check if this is a widget.
let widgetExpr = printf "(IHaskell.Display.Widget (%s))" expr :: String let widgetExpr = printf "(IHaskell.Display.Widget (%s))" expr :: String
isWidget <- attempt $ exprType widgetExpr isWidget <- attempt $ exprType widgetExpr
-- Check if this is a declaration -- Check if this is a template haskell declaration
-- let declExpr = printf "((id :: Q [Dec] -> Q [Dec]) (%s))" expr::String
let declExpr = printf "((id :: DecsQ -> DecsQ) (%s))" expr::String let declExpr = printf "((id :: DecsQ -> DecsQ) (%s))" expr::String
isDeclaration <- attempt $ exprType declExpr isTHDeclaration <- attempt $ exprType declExpr
write $ "Can Display: " ++ show canRunDisplay write $ "Can Display: " ++ show canRunDisplay
write $ " Is Widget: " ++ show isWidget write $ "Is Widget: " ++ show isWidget
if isDeclaration write $ "Is Declaration: " ++ show isTHDeclaration
then do
write $ " Is Declaration: " ++ show isDeclaration
(GHC.runDecls expr) >> return ()
else
write $ " Is Declaration:" ++ show isDeclaration
if canRunDisplay
then do
-- Use the display. As a result, `it` is set to the output.
out <- useDisplay displayExpr
-- Register the `it` object as a widget. if isTHDeclaration
if isWidget -- If it typechecks as a DecsQ, we do not want to display the DecsQ,
then registerWidget out -- we just want the declaration made.
else return out then do
else do write $ "Suppressing display for template haskell declaration"
if isDeclaration GHC.runDecls expr
-- We do not want to display the DecsQ, we just want the return EvalOut {
-- declaration made.
then do write $ "Suppressing display for template haskell declaration"
return EvalOut {
evalStatus = Success, evalStatus = Success,
evalResult = mempty, evalResult = mempty,
evalState = state, evalState = state,
evalPager = "", evalPager = "",
evalComms = [] evalComms = []
} }
else do else do
-- Evaluate this expression as though it's just a statement. if canRunDisplay
-- The output is bound to 'it', so we can then use it. then do
evalOut <- evalCommand output (Statement expr) state -- Use the display. As a result, `it` is set to the output.
out <- useDisplay displayExpr
let out = evalResult evalOut
showErr = isShowError out -- Register the `it` object as a widget.
if isWidget
-- If evaluation failed, return the failure. If it was successful, we then registerWidget out
-- may be able to use the IHaskellDisplay typeclass. else return out
return $ if not showErr || useShowErrors state else do
then evalOut -- Evaluate this expression as though it's just a statement.
else postprocessShowError evalOut -- The output is bound to 'it', so we can then use it.
evalOut <- evalCommand output (Statement expr) state
let out = evalResult evalOut
showErr = isShowError out
-- If evaluation failed, return the failure. If it was successful, we
-- may be able to use the IHaskellDisplay typeclass.
return $ if not showErr || useShowErrors state
then evalOut
else postprocessShowError evalOut
where where
-- Try to evaluate an action. Return True if it succeeds and False if -- Try to evaluate an action. Return True if it succeeds and False if
......
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