From 40cb20dea538bdcc2592a62eb56be89be44c96c8 Mon Sep 17 00:00:00 2001 From: CJ East Date: Tue, 6 Jan 2015 03:03:32 +1100 Subject: [PATCH 1/3] Initial change to permit use of inline template haskell, to address issue: https://github.com/gibiansky/IHaskell/issues/236 To verify functionality, paste the following into a code block in IHaskell. ``` :ext TemplateHaskell import Language.Haskell.TH import Control.Lens data Foo a = Foo { _bar :: Int, _baz :: Int, _quux :: a } makeLenses ''Foo :ty baz ``` --- ihaskell.cabal | 1 + src/IHaskell/Eval/Evaluate.hs | 50 ++++++++++++++++++++++++++--------- 2 files changed, 38 insertions(+), 13 deletions(-) diff --git a/ihaskell.cabal b/ihaskell.cabal index 7aee9e54..2d671a45 100644 --- a/ihaskell.cabal +++ b/ihaskell.cabal @@ -85,6 +85,7 @@ library system-argv0 -any, system-filepath -any, tar -any, + template-haskell -any, text >=0.11, transformers -any, unix >= 2.6, diff --git a/src/IHaskell/Eval/Evaluate.hs b/src/IHaskell/Eval/Evaluate.hs index ab04f951..f2e2eb43 100644 --- a/src/IHaskell/Eval/Evaluate.hs +++ b/src/IHaskell/Eval/Evaluate.hs @@ -20,6 +20,7 @@ import Data.Char as Char import Data.Dynamic import Data.Typeable import qualified Data.Serialize as Serialize +import qualified Language.Haskell.TH as TH import System.Directory import Filesystem.Path.CurrentOS (encodeString) import System.Posix.IO @@ -78,7 +79,7 @@ data ErrorOccurred = Success | Failure deriving (Show, Eq) -- | Enable debugging output debug :: Bool -debug = False +debug = False -- | Set GHC's verbosity for debugging ghcVerbosity :: Maybe Int @@ -704,8 +705,20 @@ evalCommand output (Expression expr) state = do let widgetExpr = printf "(IHaskell.Display.Widget (%s))" expr :: String isWidget <- attempt $ exprType widgetExpr + -- Check if this is a declaration + -- let declExpr = printf "((id :: Q [Dec] -> Q [Dec]) (%s))" expr::String + let declExpr = printf "((id :: DecsQ -> DecsQ) (%s))" expr::String + isDeclaration <- attempt $ exprType declExpr + write $ "Can Display: " ++ show canRunDisplay - write $ " Is Widget: " ++ show canRunDisplay + write $ " Is Widget: " ++ show isWidget + if isDeclaration + then do + write $ " Is Declaration: " ++ show isDeclaration + (GHC.runDecls expr) >> return () + else + write $ " Is Declaration:" ++ show isDeclaration + if canRunDisplay then do @@ -716,20 +729,31 @@ evalCommand output (Expression expr) state = do if isWidget then registerWidget out else return out - else do - -- Evaluate this expression as though it's just a statement. - -- The output is bound to 'it', so we can then use it. - evalOut <- evalCommand output (Statement expr) state + if isDeclaration + -- We do not want to display the DecsQ, we just want the + -- declaration made. + then do write $ "Suppressing display for template haskell declaration" + return EvalOut { + evalStatus = Success, + evalResult = mempty, + evalState = state, + evalPager = "", + evalComms = [] + } + else do + -- Evaluate this expression as though it's just a statement. + -- 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 + 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 + -- 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 -- Try to evaluate an action. Return True if it succeeds and False if From ac4f55228492528e29d34be50d9601fb2ba7758c Mon Sep 17 00:00:00 2001 From: CJ East Date: Wed, 7 Jan 2015 01:45:45 +1100 Subject: [PATCH 2/3] Fix to permit use of future IHaskellDisplay instance. See comments at https://github.com/gibiansky/IHaskell/pull/330 --- src/IHaskell/Eval/Evaluate.hs | 72 +++++++++++++++++------------------ 1 file changed, 34 insertions(+), 38 deletions(-) diff --git a/src/IHaskell/Eval/Evaluate.hs b/src/IHaskell/Eval/Evaluate.hs index f2e2eb43..fd42bc99 100644 --- a/src/IHaskell/Eval/Evaluate.hs +++ b/src/IHaskell/Eval/Evaluate.hs @@ -79,7 +79,7 @@ data ErrorOccurred = Success | Failure deriving (Show, Eq) -- | Enable debugging output debug :: Bool -debug = False +debug = False -- | Set GHC's verbosity for debugging ghcVerbosity :: Maybe Int @@ -699,61 +699,57 @@ evalCommand output (Expression expr) state = do -- typeclass instance, this will throw an exception and thus `attempt` will -- return False, and we just resort to plaintext. let displayExpr = printf "(IHaskell.Display.display (%s))" expr :: String + write displayExpr canRunDisplay <- attempt $ exprType displayExpr -- Check if this is a widget. let widgetExpr = printf "(IHaskell.Display.Widget (%s))" expr :: String isWidget <- attempt $ exprType widgetExpr - -- Check if this is a declaration - -- let declExpr = printf "((id :: Q [Dec] -> Q [Dec]) (%s))" expr::String + -- Check if this is a template haskell declaration let declExpr = printf "((id :: DecsQ -> DecsQ) (%s))" expr::String - isDeclaration <- attempt $ exprType declExpr + isTHDeclaration <- attempt $ exprType declExpr write $ "Can Display: " ++ show canRunDisplay - write $ " Is Widget: " ++ show isWidget - if isDeclaration + write $ "Is Widget: " ++ show isWidget + write $ "Is Declaration: " ++ show isTHDeclaration + + if isTHDeclaration + -- If it typechecks as a DecsQ, we do not want to display the DecsQ, + -- we just want the declaration made. 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 isWidget - then registerWidget out - else return out - else do - if isDeclaration - -- We do not want to display the DecsQ, we just want the - -- declaration made. - then do write $ "Suppressing display for template haskell declaration" - return EvalOut { + write $ "Suppressing display for template haskell declaration" + GHC.runDecls expr + return EvalOut { evalStatus = Success, evalResult = mempty, evalState = state, evalPager = "", evalComms = [] } - else do - -- Evaluate this expression as though it's just a statement. - -- The output is bound to 'it', so we can then use it. - evalOut <- evalCommand output (Statement expr) state + else do + if canRunDisplay + then do + -- 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 + then registerWidget out + else return out + else do + -- Evaluate this expression as though it's just a statement. + -- The output is bound to 'it', so we can then use it. + evalOut <- evalCommand output (Statement expr) state - -- 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 + 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 -- Try to evaluate an action. Return True if it succeeds and False if From f36c89af16615c0331461d9822d28dea40e06409 Mon Sep 17 00:00:00 2001 From: CJ East Date: Wed, 7 Jan 2015 02:01:28 +1100 Subject: [PATCH 3/3] Remove stray debug code. --- src/IHaskell/Eval/Evaluate.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/IHaskell/Eval/Evaluate.hs b/src/IHaskell/Eval/Evaluate.hs index fd42bc99..a9403e9b 100644 --- a/src/IHaskell/Eval/Evaluate.hs +++ b/src/IHaskell/Eval/Evaluate.hs @@ -699,7 +699,6 @@ evalCommand output (Expression expr) state = do -- typeclass instance, this will throw an exception and thus `attempt` will -- return False, and we just resort to plaintext. let displayExpr = printf "(IHaskell.Display.display (%s))" expr :: String - write displayExpr canRunDisplay <- attempt $ exprType displayExpr -- Check if this is a widget.