Motivation
|
data RawCreatableV f = RawCreatable |
|
{ username :: Validatable f Text (Maybe Username.ValidationErrors) |
|
, emailAddress :: Validatable f Text (First EmailAddress.ValidationError) |
|
, password :: Validatable f Text (Maybe Password.ValidationErrors) |
|
} |
|
deriving stock Generic |
|
|
|
type RawCreatable = RawCreatableV Identity |
|
|
|
deriving stock instance Show RawCreatable |
|
deriving stock instance Eq RawCreatable |
|
deriving anyclass instance FromJSON RawCreatable |
|
deriving anyclass instance ToJSON RawCreatable |
|
|
|
type RawCreatableValidationErrors = RawCreatableV Validate |
|
|
|
deriving stock instance Show RawCreatableValidationErrors |
|
deriving anyclass instance FromJSON RawCreatableValidationErrors |
|
deriving anyclass instance ToJSON RawCreatableValidationErrors |
|
deriving via (GenericSemigroup RawCreatableValidationErrors) instance Semigroup RawCreatableValidationErrors |
|
deriving via (GenericMonoid RawCreatableValidationErrors) instance Monoid RawCreatableValidationErrors |
|
|
|
data ParsedCreatable = ParsedCreatable |
|
{ username :: Username |
|
, emailAddress :: EmailAddress |
|
, password :: Password |
|
} |
|
deriving stock (Generic, Show, Eq) |
|
|
|
parseRawCreatableUser :: RawCreatable |
|
-> Validation |
|
RawCreatableValidationErrors |
|
ParsedCreatable |
|
parseRawCreatableUser RawCreatable {..} = |
|
let |
|
validateUsername = Username.mk username |> first \e -> |
|
mempty { username = Just e } :: RawCreatableValidationErrors |
|
validateEmailAddress = EmailAddress.mk emailAddress |> maybeToSuccess |
|
(mempty { emailAddress = coerce $ Just EmailAddress.IsInvalid } :: RawCreatableValidationErrors |
|
) |
|
validatePassword = Password.mk password |> first \e -> |
|
mempty { password = Just e } :: RawCreatableValidationErrors |
|
in |
|
ParsedCreatable |
|
<$> validateUsername |
|
<*> validateEmailAddress |
|
<*> validatePassword |
As it's obvious, making validation functions for product types with record syntax is harsh and verbose but it shouldn't be. We can use the Generic machinery of GHC to make it comfortable.
Summary
To be able to make a type-level mechanism for making validation function for product types we'll need some type information of the product type like the field name and the value type of the field. The best way to have such information at the type level is row types. Unfortunately, Haskell doesn't have row types yet. So, Generics to the rescue!
Basic Example
As an example, I'll demonstrate a form that consists of username and future fields.
Validation of username field is totally a simple pure function of type Text -> Validation ValidationErrors Username but for the sake of implementation costs we will represent it as follow:
newtype Username = Username { un :: Text }
data ValidationError = IsShort | IsLong | Invalid deriving stock Generic
type ValidationErrors = NonEmpty ValidationError
instance Validatable Username where
type Raw Username = Text
type Parsed Username = Username
type Errors Username = ValidationErrors
validate :: Text -> Sem '[] (Validation ValidationErrors Username)
validate = undefinedAs mentioned, there is a potential design space with the validate @Username type. As it doesn't need any effects, wrapping the whole validation in Sem looks redundant. It's not optimal but makes type-level computations simpler by now. We can reconsider having a more precise type in the future.
Validation of Future depends on an effect named TimeL:
newtype Future = Future { un :: OffsetDatetime }
data ValidationError = IsPast deriving stock Generic
instance Validatable Future where
type Raw Future = OffsetDatetime
type Parsed Future = Future
type Errors Future = ValidationError
type Effects Future = '[TimeL]
validate :: OffsetDatetime -> Sem '[TimeL] (Validation ValidationError Future)
validate = undefinedAnd finally the Form type:
data Form (v :: Validity) = Form
{ username :: Validate v Username
, future :: Validate v Future
}
deriving stock Generic
deriving Validatable via (Generically (Form v))By deriving Validatable for Form v we'll be able to validate the product type as follow:
x = validate @(Form 'Raw) Form { username = "user_name", future = 13 }Also, the Error type of derived Validtable should have ToJSON and FromJSON instances which render to and un-render from the following JSON structure:
{ "username": [ { "tag": "IsShort", "message": "username is too short" } ]
, "future": [ { "tag": "IsPast", "message": "future is not past!" } ]
}Implementation Details
Please
- Read Generic Validation of Nested Data.
Thank you.
Flags
React
Typescript
Django
Laravel
Facebook
Microsoft
Google
Alibaba
D3
Tencent