    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE TemplateHaskellQuotes #-}
    {-# LANGUAGE TypeFamilies #-}

    module Yesod.Core.Internal.TH
        ( mkYesod
        , mkYesodOpts

        , mkYesodWith

        , mkYesodData
        , mkYesodDataOpts

        , mkYesodSubData
        , mkYesodSubDataOpts

        , mkYesodWithParser
        , mkYesodWithParserOpts

        , mkYesodDispatch
        , mkYesodDispatchOpts

        , masterTypeSyns

        , mkYesodGeneral
        , mkYesodGeneralOpts

        , mkMDS
        , mkDispatchInstance

        , mkYesodSubDispatch

        , subTopDispatch
        , instanceD

        , RouteOpts
        , defaultOpts
        , setEqDerived
        , setShowDerived
        , setReadDerived
        , setCreateResources
        , setParameterizedSubroute
        )
     where

    import Prelude hiding (exp)
    import Yesod.Core.Handler

    import Language.Haskell.TH hiding (cxt, instanceD)
    import Language.Haskell.TH.Syntax

    import qualified Network.Wai as W

    import Data.ByteString.Lazy.Char8 ()
    import Data.List (foldl')
    import Control.Monad (replicateM, void)
    import Text.Parsec (parse, many1, many, eof, try, option, sepBy1)
    import Text.ParserCombinators.Parsec.Char (alphaNum, spaces, string, char)

    import Yesod.Routes.TH
    import Yesod.Routes.Parse
    import Yesod.Core.Content (ToTypedContent (..))
    import Yesod.Core.Types
    import Yesod.Core.Class.Dispatch
    import Yesod.Core.Internal.Run

    -- | Generates URL datatype and site function for the given 'Resource's. This
    -- is used for creating sites, /not/ subsites. See 'mkYesodSubData' and 'mkYesodSubDispatch' for the latter.
    -- Use 'parseRoutes' to create the 'Resource's.
    --
    -- Contexts and type variables in the name of the datatype are parsed.
    -- For example, a datatype @App a@ with typeclass constraint @MyClass a@ can be written as @\"(MyClass a) => App a\"@.
    mkYesod :: String -- ^ name of the argument datatype
            -> [ResourceTree String]
            -> Q [Dec]
    mkYesod :: [Char] -> [ResourceTree [Char]] -> Q [Dec]
    mkYesod = RouteOpts -> [Char] -> [ResourceTree [Char]] -> Q [Dec]
    mkYesodOpts RouteOpts
    defaultOpts

    -- | `mkYesod` but with custom options.
    --
    -- @since 1.6.25.0
    mkYesodOpts :: RouteOpts
                -> String
                -> [ResourceTree String]
                -> Q [Dec]
    mkYesodOpts :: RouteOpts -> [Char] -> [ResourceTree [Char]] -> Q [Dec]
    mkYesodOpts RouteOpts
    opts [Char]
    name = (([Dec], [Dec]) -> [Dec]) -> Q ([Dec], [Dec]) -> Q [Dec]
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (([Dec] -> [Dec] -> [Dec]) -> ([Dec], [Dec]) -> [Dec]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry [Dec] -> [Dec] -> [Dec]
    forall a. [a] -> [a] -> [a]
    (++)) (Q ([Dec], [Dec]) -> Q [Dec])
    -> ([ResourceTree [Char]] -> Q ([Dec], [Dec]))
    -> [ResourceTree [Char]]
    -> Q [Dec]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RouteOpts
    -> [Char]
    -> Bool
    -> (Exp -> Q Exp)
    -> [ResourceTree [Char]]
    -> Q ([Dec], [Dec])
    mkYesodWithParserOpts RouteOpts
    opts [Char]
    name Bool
    False Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    {-# DEPRECATED mkYesodWith "Contexts and type variables are now parsed from the name in `mkYesod`. <https://github.com/yesodweb/yesod/pull/1366>" #-}
    -- | Similar to 'mkYesod', except contexts and type variables are not parsed.
    -- Instead, they are explicitly provided.
    -- You can write @(MyClass a) => App a@ with @mkYesodWith [[\"MyClass\",\"a\"]] \"App\" [\"a\"] ...@.
    mkYesodWith :: [[String]] -- ^ list of contexts
                -> String -- ^ name of the argument datatype
                -> [String] -- ^ list of type variables
                -> [ResourceTree String]
                -> Q [Dec]
    mkYesodWith :: [[[Char]]]
    -> [Char] -> [[Char]] -> [ResourceTree [Char]] -> Q [Dec]
    mkYesodWith [[[Char]]]
    cxts [Char]
    name [[Char]]
    args = (([Dec], [Dec]) -> [Dec]) -> Q ([Dec], [Dec]) -> Q [Dec]
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (([Dec] -> [Dec] -> [Dec]) -> ([Dec], [Dec]) -> [Dec]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry [Dec] -> [Dec] -> [Dec]
    forall a. [a] -> [a] -> [a]
    (++)) (Q ([Dec], [Dec]) -> Q [Dec])
    -> ([ResourceTree [Char]] -> Q ([Dec], [Dec]))
    -> [ResourceTree [Char]]
    -> Q [Dec]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[[Char]]]
    -> [Char]
    -> [[Char]]
    -> Bool
    -> (Exp -> Q Exp)
    -> [ResourceTree [Char]]
    -> Q ([Dec], [Dec])
    mkYesodGeneral [[[Char]]]
    cxts [Char]
    name [[Char]]
    args Bool
    False Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    -- | Sometimes, you will want to declare your routes in one file and define
    -- your handlers elsewhere. For example, this is the only way to break up a
    -- monolithic file into smaller parts. Use this function, paired with
    -- 'mkYesodDispatch', to do just that.
    mkYesodData :: String -> [ResourceTree String] -> Q [Dec]
    mkYesodData :: [Char] -> [ResourceTree [Char]] -> Q [Dec]
    mkYesodData = RouteOpts -> [Char] -> [ResourceTree [Char]] -> Q [Dec]
    mkYesodDataOpts RouteOpts
    defaultOpts

    -- | `mkYesodData` but with custom options.
    --
    -- @since 1.6.25.0
    mkYesodDataOpts :: RouteOpts -> String -> [ResourceTree String] -> Q [Dec]
    mkYesodDataOpts :: RouteOpts -> [Char] -> [ResourceTree [Char]] -> Q [Dec]
    mkYesodDataOpts RouteOpts
    opts [Char]
    name [ResourceTree [Char]]
    resS = ([Dec], [Dec]) -> [Dec]
    forall a b. (a, b) -> a
    fst (([Dec], [Dec]) -> [Dec]) -> Q ([Dec], [Dec]) -> Q [Dec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RouteOpts
    -> [Char]
    -> Bool
    -> (Exp -> Q Exp)
    -> [ResourceTree [Char]]
    -> Q ([Dec], [Dec])
    mkYesodWithParserOpts RouteOpts
    opts [Char]
    name Bool
    False Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ResourceTree [Char]]
    resS

    mkYesodSubData :: String -> [ResourceTree String] -> Q [Dec]
    mkYesodSubData :: [Char] -> [ResourceTree [Char]] -> Q [Dec]
    mkYesodSubData = RouteOpts -> [Char] -> [ResourceTree [Char]] -> Q [Dec]
    mkYesodSubDataOpts RouteOpts
    defaultOpts

    -- |
    --
    -- @since 1.6.25.0
    mkYesodSubDataOpts :: RouteOpts -> String -> [ResourceTree String] -> Q [Dec]
    mkYesodSubDataOpts :: RouteOpts -> [Char] -> [ResourceTree [Char]] -> Q [Dec]
    mkYesodSubDataOpts RouteOpts
    opts [Char]
    name [ResourceTree [Char]]
    resS = ([Dec], [Dec]) -> [Dec]
    forall a b. (a, b) -> a
    fst (([Dec], [Dec]) -> [Dec]) -> Q ([Dec], [Dec]) -> Q [Dec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RouteOpts
    -> [Char]
    -> Bool
    -> (Exp -> Q Exp)
    -> [ResourceTree [Char]]
    -> Q ([Dec], [Dec])
    mkYesodWithParserOpts RouteOpts
    opts [Char]
    name Bool
    True Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ResourceTree [Char]]
    resS

    -- | Parses contexts and type arguments out of name before generating TH.
    mkYesodWithParser :: String                    -- ^ foundation type
                      -> Bool                      -- ^ is this a subsite
                      -> (Exp -> Q Exp)            -- ^ unwrap handler
                      -> [ResourceTree String]
                      -> Q([Dec],[Dec])
    mkYesodWithParser :: [Char]
    -> Bool
    -> (Exp -> Q Exp)
    -> [ResourceTree [Char]]
    -> Q ([Dec], [Dec])
    mkYesodWithParser = RouteOpts
    -> [Char]
    -> Bool
    -> (Exp -> Q Exp)
    -> [ResourceTree [Char]]
    -> Q ([Dec], [Dec])
    mkYesodWithParserOpts RouteOpts
    defaultOpts

    -- | Parses contexts and type arguments out of name before generating TH.
    --
    -- @since 1.6.25.0
    mkYesodWithParserOpts :: RouteOpts                 -- ^ Additional route options
                          -> String                    -- ^ foundation type
                          -> Bool                      -- ^ is this a subsite
                          -> (Exp -> Q Exp)            -- ^ unwrap handler
                          -> [ResourceTree String]
                          -> Q([Dec],[Dec])
    mkYesodWithParserOpts :: RouteOpts
    -> [Char]
    -> Bool
    -> (Exp -> Q Exp)
    -> [ResourceTree [Char]]
    -> Q ([Dec], [Dec])
    mkYesodWithParserOpts RouteOpts
    opts [Char]
    name Bool
    isSub Exp -> Q Exp
    f [ResourceTree [Char]]
    resS = do
        let ([Char]
    name', [[Char]]
    rest, [[[Char]]]
    cxt) = case Parsec [Char] () ([Char], [[Char]], [[[Char]]])
    -> [Char]
    -> [Char]
    -> Either ParseError ([Char], [[Char]], [[[Char]]])
    forall s t a.
    Stream s Identity t =>
    Parsec s () a -> [Char] -> s -> Either ParseError a
    parse Parsec [Char] () ([Char], [[Char]], [[[Char]]])
    parseName [Char]
    "" [Char]
    name of
                Left ParseError
    err -> [Char] -> ([Char], [[Char]], [[[Char]]])
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> ([Char], [[Char]], [[[Char]]]))
    -> [Char] -> ([Char], [[Char]], [[[Char]]])
    forall a b. (a -> b) -> a -> b
    $ ParseError -> [Char]
    forall a. Show a => a -> [Char]
    show ParseError
    err
                Right ([Char], [[Char]], [[[Char]]])
    a -> ([Char], [[Char]], [[[Char]]])
    a
        RouteOpts
    -> [[[Char]]]
    -> [Char]
    -> [[Char]]
    -> Bool
    -> (Exp -> Q Exp)
    -> [ResourceTree [Char]]
    -> Q ([Dec], [Dec])
    mkYesodGeneralOpts RouteOpts
    opts [[[Char]]]
    cxt [Char]
    name' [[Char]]
    rest Bool
    isSub Exp -> Q Exp
    f [ResourceTree [Char]]
    resS

        where
            parseName :: Parsec [Char] () ([Char], [[Char]], [[[Char]]])
    parseName = do
                cxt <- [[[Char]]]
    -> ParsecT [Char] () Identity [[[Char]]]
    -> ParsecT [Char] () Identity [[[Char]]]
    forall s (m :: * -> *) t a u.
    Stream s m t =>
    a -> ParsecT s u m a -> ParsecT s u m a
    option [] ParsecT [Char] () Identity [[[Char]]]
    parseContext
                name' <- parseWord
                args <- many parseWord
                spaces
                eof
                return ( name', args, cxt)

            parseWord :: ParsecT [Char] u Identity [Char]
    parseWord = do
                ParsecT [Char] u Identity ()
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
    spaces
                ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity [Char]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 ParsecT [Char] u Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    alphaNum

            parseContext :: ParsecT [Char] () Identity [[[Char]]]
    parseContext = ParsecT [Char] () Identity [[[Char]]]
    -> ParsecT [Char] () Identity [[[Char]]]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Char] () Identity [[[Char]]]
     -> ParsecT [Char] () Identity [[[Char]]])
    -> ParsecT [Char] () Identity [[[Char]]]
    -> ParsecT [Char] () Identity [[[Char]]]
    forall a b. (a -> b) -> a -> b
    $ do
                cxts <- ParsecT [Char] () Identity [[[Char]]]
    -> ParsecT [Char] () Identity [[[Char]]]
    forall {s} {m :: * -> *} {u} {b}.
    Stream s m Char =>
    ParsecT s u m b -> ParsecT s u m b
    parseParen ParsecT [Char] () Identity [[[Char]]]
    parseContexts
                spaces
                _ <- string "=>"
                return cxts

            parseParen :: ParsecT s u m b -> ParsecT s u m b
    parseParen ParsecT s u m b
    p = do
                ParsecT s u m ()
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
    spaces
                _ <- Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '('
                r <- p
                spaces
                _ <- char ')'
                return r

            parseContexts :: ParsecT [Char] () Identity [[[Char]]]
    parseContexts =
                ParsecT [Char] () Identity [[Char]]
    -> ParsecT [Char] () Identity ()
    -> ParsecT [Char] () Identity [[[Char]]]
    forall s (m :: * -> *) t u a sep.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
    sepBy1 (ParsecT [Char] () Identity [Char]
    -> ParsecT [Char] () Identity [[Char]]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 ParsecT [Char] () Identity [Char]
    forall {u}. ParsecT [Char] u Identity [Char]
    parseWord) (ParsecT [Char] () Identity ()
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
    spaces ParsecT [Char] () Identity ()
    -> ParsecT [Char] () Identity Char
    -> ParsecT [Char] () Identity Char
    forall a b.
    ParsecT [Char] () Identity a
    -> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Char -> ParsecT [Char] () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    ',' ParsecT [Char] () Identity Char
    -> ParsecT [Char] () Identity () -> ParsecT [Char] () Identity ()
    forall a b.
    ParsecT [Char] () Identity a
    -> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> ParsecT [Char] () Identity ()
    forall a. a -> ParsecT [Char] () Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    -- | See 'mkYesodData'.
    mkYesodDispatch :: String -> [ResourceTree String] -> Q [Dec]
    mkYesodDispatch :: [Char] -> [ResourceTree [Char]] -> Q [Dec]
    mkYesodDispatch = RouteOpts -> [Char] -> [ResourceTree [Char]] -> Q [Dec]
    mkYesodDispatchOpts RouteOpts
    defaultOpts

    -- | See 'mkYesodDataOpts'
    --
    -- @since 1.6.25.0
    mkYesodDispatchOpts :: RouteOpts -> String -> [ResourceTree String] -> Q [Dec]
    mkYesodDispatchOpts :: RouteOpts -> [Char] -> [ResourceTree [Char]] -> Q [Dec]
    mkYesodDispatchOpts RouteOpts
    opts [Char]
    name = (([Dec], [Dec]) -> [Dec]) -> Q ([Dec], [Dec]) -> Q [Dec]
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Dec], [Dec]) -> [Dec]
    forall a b. (a, b) -> b
    snd (Q ([Dec], [Dec]) -> Q [Dec])
    -> ([ResourceTree [Char]] -> Q ([Dec], [Dec]))
    -> [ResourceTree [Char]]
    -> Q [Dec]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RouteOpts
    -> [Char]
    -> Bool
    -> (Exp -> Q Exp)
    -> [ResourceTree [Char]]
    -> Q ([Dec], [Dec])
    mkYesodWithParserOpts RouteOpts
    opts [Char]
    name Bool
    False Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    -- | Get the Handler and Widget type synonyms for the given site.
    masterTypeSyns :: [Name] -> Type -> [Dec] -- FIXME remove from here, put into the scaffolding itself?
    masterTypeSyns :: [Name] -> Type -> [Dec]
    masterTypeSyns [Name]
    vs Type
    site =
        [ Name -> [TyVarBndr BndrVis] -> Type -> Dec
    TySynD ([Char] -> Name
    mkName [Char]
    "Handler") ((Name -> TyVarBndr BndrVis) -> [Name] -> [TyVarBndr BndrVis]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Name -> TyVarBndr BndrVis
    forall flag. DefaultBndrFlag flag => Name -> TyVarBndr flag
    plainTV [Name]
    vs)
          (Type -> Dec) -> Type -> Dec
    forall a b. (a -> b) -> a -> b
    $ Name -> Type
    ConT ''HandlerFor Type -> Type -> Type
    `AppT` Type
    site
        , Name -> [TyVarBndr BndrVis] -> Type -> Dec
    TySynD ([Char] -> Name
    mkName [Char]
    "Widget")  ((Name -> TyVarBndr BndrVis) -> [Name] -> [TyVarBndr BndrVis]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Name -> TyVarBndr BndrVis
    forall flag. DefaultBndrFlag flag => Name -> TyVarBndr flag
    plainTV [Name]
    vs)
          (Type -> Dec) -> Type -> Dec
    forall a b. (a -> b) -> a -> b
    $ Name -> Type
    ConT ''WidgetFor Type -> Type -> Type
    `AppT` Type
    site Type -> Type -> Type
    `AppT` Name -> Type
    ConT ''()
        ]

    mkYesodGeneral :: [[String]]                -- ^ Appliction context. Used in RenderRoute, RouteAttrs, and ParseRoute instances.
                   -> String                    -- ^ foundation type
                   -> [String]                  -- ^ arguments for the type
                   -> Bool                      -- ^ is this a subsite
                   -> (Exp -> Q Exp)            -- ^ unwrap handler
                   -> [ResourceTree String]
                   -> Q([Dec],[Dec])
    mkYesodGeneral :: [[[Char]]]
    -> [Char]
    -> [[Char]]
    -> Bool
    -> (Exp -> Q Exp)
    -> [ResourceTree [Char]]
    -> Q ([Dec], [Dec])
    mkYesodGeneral = RouteOpts
    -> [[[Char]]]
    -> [Char]
    -> [[Char]]
    -> Bool
    -> (Exp -> Q Exp)
    -> [ResourceTree [Char]]
    -> Q ([Dec], [Dec])
    mkYesodGeneralOpts RouteOpts
    defaultOpts

    -- |
    --
    -- @since 1.6.25.0
    mkYesodGeneralOpts :: RouteOpts                 -- ^ Options to adjust route creation
                       -> [[String]]                -- ^ Appliction context. Used in RenderRoute, RouteAttrs, and ParseRoute instances.
                       -> String                    -- ^ foundation type
                       -> [String]                  -- ^ arguments for the type
                       -> Bool                      -- ^ is this a subsite
                       -> (Exp -> Q Exp)            -- ^ unwrap handler
                       -> [ResourceTree String]
                       -> Q([Dec],[Dec])
    mkYesodGeneralOpts :: RouteOpts
    -> [[[Char]]]
    -> [Char]
    -> [[Char]]
    -> Bool
    -> (Exp -> Q Exp)
    -> [ResourceTree [Char]]
    -> Q ([Dec], [Dec])
    mkYesodGeneralOpts RouteOpts
    opts [[[Char]]]
    appCxt' [Char]
    namestr [[Char]]
    mtys Bool
    isSub Exp -> Q Exp
    f [ResourceTree [Char]]
    resS = do
        let appCxt :: [Type]
    appCxt = ([[Char]] -> Type) -> [[[Char]]] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\[[Char]]
    ctxs ->
                case [[Char]]
    ctxs of
                    [Char]
    c:[[Char]]
    rest ->
                        (Type -> [Char] -> Type) -> Type -> [[Char]] -> Type
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\Type
    acc [Char]
    v -> Type
    acc Type -> Type -> Type
    `AppT` (Type, Name) -> Type
    forall a b. (a, b) -> a
    fst ([Char] -> (Type, Name)
    nameToType [Char]
    v)) (Name -> Type
    ConT (Name -> Type) -> Name -> Type
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Name
    mkName [Char]
    c) [[Char]]
    rest
                    [] -> [Char] -> Type
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Type) -> [Char] -> Type
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Bad context: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    forall a. Show a => a -> [Char]
    show [[Char]]
    ctxs
              ) [[[Char]]]
    appCxt'
        mname <- [Char] -> Q (Maybe Name)
    lookupTypeName [Char]
    namestr
        arity <- case mname of
                   Just Name
    name -> do
                     info <- Name -> Q Info
    reify Name
    name
                     return $
                       case info of
                         TyConI Dec
    dec ->
                           case Dec
    dec of
                             DataD [Type]
    _ Name
    _ [TyVarBndr BndrVis]
    vs Maybe Type
    _ [Con]
    _ [DerivClause]
    _ -> [TyVarBndr BndrVis] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [TyVarBndr BndrVis]
    vs
                             NewtypeD [Type]
    _ Name
    _ [TyVarBndr BndrVis]
    vs Maybe Type
    _ Con
    _ [DerivClause]
    _ -> [TyVarBndr BndrVis] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [TyVarBndr BndrVis]
    vs
                             TySynD Name
    _ [TyVarBndr BndrVis]
    vs Type
    _ -> [TyVarBndr BndrVis] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [TyVarBndr BndrVis]
    vs
                             Dec
    _ -> Int
    0
                         Info
    _ -> Int
    0
                   Maybe Name
    _ -> Int -> Q Int
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    0
        let name = [Char] -> Name
    mkName [Char]
    namestr
        -- Generate as many variable names as the arity indicates
        vns <- replicateM (arity - length mtys) $ newName "t"
        -- types that you apply to get a concrete site name
        let boundNames = ([Char] -> (Type, Name)) -> [[Char]] -> [(Type, Name)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Char] -> (Type, Name)
    nameToType [[Char]]
    mtys
            argtypes = ((Type, Name) -> Type) -> [(Type, Name)] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Type, Name) -> Type
    forall a b. (a, b) -> a
    fst [(Type, Name)]
    boundNames [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ (Name -> Type) -> [Name] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Name -> Type
    VarT [Name]
    vns
        -- typevars that should appear in synonym head
        let argvars = (([Char] -> Name) -> [[Char]] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Char] -> Name
    mkName ([[Char]] -> [Name])
    -> ([[Char]] -> [[Char]]) -> [[Char]] -> [Name]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char] -> Bool) -> [[Char]] -> [[Char]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter [Char] -> Bool
    isTvar) [[Char]]
    mtys [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ [Name]
    vns
            -- Base type (site type with variables)
        let site = (Type -> Type -> Type) -> Type -> [Type] -> Type
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Type -> Type -> Type
    AppT (Name -> Type
    ConT Name
    name) [Type]
    argtypes
            res = (ResourceTree [Char] -> ResourceTree Type)
    -> [ResourceTree [Char]] -> [ResourceTree Type]
    forall a b. (a -> b) -> [a] -> [b]
    map (([Char] -> Type) -> ResourceTree [Char] -> ResourceTree Type
    forall a b. (a -> b) -> ResourceTree a -> ResourceTree b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Char] -> Type
    parseType ([Char] -> Type) -> ([Char] -> [Char]) -> [Char] -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    dropBracket)) [ResourceTree [Char]]
    resS
        renderRouteDec <- mkRenderRouteInstanceOpts opts appCxt boundNames site res
        routeAttrsDec  <- mkRouteAttrsInstance appCxt site res
        dispatchDec    <- mkDispatchInstance site appCxt f res
        parseRoute <- mkParseRouteInstance appCxt site res
        let rname = [Char] -> Name
    mkName ([Char] -> Name) -> [Char] -> Name
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "resources" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    namestr
        resourcesDec <-
            if shouldCreateResources opts
                then do
                    eres <- lift resS
                    pure
                        [ SigD rname $ ListT `AppT` (ConT ''ResourceTree `AppT` ConT ''String)
                        , FunD rname [Clause [] (NormalB eres) []]
                        ]
                else do
                    pure []
        let dataDec = [[Dec]] -> [Dec]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                [ [Dec
    parseRoute]
                , [Dec]
    renderRouteDec
                , [Dec
    routeAttrsDec]
                , [Dec]
    resourcesDec
                , if Bool
    isSub then [] else [Name] -> Type -> [Dec]
    masterTypeSyns [Name]
    argvars Type
    site
                ]
        return (dataDec, dispatchDec)

    mkMDS :: (Exp -> Q Exp) -> Q Exp -> Q Exp -> MkDispatchSettings a site b
    mkMDS :: forall a site b.
    (Exp -> Q Exp) -> Q Exp -> Q Exp -> MkDispatchSettings a site b
    mkMDS Exp -> Q Exp
    f Q Exp
    rh Q Exp
    sd = MkDispatchSettings
        { mdsRunHandler :: Q Exp
    mdsRunHandler = Q Exp
    rh
        , mdsSubDispatcher :: Q Exp
    mdsSubDispatcher = Q Exp
    sd
        , mdsGetPathInfo :: Q Exp
    mdsGetPathInfo = [|W.pathInfo|]
        , mdsSetPathInfo :: Q Exp
    mdsSetPathInfo = [|\p r -> r { W.pathInfo = p }|]
        , mdsMethod :: Q Exp
    mdsMethod = [|W.requestMethod|]
        , mds404 :: Q Exp
    mds404 = [|void notFound|]
        , mds405 :: Q Exp
    mds405 = [|void badMethod|]
        , mdsGetHandler :: Maybe [Char] -> [Char] -> Q Exp
    mdsGetHandler = Maybe [Char] -> [Char] -> Q Exp
    defaultGetHandler
        , mdsUnwrapper :: Exp -> Q Exp
    mdsUnwrapper = Exp -> Q Exp
    f
        }

    -- | If the generation of @'YesodDispatch'@ instance require finer
    -- control of the types, contexts etc. using this combinator. You will
    -- hardly need this generality. However, in certain situations, like
    -- when writing library/plugin for yesod, this combinator becomes
    -- handy.
    mkDispatchInstance :: Type                      -- ^ The master site type
                       -> Cxt                       -- ^ Context of the instance
                       -> (Exp -> Q Exp)            -- ^ Unwrap handler
                       -> [ResourceTree c]          -- ^ The resource
                       -> DecsQ
    mkDispatchInstance :: forall c.
    Type -> [Type] -> (Exp -> Q Exp) -> [ResourceTree c] -> Q [Dec]
    mkDispatchInstance Type
    master [Type]
    cxt Exp -> Q Exp
    f [ResourceTree c]
    res = do
        clause' <-
            MkDispatchSettings (ZonkAny 2) (ZonkAny 1) (ZonkAny 0)
    -> [ResourceTree c] -> Q Clause
    forall b site c a.
    MkDispatchSettings b site c -> [ResourceTree a] -> Q Clause
    mkDispatchClause
                ((Exp -> Q Exp)
    -> Q Exp
    -> Q Exp
    -> MkDispatchSettings (ZonkAny 2) (ZonkAny 1) (ZonkAny 0)
    forall a site b.
    (Exp -> Q Exp) -> Q Exp -> Q Exp -> MkDispatchSettings a site b
    mkMDS
                    Exp -> Q Exp
    f
                    [|yesodRunner|]
                    [|\parentRunner getSub toParent env -> yesodSubDispatch
                        YesodSubRunnerEnv
                        { ysreParentRunner = parentRunner
                        , ysreGetSub = getSub
                        , ysreToParentRoute = toParent
                        , ysreParentEnv = env
                        }
                    |])
                [ResourceTree c]
    res
        let thisDispatch = Name -> [Clause] -> Dec
    FunD 'yesodDispatch [Clause
    clause']
        return [instanceD cxt yDispatch [thisDispatch]]
      where
        yDispatch :: Type
    yDispatch = Name -> Type
    ConT ''YesodDispatch Type -> Type -> Type
    `AppT` Type
    master

    mkYesodSubDispatch :: [ResourceTree a] -> Q Exp
    mkYesodSubDispatch :: forall a. [ResourceTree a] -> Q Exp
    mkYesodSubDispatch [ResourceTree a]
    res = do
        clause' <-
            MkDispatchSettings (ZonkAny 5) (ZonkAny 4) (ZonkAny 3)
    -> [ResourceTree a] -> Q Clause
    forall b site c a.
    MkDispatchSettings b site c -> [ResourceTree a] -> Q Clause
    mkDispatchClause
                ((Exp -> Q Exp)
    -> Q Exp
    -> Q Exp
    -> MkDispatchSettings (ZonkAny 5) (ZonkAny 4) (ZonkAny 3)
    forall a site b.
    (Exp -> Q Exp) -> Q Exp -> Q Exp -> MkDispatchSettings a site b
    mkMDS
                    Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                    [|subHelper|]
                    [|subTopDispatch|])
            [ResourceTree a]
    res
        inner <- newName "inner"
        let innerFun = Name -> [Clause] -> Dec
    FunD Name
    inner [Clause
    clause']
        helper <- newName "helper"
        let fun = Name -> [Clause] -> Dec
    FunD Name
    helper
                    [ [Pat] -> Body -> [Dec] -> Clause
    Clause
                        []
                        (Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    inner)
                        [Dec
    innerFun]
                    ]
        return $ LetE [fun] (VarE helper)

    subTopDispatch ::
        (YesodSubDispatch sub master) =>
            (forall content. ToTypedContent content =>
                SubHandlerFor child master content ->
                YesodSubRunnerEnv child master ->
                Maybe (Route child) ->
                W.Application
            ) ->
            (mid -> sub) ->
            (Route sub -> Route mid) ->
            YesodSubRunnerEnv mid master ->
            W.Application
    subTopDispatch :: forall sub master child mid.
    YesodSubDispatch sub master =>
    (forall content.
     ToTypedContent content =>
     SubHandlerFor child master content
     -> YesodSubRunnerEnv child master
     -> Maybe (Route child)
     -> Application)
    -> (mid -> sub)
    -> (Route sub -> Route mid)
    -> YesodSubRunnerEnv mid master
    -> Application
    subTopDispatch forall content.
    ToTypedContent content =>
    SubHandlerFor child master content
    -> YesodSubRunnerEnv child master
    -> Maybe (Route child)
    -> Application
    _ mid -> sub
    getSub Route sub -> Route mid
    toParent YesodSubRunnerEnv mid master
    env = YesodSubRunnerEnv sub master -> Application
    forall sub master.
    YesodSubDispatch sub master =>
    YesodSubRunnerEnv sub master -> Application
    yesodSubDispatch
                (YesodSubRunnerEnv
                { ysreParentRunner :: ParentRunner master
    ysreParentRunner = YesodSubRunnerEnv mid master -> ParentRunner master
    forall sub parent.
    YesodSubRunnerEnv sub parent -> ParentRunner parent
    ysreParentRunner YesodSubRunnerEnv mid master
    env
                , ysreGetSub :: master -> sub
    ysreGetSub = mid -> sub
    getSub (mid -> sub) -> (master -> mid) -> master -> sub
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . YesodSubRunnerEnv mid master -> master -> mid
    forall sub parent. YesodSubRunnerEnv sub parent -> parent -> sub
    ysreGetSub YesodSubRunnerEnv mid master
    env
                , ysreToParentRoute :: Route sub -> Route master
    ysreToParentRoute = YesodSubRunnerEnv mid master -> Route mid -> Route master
    forall sub parent.
    YesodSubRunnerEnv sub parent -> Route sub -> Route parent
    ysreToParentRoute YesodSubRunnerEnv mid master
    env (Route mid -> Route master)
    -> (Route sub -> Route mid) -> Route sub -> Route master
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Route sub -> Route mid
    toParent
                , ysreParentEnv :: YesodRunnerEnv master
    ysreParentEnv = YesodSubRunnerEnv mid master -> YesodRunnerEnv master
    forall sub parent.
    YesodSubRunnerEnv sub parent -> YesodRunnerEnv parent
    ysreParentEnv YesodSubRunnerEnv mid master
    env
                })

    instanceD :: Cxt -> Type -> [Dec] -> Dec
    instanceD :: [Type] -> Type -> [Dec] -> Dec
    instanceD = Maybe Overlap -> [Type] -> Type -> [Dec] -> Dec
    InstanceD Maybe Overlap
    forall a. Maybe a
    Nothing