From cb6f497c03b0d21a2ce35f2cbdf637eb18fb4012 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 17 Dec 2009 10:36:10 +0200
Subject: [PATCH] VerbMap now becomes a function in quasi-quoting

---
 Yesod/Resource.hs      | 19 +++++++++++++------
 test/quasi-resource.hs | 43 ++++++++++++++++++++++++------------------
 2 files changed, 38 insertions(+), 24 deletions(-)

diff --git a/Yesod/Resource.hs b/Yesod/Resource.hs
index 0e41b4c4..28806d7e 100644
--- a/Yesod/Resource.hs
+++ b/Yesod/Resource.hs
@@ -257,13 +257,20 @@ instance Lift RPP where
     lift (Slurp s) =
         return $ ConE (mkName "Slurp") `AppE` (LitE $ StringL s)
 instance Lift VerbMap where
-    lift (AllVerbs s) = return $ ListE $ map helper [minBound..maxBound]
+    lift (AllVerbs s) =
+      return $ LamE [VarP $ mkName "_FIXMEverb"] $ VarE $ mkName s
+    lift (Verbs vs) =
+      return $ LamE [VarP $ mkName "verb"]
+             $ CaseE (VarE $ mkName "verb")
+             $ map helper vs ++ [whenNotFound]
         where
-            helper :: Verb -> Exp
-            helper v = TupE [(helper2 v), LitE $ StringL s]
-            helper2 :: Verb -> Exp
-            helper2 = ConE . mkName . show
-    lift (Verbs v) = lift v
+            helper :: (Verb, String) -> Match
+            helper (v, f) =
+                Match (ConP (mkName $ show v) [])
+                      (NormalB $ VarE $ mkName f)
+                      []
+            whenNotFound :: Match
+            whenNotFound = Match WildP (NormalB $ VarE $ mkName "notFound") []
 
 strToExp :: String -> Q Exp
 strToExp s = do
diff --git a/test/quasi-resource.hs b/test/quasi-resource.hs
index 9013ce86..44cee4d7 100644
--- a/test/quasi-resource.hs
+++ b/test/quasi-resource.hs
@@ -1,24 +1,33 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE QuasiQuotes #-}
 
-import Yesod.Resource
-import Yesod.Definitions
-import Data.Convertible.Text
+import Yesod
+import Yesod.Rep
 
-handler :: [(RP, [(Verb, [Char])])]
-handler =
-    $(rpnodesTHCheck
-         [ RPNode (cs "static/*filepath") $ AllVerbs "getStatic"
-         , RPNode (cs "page") $ Verbs [(Get, "pageIndex"), (Put, "pageAdd")]
-         , RPNode (cs "page/$page") $ Verbs [ (Get, "pageDetail")
-                                            , (Delete, "pageDelete")
-                                            , (Post, "pageUpdate")
-                                            ]
-         , RPNode (cs "user/#id") $ Verbs [(Get, "userInfo")]
-         ])
+data MyYesod = MyYesod
 
-handler2 :: [(RP, [(Verb, [Char])])]
-handler2 = [$rpnodesQuasi|
+instance Show (Handler MyYesod RepChooser) where show _ = "Another handler"
+
+getStatic :: Handler MyYesod RepChooser
+getStatic = undefined
+pageIndex :: Handler MyYesod RepChooser
+pageIndex = undefined
+pageAdd :: Handler MyYesod RepChooser
+pageAdd = undefined
+pageDetail :: Handler MyYesod RepChooser
+pageDetail = undefined
+pageDelete :: Handler MyYesod RepChooser
+pageDelete = undefined
+pageUpdate :: Handler MyYesod RepChooser
+pageUpdate = undefined
+userInfo :: Handler MyYesod RepChooser
+userInfo = undefined
+
+instance Show (Verb -> Handler MyYesod RepChooser) where
+    show _ = "verb -> handler"
+handler :: [(RP, Verb -> Handler MyYesod RepChooser)]
+handler = [$rpnodesQuasi|
 /static/*filepath/: getStatic
 /page/:
     Get: pageIndex
@@ -34,5 +43,3 @@ handler2 = [$rpnodesQuasi|
 main :: IO ()
 main = do
     print handler
-    print handler2
-    print $ handler == handler2