module IHP.ValidationSupport.Types where

import IHP.Prelude
import qualified Data.Text as Text
import IHP.ModelSupport (Violation (..))
import Text.Blaze.Html5 (Html)
import qualified Text.Blaze.Html.Renderer.Text as Blaze
import qualified Data.List as List

data ValidatorResult
    = Success
    | Failure !Text
    | FailureHtml !Text
    deriving (ValidatorResult -> ValidatorResult -> Bool
(ValidatorResult -> ValidatorResult -> Bool)
-> (ValidatorResult -> ValidatorResult -> Bool)
-> Eq ValidatorResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidatorResult -> ValidatorResult -> Bool
== :: ValidatorResult -> ValidatorResult -> Bool
$c/= :: ValidatorResult -> ValidatorResult -> Bool
/= :: ValidatorResult -> ValidatorResult -> Bool
Eq, Int -> ValidatorResult -> ShowS
[ValidatorResult] -> ShowS
ValidatorResult -> String
(Int -> ValidatorResult -> ShowS)
-> (ValidatorResult -> String)
-> ([ValidatorResult] -> ShowS)
-> Show ValidatorResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidatorResult -> ShowS
showsPrec :: Int -> ValidatorResult -> ShowS
$cshow :: ValidatorResult -> String
show :: ValidatorResult -> String
$cshowList :: [ValidatorResult] -> ShowS
showList :: [ValidatorResult] -> ShowS
Show)

{-# INLINE isSuccess #-}
isSuccess :: ValidatorResult -> Bool
isSuccess ValidatorResult
Success = Bool
True
isSuccess ValidatorResult
_       = Bool
False

{-# INLINE isFailure #-}
isFailure :: ValidatorResult -> Bool
isFailure Failure {} = Bool
True
isFailure FailureHtml {} = Bool
True
isFailure ValidatorResult
_  = Bool
False

{-# INLINE attachValidatorResult #-}
attachValidatorResult :: (KnownSymbol field, HasField "meta" model MetaBag, SetField "meta" model MetaBag) => Proxy field -> ValidatorResult -> model -> model
attachValidatorResult :: forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag,
 SetField "meta" model MetaBag) =>
Proxy field -> ValidatorResult -> model -> model
attachValidatorResult Proxy field
field ValidatorResult
Success model
record = model
record
attachValidatorResult Proxy field
field (Failure Text
message) model
record = Proxy "meta" -> (MetaBag -> MetaBag) -> model -> model
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value,
 SetField name model value) =>
Proxy name -> (value -> value) -> model -> model
modify Proxy "meta"
#meta MetaBag -> MetaBag
prependAnnotation model
record
    where
        prependAnnotation :: MetaBag -> MetaBag
        prependAnnotation :: MetaBag -> MetaBag
prependAnnotation = Proxy "annotations"
-> ([(Text, Violation)] -> [(Text, Violation)])
-> MetaBag
-> MetaBag
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value,
 SetField name model value) =>
Proxy name -> (value -> value) -> model -> model
modify Proxy "annotations"
#annotations (\[(Text, Violation)]
a -> (Text, Violation)
annotation(Text, Violation) -> [(Text, Violation)] -> [(Text, Violation)]
forall a. a -> [a] -> [a]
:[(Text, Violation)]
a)
        annotation :: (Text, Violation)
annotation = (String -> Text
Text.pack (Proxy field -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy field
field), Text -> Violation
TextViolation Text
message)
attachValidatorResult Proxy field
field (FailureHtml Text
message) model
record = Proxy "meta" -> (MetaBag -> MetaBag) -> model -> model
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value,
 SetField name model value) =>
Proxy name -> (value -> value) -> model -> model
modify Proxy "meta"
#meta MetaBag -> MetaBag
prependAnnotation model
record
    where
        prependAnnotation :: MetaBag -> MetaBag
        prependAnnotation :: MetaBag -> MetaBag
prependAnnotation = Proxy "annotations"
-> ([(Text, Violation)] -> [(Text, Violation)])
-> MetaBag
-> MetaBag
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value,
 SetField name model value) =>
Proxy name -> (value -> value) -> model -> model
modify Proxy "annotations"
#annotations (\[(Text, Violation)]
a -> (Text, Violation)
annotation(Text, Violation) -> [(Text, Violation)] -> [(Text, Violation)]
forall a. a -> [a] -> [a]
:[(Text, Violation)]
a)
        annotation :: (Text, Violation)
annotation = (String -> Text
Text.pack (Proxy field -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy field
field), Text -> Violation
HtmlViolation Text
message)

-- | Adds a plain-text validation error to a record
--
-- __Example:__
--
-- >>> record |> attachFailure #email "should be a valid email"
-- User { .., meta = MetaBag { .., annotations = [ ("email", TextViolation "should be a valid email") ] } }
--
-- You can use this together with 'getValidationFailure'
--
-- > user
-- >     |> attachFailure #email "cannot be empty"
-- >     |> getValidationFailure #email
-- >
-- > --  Returns: Just "cannot be empty"
--
-- If your error message uses HTML code, use 'attachFailureHtml'.
attachFailure :: (KnownSymbol field, HasField "meta" model MetaBag, SetField "meta" model MetaBag) => Proxy field -> Text -> model -> model
attachFailure :: forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag,
 SetField "meta" model MetaBag) =>
Proxy field -> Text -> model -> model
attachFailure Proxy field
field !Text
message = Proxy field -> ValidatorResult -> model -> model
forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag,
 SetField "meta" model MetaBag) =>
Proxy field -> ValidatorResult -> model -> model
attachValidatorResult Proxy field
field (Text -> ValidatorResult
Failure Text
message)
{-# INLINE attachFailure #-}

-- | Adds a validation error to a record. The error message can contain HTML code.
--
-- __Example:__
--
-- >>> record |> attachFailureHtml #email [hsx|should be a valid email. <a href="https://example.com/docs#email">Check out the documentation</a>|]
-- User { .., meta = MetaBag { .., annotations = [ ("email", HtmlViolation "should be a valid email. <a href="https://example.com/docs#email">Check out the documentation</a>") ] } }
--
-- You can use this together with 'getValidationViolation'
--
-- > user
-- >     |> attachFailure #email "cannot be empty"
-- >     |> getValidationViolation #email
-- >
-- > --  Returns: Just (HtmlViolation "should be a valid email. <a href="https://example.com/docs#email">Check out the documentation</a>")
attachFailureHtml :: (KnownSymbol field, HasField "meta" model MetaBag, SetField "meta" model MetaBag) => Proxy field -> Html -> model -> model
attachFailureHtml :: forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag,
 SetField "meta" model MetaBag) =>
Proxy field -> Html -> model -> model
attachFailureHtml Proxy field
field !Html
message = Proxy field -> ValidatorResult -> model -> model
forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag,
 SetField "meta" model MetaBag) =>
Proxy field -> ValidatorResult -> model -> model
attachValidatorResult Proxy field
field (Text -> ValidatorResult
FailureHtml Text
renderedHtml)
    where
        renderedHtml :: Text
renderedHtml = Html
message
                Html -> (Html -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Html -> Text
Blaze.renderHtml
                Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs
{-# INLINE attachFailureHtml #-}

-- | Returns the validation failure for a field or Nothing
--
-- > user
-- >     |> attachFailure #email "cannot be empty"
-- >     |> getValidationFailure #email
-- >
-- > --  Returns: Just "cannot be empty"
--
-- When 'attachFailureHtml' is used, this function will return HTML code:
--
-- > user
-- >     |> attachFailureHtml #url [hsx|Invalid value, check <a href="https://example.com">the documentation</a>|]
-- >     |> getValidationFailure #url
-- >
-- > --  Returns: Just "Invalid value, check <a href="https://example.com">the documentation</a>"
--
--
-- If you need to special-case validation errors with HTML code, use 'getValidationViolation'
getValidationFailure :: (KnownSymbol field, HasField "meta" model MetaBag) => Proxy field -> model -> Maybe Text
getValidationFailure :: forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag) =>
Proxy field -> model -> Maybe Text
getValidationFailure Proxy field
field model
model = (.message) (Violation -> Text) -> Maybe Violation -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy field -> model -> Maybe Violation
forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag) =>
Proxy field -> model -> Maybe Violation
getValidationViolation Proxy field
field model
model
{-# INLINE getValidationFailure #-}

-- | Similar to 'getValidationFailure', but exposes the information whether the error message contains HTML code
--
-- >>> user |> getValidationViolation #email
-- Just (TextViolation "cannot be empty")
--
getValidationViolation :: (KnownSymbol field, HasField "meta" model MetaBag) => Proxy field -> model -> Maybe Violation
getValidationViolation :: forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag) =>
Proxy field -> model -> Maybe Violation
getValidationViolation Proxy field
field model
model =
        Text -> [(Text, Violation)] -> Maybe Violation
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup Text
fieldName model
model.meta.annotations
    where
        fieldName :: Text
fieldName = String -> Text
Text.pack (Proxy field -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy field
field)