VerbMap now becomes a function in quasi-quoting
This commit is contained in:
parent
aedb43fe69
commit
cb6f497c03
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user