Use new mkParseRouteInstance in yesod-core

yesod-core/Yesod/Core/Internal/TH.hs

@@ -76,7 +76,7 @@ mkYesodGeneral :: String                   -- ^ foundation type
 mkYesodGeneral name args isSub resS = do
      renderRouteDec <- mkRenderRouteInstance site res
      dispatchDec    <- mkDispatchInstance site res
-     parse <- mkParseRoute site res
+     parse <- mkParseRouteInstance site res
      return (parse : renderRouteDec ++ if isSub then [] else masterTypeSyns site, dispatchDec)
   where site    = foldl' AppT (ConT $ mkName name) (map (VarT . mkName) args)
         res     = map (fmap parseType) resS
@@ -116,23 +116,6 @@ mkDispatchInstance master res = do
   where
     yDispatch = ConT ''YesodDispatch `AppT` master
 
-mkParseRoute :: Type -> [ResourceTree a] -> Q Dec
-mkParseRoute typ res = do
-    Clause [VarP getEnv, req] body decs <- mkDispatchClause mds res
-    let clause = Clause [req] body $ FunD getEnv [Clause [] (NormalB $ ConE '()) []] : decs
-    return $ InstanceD [] (ConT ''ParseRoute `AppT` typ) [FunD 'parseRoute [clause]]
-  where
-    mds = MkDispatchSettings
-        { mdsRunHandler = [|\_ _ route _ -> route |]
-        , mdsSubDispatcher = [|\_ _ toParent _ req -> fmap toParent $ parseRoute req|]
-        , mdsGetPathInfo = [|fst|]
-        , mdsSetPathInfo = [|\p (_, q) -> (p, q)|]
-        , mdsMethod = [|const $ S8.pack "GET"|]
-        , mds404 = [|const ()|]
-        , mds405 = [|const ()|]
-        , mdsGetHandler = \_ _ -> [|const ()|]
-        }
-
 mkYesodSubDispatch :: [ResourceTree a] -> Q Exp
 mkYesodSubDispatch res = do
     clause' <- mkDispatchClause (mkMDS [|subHelper . fmap toTypedContent|]) res

yesod-core/test/YesodCoreTest/Json.hs

@@ -12,6 +12,7 @@ data App = App
 
 mkYesod "App" [parseRoutes|
 / HomeR GET
+/has-multiple-pieces/#Int/#Int MultiplePiecesR GET
 |]
 
 instance Yesod App
@@ -23,6 +24,8 @@ getHomeR = do
         Nothing -> invalidArgs ["foo not found"]
         Just foo -> return $ RepPlain $ toContent (foo :: Text)
 
+getMultiplePiecesR _ _ = return ()
+
 test :: String
      -> ByteString
      -> (SResponse -> Session ())

yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs

@@ -29,6 +29,10 @@ getBinR = do
     |]
     lift $ defaultLayout widget
 
+getOnePiecesR _ = return ()
+getTwoPiecesR _ _ = return ()
+getThreePiecesR _ _ _ = return ()
+
 data Y = Y
 mkYesod "Y" [parseRoutes|
 / RootR GET

yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs

@@ -13,6 +13,9 @@ mkYesodSubData "Subsite" [parseRoutes|
 /bar BarR GET
 /baz BazR GET
 /bin BinR GET
+/has-one-piece/#Int OnePiecesR GET
+/has-two-pieces/#Int/#Int TwoPiecesR GET
+/has-three-pieces/#Int/#Int/#Int ThreePiecesR GET
 |]
 
 instance Yesod master => YesodSubDispatch Subsite (HandlerT master IO) where