数据类型的自定义通用表示形式

时间:2018-09-20 19:11:13

标签: haskell

我需要通过给定的记录类型来呈现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

1 个答案:

答案 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