Commit 021e3bf0 authored by Andrew Gibiansky's avatar Andrew Gibiansky

Merge pull request #330 from cje/th

Permit use of inline template haskell
parents de20c696 f36c89af
...@@ -85,6 +85,7 @@ library ...@@ -85,6 +85,7 @@ library
system-argv0 -any, system-argv0 -any,
system-filepath -any, system-filepath -any,
tar -any, tar -any,
template-haskell -any,
text >=0.11, text >=0.11,
transformers -any, transformers -any,
unix >= 2.6, unix >= 2.6,
......
...@@ -20,6 +20,7 @@ import Data.Char as Char ...@@ -20,6 +20,7 @@ import Data.Char as Char
import Data.Dynamic import Data.Dynamic
import Data.Typeable import Data.Typeable
import qualified Data.Serialize as Serialize import qualified Data.Serialize as Serialize
import qualified Language.Haskell.TH as TH
import System.Directory import System.Directory
import Filesystem.Path.CurrentOS (encodeString) import Filesystem.Path.CurrentOS (encodeString)
import System.Posix.IO import System.Posix.IO
...@@ -78,7 +79,7 @@ data ErrorOccurred = Success | Failure deriving (Show, Eq) ...@@ -78,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
...@@ -704,32 +705,50 @@ evalCommand output (Expression expr) state = do ...@@ -704,32 +705,50 @@ evalCommand output (Expression expr) state = do
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
write $ "Can Display: " ++ show canRunDisplay -- Check if this is a template haskell declaration
write $ " Is Widget: " ++ show canRunDisplay let declExpr = printf "((id :: DecsQ -> DecsQ) (%s))" expr::String
isTHDeclaration <- attempt $ exprType declExpr
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. write $ "Can Display: " ++ show canRunDisplay
if isWidget write $ "Is Widget: " ++ show isWidget
then registerWidget out write $ "Is Declaration: " ++ show isTHDeclaration
else return out
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
else do -- Register the `it` object as a widget.
-- Evaluate this expression as though it's just a statement. if isWidget
-- The output is bound to 'it', so we can then use it. then registerWidget out
evalOut <- evalCommand output (Statement expr) state else return out
else do
let out = evalResult evalOut -- Evaluate this expression as though it's just a statement.
showErr = isShowError out -- 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. let out = evalResult evalOut
return $ if not showErr || useShowErrors state showErr = isShowError out
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 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