This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap".
The branch, master has been updated
via 56e2e781b325de25dffd74fe44fd3cdebcabd92b (commit)
from a9086854d476806cd3f59e9a887d8c3068803996 (commit)
Summary of changes:
src/Snap/Loader/Hint.hs | 29 ++++++++---------------------
1 files changed, 8 insertions(+), 21 deletions(-)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 56e2e781b325de25dffd74fe44fd3cdebcabd92b
Author: Carl Howells <[email protected]>
Date: Thu Jul 1 14:48:15 2010 -0700
Simplification of TH in Snap.Loader.Hint
diff --git a/src/Snap/Loader/Hint.hs b/src/Snap/Loader/Hint.hs
index 7de400a..3109451 100644
--- a/src/Snap/Loader/Hint.hs
+++ b/src/Snap/Loader/Hint.hs
@@ -20,7 +20,7 @@ import Data.Time.Clock
import Language.Haskell.Interpreter hiding (lift, liftIO)
import Language.Haskell.Interpreter.Unsafe (unsafeSetGhcOption)
-import Language.Haskell.TH.Syntax
+import Language.Haskell.TH
import Prelude hiding (catch)
@@ -47,27 +47,14 @@ loadSnapTH initialize cleanup action = do
modules = catMaybes [initMod, cleanMod, actMod]
opts = getHintOpts args
- hintSnapE <- [| \o m i c a ->
- fmap ((,) $ return ()) $ hintSnap o m i c a |]
+ let static = Static.loadSnapTH initialize cleanup action
- [ optsE, modulesE ] <- mapM lift [ opts, modules ]
- [ initE, cleanE, actE ] <- mapM lift [ initBase, cleanBase, actBase ]
-
- staticE <- Static.loadSnapTH initialize cleanup action
-
- -- Wrap the hintSnap call in a let block. This let block
- -- vacuously pattern-matches the static expression, providing an
- -- extra check that the types were correct at compile-time, at
- -- least. This check isn't infallible, because the type isn't
- -- fully specified, but it's an extra level of help with
- -- negligible compile-time cost.
- let hintApp = foldl AppE hintSnapE [optsE, modulesE, initE, cleanE, actE]
- nameUnused = mkName "_"
- body = NormalB staticE
- clause = Clause [] body []
- staticDec = FunD nameUnused [clause]
-
- return $ LetE [staticDec] hintApp
+ -- The let in this block causes the static expression to be
+ -- pattern-matched, providing an extra check that the types were
+ -- correct at compile-time, at least.
+ [| do let _ = $static :: IO (IO (), Snap ())
+ hint <- hintSnap opts modules initBase cleanBase actBase
+ return (return (), hint) |]
------------------------------------------------------------------------------
-----------------------------------------------------------------------
hooks/post-receive
--
snap
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
