Merge pull request #330 from cje/th

Permit use of inline template haskell

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,

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,32 +705,50 @@ evalCommand output (Expression expr) state = do
   let widgetExpr = printf "(IHaskell.Display.Widget (%s))" expr :: String
   isWidget <- attempt $ exprType widgetExpr
 
+  -- Check if this is a template haskell declaration 
+  let declExpr = printf "((id :: DecsQ -> DecsQ) (%s))" expr::String
+  isTHDeclaration <- attempt $ exprType declExpr  
+
   write $ "Can Display: " ++ show canRunDisplay
-  write $ "  Is Widget: " ++ show canRunDisplay
+  write $ "Is Widget: " ++ show isWidget 
+  write $ "Is Declaration: " ++ show isTHDeclaration 
 
-  if canRunDisplay
-  then do
-    -- Use the display. As a result, `it` is set to the output.
-    out <- useDisplay displayExpr
+  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 $ "Suppressing display for template haskell declaration"  
+          GHC.runDecls expr  
+          return EvalOut {
+                    evalStatus = Success,
+                    evalResult = mempty,  
+                    evalState = state,
+                    evalPager = "",
+                    evalComms = []
+                }
+  else do  
+      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
+        -- 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
 
-  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