Question

Haskell泛型的大多数示例在:+:和:*:类型/构造函数周围递归执行少量计算。我似乎正在解决一个可能无法解决的问题。

我试图编写一个泛型验证函数，它接受任何两个具有相同形状的记录，并对recordA中的每个字段验证recordB中定义的验证函数，以返回错误记录相同形状或记录A本身。

示例：

-- Some type synonyms for better readability
type Name = Text
type Age = Int
type Email = Text
type GeneralError = Text
type FieldError = Text

-- a polymorphic record to help preserve the shape of various records
data User n a e = User {name :: n, age :: a, email :: e}

-- the incoming value which has been parsed into the correct type
-- but still needs various values to be validated, eg length, format, etc
type UserInput = User Name Age Email

-- specifies the exact errors for each field
type UserError = User [FieldError] [FieldError] [FieldError]

-- specifies how to validate each field. the validator is being passed
-- the complete record along with the specific field to allow
-- validations that depends on the value of another field
type UserValidator = User
                     (UserInput -> Name -> Either ([GeneralError], [FieldError]) Name)
                     (UserInput -> Age -> Either ([GeneralError], [FieldError]) Age)
                     (UserInput -> Email -> Either ([GeneralError], [FieldError]) Email)

let (validationResult :: Either ([GeneralError], UserError) UserInput)
  = genericValidation (i :: UserInput) (v :: UserValidator)

现在，在:*:周围递归执行此操作可能不起作用的原因是，需要查看每个验证函数的结果，然后确定返回值是否应该是一个Left ([GeneralError], UserError)或Right UserInput。我们无法在第一个失败的验证函数上评估Left值。

有没有办法用Haskell泛型编写这个genericValidation函数？

Answer 1

现在，在:*:周围递归执行此操作可能不起作用的原因是，需要查看每个验证函数的结果，然后确定返回值是否应为Left ([GeneralError], UserError)或一个Right UserInput。我们无法在第一个失败的验证函数上评估Left值。

Applicative的标准Either行为不是该类型的唯一合理行为！正如您所说，当您（例如，验证表单）时，您希望返回 all 的集合，而不仅仅是第一个发生的错误。所以这里的类型在结构上与Either相同，但具有不同的Applicative实例。

newtype Validation e a = Validation (Either e a) deriving Functor

instance Semigroup e => Applicative (Validation e) where
    pure = Validation . pure
    Validation (Right f) <*> Validation (Right x) = Validation (Right $ f x)
    Validation (Left e1) <*> Validation (Left e2) = Validation (Left $ e1 <> e2)
    Validation (Left e) <*> _ = Validation (Left e)
    _ <*> Validation (Left e) = Validation (Left e)

当两个计算都失败时，组合计算也会失败，返回使用Semigroup实例组成的两个错误 - 两个错误，对于两个的某些合适概念。如果两个计算都成功，或者只有其中一个计算失败，则Validation的行为类似于Either。所以它有点像Either和Writer应用程序的Frankensteinian混搭。

此实例确实符合Applicative法律，但我会将证据留给您。哦，Validation不能成为合法的Monad。

原谅我冒昧地重新安排你的类型。我正在使用一种常见的技巧来重用各种不同类型的记录结构：通过类型构造函数对记录进行参数化。您可以通过将模板应用于Identity仿函数来恢复原始记录。

data UserTemplate f = UserTemplate {
    name :: f Name,
    age :: f Age,
    email :: f Email
}
type User = UserTemplate Identity

一个有用的新类型：Validator是一个函数，它接受a并返回a或错误的单一摘要。

newtype Validator e a = Validator { runValidator :: a -> Validation e a }

一个有用的类：HTraversable与Traversable类似，但适用于类型构造函数类别到Hask的仿函数。（a previous question of mine中的更多内容。）

class HFunctor t where
    hmap :: (forall x. f x -> g x) -> t f -> t g
class HFunctor t => HTraversable t where
    htraverse :: Applicative a => (forall x. f x -> Compose a g x) -> t f -> a (t g)
    htraverse f = hsequence . hmap f
    hsequence :: Applicative a => t (Compose a g) -> a (t g)
    hsequence = htraverse id

为什么HTraversable相关？ Traversable Classic™允许您将Applicative效果（如Validation）排序到同类容器（如列表）上。但是记录更像是异构容器：记录“包含”一堆字段，但每个字段都有自己的类型。 HTraversable正是您需要对多态容器进行Applicative次操作时的类。

另一个有用的类将zipWith概括为这些异构容器。

class HZip t where
    hzip :: (forall x. f x -> g x -> h x) -> t f -> t g -> t h

以UserTemplate方式构建的记录是可遍历和可拉伸的。（事实上它们通常是HRepresentable - 类似于Representable的高阶概念 - 这是一个非常有用的属性，但我不会在这里详述。）

instance HFunctor UserTemplate where
    hmap f (UserTemplate n a e) = UserTemplate (f n) (f a) (f e)

instance HTraversable UserTemplate where
    htraverse f (UserTemplate n a e) = UserTemplate <$>
        getCompose (f n) <*>
        getCompose (f a) <*>
        getCompose (f e)

instance HZip UserTemplate where
    hzip f (UserTemplate n1 a1 e1) (UserTemplate n2 a2 e2) = UserTemplate (f n1 n2) (f a1 a2) (f e1 e2)

希望对于适合此模式的任意记录，Generic或{H} HTraversable和HZip的实现应该很容易。

因此，计划是：为每个字段编写Validator，然后在要验证的对象上hzip这些Validator。然后，您可以htraverse结果获取包含已验证对象的Validation。根据您的问题，此模式适用于逐场验证。如果您需要查看多个字段来验证记录，则无法使用hzip（但当然您也无法使用Generic）。

type Validatable t = (HZip t, HTraversable t)
validate :: (Semigroup e, Validatable t) => t (Validator e) -> Validator e (t Identity)
validate t = Validator $ htraverse (Compose . fmap Identity) . hzip val t
    where val v = runValidator v . runIdentity

User等类型的特定验证器主要涉及选择幺半群错误并返回验证函数的记录。在这里，我为Monoid定义了一个UserError，它通过记录的每个字段逐点提升一个{1}}。

现在您可以定义验证器功能的记录。

type UserError e = UserTemplate (Const e)

instance Semigroup e => Semigroup (UserError e) where
   x <> y = hzip (<>) x y

您可以更轻松地编写较小的验证器 - 这样每个验证器都不需要知道整个错误结构 - 使用镜头。

Answer 2

此答案试图遵守特定于字段的错误应存储在适当的插槽中的要求。我不会解决一般错误＆＃34;因为它们更容易实现，而且这个答案非常复杂。

我们将使用常规记录，而不是使用多态记录，并使用generics-sop库进行扩充。此库允许您定义和使用记录的通用表示，其中每个记录字段都包装在某个类型构造函数中。通用表示基本上是n-ary products parameterized by a type-level list of field types。请注意，这些字段没有名称;如果我们想直接操纵n-ary产品，我们需要在位置上工作。

import Data.Bifunctor (bimap)
import qualified GHC.Generics as GHC
import Generics.SOP
import Control.Applicative.Lift (Errors,runErrors,failure)

data User = User { name :: Name, age :: Age, email :: Email } deriving (Show,GHC.Generic)

instance Generic User -- this generic is from generics-sop

字段验证类型，取决于Errors中的transformers。请注意，它还会收到整个记录r：

newtype Validator r a = 
    Validator { runValidator :: r -> a -> Errors [FieldError] a }

Usher包装一个函数，将FieldError s注入N-ary错误记录的正确插槽中：

newtype Usher res xs a = Usher { getUsher :: res -> NP (K res) xs }

ushers会为每个字段返回一个带有适当Usher个注入器的n-ary产品。注意Monoid约束;如果没有它，我们就无法在其他领域注入空值。

ushers :: forall r xs res. (IsProductType r xs, Monoid res)
       => Proxy r -> NP (Usher res xs) xs
ushers _ =
    let expand (Fn injection) =
            Usher $ \res -> hexpand (K mempty) (unK (injection (K res)))
    in hliftA expand (injections @xs @(K res))

generics-sop提供的另一个辅助函数：

-- combine the individual fields of a list of uniform n-ary-products 
fold_NP :: forall w xs . (Monoid w, SListI xs) => [NP (K w) xs] -> NP (K w) xs
fold_NP = Prelude.foldr (hliftA2 (mapKKK mappend)) (hpure (K mempty))

实际验证功能。请注意，验证器列表是作为n-ary产品提供的（从记录r派生而来）：

validate :: forall r xs . IsProductType r xs
         => NP (Validator r) xs -> r -> Either (NP (K [FieldError]) xs) r
validate validators r =
    let validators' = validators    :: NP (Validator r) xs
        rs = hpure (K r)            :: NP (K r) xs -- a copy of the record in each slot
        np = unZ (unSOP (from r))   :: NP I xs -- generic representation of the record
        validated                   :: NP (Errors [FieldError])   xs
        validated = hliftA3 (\(Validator v) (K rec) (I a) -> v rec a) validators' rs np

        ushers' = ushers (Proxy @r) :: NP (Usher [FieldError] xs) xs -- error injectors
        injected                    :: NP (Errors [NP (K [FieldError]) xs]) xs
        injected = hliftA2 (\(Usher usher) errors ->
                                case runErrors errors of
                                    Right a' -> pure a'
                                    Left es -> failure [usher es])
                           ushers'
                           validated
    in bimap fold_NP (to . SOP . Z) . runErrors . hsequence $ injected

最后，一个例子：

main :: IO ()
main = do
   let valfail msg = Validator (\_ _ -> failure [msg])
       validators = valfail "err1" :* valfail "err2" :* valfail "err3" :* Nil 
   print $ validate validators (User "Foo" 40 "boo@bar")
   -- returns Left (K ["err1"] :* (K ["err2"] :* (K ["err3"] :* Nil)))

是否有必要以递归方式编写Haskell泛型？

2 个答案: