- needsExtras all_tydata deriv_decls xDeriveRepresentable tc_name
- | xDeriveRepresentable
- -- The flag DeriveGenerics is on, so the types the are
- -- deriving Representable should get the extras defined
- && ( tc_name `elem` map (tcdName . unLoc . snd) all_tydata
- || False) --tc_name `elem` map (unLoc . deriv_type . unLoc) deriv_decls)
- -- JPM TODO: we should check in deriv_decls too, for now we
- -- don't accept standalone deriving...
- = True
- | otherwise
- -- Don't generate anything
- = False
+ -- We need extras if the flag DeriveGeneric is on and this type is
+ -- deriving Generic
+ needsExtras xDerRep tydata tc_name = xDerRep && tc_name `elem` tydata
+
+ -- Extracts the name of the class in the deriving
+ getClassName :: HsType Name -> Maybe Name
+ getClassName (HsForAllTy _ _ _ (L _ n)) = getClassName n
+ getClassName (HsPredTy (HsClassP n _)) = Just n
+ getClassName _ = Nothing
+
+ -- Extracts the name of the type in the deriving
+ -- This function (and also getClassName above) is not really nice, and I
+ -- might not have covered all possible cases. I wonder if there is no easier
+ -- way to extract class and type name from a LDerivDecl...
+ getTypeName :: HsType Name -> Maybe Name
+ getTypeName (HsForAllTy _ _ _ (L _ n)) = getTypeName n
+ getTypeName (HsTyVar n) = Just n
+ getTypeName (HsOpTy _ (L _ n) _) = Just n
+ getTypeName (HsPredTy (HsClassP _ [L _ n])) = getTypeName n
+ getTypeName (HsAppTy (L _ n) _) = getTypeName n
+ getTypeName (HsParTy (L _ n)) = getTypeName n
+ getTypeName (HsKindSig (L _ n) _) = getTypeName n
+ getTypeName _ = Nothing