{-# LANGUAGE TemplateHaskell, CPP #-}
module Yesod.Routes.TH.RenderRoute
    ( -- ** RenderRoute
      mkRenderRouteInstance
    , mkRouteCons
    , mkRenderRouteClauses
    ) where

import Yesod.Routes.TH.Types
import Language.Haskell.TH (conT)
import Language.Haskell.TH.Syntax
import Data.Bits (xor)
import Data.Maybe (maybeToList)
import Control.Monad (replicateM)
import Data.Text (pack)
import Web.PathPieces (PathPiece (..), PathMultiPiece (..))
import Yesod.Routes.Class

-- | Generate the constructors of a route data type.
mkRouteCons :: [ResourceTree Type] -> Q ([Con], [Dec])
mkRouteCons :: [ResourceTree Type] -> Q ([Con], [Dec])
mkRouteCons [ResourceTree Type]
rttypes =
    [([Con], [Dec])] -> ([Con], [Dec])
forall a. Monoid a => [a] -> a
mconcat ([([Con], [Dec])] -> ([Con], [Dec]))
-> Q [([Con], [Dec])] -> Q ([Con], [Dec])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ResourceTree Type -> Q ([Con], [Dec]))
-> [ResourceTree Type] -> Q [([Con], [Dec])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ResourceTree Type -> Q ([Con], [Dec])
mkRouteCon [ResourceTree Type]
rttypes
  where
    mkRouteCon :: ResourceTree Type -> Q ([Con], [Dec])
mkRouteCon (ResourceLeaf Resource Type
res) =
        ([Con], [Dec]) -> Q ([Con], [Dec])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Con
con], [])
      where
        con :: Con
con = Name -> [BangType] -> Con
NormalC (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Resource Type -> String
forall typ. Resource typ -> String
resourceName Resource Type
res)
            ([BangType] -> Con) -> [BangType] -> Con
forall a b. (a -> b) -> a -> b
$ (Type -> BangType) -> [Type] -> [BangType]
forall a b. (a -> b) -> [a] -> [b]
map (\Type
x -> (Bang
notStrict, Type
x))
            ([Type] -> [BangType]) -> [Type] -> [BangType]
forall a b. (a -> b) -> a -> b
$ [[Type]] -> [Type]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Type]
singles, [Type]
multi, [Type]
sub]
        singles :: [Type]
singles = (Piece Type -> [Type]) -> [Piece Type] -> [Type]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Piece Type -> [Type]
forall a. Piece a -> [a]
toSingle ([Piece Type] -> [Type]) -> [Piece Type] -> [Type]
forall a b. (a -> b) -> a -> b
$ Resource Type -> [Piece Type]
forall typ. Resource typ -> [Piece typ]
resourcePieces Resource Type
res
        toSingle :: Piece a -> [a]
toSingle Static{} = []
        toSingle (Dynamic a
typ) = [a
typ]

        multi :: [Type]
multi = Maybe Type -> [Type]
forall a. Maybe a -> [a]
maybeToList (Maybe Type -> [Type]) -> Maybe Type -> [Type]
forall a b. (a -> b) -> a -> b
$ Resource Type -> Maybe Type
forall typ. Resource typ -> Maybe typ
resourceMulti Resource Type
res

        sub :: [Type]
sub =
            case Resource Type -> Dispatch Type
forall typ. Resource typ -> Dispatch typ
resourceDispatch Resource Type
res of
                Subsite { subsiteType :: forall typ. Dispatch typ -> typ
subsiteType = Type
typ } -> [Name -> Type
ConT ''Route Type -> Type -> Type
`AppT` Type
typ]
                Dispatch Type
_ -> []

    mkRouteCon (ResourceParent String
name CheckOverlap
_check [Piece Type]
pieces [ResourceTree Type]
children) = do
        ([Con]
cons, [Dec]
decs) <- [ResourceTree Type] -> Q ([Con], [Dec])
mkRouteCons [ResourceTree Type]
children
#if MIN_VERSION_template_haskell(2,12,0)
        Dec
dec <- [Type]
-> Name
-> [TyVarBndr]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataD [] (String -> Name
mkName String
name) [] Maybe Type
forall a. Maybe a
Nothing [Con]
cons ([DerivClause] -> Dec) -> Q [DerivClause] -> Q Dec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Type] -> [DerivClause]) -> Q [Type] -> Q [DerivClause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DerivClause -> [DerivClause]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DerivClause -> [DerivClause])
-> ([Type] -> DerivClause) -> [Type] -> [DerivClause]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe DerivStrategy -> [Type] -> DerivClause
DerivClause Maybe DerivStrategy
forall a. Maybe a
Nothing) ((Name -> Q Type) -> [Name] -> Q [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> Q Type
conT [''Show, ''Read, ''Eq])
#else
        dec <- DataD [] (mkName name) [] Nothing cons <$> mapM conT [''Show, ''Read, ''Eq]
#endif
        ([Con], [Dec]) -> Q ([Con], [Dec])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Con
con], Dec
dec Dec -> [Dec] -> [Dec]
forall a. a -> [a] -> [a]
: [Dec]
decs)
      where
        con :: Con
con = Name -> [BangType] -> Con
NormalC (String -> Name
mkName String
name)
            ([BangType] -> Con) -> [BangType] -> Con
forall a b. (a -> b) -> a -> b
$ (Type -> BangType) -> [Type] -> [BangType]
forall a b. (a -> b) -> [a] -> [b]
map (\Type
x -> (Bang
notStrict, Type
x))
            ([Type] -> [BangType]) -> [Type] -> [BangType]
forall a b. (a -> b) -> a -> b
$ [Type]
singles [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ [Name -> Type
ConT (Name -> Type) -> Name -> Type
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
name]

        singles :: [Type]
singles = (Piece Type -> [Type]) -> [Piece Type] -> [Type]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Piece Type -> [Type]
forall a. Piece a -> [a]
toSingle [Piece Type]
pieces
        toSingle :: Piece a -> [a]
toSingle Static{} = []
        toSingle (Dynamic a
typ) = [a
typ]

-- | Clauses for the 'renderRoute' method.
mkRenderRouteClauses :: [ResourceTree Type] -> Q [Clause]
mkRenderRouteClauses :: [ResourceTree Type] -> Q [Clause]
mkRenderRouteClauses =
    (ResourceTree Type -> Q Clause)
-> [ResourceTree Type] -> Q [Clause]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ResourceTree Type -> Q Clause
go
  where
    isDynamic :: Piece typ -> CheckOverlap
isDynamic Dynamic{} = CheckOverlap
True
    isDynamic Piece typ
_ = CheckOverlap
False

    go :: ResourceTree Type -> Q Clause
go (ResourceParent String
name CheckOverlap
_check [Piece Type]
pieces [ResourceTree Type]
children) = do
        let cnt :: Int
cnt = [Piece Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Piece Type] -> Int) -> [Piece Type] -> Int
forall a b. (a -> b) -> a -> b
$ (Piece Type -> CheckOverlap) -> [Piece Type] -> [Piece Type]
forall a. (a -> CheckOverlap) -> [a] -> [a]
filter Piece Type -> CheckOverlap
forall typ. Piece typ -> CheckOverlap
isDynamic [Piece Type]
pieces
        [Name]
dyns <- Int -> Q Name -> Q [Name]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
cnt (Q Name -> Q [Name]) -> Q Name -> Q [Name]
forall a b. (a -> b) -> a -> b
$ String -> Q Name
newName String
"dyn"
        Name
child <- String -> Q Name
newName String
"child"
        let pat :: Pat
pat = Name -> [Pat] -> Pat
conPCompat (String -> Name
mkName String
name) ([Pat] -> Pat) -> [Pat] -> Pat
forall a b. (a -> b) -> a -> b
$ (Name -> Pat) -> [Name] -> [Pat]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Pat
VarP ([Name] -> [Pat]) -> [Name] -> [Pat]
forall a b. (a -> b) -> a -> b
$ [Name]
dyns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
child]

        Exp
pack' <- [|pack|]
        Exp
tsp <- [|toPathPiece|]
        let piecesSingle :: [Exp]
piecesSingle = (String -> Exp) -> Exp -> [Piece Type] -> [Name] -> [Exp]
forall typ.
(String -> Exp) -> Exp -> [Piece typ] -> [Name] -> [Exp]
mkPieces (Exp -> Exp -> Exp
AppE Exp
pack' (Exp -> Exp) -> (String -> Exp) -> String -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Exp
LitE (Lit -> Exp) -> (String -> Lit) -> String -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL) Exp
tsp [Piece Type]
pieces [Name]
dyns

        Name
childRender <- String -> Q Name
newName String
"childRender"
        let rr :: Exp
rr = Name -> Exp
VarE Name
childRender
        [Clause]
childClauses <- [ResourceTree Type] -> Q [Clause]
mkRenderRouteClauses [ResourceTree Type]
children

        Name
a <- String -> Q Name
newName String
"a"
        Name
b <- String -> Q Name
newName String
"b"

        Exp
colon <- [|(:)|]
        let cons :: Exp -> Exp -> Exp
cons Exp
y Exp
ys = Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
y) Exp
colon (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
ys)
        let pieces' :: Exp
pieces' = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Exp -> Exp -> Exp
cons (Name -> Exp
VarE Name
a) [Exp]
piecesSingle

        let body :: Exp
body = [Pat] -> Exp -> Exp
LamE [[Pat] -> Pat
TupP [Name -> Pat
VarP Name
a, Name -> Pat
VarP Name
b]] ([Maybe Exp] -> Exp
TupE
#if MIN_VERSION_template_haskell(2,16,0)
                                                  ([Maybe Exp] -> Exp) -> [Maybe Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Maybe Exp
forall a. a -> Maybe a
Just
#endif
                                                  [Exp
pieces', Name -> Exp
VarE Name
b]
                                                ) Exp -> Exp -> Exp
`AppE` (Exp
rr Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
child)

        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] (Exp -> Body
NormalB Exp
body) [Name -> [Clause] -> Dec
FunD Name
childRender [Clause]
childClauses]

    go (ResourceLeaf Resource Type
res) = do
        let cnt :: Int
cnt = [Piece Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Piece Type -> CheckOverlap) -> [Piece Type] -> [Piece Type]
forall a. (a -> CheckOverlap) -> [a] -> [a]
filter Piece Type -> CheckOverlap
forall typ. Piece typ -> CheckOverlap
isDynamic ([Piece Type] -> [Piece Type]) -> [Piece Type] -> [Piece Type]
forall a b. (a -> b) -> a -> b
$ Resource Type -> [Piece Type]
forall typ. Resource typ -> [Piece typ]
resourcePieces Resource Type
res) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> (Type -> Int) -> Maybe Type -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> Type -> Int
forall a b. a -> b -> a
const Int
1) (Resource Type -> Maybe Type
forall typ. Resource typ -> Maybe typ
resourceMulti Resource Type
res)
        [Name]
dyns <- Int -> Q Name -> Q [Name]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
cnt (Q Name -> Q [Name]) -> Q Name -> Q [Name]
forall a b. (a -> b) -> a -> b
$ String -> Q Name
newName String
"dyn"
        [Name]
sub <-
            case Resource Type -> Dispatch Type
forall typ. Resource typ -> Dispatch typ
resourceDispatch Resource Type
res of
                Subsite{} -> Name -> [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Name]) -> Q Name -> Q [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q Name
newName String
"sub"
                Dispatch Type
_ -> [Name] -> Q [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        let pat :: Pat
pat = Name -> [Pat] -> Pat
conPCompat (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Resource Type -> String
forall typ. Resource typ -> String
resourceName Resource Type
res) ([Pat] -> Pat) -> [Pat] -> Pat
forall a b. (a -> b) -> a -> b
$ (Name -> Pat) -> [Name] -> [Pat]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Pat
VarP ([Name] -> [Pat]) -> [Name] -> [Pat]
forall a b. (a -> b) -> a -> b
$ [Name]
dyns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
sub

        Exp
pack' <- [|pack|]
        Exp
tsp <- [|toPathPiece|]
        let piecesSingle :: [Exp]
piecesSingle = (String -> Exp) -> Exp -> [Piece Type] -> [Name] -> [Exp]
forall typ.
(String -> Exp) -> Exp -> [Piece typ] -> [Name] -> [Exp]
mkPieces (Exp -> Exp -> Exp
AppE Exp
pack' (Exp -> Exp) -> (String -> Exp) -> String -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Exp
LitE (Lit -> Exp) -> (String -> Lit) -> String -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL) Exp
tsp (Resource Type -> [Piece Type]
forall typ. Resource typ -> [Piece typ]
resourcePieces Resource Type
res) [Name]
dyns

        Exp
piecesMulti <-
            case Resource Type -> Maybe Type
forall typ. Resource typ -> Maybe typ
resourceMulti Resource Type
res of
                Maybe Type
Nothing -> 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] -> Exp
ListE []
                Just{} -> do
                    Exp
tmp <- [|toPathMultiPiece|]
                    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
tmp Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE ([Name] -> Name
forall a. [a] -> a
last [Name]
dyns)

        Exp
body <-
            case [Name]
sub of
                [Name
x] -> do
                    Exp
rr <- [|renderRoute|]
                    Name
a <- String -> Q Name
newName String
"a"
                    Name
b <- String -> Q Name
newName String
"b"

                    Exp
colon <- [|(:)|]
                    let cons :: Exp -> Exp -> Exp
cons Exp
y Exp
ys = Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
y) Exp
colon (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
ys)
                    let pieces :: Exp
pieces = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Exp -> Exp -> Exp
cons (Name -> Exp
VarE Name
a) [Exp]
piecesSingle

                    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
$ [Pat] -> Exp -> Exp
LamE [[Pat] -> Pat
TupP [Name -> Pat
VarP Name
a, Name -> Pat
VarP Name
b]] ([Maybe Exp] -> Exp
TupE
#if MIN_VERSION_template_haskell(2,16,0)
                                                            ([Maybe Exp] -> Exp) -> [Maybe Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Maybe Exp
forall a. a -> Maybe a
Just
#endif
                                                            [Exp
pieces, Name -> Exp
VarE Name
b]
                                                          ) Exp -> Exp -> Exp
`AppE` (Exp
rr Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
x)
                [Name]
_ -> do
                    Exp
colon <- [|(:)|]
                    let cons :: Exp -> Exp -> Exp
cons Exp
a Exp
b = Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
a) Exp
colon (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
b)
                    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
$ [Maybe Exp] -> Exp
TupE
#if MIN_VERSION_template_haskell(2,16,0)
                      ([Maybe Exp] -> Exp) -> [Maybe Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Maybe Exp
forall a. a -> Maybe a
Just
#endif
                      [(Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Exp -> Exp -> Exp
cons Exp
piecesMulti [Exp]
piecesSingle, [Exp] -> Exp
ListE []]

        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] (Exp -> Body
NormalB Exp
body) []

    mkPieces :: (String -> Exp) -> Exp -> [Piece typ] -> [Name] -> [Exp]
mkPieces String -> Exp
_ Exp
_ [] [Name]
_ = []
    mkPieces String -> Exp
toText Exp
tsp (Static String
s:[Piece typ]
ps) [Name]
dyns = String -> Exp
toText String
s Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
: (String -> Exp) -> Exp -> [Piece typ] -> [Name] -> [Exp]
mkPieces String -> Exp
toText Exp
tsp [Piece typ]
ps [Name]
dyns
    mkPieces String -> Exp
toText Exp
tsp (Dynamic{}:[Piece typ]
ps) (Name
d:[Name]
dyns) = Exp
tsp Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
d Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
: (String -> Exp) -> Exp -> [Piece typ] -> [Name] -> [Exp]
mkPieces String -> Exp
toText Exp
tsp [Piece typ]
ps [Name]
dyns
    mkPieces String -> Exp
_ Exp
_ (Dynamic typ
_ : [Piece typ]
_) [] = String -> [Exp]
forall a. HasCallStack => String -> a
error String
"mkPieces 120"

-- | Generate the 'RenderRoute' instance.
--
-- This includes both the 'Route' associated type and the
-- 'renderRoute' method.  This function uses both 'mkRouteCons' and
-- 'mkRenderRouteClasses'.
mkRenderRouteInstance :: Cxt -> Type -> [ResourceTree Type] -> Q [Dec]
mkRenderRouteInstance :: [Type] -> Type -> [ResourceTree Type] -> Q [Dec]
mkRenderRouteInstance [Type]
cxt Type
typ [ResourceTree Type]
ress = do
    [Clause]
cls <- [ResourceTree Type] -> Q [Clause]
mkRenderRouteClauses [ResourceTree Type]
ress
    ([Con]
cons, [Dec]
decs) <- [ResourceTree Type] -> Q ([Con], [Dec])
mkRouteCons [ResourceTree Type]
ress
#if MIN_VERSION_template_haskell(2,15,0)
    Dec
did <- [Type]
-> Maybe [TyVarBndr]
-> Type
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataInstD [] Maybe [TyVarBndr]
forall a. Maybe a
Nothing (Type -> Type -> Type
AppT (Name -> Type
ConT ''Route) Type
typ) Maybe Type
forall a. Maybe a
Nothing [Con]
cons ([DerivClause] -> Dec) -> Q [DerivClause] -> Q Dec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Type] -> [DerivClause]) -> Q [Type] -> Q [DerivClause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DerivClause -> [DerivClause]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DerivClause -> [DerivClause])
-> ([Type] -> DerivClause) -> [Type] -> [DerivClause]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe DerivStrategy -> [Type] -> DerivClause
DerivClause Maybe DerivStrategy
forall a. Maybe a
Nothing) ((Name -> Q Type) -> [Name] -> Q [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> Q Type
conT (CheckOverlap -> [Name]
clazzes CheckOverlap
False))
    let sds :: [Dec]
sds = (Name -> Dec) -> [Name] -> [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Name
t -> Maybe DerivStrategy -> [Type] -> Type -> Dec
StandaloneDerivD Maybe DerivStrategy
forall a. Maybe a
Nothing [Type]
cxt (Type -> Dec) -> Type -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Type
ConT Name
t Type -> Type -> Type
`AppT` ( Name -> Type
ConT ''Route Type -> Type -> Type
`AppT` Type
typ)) (CheckOverlap -> [Name]
clazzes CheckOverlap
True)
#elif MIN_VERSION_template_haskell(2,12,0)
    did <- DataInstD [] ''Route [typ] Nothing cons <$> fmap (pure . DerivClause Nothing) (mapM conT (clazzes False))
    let sds = fmap (\t -> StandaloneDerivD Nothing cxt $ ConT t `AppT` ( ConT ''Route `AppT` typ)) (clazzes True)
#else
    did <- DataInstD [] ''Route [typ] Nothing cons <$> mapM conT (clazzes False)
    let sds = fmap (\t -> StandaloneDerivD cxt $ ConT t `AppT` ( ConT ''Route `AppT` typ)) (clazzes True)
#endif
    [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Type] -> Type -> [Dec] -> Dec
instanceD [Type]
cxt (Name -> Type
ConT ''RenderRoute Type -> Type -> Type
`AppT` Type
typ)
        [ Dec
did
        , Name -> [Clause] -> Dec
FunD (String -> Name
mkName String
"renderRoute") [Clause]
cls
        ]
        Dec -> [Dec] -> [Dec]
forall a. a -> [a] -> [a]
: [Dec]
sds [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
++ [Dec]
decs
  where
    clazzes :: CheckOverlap -> [Name]
clazzes CheckOverlap
standalone = if CheckOverlap
standalone CheckOverlap -> CheckOverlap -> CheckOverlap
forall a. Bits a => a -> a -> a
`xor` [Type] -> CheckOverlap
forall (t :: * -> *) a. Foldable t => t a -> CheckOverlap
null [Type]
cxt then
          [Name]
clazzes'
        else
          []
    clazzes' :: [Name]
clazzes' = [''Show, ''Eq, ''Read]

notStrict :: Bang
notStrict :: Bang
notStrict = SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
NoSourceStrictness

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

conPCompat :: Name -> [Pat] -> Pat
conPCompat :: Name -> [Pat] -> Pat
conPCompat Name
n [Pat]
pats = Name -> [Pat] -> Pat
ConP Name
n
#if MIN_VERSION_template_haskell(2,18,0)
                         []
#endif
                         [Pat]
pats