module Data.Derive.Has(makeHas) where
import Language.Haskell
import Data.Derive.Internal.Derivation
import Data.List
makeHas :: Derivation
makeHas = derivationCustom "Has" $ \(_,d) -> Right $ concatMap (makeHasField d) $ dataDeclFields d
makeHasField :: DataDecl -> String -> [Decl]
makeHasField d field = [TypeSig sl [name has] typ, binds has ms]
where
has = "has" ++ title field
typ = TyFun (dataDeclType d) (tyCon "Bool")
(yes,no) = partition (elem field . map fst . ctorDeclFields) $ dataDeclCtors d
match pat val = ([pat], con val)
ms | null no = [match PWildCard "True"]
| otherwise = [match (PRec (qname $ ctorDeclName c) []) "True" | c <- yes] ++ [match PWildCard "False"]