我需要通过给定的记录类型来呈现html表单。因此,我创建了类型类
class EntityRep a where
toRep :: Proxy a -> [FieldRep]
default toRep :: (Generic a, GEntityRep (Rep a)) => Proxy a -> [FieldRep]
toRep _ = gtoRep (Proxy :: Proxy (Rep a))
其中
data FieldRep = FieldRep
{ fieldName :: String
, fieldRequired :: Bool
} deriving (Show)
class GEntityRep f where
gtoRep :: Proxy f -> [FieldRep]
以及选择器表示形式的实例:
instance (Selector a, Required a) => GEntityRep (M1 S s (K1 R a)) where
gtoRep _ = [FieldRep { fieldName = selName (undefined :: M1 S s (K1 R a) ())
, fieldRequired = isRequired (Proxy @a) }]
所以我要实现该功能
isRequired :: (Required a) => Proxy a -> Bool
--returns True, only if the type is (Maybe a) for all a
我试图使用Data.Data
:
constrs :: forall a. (Data a) => Proxy a -> [Constr]
constrs _ = let dt = dataTypeOf (undefined :: a)
in if isAlgType dt then dataTypeConstrs dt
else []
isRequired :: forall a. (Data a) => Proxy a -> Bool
isRequired proxy =
toConstr (Nothing :: Maybe ()) `elem` (constrs proxy)
|| toConstr (Just () :: Maybe ()) `elem` (constrs proxy)
但这不起作用,因为不同类型的构造可能相等。
最后,进行以下记录
data PK a = PK a | Unset deriving (Data, Typeable, Show)
data ProductCategory = Clothes | Food deriving (Data, Typeable, Show)
data Product = Product { productName :: String
, productCategory :: ProductCategory
, productPrice :: Maybe Int } deriving (Generic, Show)
instance EntityRep Product
以下表达式
>>> toRep (Proxy @Product)
应该返回
[FieldRep{fieldName="productName"
,fieldRequired=True}
,FieldRep{fieldName="productCategory"
,fieldRequired=True}
,FieldRep{fieldName="productPrice"
,fieldRequired=False}]
我可以创建类型类
class Required a where
isRequired :: Proxy a -> Bool
然后将其实现为各种类型,但是太麻烦了。除Maybe a
之外,所有实例都是相同的。
我们可以进行默认实现
instance Required a where
isRequired _ = True
然后将其与Maybe a
实例重叠:
instance {-# OVERLAPPING #-} Required (Maybe a) where
isRequired _ = False
答案 0 :(得分:0)
使用TypeFamilies
结束approach
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
import Data.Proxy
type family (F a) :: Bool where
F (Maybe a) = 'False
F a = 'True
class Required a where
isRequired :: Proxy a -> Bool
class Required' (flag :: Bool) a where
isRequired' :: Proxy flag -> Proxy a -> Bool
instance (F a ~ flag, Required' flag a) => Required a where
isRequired = isRequired' (Proxy :: Proxy flag)
instance Required' 'False (Maybe a) where
isRequired' _ _ = False
instance Required' 'True a where
isRequired' _ x = True