{-# LANGUAGE RecordWildCards, TemplateHaskell, ViewPatterns #-}
module Yesod.Routes.TH.Dispatch
    ( MkDispatchSettings (..)
    , mkDispatchClause
    , defaultGetHandler
    ) where

import Prelude hiding (exp)
import Language.Haskell.TH.Syntax
import Web.PathPieces
import Data.Maybe (catMaybes)
import Control.Monad (forM)
import Data.List (foldl')
import Control.Arrow (second)
import System.Random (randomRIO)
import Yesod.Routes.TH.Types
import Data.Char (toLower)

data MkDispatchSettings b site c = MkDispatchSettings
    { MkDispatchSettings b site c -> Q Exp
mdsRunHandler :: Q Exp
    , MkDispatchSettings b site c -> Q Exp
mdsSubDispatcher :: Q Exp
    , MkDispatchSettings b site c -> Q Exp
mdsGetPathInfo :: Q Exp
    , MkDispatchSettings b site c -> Q Exp
mdsSetPathInfo :: Q Exp
    , MkDispatchSettings b site c -> Q Exp
mdsMethod :: Q Exp
    , MkDispatchSettings b site c -> Q Exp
mds404 :: Q Exp
    , MkDispatchSettings b site c -> Q Exp
mds405 :: Q Exp
    , MkDispatchSettings b site c -> Maybe String -> String -> Q Exp
mdsGetHandler :: Maybe String -> String -> Q Exp
    , MkDispatchSettings b site c -> Exp -> Q Exp
mdsUnwrapper :: Exp -> Q Exp
    }

data SDC = SDC
    { SDC -> Clause
clause404 :: Clause
    , SDC -> [Exp]
extraParams :: [Exp]
    , SDC -> [Exp]
extraCons :: [Exp]
    , SDC -> Exp
envExp :: Exp
    , SDC -> Exp
reqExp :: Exp
    }

-- | A simpler version of Yesod.Routes.TH.Dispatch.mkDispatchClause, based on
-- view patterns.
--
-- Since 1.4.0
mkDispatchClause :: MkDispatchSettings b site c -> [ResourceTree a] -> Q Clause
mkDispatchClause :: MkDispatchSettings b site c -> [ResourceTree a] -> Q Clause
mkDispatchClause MkDispatchSettings {Q Exp
Maybe String -> String -> Q Exp
Exp -> Q Exp
mdsUnwrapper :: Exp -> Q Exp
mdsGetHandler :: Maybe String -> String -> Q Exp
mds405 :: Q Exp
mds404 :: Q Exp
mdsMethod :: Q Exp
mdsSetPathInfo :: Q Exp
mdsGetPathInfo :: Q Exp
mdsSubDispatcher :: Q Exp
mdsRunHandler :: Q Exp
mdsUnwrapper :: forall b site c. MkDispatchSettings b site c -> Exp -> Q Exp
mdsGetHandler :: forall b site c.
MkDispatchSettings b site c -> Maybe String -> String -> Q Exp
mds405 :: forall b site c. MkDispatchSettings b site c -> Q Exp
mds404 :: forall b site c. MkDispatchSettings b site c -> Q Exp
mdsMethod :: forall b site c. MkDispatchSettings b site c -> Q Exp
mdsSetPathInfo :: forall b site c. MkDispatchSettings b site c -> Q Exp
mdsGetPathInfo :: forall b site c. MkDispatchSettings b site c -> Q Exp
mdsSubDispatcher :: forall b site c. MkDispatchSettings b site c -> Q Exp
mdsRunHandler :: forall b site c. MkDispatchSettings b site c -> Q Exp
..} [ResourceTree a]
resources = do
    Int
suffix <- IO Int -> Q Int
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO Int -> Q Int) -> IO Int -> Q Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
1000, Int
9999 :: Int)
    Name
envName <- String -> Q Name
newName (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$ String
"env" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
suffix
    Name
reqName <- String -> Q Name
newName (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$ String
"req" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
suffix
    Name
helperName <- String -> Q Name
newName (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$ String
"helper" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
suffix

    let envE :: Exp
envE = Name -> Exp
VarE Name
envName
        reqE :: Exp
reqE = Name -> Exp
VarE Name
reqName
        helperE :: Exp
helperE = Name -> Exp
VarE Name
helperName

    Clause
clause404' <- Exp -> Exp -> Q Clause
mkClause404 Exp
envE Exp
reqE
    Exp
getPathInfo <- Q Exp
mdsGetPathInfo
    let pathInfo :: Exp
pathInfo = Exp
getPathInfo Exp -> Exp -> Exp
`AppE` Exp
reqE

    let sdc :: SDC
sdc = SDC :: Clause -> [Exp] -> [Exp] -> Exp -> Exp -> SDC
SDC
            { clause404 :: Clause
clause404 = Clause
clause404'
            , extraParams :: [Exp]
extraParams = []
            , extraCons :: [Exp]
extraCons = []
            , envExp :: Exp
envExp = Exp
envE
            , reqExp :: Exp
reqExp = Exp
reqE
            }
    [Clause]
clauses <- (ResourceTree a -> Q Clause) -> [ResourceTree a] -> Q [Clause]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SDC -> ResourceTree a -> Q Clause
forall a. SDC -> ResourceTree a -> Q Clause
go SDC
sdc) [ResourceTree a]
resources

    Clause -> Q Clause
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> Q Clause) -> Clause -> Q Clause
forall a b. (a -> b) -> a -> b
$ [Pat] -> Body -> [Dec] -> Clause
Clause
        [Name -> Pat
VarP Name
envName, Name -> Pat
VarP Name
reqName]
        (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Exp
helperE Exp -> Exp -> Exp
`AppE` Exp
pathInfo)
        [Name -> [Clause] -> Dec
FunD Name
helperName ([Clause] -> Dec) -> [Clause] -> Dec
forall a b. (a -> b) -> a -> b
$ [Clause]
clauses [Clause] -> [Clause] -> [Clause]
forall a. [a] -> [a] -> [a]
++ [Clause
clause404']]
  where
    handlePiece :: Piece a -> Q (Pat, Maybe Exp)
    handlePiece :: Piece a -> Q (Pat, Maybe Exp)
handlePiece (Static String
str) = (Pat, Maybe Exp) -> Q (Pat, Maybe Exp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Pat
LitP (Lit -> Pat) -> Lit -> Pat
forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL String
str, Maybe Exp
forall a. Maybe a
Nothing)
    handlePiece (Dynamic a
_) = do
        Name
x <- String -> Q Name
newName String
"dyn"
        let pat :: Pat
pat = Exp -> Pat -> Pat
ViewP (Name -> Exp
VarE 'fromPathPiece) (Name -> [Pat] -> Pat
ConP 'Just [Name -> Pat
VarP Name
x])
        (Pat, Maybe Exp) -> Q (Pat, Maybe Exp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat
pat, Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE Name
x)

    handlePieces :: [Piece a] -> Q ([Pat], [Exp])
    handlePieces :: [Piece a] -> Q ([Pat], [Exp])
handlePieces = ([(Pat, Maybe Exp)] -> ([Pat], [Exp]))
-> Q [(Pat, Maybe Exp)] -> Q ([Pat], [Exp])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Maybe Exp] -> [Exp]) -> ([Pat], [Maybe Exp]) -> ([Pat], [Exp])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Maybe Exp] -> [Exp]
forall a. [Maybe a] -> [a]
catMaybes (([Pat], [Maybe Exp]) -> ([Pat], [Exp]))
-> ([(Pat, Maybe Exp)] -> ([Pat], [Maybe Exp]))
-> [(Pat, Maybe Exp)]
-> ([Pat], [Exp])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Pat, Maybe Exp)] -> ([Pat], [Maybe Exp])
forall a b. [(a, b)] -> ([a], [b])
unzip) (Q [(Pat, Maybe Exp)] -> Q ([Pat], [Exp]))
-> ([Piece a] -> Q [(Pat, Maybe Exp)])
-> [Piece a]
-> Q ([Pat], [Exp])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Piece a -> Q (Pat, Maybe Exp))
-> [Piece a] -> Q [(Pat, Maybe Exp)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Piece a -> Q (Pat, Maybe Exp)
forall a. Piece a -> Q (Pat, Maybe Exp)
handlePiece

    mkCon :: String -> [Exp] -> Exp
    mkCon :: String -> [Exp] -> Exp
mkCon String
name = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Exp -> Exp -> Exp
AppE (Name -> Exp
ConE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
name)

    mkPathPat :: Pat -> [Pat] -> Pat
    mkPathPat :: Pat -> [Pat] -> Pat
mkPathPat Pat
final =
        (Pat -> Pat -> Pat) -> Pat -> [Pat] -> Pat
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Pat -> Pat -> Pat
addPat Pat
final
      where
        addPat :: Pat -> Pat -> Pat
addPat Pat
x Pat
y = Name -> [Pat] -> Pat
ConP '(:) [Pat
x, Pat
y]

    go :: SDC -> ResourceTree a -> Q Clause
    go :: SDC -> ResourceTree a -> Q Clause
go SDC
sdc (ResourceParent String
name CheckOverlap
_check [Piece a]
pieces [ResourceTree a]
children) = do
        ([Pat]
pats, [Exp]
dyns) <- [Piece a] -> Q ([Pat], [Exp])
forall a. [Piece a] -> Q ([Pat], [Exp])
handlePieces [Piece a]
pieces
        let sdc' :: SDC
sdc' = SDC
sdc
                { extraParams :: [Exp]
extraParams = SDC -> [Exp]
extraParams SDC
sdc [Exp] -> [Exp] -> [Exp]
forall a. [a] -> [a] -> [a]
++ [Exp]
dyns
                , extraCons :: [Exp]
extraCons = SDC -> [Exp]
extraCons SDC
sdc [Exp] -> [Exp] -> [Exp]
forall a. [a] -> [a] -> [a]
++ [String -> [Exp] -> Exp
mkCon String
name [Exp]
dyns]
                }
        [Clause]
childClauses <- (ResourceTree a -> Q Clause) -> [ResourceTree a] -> Q [Clause]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SDC -> ResourceTree a -> Q Clause
forall a. SDC -> ResourceTree a -> Q Clause
go SDC
sdc') [ResourceTree a]
children

        Name
restName <- String -> Q Name
newName String
"rest"
        let restE :: Exp
restE = Name -> Exp
VarE Name
restName
            restP :: Pat
restP = Name -> Pat
VarP Name
restName

        Name
helperName <- String -> Q Name
newName (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$ String
"helper" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
        let helperE :: Exp
helperE = Name -> Exp
VarE Name
helperName

        Clause -> Q Clause
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> Q Clause) -> Clause -> Q Clause
forall a b. (a -> b) -> a -> b
$ [Pat] -> Body -> [Dec] -> Clause
Clause
            [Pat -> [Pat] -> Pat
mkPathPat Pat
restP [Pat]
pats]
            (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Exp
helperE Exp -> Exp -> Exp
`AppE` Exp
restE)
            [Name -> [Clause] -> Dec
FunD Name
helperName ([Clause] -> Dec) -> [Clause] -> Dec
forall a b. (a -> b) -> a -> b
$ [Clause]
childClauses [Clause] -> [Clause] -> [Clause]
forall a. [a] -> [a] -> [a]
++ [SDC -> Clause
clause404 SDC
sdc]]
    go SDC {[Exp]
Exp
Clause
reqExp :: Exp
envExp :: Exp
extraCons :: [Exp]
extraParams :: [Exp]
clause404 :: Clause
reqExp :: SDC -> Exp
envExp :: SDC -> Exp
extraCons :: SDC -> [Exp]
extraParams :: SDC -> [Exp]
clause404 :: SDC -> Clause
..} (ResourceLeaf (Resource String
name [Piece a]
pieces Dispatch a
dispatch [String]
_ CheckOverlap
_check)) = do
        ([Pat]
pats, [Exp]
dyns) <- [Piece a] -> Q ([Pat], [Exp])
forall a. [Piece a] -> Q ([Pat], [Exp])
handlePieces [Piece a]
pieces

        (Exp
chooseMethod, Pat
finalPat) <- Dispatch a -> [Exp] -> Q (Exp, Pat)
forall a. Dispatch a -> [Exp] -> Q (Exp, Pat)
handleDispatch Dispatch a
dispatch [Exp]
dyns

        Clause -> Q Clause
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> Q Clause) -> Clause -> Q Clause
forall a b. (a -> b) -> a -> b
$ [Pat] -> Body -> [Dec] -> Clause
Clause
            [Pat -> [Pat] -> Pat
mkPathPat Pat
finalPat [Pat]
pats]
            (Exp -> Body
NormalB Exp
chooseMethod)
            []
      where
        handleDispatch :: Dispatch a -> [Exp] -> Q (Exp, Pat)
        handleDispatch :: Dispatch a -> [Exp] -> Q (Exp, Pat)
handleDispatch Dispatch a
dispatch' [Exp]
dyns =
            case Dispatch a
dispatch' of
                Methods Maybe a
multi [String]
methods -> do
                    (Pat
finalPat, Maybe Exp
mfinalE) <-
                        case Maybe a
multi of
                            Maybe a
Nothing -> (Pat, Maybe Exp) -> Q (Pat, Maybe Exp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Pat] -> Pat
ConP '[] [], Maybe Exp
forall a. Maybe a
Nothing)
                            Just a
_ -> do
                                Name
multiName <- String -> Q Name
newName String
"multi"
                                let pat :: Pat
pat = Exp -> Pat -> Pat
ViewP (Name -> Exp
VarE 'fromPathMultiPiece)
                                                (Name -> [Pat] -> Pat
ConP 'Just [Name -> Pat
VarP Name
multiName])
                                (Pat, Maybe Exp) -> Q (Pat, Maybe Exp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat
pat, Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE Name
multiName)

                    let dynsMulti :: [Exp]
dynsMulti =
                            case Maybe Exp
mfinalE of
                                Maybe Exp
Nothing -> [Exp]
dyns
                                Just Exp
e -> [Exp]
dyns [Exp] -> [Exp] -> [Exp]
forall a. [a] -> [a] -> [a]
++ [Exp
e]
                        route' :: Exp
route' = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Exp -> Exp -> Exp
AppE (Name -> Exp
ConE (String -> Name
mkName String
name)) [Exp]
dynsMulti
                        route :: Exp
route = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Exp -> Exp -> Exp
AppE Exp
route' [Exp]
extraCons
                        jroute :: Exp
jroute = Name -> Exp
ConE 'Just Exp -> Exp -> Exp
`AppE` Exp
route
                        allDyns :: [Exp]
allDyns = [Exp]
extraParams [Exp] -> [Exp] -> [Exp]
forall a. [a] -> [a] -> [a]
++ [Exp]
dynsMulti
                        mkRunExp :: Maybe String -> Q Exp
mkRunExp Maybe String
mmethod = do
                            Exp
runHandlerE <- Q Exp
mdsRunHandler
                            Exp
handlerE' <- Maybe String -> String -> Q Exp
mdsGetHandler Maybe String
mmethod String
name
                            Exp
handlerE <- Exp -> Q Exp
mdsUnwrapper (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Exp -> Exp -> Exp
AppE Exp
handlerE' [Exp]
allDyns
                            Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
runHandlerE
                                Exp -> Exp -> Exp
`AppE` Exp
handlerE
                                Exp -> Exp -> Exp
`AppE` Exp
envExp
                                Exp -> Exp -> Exp
`AppE` Exp
jroute
                                Exp -> Exp -> Exp
`AppE` Exp
reqExp

                    Exp
func <-
                        case [String]
methods of
                            [] -> Maybe String -> Q Exp
mkRunExp Maybe String
forall a. Maybe a
Nothing
                            [String]
_ -> do
                                Exp
getMethod <- Q Exp
mdsMethod
                                let methodE :: Exp
methodE = Exp
getMethod Exp -> Exp -> Exp
`AppE` Exp
reqExp
                                [Match]
matches <- [String] -> (String -> Q Match) -> Q [Match]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
methods ((String -> Q Match) -> Q [Match])
-> (String -> Q Match) -> Q [Match]
forall a b. (a -> b) -> a -> b
$ \String
method -> do
                                    Exp
exp <- Maybe String -> Q Exp
mkRunExp (String -> Maybe String
forall a. a -> Maybe a
Just String
method)
                                    Match -> Q Match
forall (m :: * -> *) a. Monad m => a -> m a
return (Match -> Q Match) -> Match -> Q Match
forall a b. (a -> b) -> a -> b
$ Pat -> Body -> [Dec] -> Match
Match (Lit -> Pat
LitP (Lit -> Pat) -> Lit -> Pat
forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL String
method) (Exp -> Body
NormalB Exp
exp) []
                                Match
match405 <- do
                                    Exp
runHandlerE <- Q Exp
mdsRunHandler
                                    Exp
handlerE <- Q Exp
mds405
                                    let exp :: Exp
exp = Exp
runHandlerE
                                            Exp -> Exp -> Exp
`AppE` Exp
handlerE
                                            Exp -> Exp -> Exp
`AppE` Exp
envExp
                                            Exp -> Exp -> Exp
`AppE` Exp
jroute
                                            Exp -> Exp -> Exp
`AppE` Exp
reqExp
                                    Match -> Q Match
forall (m :: * -> *) a. Monad m => a -> m a
return (Match -> Q Match) -> Match -> Q Match
forall a b. (a -> b) -> a -> b
$ Pat -> Body -> [Dec] -> Match
Match Pat
WildP (Exp -> Body
NormalB Exp
exp) []
                                Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp -> [Match] -> Exp
CaseE Exp
methodE ([Match] -> Exp) -> [Match] -> Exp
forall a b. (a -> b) -> a -> b
$ [Match]
matches [Match] -> [Match] -> [Match]
forall a. [a] -> [a] -> [a]
++ [Match
match405]

                    (Exp, Pat) -> Q (Exp, Pat)
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
func, Pat
finalPat)
                Subsite a
_ String
getSub -> do
                    Name
restPath <- String -> Q Name
newName String
"restPath"
                    Exp
setPathInfoE <- Q Exp
mdsSetPathInfo
                    Exp
subDispatcherE <- Q Exp
mdsSubDispatcher
                    Exp
runHandlerE <- Q Exp
mdsRunHandler
                    Name
sub <- String -> Q Name
newName String
"sub"
                    let allDyns :: [Exp]
allDyns = [Exp]
extraParams [Exp] -> [Exp] -> [Exp]
forall a. [a] -> [a] -> [a]
++ [Exp]
dyns
                    Name
sroute <- String -> Q Name
newName String
"sroute"
                    let sub2 :: Exp
sub2 = [Pat] -> Exp -> Exp
LamE [Name -> Pat
VarP Name
sub]
                            ((Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Exp
a Exp
b -> Exp
a Exp -> Exp -> Exp
`AppE` Exp
b) (Name -> Exp
VarE (String -> Name
mkName String
getSub) Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
sub) [Exp]
allDyns)
                    let reqExp' :: Exp
reqExp' = Exp
setPathInfoE Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
restPath Exp -> Exp -> Exp
`AppE` Exp
reqExp
                        route' :: Exp
route' = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Exp -> Exp -> Exp
AppE (Name -> Exp
ConE (String -> Name
mkName String
name)) [Exp]
dyns
                        route :: Exp
route = [Pat] -> Exp -> Exp
LamE [Name -> Pat
VarP Name
sroute] (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Exp -> Exp -> Exp
AppE (Exp -> Exp -> Exp
AppE Exp
route' (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE Name
sroute) [Exp]
extraCons
                        exp :: Exp
exp = Exp
subDispatcherE
                            Exp -> Exp -> Exp
`AppE` Exp
runHandlerE
                            Exp -> Exp -> Exp
`AppE` Exp
sub2
                            Exp -> Exp -> Exp
`AppE` Exp
route
                            Exp -> Exp -> Exp
`AppE` Exp
envExp
                            Exp -> Exp -> Exp
`AppE` Exp
reqExp'
                    (Exp, Pat) -> Q (Exp, Pat)
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
exp, Name -> Pat
VarP Name
restPath)

    mkClause404 :: Exp -> Exp -> Q Clause
mkClause404 Exp
envE Exp
reqE = do
        Exp
handler <- Q Exp
mds404
        Exp
runHandler <- Q Exp
mdsRunHandler
        let exp :: Exp
exp = Exp
runHandler Exp -> Exp -> Exp
`AppE` Exp
handler Exp -> Exp -> Exp
`AppE` Exp
envE Exp -> Exp -> Exp
`AppE` Name -> Exp
ConE 'Nothing Exp -> Exp -> Exp
`AppE` Exp
reqE
        Clause -> Q Clause
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> Q Clause) -> Clause -> Q Clause
forall a b. (a -> b) -> a -> b
$ [Pat] -> Body -> [Dec] -> Clause
Clause [Pat
WildP] (Exp -> Body
NormalB Exp
exp) []

defaultGetHandler :: Maybe String -> String -> Q Exp
defaultGetHandler :: Maybe String -> String -> Q Exp
defaultGetHandler Maybe String
Nothing String
s = Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"handle" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
defaultGetHandler (Just String
method) String
s = Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
method String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s