diff --git a/haskell-src-meta.cabal b/haskell-src-meta.cabal --- a/haskell-src-meta.cabal +++ b/haskell-src-meta.cabal @@ -1,5 +1,5 @@ name: haskell-src-meta -version: 0.1.1 +version: 0.2 cabal-version: >= 1.6 build-type: Simple license: BSD3 @@ -14,9 +14,9 @@ to template-haskell abstract syntax isn't 100% complete yet. library - build-depends: base == 4.2.*, containers == 0.3.*, + build-depends: base >= 4.1 && < 4.3, containers >= 0.2 && < 0.4, haskell-src-exts >= 1.6 && < 1.10, - template-haskell == 2.4.*, + template-haskell >= 2.3 && < 2.5, pretty == 1.0.*, syb >= 0.1 && < 0.2, th-lift == 0.5.* hs-source-dirs: src exposed-modules: Language.Haskell.Meta, @@ -26,6 +26,7 @@ Language.Haskell.Meta.Syntax.Translate, Language.Haskell.TH.Instances.Lift, Language.Haskell.Meta.Utils, + Language.Haskell.Meta.QQ.ADo, Language.Haskell.Meta.QQ.Hs, Language.Haskell.Meta.QQ.Here, Language.Haskell.Meta.QQ.HsHere, diff --git a/src/Language/Haskell/Meta/QQ/ADo.hs b/src/Language/Haskell/Meta/QQ/ADo.hs new file mode 100644 --- /dev/null +++ b/src/Language/Haskell/Meta/QQ/ADo.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE PatternGuards, TemplateHaskell, QuasiQuotes #-} + +-- | Applicative do. Phillipa Cowderoy's idea, some explanations due Edward +-- Kmett +-- +-- Pointful version of "Language.Haskell.Meta.QQ.Idiom". Note the only +-- expression which has the bound variables in scope is the last one. +-- +-- This lets you work with applicatives without the order of fields in an data +-- constructor becoming such a burden. +-- +-- In a similar role as 'fail' in do notation, if match failures can be +-- expected, the result is an @Applicative f => f (Maybe a)@, rather than +-- @Applicative f => f a@, where @a@ may be partially defined. +module Language.Haskell.Meta.QQ.ADo ( + + ado, + ado' + + -- * Desugaring + -- $desugaring + ) where + +import Control.Applicative +import Language.Haskell.Meta +import Language.Haskell.TH.Lib +import Language.Haskell.TH.Quote +import Language.Haskell.TH.Syntax +import Control.Monad +import qualified Data.Set as S + +import Language.Haskell.Meta.Utils (cleanNames) + +import Data.Generics + +-- $desugaring +-- +-- If you use patterns that may fail: +-- +-- > foo :: Applicative f => f (Maybe T) +-- > foo = [$ado| +-- > x:xs <- foo bar baz +-- > Just y <- quux quaffle +-- > T x y |] +-- +-- 'ado' desugars to: +-- +-- > foo = (\x y -> case (x,y) of +-- > (x:xs,Just y) -> Just $ T x y +-- > _ -> Nothing +-- > ) <$> foo bar baz <*> quux quaffle +-- +-- While 'ado'' desugars to the less safe: +-- +-- > foo = (\(x:xs) (Just y) -> T x y) <$> foo bar baz <*> quux quaffle +-- +-- If the simple patterns cannot fail, there is no 'Maybe' for the 'ado' quote, +-- just like 'ado'': +-- +-- > newtype A = A Int +-- > foo :: Applicative f => f T +-- > foo = [$ado| +-- > ~(x:xs) <- foo bar baz +-- > A y <- quux quaffle +-- > T x y |] +-- +-- Becomes: +-- +-- > foo = (\ ~(x:xs) (A y) -> T x y) <$> foo bar baz <*> quux quaffle + +-- | Usage: +-- +-- > ghci> [$ado| a <- "foo"; b <- "bar"; (a,b) |] +-- > [('f','b'),('f','a'),('f','r'),('o','b'),('o','a'),('o','r'),('o','b'),('o','a'),('o','r')] +-- +-- > ghci> [$ado| Just a <- [Just 1,Nothing,Just 2]; b <- "fo"; (a,b) |] +-- > [Just (1,'f'),Just (1,'o'),Nothing,Nothing,Just (2,'f'),Just (2,'o')] +ado :: QuasiQuoter +ado = ado'' False + +-- | Variant of 'ado' that does not implicitly add a Maybe when patterns may fail: +-- +-- > ghci> [$ado'| Just a <- [Just 1,Nothing,Just 2]; b <- "fo"; (a,b) |] +-- > [(1,'f'),(1,'o'),*** Exception: :... +-- +ado' :: QuasiQuoter +ado' = ado'' True + +ado'' :: Bool -> QuasiQuoter +ado'' b = QuasiQuoter + (\str -> fmap cleanNames $ applicate b =<< parseDo str) + (either fail return . parsePat) + +parseDo :: (Monad m) => String -> m [Stmt] +parseDo str = + let prefix = "do\n" in + case parseExp $ prefix ++ str of + Right (DoE stmts) -> return stmts + Right a -> fail $ "ado can't handle:\n" ++ show a + Left a -> fail a + +applicate :: Bool -> [Stmt] -> ExpQ +applicate rawPatterns stmt = do + (_:ps,f:es) <- fmap (unzip . reverse) $ + flip mapM stmt $ \s -> + case s of + BindS p e -> return (p,e) + NoBindS e -> return (WildP,e) + LetS _ -> fail $ "LetS not supported" + ParS _ -> fail $ "ParS not supported" + + fps <- failingPatterns ps + f' <- case filter (not . snd) $ zip ps fps of + [] -> return $ LamE ps f + _ | rawPatterns -> return $ LamE ps f + | otherwise -> do + xs <- mapM (const $ newName "x") ps + return $ LamE (map VarP xs) $ CaseE (TupE (map VarE xs)) + [Match (TupP ps) (NormalB $ ConE 'Just `AppE` f) [] + ,Match WildP (NormalB $ ConE 'Nothing) [] + ] + + return $ foldl (\g e -> VarE '(<**>) `AppE` e `AppE` g) + (VarE 'pure `AppE` f') + es + +failingPatterns :: (Data a) => [a] -> Q [Bool] +failingPatterns ps = flip mapM ps $ \p -> + let couldFail x = liftM not (singleCon x) + + constrs :: Data a => a -> S.Set Name + constrs = S.fromList . map (\(ConP n _) -> n) + . listify (\x -> case x of ConP {} -> True; _ -> False) + irrefutables = constrs + . listify (\x -> case x of TildeP {} -> True; _ -> False) + + in liftM null $ filterM couldFail $ S.elems $ + constrs p S.\\ irrefutables p + +singleCon :: Name -> Q Bool +singleCon n = do + DataConI _ _ tn _ <- reify n + TyConI dec <- reify tn + case dec of + DataD _ _ _ [_] _ -> return True + NewtypeD {} -> return True + DataD _ _ _ (_:_) _ -> return False + _ -> fail $ "Bad dec: "++show dec + diff --git a/src/Language/Haskell/Meta/QQ/HsHere.hs b/src/Language/Haskell/Meta/QQ/HsHere.hs --- a/src/Language/Haskell/Meta/QQ/HsHere.hs +++ b/src/Language/Haskell/Meta/QQ/HsHere.hs @@ -18,6 +18,14 @@ | ManyH [Here] deriving (Eq,Show,Data,Typeable) +-- | Example: +-- +-- > a x = [$here| random "text" $(x + 1) +-- > something else|] +-- +-- Is like: +-- +-- > a x = " random \"text\" "++ show (x + 1) ++"\n something else" here :: QuasiQuoter here = QuasiQuoter {quoteExp = hereExpQ diff --git a/src/Language/Haskell/Meta/Syntax/Translate.hs b/src/Language/Haskell/Meta/Syntax/Translate.hs --- a/src/Language/Haskell/Meta/Syntax/Translate.hs +++ b/src/Language/Haskell/Meta/Syntax/Translate.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, TypeSynonymInstances #-} +{-# LANGUAGE CPP, TemplateHaskell, TypeSynonymInstances #-} {- | Module : Language.Haskell.Meta.Syntax.Translate @@ -135,9 +135,11 @@ toLit (Hs.PrimChar a) = CharL a -- XXX toLit (Hs.PrimString a) = StringL a -- XXX toLit (Hs.PrimInt a) = IntPrimL a - toLit (Hs.PrimWord a) = WordPrimL a toLit (Hs.PrimFloat a) = FloatPrimL a toLit (Hs.PrimDouble a) = DoublePrimL a +#if MIN_VERSION_template_haskell(2,4,0) + toLit (Hs.PrimWord a) = WordPrimL a +#endif /* MIN_VERSION_template_haskell(2,4,0) */ ----------------------------------------------------------------------------- @@ -171,7 +173,9 @@ toPat (Hs.PXETag _ _ _ pM) = error "toPat: HsPXETag not supported" toPat (Hs.PXPcdata _) = error "toPat: HsPXPcdata not supported" toPat (Hs.PXPatTag p) = error "toPat: HsPXPatTag not supported" +#if MIN_VERSION_template_haskell(2,4,0) toPat (Hs.PBangPat p) = BangP (toPat p) +#endif /* MIN_VERSION_template_haskell(2,4,0) */ ----------------------------------------------------------------------------- @@ -214,8 +218,7 @@ toExp (Hs.Let bs e) = LetE (hsBindsToDecs bs) (toExp e) -- toExp (HsWith e bs toExp (Hs.If a b c) = CondE (toExp a) (toExp b) (toExp c) - -- toExp (HsCase e xs) - -- toExp (HsDo ss) + toExp (Hs.Do ss) = DoE (map toStmt ss) -- toExp (HsMDo ss) toExp (Hs.Tuple xs) = TupE (fmap toExp xs) toExp (Hs.List xs) = ListE (fmap toExp xs) @@ -228,7 +231,7 @@ toExp (Hs.EnumFromThenTo e f g) = ArithSeqE $ FromThenToR (toExp e) (toExp f) (toExp g) toExp (Hs.ExpTypeSig _ e t) = SigE (toExp e) (toType t) -- HsListComp HsExp [HsStmt] - -- toExp (HsListComp e ss) = CompE + -- toExp (HsListComp e ss) = CompE -- NEED: a way to go e -> Stmt toExp a@(Hs.ListComp e ss) = error $ errorMsg "toExp" a {- HsVarQuote HsQName @@ -250,9 +253,19 @@ toExp (Hs.IdSplice s) = VarE (toName s) toExp (Hs.ParenSplice e) = toExp e +toMatch :: Hs.Alt -> Match toMatch (Hs.Alt _ p galts ds) = Match (toPat p) (toBody galts) (toDecs ds) + +toBody :: Hs.GuardedAlts -> Body toBody (Hs.UnGuardedAlt e) = NormalB $ toExp e -toBody (Hs.GuardedAlts alts) = GuardedB $ map toGuard alts +toBody (Hs.GuardedAlts alts) = GuardedB $ do + Hs.GuardedAlt _ stmts e <- alts + let + g = case map toStmt stmts of + [NoBindS x] -> NormalG x + xs -> PatG xs + return (g, toExp e) + toGuard (Hs.GuardedAlt _ ([Hs.Qualifier e1]) e2) = (NormalG $ toExp e1,toExp e2) ----------------------------------------------------------------------------- @@ -301,20 +314,33 @@ toName (Hs.KindedVar n _) = toName n toName (Hs.UnkindedVar n) = toName n +instance ToName Name where + toName = id + +#if MIN_VERSION_template_haskell(2,4,0) instance ToName TyVarBndr where toName (PlainTV n) = n toName (KindedTV n _) = n +#endif /* !MIN_VERSION_template_haskell(2,4,0) */ +#if MIN_VERSION_template_haskell(2,4,0) toKind :: Hs.Kind -> Kind toKind Hs.KindStar = StarK toKind (Hs.KindFn k1 k2) = ArrowK (toKind k1) (toKind k2) toKind (Hs.KindParen kp) = toKind kp toKind Hs.KindBang = error "toKind: HsKindBang not supported" toKind (Hs.KindVar _) = error "toKind: HsKindVar not supported" +#endif /* !MIN_VERSION_template_haskell(2,4,0) */ +#if MIN_VERSION_template_haskell(2,4,0) toTyVar :: Hs.TyVarBind -> TyVarBndr toTyVar (Hs.KindedVar n k) = KindedTV (toName n) (toKind k) toTyVar (Hs.UnkindedVar n) = PlainTV (toName n) +#else /* !MIN_VERSION_template_haskell(2,4,0) */ +toTyVar :: Hs.TyVarBind -> Name +toTyVar (Hs.KindedVar n _) = toName n +toTyVar (Hs.UnkindedVar n) = toName n +#endif /* !MIN_VERSION_template_haskell(2,4,0) */ {- | TH does't handle @@ -350,10 +376,17 @@ toCxt :: Hs.Context -> Cxt toCxt = fmap toPred where +#if MIN_VERSION_template_haskell(2,4,0) toPred (Hs.ClassA n ts) = ClassP (toName n) (fmap toType ts) toPred (Hs.InfixA t1 n t2) = ClassP (toName n) (fmap toType [t1, t2]) toPred (Hs.EqualP t1 t2) = EqualP (toType t1) (toType t2) - toPred a@(Hs.IParam _ _) = error $ errorMsg "toType" a + toPred a@(Hs.IParam _ _) = error $ errorMsg "toPred" a +#else /* !MIN_VERSION_template_haskell(2,4,0) */ + toPred (Hs.ClassA n ts) = foldAppT (ConT (toName n)) (fmap toType ts) + toPred (Hs.InfixA t1 n t2) = foldAppT (ConT (toName n)) (fmap toType [t1, t2]) + toPred a@(Hs.EqualP _ _) = error $ errorMsg "toPred" a + toPred a@(Hs.IParam _ _) = error $ errorMsg "toPred" a +#endif /* !MIN_VERSION_template_haskell(2,4,0) */ foldAppT :: Type -> [Type] -> Type foldAppT t ts = foldl' AppT t ts @@ -454,7 +487,7 @@ toDec a@(Hs.InfixDecl _ asst i ops) = error $ errorMsg "toDec" a toDec a@(Hs.ClassDecl _ cxt n ns funDeps cDecs) = error $ errorMsg "toDec" a toDec a@(Hs.InstDecl _ cxt qn ts instDecs) = error $ errorMsg "toDec" a - toDec a@(Hs.DerivDecl _ cxt qn ts) = error $ errorMsg "toDec" a + toDec a@(Hs.DerivDecl _ cxt qn ts) = error $ errorMsg "toDec" a toDec a@(Hs.DefaultDecl _ ts) = error $ errorMsg "toDec" a toDec a@(Hs.SpliceDecl _ s) = error $ errorMsg "toDec" a -- This type-signature conversion is just wrong. @@ -463,8 +496,10 @@ -- XXXXXXXXXXXXXX: oh crap, we can't return a [Dec] from this class! = let xs = fmap (flip SigD (toType t) . toName) ns in case xs of x:_ -> x; [] -> error "toDec: malformed TypeSig!" +#if MIN_VERSION_template_haskell(2,4,0) toDec (Hs.InlineSig _ b act id) = PragmaD $ InlineP (toName id) (InlineSpec True False Nothing) +#endif /* MIN_VERSION_template_haskell(2,4,0) */ {- data HsDecl = ... | HsFunBind [HsMatch] | ... data HsMatch = HsMatch SrcLoc HsName [HsPat] HsRhs HsBinds @@ -582,7 +617,11 @@ toDecs a = [toDec a] collectVars e = case e of +#if MIN_VERSION_template_haskell(2,4,0) VarT n -> [PlainTV n] +#else /* !MIN_VERSION_template_haskell(2,4,0) */ + VarT n -> [n] +#endif /* !MIN_VERSION_template_haskell(2,4,0) */ AppT t1 t2 -> nub $ collectVars t1 ++ collectVars t2 ForallT ns _ t -> collectVars t \\ ns _ -> [] diff --git a/src/Language/Haskell/Meta/Syntax/Vars.hs b/src/Language/Haskell/Meta/Syntax/Vars.hs --- a/src/Language/Haskell/Meta/Syntax/Vars.hs +++ b/src/Language/Haskell/Meta/Syntax/Vars.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} {- | @@ -45,24 +46,29 @@ vars (ConP n ps) = n `S.insert` vars ps vars (InfixP p n q) = n `S.insert` vars [p,q] vars (TildeP p) = vars p - vars (BangP p) = vars p vars (AsP n p) = n `S.insert` vars p vars (WildP) = S.empty vars (RecP n pfs) = (n `S.insert`) . vars . fmap snd $ pfs vars (ListP ps) = vars ps vars (SigP p _) = vars p +#if MIN_VERSION_template_haskell(2,4,0) + vars (BangP p) = vars p +#endif /* MIN_VERSION_template_haskell(2,4,0) */ + bvs (LitP _) = S.empty bvs (VarP n) = S.singleton n bvs (TupP ps) = bvs ps bvs (ConP _ ps) = bvs ps bvs (InfixP p _ q) = bvs [p,q] bvs (TildeP p) = bvs p - bvs (BangP p) = bvs p bvs (AsP n p) = n `S.insert` bvs p bvs (WildP) = S.empty bvs (RecP _ pfs) = bvs . fmap snd $ pfs bvs (ListP ps) = bvs ps bvs (SigP p _) = bvs p +#if MIN_VERSION_template_haskell(2,4,0) + bvs (BangP p) = bvs p +#endif /* MIN_VERSION_template_haskell(2,4,0) */ instance Vars Range Name where diff --git a/src/Language/Haskell/Meta/Utils.hs b/src/Language/Haskell/Meta/Utils.hs --- a/src/Language/Haskell/Meta/Utils.hs +++ b/src/Language/Haskell/Meta/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell, RankNTypes, StandaloneDeriving, DeriveDataTypeable, PatternGuards, FlexibleContexts, FlexibleInstances, TypeSynonymInstances #-} @@ -15,8 +16,8 @@ import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax import Language.Haskell.TH.Lib +import Language.Haskell.TH.Lift (deriveLift) import Language.Haskell.TH.Ppr -import Language.Haskell.TH.Lift import Text.PrettyPrint import Control.Monad @@ -117,19 +118,22 @@ mkVarT = varT . mkName - +-- | Infinite list of names composed of lowercase letters myNames :: [Name] myNames = let xs = fmap (:[]) ['a'..'z'] ys = iterate (join (zipWith (++))) xs in fmap mkName (concat ys) +-- | Generalisation of renameTs +renameThings _ env new acc [] = (reverse acc, env, new) +renameThings f env new acc (t:ts) = + let (t', env', new') = f env new t + in renameThings f env' new' (t':acc) ts + -- | renameT applied to a list of types renameTs :: [(Name, Name)] -> [Name] -> [Type] -> [Type] -> ([Type], [(Name,Name)], [Name]) -renameTs env new acc [] = (reverse acc, env, new) -renameTs env new acc (t:ts) = - let (t',env',new') = renameT env new t - in renameTs env' new' (t':acc) ts +renameTs = renameThings renameT -- | Rename type variables in the Type according to the given association -- list. Normalise constructor names (remove qualification, etc.) @@ -140,7 +144,7 @@ renameT env [] _ = error "renameT: ran out of names!" renameT env (x:new) (VarT n) | Just n' <- lookup n env = (VarT n',env,x:new) - | otherwise = (VarT x, (n,x):env, new) + | otherwise = (VarT x, (n,x):env, new) renameT env new (ConT n) = (ConT (normaliseName n), env, new) renameT env new t@(TupleT {}) = (t,env,new) renameT env new ArrowT = (ArrowT,env,new) @@ -149,21 +153,31 @@ (s',env'',new'') = renameT env' new' t' in (AppT s s', env'', new'') renameT env new (ForallT ns cxt t) = - let unVarT (VarT n) = PlainTV n -- dropping kinds here - (ns',env2,new2) = renameTs env new [] (fmap (VarT . toName) ns) - ns'' = fmap unVarT ns' - renameCs env new acc [] = (reverse acc, env, new) - renameCs env new acc (ClassP n ts:cs) = - let (ts', env', new') = renameTs env new [] ts - in renameCs env' new' (ClassP (normaliseName n) ts' : acc) cs - renameCs env new acc (EqualP t1 t2:cs) = - let (t1', env', new') = renameT env new t1 - (t2', env'', new'') = renameT env' new' t2 - in renameCs env'' new'' (EqualP t1' t2' : acc) cs - (cxt',env3,new3) = renameCs env2 new2 [] cxt - (t',env4,new4) = renameT env3 new3 t - in (ForallT ns'' cxt' t', env4, new4) + let (ns',env2,new2) = renameTs env new [] (fmap (VarT . toName) ns) + ns'' = fmap unVarT ns' + (cxt',env3,new3) = renamePreds env2 new2 [] cxt + (t',env4,new4) = renameT env3 new3 t + in (ForallT ns'' cxt' t', env4, new4) + where +#if MIN_VERSION_template_haskell(2,4,0) + unVarT (VarT n) = PlainTV n + renamePreds = renameThings renamePred + renamePred env new (ClassP n ts) = let + (ts', env', new') = renameTs env new [] ts + in (ClassP (normaliseName n) ts', env', new') + + renamePred env new (EqualP t1 t2) = let + (t1', env1, new1) = renameT env new t1 + (t2', env2, new2) = renameT env1 new1 t2 + in (EqualP t1' t2', env2, new2) + +#else /* !MIN_VERSION_template_haskell(2,4,0) */ + unVarT (VarT n) = n + renamePreds = renameTs + +#endif /* !MIN_VERSION_template_haskell(2,4,0) */ + -- | Remove qualification, etc. normaliseName :: Name -> Name normaliseName = mkName . nameBase @@ -189,7 +203,6 @@ - -- | Produces pretty code suitable -- for human consumption. deriveLiftPretty :: Name -> Q String @@ -201,7 +214,6 @@ - splitCon :: Con -> (Name,[Type]) splitCon c = (conName c, conTypes c) @@ -231,7 +243,11 @@ decCons _ = [] +#if MIN_VERSION_template_haskell(2,4,0) decTyVars :: Dec -> [TyVarBndr] +#else /* !MIN_VERSION_template_haskell(2,4,0) */ +decTyVars :: Dec -> [Name] +#endif /* !MIN_VERSION_template_haskell(2,4,0) */ decTyVars (DataD _ _ ns _ _) = ns decTyVars (NewtypeD _ _ ns _ _) = ns decTyVars (TySynD _ ns _) = ns diff --git a/src/Language/Haskell/TH/Instances/Lift.hs b/src/Language/Haskell/TH/Instances/Lift.hs --- a/src/Language/Haskell/TH/Instances/Lift.hs +++ b/src/Language/Haskell/TH/Instances/Lift.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving, TemplateHaskell #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -20,13 +21,7 @@ deriving instance Ord Dec deriving instance Ord Stmt deriving instance Ord Type -deriving instance Ord TyVarBndr -deriving instance Ord Pred -deriving instance Ord Kind -deriving instance Ord FamFlavour deriving instance Ord Foreign -deriving instance Ord InlineSpec -deriving instance Ord Pragma deriving instance Ord FunDep deriving instance Ord Con deriving instance Ord Body @@ -40,6 +35,15 @@ deriving instance Ord Pat deriving instance Ord Lit +#if MIN_VERSION_template_haskell(2,4,0) +deriving instance Ord TyVarBndr +deriving instance Ord Pred +deriving instance Ord Kind +deriving instance Ord FamFlavour +deriving instance Ord InlineSpec +deriving instance Ord Pragma +#endif /* MIN_VERSION_template_haskell(2,4,0) */ + deriving instance Show Loc deriving instance Eq Loc @@ -50,8 +54,33 @@ instance Ppr Lit where ppr l = ppr (LitE l) -deriveLiftMany [''Body, ''Callconv, ''Clause, ''Con, ''Dec, - ''Exp, ''FamFlavour, ''Fixity, ''FixityDirection, ''Foreign, ''FunDep, - ''Guard, ''Info, ''InlineSpec, ''Kind, ''Lit, ''Match, ''Pat, ''Pragma, - ''Pred, ''Range, ''Safety, ''Stmt, ''Strict, ''Type, ''TyVarBndr] +$(deriveLiftMany [ ''Body + , ''Callconv + , ''Clause + , ''Con + , ''Dec + , ''Exp + , ''Fixity + , ''FixityDirection + , ''Foreign + , ''FunDep + , ''Guard + , ''Info + , ''Lit + , ''Match + , ''Pat + , ''Range + , ''Safety + , ''Stmt + , ''Strict + , ''Type +#if MIN_VERSION_template_haskell(2,4,0) + , ''FamFlavour + , ''InlineSpec + , ''Kind + , ''Pragma + , ''Pred + , ''TyVarBndr +#endif /* MIN_VERSION_template_haskell(2,4,0) */ + ])