{-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveGeneric #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Derive.TopDown.Standalone
-- Copyright   :  (c) Song Zhang
-- License     :  BSD-style (see the LICENSE file)
-- 
-- Maintainer  :  haskell.zhang.song `at` hotmail.com
-- Stability   :  experimental
-- Portability :  non-portable
--
-----------------------------------------------------------------------------

module Data.Derive.TopDown.Standalone (
     deriving_
   , deriving_with_breaks
   , derivings
   , derivingss
   , deriving_with
#if __GLASGOW_HASKELL__ >= 802
   , strategy_deriving
   , strategy_derivings
   , strategy_derivingss
#endif
) 

where

import Data.Derive.TopDown.Lib
import Data.Derive.TopDown.CxtGen (genInferredContext)
import Language.Haskell.TH
import Control.Monad
import Control.Monad.Trans
import Control.Monad.State
import Data.Derive.TopDown.IsInstance
import Data.List (foldl1')
import Data.Primitive.Types
import GHC.Generics


reset_strategy :: TypeName -> Maybe DerivStrategy -> Q (Maybe DerivStrategy)
reset_strategy :: Name -> Maybe DerivStrategy -> Q (Maybe DerivStrategy)
reset_strategy Name
tn Maybe DerivStrategy
st = do
        DecTyType
declareType <- Name -> Q DecTyType
decType Name
tn
        case (DecTyType
declareType, Maybe DerivStrategy
st) of
          (DecTyType
_, Maybe DerivStrategy
Nothing) -> Maybe DerivStrategy -> Q (Maybe DerivStrategy)
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DerivStrategy
forall a. Maybe a
Nothing
          (DecTyType
Data, Just DerivStrategy
NewtypeStrategy) -> Maybe DerivStrategy -> Q (Maybe DerivStrategy)
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DerivStrategy
forall a. Maybe a
Nothing
          (DecTyType, Maybe DerivStrategy)
_ -> Maybe DerivStrategy -> Q (Maybe DerivStrategy)
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DerivStrategy
st

gen_standalone_deriving_decl :: ClassName
                          -> TypeName
                          -> Maybe DerivStrategy  
                          -> [TypeName]  -- ^ a list of types that breaks the generation process
                          -> ContextGenderator -- ^ a context generator
                          -> StateT [Type] Q [Dec]
gen_standalone_deriving_decl :: Name
-> Name
-> Maybe DerivStrategy
-> [Name]
-> ContextGenderator
-> StateT [Type] Q [Dec]
gen_standalone_deriving_decl Name
cn Name
tn Maybe DerivStrategy
st [Name]
breaks ContextGenderator
cg = do
                       ([TyVarBndr ()]
tvbs, [Con]
cons) <- Q ([TyVarBndr ()], [Con])
-> StateT [Type] Q ([TyVarBndr ()], [Con])
forall (m :: * -> *) a. Monad m => m a -> StateT [Type] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q ([TyVarBndr ()], [Con])
 -> StateT [Type] Q ([TyVarBndr ()], [Con]))
-> Q ([TyVarBndr ()], [Con])
-> StateT [Type] Q ([TyVarBndr ()], [Con])
forall a b. (a -> b) -> a -> b
$ Name -> Q ([TyVarBndr ()], [Con])
getTyVarCons Name
tn
                       let typeNames :: [Name]
typeNames = (TyVarBndr () -> Name) -> [TyVarBndr ()] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr () -> Name
forall a. TyVarBndr a -> Name
getTVBName [TyVarBndr ()]
tvbs
                       Bool
isCnHighOrderClass <- Q Bool -> StateT [Type] Q Bool
forall (m :: * -> *) a. Monad m => m a -> StateT [Type] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Bool -> StateT [Type] Q Bool) -> Q Bool -> StateT [Type] Q Bool
forall a b. (a -> b) -> a -> b
$ Name -> Q Bool
isHigherOrderClass Name
cn
                       -- prevent calling isInstance class with * -> * and type with *
                       if Bool
isCnHighOrderClass Bool -> Bool -> Bool
&& [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
typeNames
                        then [Dec] -> StateT [Type] Q [Dec]
forall a. a -> StateT [Type] Q a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                        else do
                           Type
saturatedType <- Q Type -> StateT [Type] Q Type
forall (m :: * -> *) a. Monad m => m a -> StateT [Type] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Type -> StateT [Type] Q Type) -> Q Type -> StateT [Type] Q Type
forall a b. (a -> b) -> a -> b
$ (Q Type -> Q Type -> Q Type) -> [Q Type] -> Q Type
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
tn Q Type -> [Q Type] -> [Q Type]
forall a. a -> [a] -> [a]
: (Name -> Q Type) -> [Name] -> [Q Type]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT [Name]
typeNames)
                           Type
instanceType <- if Bool
isCnHighOrderClass Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> ([Name] -> Bool) -> [Name] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [Name]
typeNames
                                                then let pns :: [Name]
pns = [Name] -> [Name]
forall a. HasCallStack => [a] -> [a]
init [Name]
typeNames
                                                      in  if [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
pns
                                                            then Q Type -> StateT [Type] Q Type
forall (m :: * -> *) a. Monad m => m a -> StateT [Type] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Type -> StateT [Type] Q Type) -> Q Type -> StateT [Type] Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
tn
                                                            else Q Type -> StateT [Type] Q Type
forall (m :: * -> *) a. Monad m => m a -> StateT [Type] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Type -> StateT [Type] Q Type) -> Q Type -> StateT [Type] Q Type
forall a b. (a -> b) -> a -> b
$ (Q Type -> Q Type -> Q Type) -> [Q Type] -> Q Type
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
tn Q Type -> [Q Type] -> [Q Type]
forall a. a -> [a] -> [a]
: ((Name -> Q Type) -> [Name] -> [Q Type]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT [Name]
pns))
                                                else Type -> StateT [Type] Q Type
forall a. a -> StateT [Type] Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
saturatedType
                           -- Stop generating further instances
                           -- 1. it is already a member of that type class
                           -- 2. we have already generated it, which is kind of same with case 1
                           -- 3. for GHC.Generic, if it is a primitive type like Int, Double
                           -- 4. It will stop on the types in breaks
                           -- 5. It will stop on primitive types and Integer when deriving Typeable
                           Bool
isMember <- Q Bool -> StateT [Type] Q Bool
forall (m :: * -> *) a. Monad m => m a -> StateT [Type] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Bool -> StateT [Type] Q Bool) -> Q Bool -> StateT [Type] Q Bool
forall a b. (a -> b) -> a -> b
$ Name -> [Type] -> Q Bool
isInstance' Name
cn [Type
instanceType]
                           Bool
isPrimitive <-Q Bool -> StateT [Type] Q Bool
forall (m :: * -> *) a. Monad m => m a -> StateT [Type] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Bool -> StateT [Type] Q Bool) -> Q Bool -> StateT [Type] Q Bool
forall a b. (a -> b) -> a -> b
$ Name -> [Type] -> Q Bool
isInstance' ''Prim [Type
saturatedType]
                           let isGeneric :: Bool
isGeneric = ''Generic Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
cn
                           let isGeneric1 :: Bool
isGeneric1 = ''Generic1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
cn
                           [Type]
table <- StateT [Type] Q [Type]
forall s (m :: * -> *). MonadState s m => m s
get
                           if Bool
isMember Bool -> Bool -> Bool
|| Type -> [Type] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Type
instanceType [Type]
table Bool -> Bool -> Bool
|| Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
tn [Name]
breaks Bool -> Bool -> Bool
||
                              (Bool
isPrimitive Bool -> Bool -> Bool
&& (Bool
isGeneric Bool -> Bool -> Bool
|| Bool
isGeneric1)) Bool -> Bool -> Bool
|| 
                              (Name
tn Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''Integer Bool -> Bool -> Bool
&& (Bool
isGeneric Bool -> Bool -> Bool
|| Bool
isGeneric1))
                              then [Dec] -> StateT [Type] Q [Dec]
forall a. a -> StateT [Type] Q a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                              else do
                                 [Type]
classContext <- if Bool
isCnHighOrderClass 
                                                   then [Type] -> StateT [Type] Q [Type]
forall a. a -> StateT [Type] Q a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                                                   else Q [Type] -> StateT [Type] Q [Type]
forall (m :: * -> *) a. Monad m => m a -> StateT [Type] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q [Type] -> StateT [Type] Q [Type])
-> Q [Type] -> StateT [Type] Q [Type]
forall a b. (a -> b) -> a -> b
$ ContextGenderator
cg  Name
cn Name
tn
                                 Maybe DerivStrategy
s <- Q (Maybe DerivStrategy) -> StateT [Type] Q (Maybe DerivStrategy)
forall (m :: * -> *) a. Monad m => m a -> StateT [Type] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q (Maybe DerivStrategy) -> StateT [Type] Q (Maybe DerivStrategy))
-> Q (Maybe DerivStrategy) -> StateT [Type] Q (Maybe DerivStrategy)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe DerivStrategy -> Q (Maybe DerivStrategy)
reset_strategy Name
tn Maybe DerivStrategy
st
                                 let decl :: [Dec]
decl = [Maybe DerivStrategy -> [Type] -> Type -> Dec
StandaloneDerivD Maybe DerivStrategy
s [Type]
classContext (Type -> Type -> Type
AppT (Name -> Type
ConT Name
cn) Type
instanceType)]
                                 ([Type] -> [Type]) -> StateT [Type] Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Type
instanceTypeType -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:)
                                 [Name]
names <- Q [Name] -> StateT [Type] Q [Name]
forall (m :: * -> *) a. Monad m => m a -> StateT [Type] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q [Name] -> StateT [Type] Q [Name])
-> Q [Name] -> StateT [Type] Q [Name]
forall a b. (a -> b) -> a -> b
$ ([[Name]] -> [Name]) -> Q [[Name]] -> Q [Name]
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Q [[Name]] -> Q [Name]) -> Q [[Name]] -> Q [Name]
forall a b. (a -> b) -> a -> b
$ (Con -> Q [Name]) -> [Con] -> Q [[Name]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Con -> Q [Name]
getCompositeTypeNames [Con]
cons
                                 [Name]
names' <- Q [Name] -> StateT [Type] Q [Name]
forall (m :: * -> *) a. Monad m => m a -> StateT [Type] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q [Name] -> StateT [Type] Q [Name])
-> Q [Name] -> StateT [Type] Q [Name]
forall a b. (a -> b) -> a -> b
$ (Name -> Q Bool) -> [Name] -> Q [Name]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\Name
x -> Name -> Q Bool
isTypeFamily Name
x Q Bool -> (Bool -> Q Bool) -> Q Bool
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> Bool -> Q Bool
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Q Bool) -> Bool -> Q Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
b) [Name]
names
                                 [[Dec]]
xs <- (Name -> StateT [Type] Q [Dec])
-> [Name] -> StateT [Type] Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Name
n -> Name
-> Name
-> Maybe DerivStrategy
-> [Name]
-> ContextGenderator
-> StateT [Type] Q [Dec]
gen_standalone_deriving_decl Name
cn Name
n Maybe DerivStrategy
st [Name]
breaks ContextGenderator
cg) [Name]
names'
                                 [Dec] -> StateT [Type] Q [Dec]
forall a. a -> StateT [Type] Q a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> StateT [Type] Q [Dec]) -> [Dec] -> StateT [Type] Q [Dec]
forall a b. (a -> b) -> a -> b
$ [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Dec]]
xs [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
++ [Dec]
decl

deriving_ :: Name -- ^ class name
          -> Name -- ^ type name
          -> Q [Dec]
deriving_ :: Name -> Name -> Q [Dec]
deriving_ Name
cn Name
tn = StateT [Type] Q [Dec] -> [Type] -> Q [Dec]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Name
-> Name
-> Maybe DerivStrategy
-> [Name]
-> ContextGenderator
-> StateT [Type] Q [Dec]
gen_standalone_deriving_decl Name
cn Name
tn Maybe DerivStrategy
forall a. Maybe a
Nothing [] ContextGenderator
genInferredContext) []

{- | This is particularly useful with 'Generic' class.

For the types like 'Int', 'Char','Ratio' or other types which are not 'Generic', there must be a way to stop the generation process on those types.

However, the deriving topdown function will only stop generating 'Generic' instances on primitive types and 'Integer' by default, so you do not need to break on them manually.

Another circumtances might be deriving for 'Typeable' class. Since there is a bug in GHC, isInstance function in TH library is not working on 'Typeable', you can manually give the types which are already instances of 'Typeable' to stop the generation process.

For others cases, there is no need to use this function, bacause for a data type @A@ which is composited by another type, when you manually write an instance declaration for @A@, the process will stop on @A@ automatically since it is already an instance of the type class.
-}
deriving_with_breaks :: Name -- ^ class name
          -> Name -- ^ type name
          -> [Name] -- ^ type names that stop the deriving process
          -> Q [Dec]
deriving_with_breaks :: Name -> Name -> [Name] -> Q [Dec]
deriving_with_breaks Name
cn Name
tn [Name]
bs = StateT [Type] Q [Dec] -> [Type] -> Q [Dec]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Name
-> Name
-> Maybe DerivStrategy
-> [Name]
-> ContextGenderator
-> StateT [Type] Q [Dec]
gen_standalone_deriving_decl Name
cn Name
tn Maybe DerivStrategy
forall a. Maybe a
Nothing [Name]
bs ContextGenderator
genInferredContext) []

derivings :: [Name] -- ^ class names
          -> Name   -- ^ type name
          -> Q [Dec]
derivings :: [Name] -> Name -> Q [Dec]
derivings [Name]
cns Name
tn = ([[Dec]] -> [Dec]) -> Q [[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]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Name -> Q [Dec]) -> [Name] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Name
x -> Name -> Name -> Q [Dec]
deriving_ Name
x Name
tn) [Name]
cns)

derivingss :: [Name] -- ^ class names
           -> [Name] -- ^ type names
           -> Q [Dec]
derivingss :: [Name] -> [Name] -> Q [Dec]
derivingss [Name]
cns [Name]
tns = ([[Dec]] -> [Dec]) -> Q [[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]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Name -> Q [Dec]) -> [Name] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Name
x -> [Name] -> Name -> Q [Dec]
derivings [Name]
cns Name
x) [Name]
tns)


#if __GLASGOW_HASKELL__ >= 802
strategy_deriving :: DerivStrategy
                  -> Name
                  -> Name
                  -> Q [Dec]

strategy_deriving :: DerivStrategy -> Name -> Name -> Q [Dec]
strategy_deriving DerivStrategy
st Name
cn Name
tn = StateT [Type] Q [Dec] -> [Type] -> Q [Dec]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Name
-> Name
-> Maybe DerivStrategy
-> [Name]
-> ContextGenderator
-> StateT [Type] Q [Dec]
gen_standalone_deriving_decl Name
cn Name
tn (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
st) [] ContextGenderator
genInferredContext) []

strategy_derivings :: DerivStrategy
                   -> [Name]
                   -> Name
                   -> Q [Dec]

strategy_derivings :: DerivStrategy -> [Name] -> Name -> Q [Dec]
strategy_derivings DerivStrategy
st [Name]
cns Name
tn = ([[Dec]] -> [Dec]) -> Q [[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]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Q [[Dec]] -> Q [Dec]) -> Q [[Dec]] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ ((Name -> Q [Dec]) -> [Name] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Name
x -> DerivStrategy -> Name -> Name -> Q [Dec]
strategy_deriving DerivStrategy
st Name
x Name
tn) [Name]
cns)

strategy_derivingss :: DerivStrategy
                    -> [Name]
                    -> [Name]
                    -> Q [Dec]
strategy_derivingss :: DerivStrategy -> [Name] -> [Name] -> Q [Dec]
strategy_derivingss DerivStrategy
st [Name]
cns [Name]
tns = ([[Dec]] -> [Dec]) -> Q [[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]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Q [[Dec]] -> Q [Dec]) -> Q [[Dec]] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ ((Name -> Q [Dec]) -> [Name] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Name
x -> DerivStrategy -> [Name] -> Name -> Q [Dec]
strategy_derivings DerivStrategy
st [Name]
cns Name
x) [Name]
tns)
#endif

{-| Context generator be the following 3 functions

 1. @genHoleContext@: It requires PartialTypeSignatures to make the context of deriving
    context a `hole' e.g. @_ => Cls (D a b)@. This case cannot handle type family
    since GHC cannot handle it

 2. @genInferredContext@: It will try to infer the context including cases with type families.

 3. @genAllFieldsContext@: It will put all fields into the context. It may generate like the followings

 @
 data List a = Nil | Cons a (List a)
 deriving instance (Show a, Show (List a)) => Show (List a)
 @
-}
deriving_with :: ClassName
              -> TypeName
              -> Maybe DerivStrategy -- ^ deriving strategy
              -> [TypeName]        -- ^ a list of types that breaks the generation process
              -> ContextGenderator -- ^ a context generator,  @genInferredContext@, @genHoleContext@ or @genAllFieldsContext@
              -> Q [Dec]
deriving_with :: Name
-> Name
-> Maybe DerivStrategy
-> [Name]
-> ContextGenderator
-> Q [Dec]
deriving_with Name
cn Name
tn Maybe DerivStrategy
st [Name]
bs ContextGenderator
cg = StateT [Type] Q [Dec] -> [Type] -> Q [Dec]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Name
-> Name
-> Maybe DerivStrategy
-> [Name]
-> ContextGenderator
-> StateT [Type] Q [Dec]
gen_standalone_deriving_decl Name
cn Name
tn Maybe DerivStrategy
st [Name]
bs ContextGenderator
cg) []