1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
|
{-|
Has is a pseudo derivation. For each field of any constructor of
the data type, Has generates @has@/FieldName/ which returns 'True'
if given the the given field is a member of the constructor of the
passed object, and 'False' otherwise.
-}
module Data.Derive.Has(makeHas) where
{-
test :: Computer
hasSpeed :: Computer -> Bool
hasSpeed _ = True
hasWeight :: Computer -> Bool
hasWeight Laptop{} = True
hasWeight _ = False
test :: Sample
-}
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"]
|