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 ff676e1debe4e9e3638a0577a3c44b7b85fbda1f (commit)
from c07cd8da9fb465ff216c3f20121cebbcb89994b5 (commit)
Summary of changes:
TODO | 4 +++-
src/Snap/Loader/Hint.hs | 21 +++++++++++++++++----
2 files changed, 20 insertions(+), 5 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 ff676e1debe4e9e3638a0577a3c44b7b85fbda1f
Author: Carl Howells <[email protected]>
Date: Wed Jun 23 19:31:14 2010 -0700
Work towards setting hint interpreter options properly
diff --git a/TODO b/TODO
index 76c19e9..591621c 100644
--- a/TODO
+++ b/TODO
@@ -1,7 +1,9 @@
TODO
----
-Integrate extracting ghc options from cabal.
+Extract ghc options via TH to include in hint configuration.
+ -- nearly done. Is waiting on a hint patch, or some other workaround.
+ -- needs a double-check that it's picking up all the options it should be.
document EVERYTHING.
-- low-level per-function documentation
diff --git a/src/Snap/Loader/Hint.hs b/src/Snap/Loader/Hint.hs
index 348505e..1c59cb1 100644
--- a/src/Snap/Loader/Hint.hs
+++ b/src/Snap/Loader/Hint.hs
@@ -6,11 +6,11 @@ module Snap.Loader.Hint where
------------------------------------------------------------------------------
import qualified Data.ByteString.Char8 as S
-import Data.List (nub)
+import Data.List (nub, isPrefixOf)
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
-import Control.Monad (when)
+import Control.Monad (ap, when)
import Control.Monad.Trans (liftIO)
import Data.Maybe (catMaybes)
@@ -21,11 +21,12 @@ import Language.Haskell.Interpreter.Unsafe
(unsafeSetGhcOption)
import Language.Haskell.TH.Syntax
+import System.Environment (getArgs)
+
------------------------------------------------------------------------------
import Snap.Types
import qualified Snap.Loader.Static as Static
-
------------------------------------------------------------------------------
-- | XXX
-- Assumes being spliced into the same source tree as the action to
@@ -34,6 +35,7 @@ import qualified Snap.Loader.Static as Static
-- Control.Monad.Trans
loadSnapTH :: Name -> Name -> Q Exp
loadSnapTH initialize action = do
+ args <- runIO getArgs
loc <- location
let initMod = nameModule initialize
@@ -48,7 +50,7 @@ loadSnapTH initialize action = do
else "."
str = "liftIO " ++ initBase ++ " >>= " ++ actBase
modules = catMaybes [initMod, actMod]
- opts = [ "-hide-package=mtl" ] :: [String]
+ opts = getHintOpts args
hintSnapE = VarE 'hintSnap
@@ -67,6 +69,17 @@ loadSnapTH initialize action = do
return $ LetE [staticDec] hintApp
+
+------------------------------------------------------------------------------
+-- | XXX
+getHintOpts :: [String] -> [String]
+getHintOpts args = "-hide-all-packages" : "-hide-package=mtl"
+ : (xArgs ++ packageArgs)
+ where
+ packages = map snd . filter ((== "-package") . fst) . ap zip tail $ args
+ packageArgs = map ("-package=" ++) packages
+ xArgs = filter ("-X" `isPrefixOf`) args
+
------------------------------------------------------------------------------
-- | XXX
hintSnap :: [String] -> String -> [String] -> String -> IO (Snap ())
-----------------------------------------------------------------------
hooks/post-receive
--
snap
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
