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 4ce811cb9e0ca33bfaa43fb0349cd51fbe795a20 (commit)
from f5eea5a542014823b9b0b9de2289717d363eb2c8 (commit)
Summary of changes:
project_template/hint/src/Config.hs | 4 ++++
project_template/hint/src/Main.hs | 7 ++++---
src/Snap/Loader/Hint.hs | 22 ++++++++++++++++------
src/Snap/Loader/Static.hs | 14 ++++++++------
4 files changed, 32 insertions(+), 15 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 4ce811cb9e0ca33bfaa43fb0349cd51fbe795a20
Author: Carl Howells <[email protected]>
Date: Thu Jun 24 21:25:50 2010 -0700
Add state cleanup to the process
diff --git a/project_template/hint/src/Config.hs
b/project_template/hint/src/Config.hs
index 5c86e7b..a4fed1b 100644
--- a/project_template/hint/src/Config.hs
+++ b/project_template/hint/src/Config.hs
@@ -15,3 +15,7 @@ getConfig = do
time <- getCurrentTime
let ets = loadTemplates "resources/templates" emptyTemplateState
either error (Config time) <$> ets
+
+
+cleanupConfig :: Config -> IO ()
+cleanupConfig _ = return ()
diff --git a/project_template/hint/src/Main.hs
b/project_template/hint/src/Main.hs
index ee1e15a..d955129 100644
--- a/project_template/hint/src/Main.hs
+++ b/project_template/hint/src/Main.hs
@@ -1,7 +1,7 @@
{-# LANGUAGE CPP, TemplateHaskell #-}
module Main where
-import Config (getConfig)
+import Config (getConfig, cleanupConfig)
import Site (site)
import Server (quickServer)
@@ -13,5 +13,6 @@ import Snap.Loader.Hint (loadSnapTH)
main :: IO ()
main = do
- snap <- $(loadSnapTH 'getConfig 'site)
- quickServer snap
+ (cleanup, snap) <- $(loadSnapTH 'getConfig 'cleanupConfig 'site)
+ quickServer snap
+ cleanup
diff --git a/src/Snap/Loader/Hint.hs b/src/Snap/Loader/Hint.hs
index 0c0b247..bf87723 100644
--- a/src/Snap/Loader/Hint.hs
+++ b/src/Snap/Loader/Hint.hs
@@ -33,26 +33,36 @@ import qualified Snap.Loader.Static as Static
-- dynamically load is located in
-- Assumes mtl is the only package installed with a conflicting
-- Control.Monad.Trans
-loadSnapTH :: Name -> Name -> Q Exp
-loadSnapTH initialize action = do
+loadSnapTH :: Name -> Name -> Name -> Q Exp
+loadSnapTH initialize cleanup action = do
args <- runIO getArgs
let initMod = nameModule initialize
initBase = nameBase initialize
+ cleanMod = nameModule cleanup
+ cleanBase = nameBase cleanup
actMod = nameModule action
actBase = nameBase action
- str = "liftIO " ++ initBase ++ " >>= " ++ actBase
- modules = catMaybes [initMod, actMod]
+ str = concat [ "do { x <- liftIO "
+ , initBase
+ , "; "
+ , actBase
+ , " x; liftIO $ "
+ , cleanBase
+ , " x; }"
+ ]
+
+ modules = catMaybes [initMod, cleanMod, actMod]
opts = getHintOpts args
- hintSnapE = VarE 'hintSnap
+ hintSnapE <- [| \o m s -> fmap ((,) $ return ()) $ hintSnap o m s |]
optsE <- lift opts
modulesE <- lift modules
strE <- lift str
- staticE <- Static.loadSnapTH initialize action
+ staticE <- Static.loadSnapTH initialize cleanup action
let hintApp = foldl AppE hintSnapE [optsE, modulesE, strE]
nameUnused = mkName "_"
diff --git a/src/Snap/Loader/Static.hs b/src/Snap/Loader/Static.hs
index 5d58171..6a8ff90 100644
--- a/src/Snap/Loader/Static.hs
+++ b/src/Snap/Loader/Static.hs
@@ -3,14 +3,16 @@
module Snap.Loader.Static where
------------------------------------------------------------------------------
+import Control.Arrow
import Language.Haskell.TH.Syntax
------------------------------------------------------------------------------
-- | XXX
-loadSnapTH :: Name -> Name -> Q Exp
-loadSnapTH initialize action = do
- let initE = VarE initialize
- actE = VarE action
- fmapE = VarE 'fmap
- simpleLoad = foldl AppE fmapE [actE, initE]
+loadSnapTH :: Name -> Name -> Name -> Q Exp
+loadSnapTH initialize cleanup action = do
+ funE <- [| \c a -> fmap (c &&& a) |]
+
+ let [initE, cleanE, actE] = map VarE [initialize, cleanup, action]
+ simpleLoad = foldl AppE funE [cleanE, actE, initE]
+
return simpleLoad
-----------------------------------------------------------------------
hooks/post-receive
--
snap
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
