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 = undefined
As 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 = undefined
And 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