{-# LANGUAGE
    MultiParamTypeClasses
  , FlexibleContexts
  , FunctionalDependencies
  , TemplateHaskellQuotes
#-}

module Data.Validation
( -- * Basics

-- $basics


-- ** Proof

-- $proof

  Proof(..)
, fromVCtx
-- ** ValueCtx

-- $valuectx

, ValueCtx(..)
, getValue
, setValue
, withField
, withValue
-- * Validating Primitives

-- $primitives


-- * Validating Complex Types

-- $complex_types

, Validatable(..)
, validate
-- * Dispute and Refute

-- $dispute_vs_refute

, refute
, refuteMany
, refuteWith
, refuteWithProof
, dispute
, disputeMany
, disputeWith
, disputeWithFact
-- * General Validators

, isRequired
, isRequiredWhen
, isRequiredUnless
, isLeft
, isRight
, isNull
, isNotNull
, minLength
, maxLength
, isLength
, isEqual
, isNotEqual
, isLessThan
, isLessThanOrEqual
, isGreaterThan
, isGreaterThanOrEqual
, hasElem
, doesNotHaveElem
, ifAny
, ifAll
, ifEach
, ifEachProven
, isMatch
-- * Validation Helpers

, validateField
, optional
, whenJust
, aggregateFailures
, (<!)
, isValid
, isInvalid
, flattenProofs
-- * Re-exports

, VCtx
, Name
, mkName
, nameBase
) where

------------------------------------------------------------------------------------------------------------------------

import Prelude hiding (foldl)
import Data.Bool
import Data.Either (rights, lefts)
import Data.Foldable (fold)
import Data.Map hiding (null, fold)
import Data.Maybe
import Language.Haskell.TH (Name, mkName, nameBase)
------------------------------------------------------------------------------------------------------------------------

import Data.Validation.Internal
------------------------------------------------------------------------------------------------------------------------


{- $basics
  Validation generally takes the form of @a -> Either f b@ where:

  [@a@]: Some unvalidated type.

  [@b@]: Some validated type.

  [@f@]: Some failure type.

  Consider the following example:

  @
  data MyFailures = EmptyEmailAddress | MalformedEmailAddress
  validateEmailAddress :: String -> Either MyFailures EmailAddress
  @

  In this case:

  * @a@ ~ 'String'
  * @b@ ~ EmailAddress
  * @f@ ~ MyFailures

-}

{- $proof

  The transformation from @a@ to @b@ is important and provides a type safe way to prove that validation was successful.
  However, rather than using the 'Either' type, this library uses the 'Proof' type.
  A 'Proof' represents either a validated type or a collection of failures.
  Notice, we use the term validation /failures/ instead of /errors/
  to differentiate between validation and error handling.
  The reason we use the 'Proof' type is because it has a custom 'Control.Applicative.Applicative' instance
  that will be helpful later.

  The 'Invalid' constructor takes a list of global failures and a map of field failures.
  Field failures are useful for identifying a specific field in a record that is invalid.
  Fields are identified using a list of 'Language.Haskell.TH.Name' types.
  There are two ways to create this type: the @TemplateHaskellQuotes@ extension and the 'Language.Haskell.TH.mkName' function.

  Using the @TemplateHaskellQuotes@ language extension, you can easily create 'Language.Haskell.TH.Name's using a special syntax.
  For a records like:

  > data User = User { emailAddress :: String }

  The name can be retrieved by referencing the name with a single quote in front:

  > let name = 'emailAddress

  This allows for the consistant and type safe generation of names.
  This method does generate a fully qualified name that includes the module name.
  The base name can be accessed using the 'Language.Haskell.TH.nameBase' function.
  This extension is considered safe Haskell while the @TemplateHaskell@ extension is not.
  See <https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/template_haskell.html#syntax> for details.

  Another approach is to use the 'Language.Haskell.TH.mkName' function.
  This allows field names to be generated for non-record types.
  However, it does require managing magic strings.

  To finish our discussion on the 'Proof' type, the reason the key is a list of names is because of subfields.
  Consider a record like this:

  @
  data Contact = Contact { phoneNumber :: String }

  data User
    = User
    { username :: String
    , contact :: Contact
    }
  @

  In this case, validating the `User` type requires validating the `contact` field which is a `Contact`.
  In that case, the key would need to identify that the `phoneNumber` field is a subfield of `contact`.
  The key would look like this:

  > ['contact, 'phoneNumber]
-}

-- | A type that holds either validation failures or a validated value.

data Proof f a
  = Valid a -- ^ A validated value.

  | Invalid [f] (Map [Name] [f]) -- ^ Global and field validation failures.

  deriving (Int -> Proof f a -> ShowS
[Proof f a] -> ShowS
Proof f a -> String
(Int -> Proof f a -> ShowS)
-> (Proof f a -> String)
-> ([Proof f a] -> ShowS)
-> Show (Proof f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall f a. (Show a, Show f) => Int -> Proof f a -> ShowS
forall f a. (Show a, Show f) => [Proof f a] -> ShowS
forall f a. (Show a, Show f) => Proof f a -> String
showList :: [Proof f a] -> ShowS
$cshowList :: forall f a. (Show a, Show f) => [Proof f a] -> ShowS
show :: Proof f a -> String
$cshow :: forall f a. (Show a, Show f) => Proof f a -> String
showsPrec :: Int -> Proof f a -> ShowS
$cshowsPrec :: forall f a. (Show a, Show f) => Int -> Proof f a -> ShowS
Show, Proof f a -> Proof f a -> Bool
(Proof f a -> Proof f a -> Bool)
-> (Proof f a -> Proof f a -> Bool) -> Eq (Proof f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall f a. (Eq a, Eq f) => Proof f a -> Proof f a -> Bool
/= :: Proof f a -> Proof f a -> Bool
$c/= :: forall f a. (Eq a, Eq f) => Proof f a -> Proof f a -> Bool
== :: Proof f a -> Proof f a -> Bool
$c== :: forall f a. (Eq a, Eq f) => Proof f a -> Proof f a -> Bool
Eq)

instance Semigroup a => Semigroup (Proof f a) where
  (Valid a1 :: a
a1)          <> :: Proof f a -> Proof f a -> Proof f a
<> (Valid a2 :: a
a2)           = a -> Proof f a
forall f a. a -> Proof f a
Valid (a
a1 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a2)
  (Invalid gfs1 :: [f]
gfs1 lfs1 :: Map [Name] [f]
lfs1) <> (Invalid gfs2 :: [f]
gfs2 lfs2 :: Map [Name] [f]
lfs2)  = [f] -> Map [Name] [f] -> Proof f a
forall f a. [f] -> Map [Name] [f] -> Proof f a
Invalid ([f]
gfs1 [f] -> [f] -> [f]
forall a. Semigroup a => a -> a -> a
<> [f]
gfs2) (([f] -> [f] -> [f])
-> Map [Name] [f] -> Map [Name] [f] -> Map [Name] [f]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith [f] -> [f] -> [f]
forall a. Semigroup a => a -> a -> a
(<>) Map [Name] [f]
lfs1 Map [Name] [f]
lfs2)
  (Valid _)           <> (Invalid gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs)    = [f] -> Map [Name] [f] -> Proof f a
forall f a. [f] -> Map [Name] [f] -> Proof f a
Invalid [f]
gfs Map [Name] [f]
lfs
  (Invalid gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs)   <> (Valid _)            = [f] -> Map [Name] [f] -> Proof f a
forall f a. [f] -> Map [Name] [f] -> Proof f a
Invalid [f]
gfs Map [Name] [f]
lfs

instance Monoid a => Monoid (Proof f a) where
  mempty :: Proof f a
mempty = a -> Proof f a
forall f a. a -> Proof f a
Valid a
forall a. Monoid a => a
mempty

instance Functor (Proof f) where
  fmap :: (a -> b) -> Proof f a -> Proof f b
fmap fn :: a -> b
fn (Valid a :: a
a)        = b -> Proof f b
forall f a. a -> Proof f a
Valid (a -> b
fn a
a)
  fmap _ (Invalid gps :: [f]
gps lps :: Map [Name] [f]
lps) = [f] -> Map [Name] [f] -> Proof f b
forall f a. [f] -> Map [Name] [f] -> Proof f a
Invalid [f]
gps Map [Name] [f]
lps

instance Applicative (Proof f) where
  pure :: a -> Proof f a
pure = a -> Proof f a
forall f a. a -> Proof f a
Valid
  (Invalid gfs1 :: [f]
gfs1 lfs1 :: Map [Name] [f]
lfs1) <*> :: Proof f (a -> b) -> Proof f a -> Proof f b
<*> (Invalid gfs2 :: [f]
gfs2 lfs2 :: Map [Name] [f]
lfs2) = [f] -> Map [Name] [f] -> Proof f b
forall f a. [f] -> Map [Name] [f] -> Proof f a
Invalid ([f]
gfs1 [f] -> [f] -> [f]
forall a. Semigroup a => a -> a -> a
<> [f]
gfs2) (([f] -> [f] -> [f])
-> Map [Name] [f] -> Map [Name] [f] -> Map [Name] [f]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith [f] -> [f] -> [f]
forall a. Semigroup a => a -> a -> a
(<>) Map [Name] [f]
lfs1 Map [Name] [f]
lfs2)
  (Invalid gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs)   <*> (Valid _)           = [f] -> Map [Name] [f] -> Proof f b
forall f a. [f] -> Map [Name] [f] -> Proof f a
Invalid [f]
gfs Map [Name] [f]
lfs
  (Valid _)           <*> (Invalid gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs)   = [f] -> Map [Name] [f] -> Proof f b
forall f a. [f] -> Map [Name] [f] -> Proof f a
Invalid [f]
gfs Map [Name] [f]
lfs
  Valid fn :: a -> b
fn            <*> Valid a :: a
a             = b -> Proof f b
forall f a. a -> Proof f a
Valid (b -> Proof f b) -> b -> Proof f b
forall a b. (a -> b) -> a -> b
$ a -> b
fn a
a

instance Monad (Proof f) where
  (Invalid gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs) >>= :: Proof f a -> (a -> Proof f b) -> Proof f b
>>= _  = [f] -> Map [Name] [f] -> Proof f b
forall f a. [f] -> Map [Name] [f] -> Proof f a
Invalid [f]
gfs Map [Name] [f]
lfs
  (Valid a :: a
a)         >>= fn :: a -> Proof f b
fn = a -> Proof f b
fn a
a

{- | Converts a 'Data.Validation.Internal.VCtx' to a 'Proof'.

  Internally, this library uses the 'Data.Validation.Internal.VCtx' type to track validation failures.
  This is because a validation failure can be partial.
  For instance, checking that a password has a special character can happen even if the check for a numeric character
  has already failed.
  This allows validation to discover as many failures as possible.

  However, once validation is complete, the result becomes binary.
  The validation has either succeeded or failed.
  In order to convert from a 'Data.Validation.Internal.VCtx' to a 'Proof', use the 'fromVCtx' function.
-}
fromVCtx :: VCtx f a -> Proof f a
fromVCtx :: VCtx f a -> Proof f a
fromVCtx (ValidCtx a :: a
a)            = a -> Proof f a
forall f a. a -> Proof f a
Valid a
a
fromVCtx (DisputedCtx gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs _) = [f] -> Map [Name] [f] -> Proof f a
forall f a. [f] -> Map [Name] [f] -> Proof f a
Invalid [f]
gfs Map [Name] [f]
lfs
fromVCtx (RefutedCtx gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs)    = [f] -> Map [Name] [f] -> Proof f a
forall f a. [f] -> Map [Name] [f] -> Proof f a
Invalid [f]
gfs Map [Name] [f]
lfs

{- $valuectx
  This library uses composable validations.
  As such, we need a type that carries information about the thing being validated.
  Specifically, we need a type to carry its value and, optionally, its name.

  A value with a name is a field and will be used to create field failures.
  A value without a name will be used to create global failures.
  This is accomplished using the 'ValueCtx' type.

  The 'withField' and 'withValue' functions are used to create these types and perform validation at the same time.
  These functions save the effort of wrapping and unwrapping values with the 'ValueCtx' type.
-}

-- | A type for storing a value to validate and, optionally, its field name.

data ValueCtx a
  = Field Name a -- ^ The 'Field' constructor represents a value that is named.

  | Global a     -- ^ The 'Global' constructor represents a value that is not named.

  deriving (Int -> ValueCtx a -> ShowS
[ValueCtx a] -> ShowS
ValueCtx a -> String
(Int -> ValueCtx a -> ShowS)
-> (ValueCtx a -> String)
-> ([ValueCtx a] -> ShowS)
-> Show (ValueCtx a)
forall a. Show a => Int -> ValueCtx a -> ShowS
forall a. Show a => [ValueCtx a] -> ShowS
forall a. Show a => ValueCtx a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueCtx a] -> ShowS
$cshowList :: forall a. Show a => [ValueCtx a] -> ShowS
show :: ValueCtx a -> String
$cshow :: forall a. Show a => ValueCtx a -> String
showsPrec :: Int -> ValueCtx a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ValueCtx a -> ShowS
Show, ValueCtx a -> ValueCtx a -> Bool
(ValueCtx a -> ValueCtx a -> Bool)
-> (ValueCtx a -> ValueCtx a -> Bool) -> Eq (ValueCtx a)
forall a. Eq a => ValueCtx a -> ValueCtx a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueCtx a -> ValueCtx a -> Bool
$c/= :: forall a. Eq a => ValueCtx a -> ValueCtx a -> Bool
== :: ValueCtx a -> ValueCtx a -> Bool
$c== :: forall a. Eq a => ValueCtx a -> ValueCtx a -> Bool
Eq)

instance Functor ValueCtx where
  fmap :: (a -> b) -> ValueCtx a -> ValueCtx b
fmap fn :: a -> b
fn (Field n :: Name
n a :: a
a) = Name -> b -> ValueCtx b
forall a. Name -> a -> ValueCtx a
Field Name
n (a -> b
fn a
a)
  fmap fn :: a -> b
fn (Global a :: a
a)  = b -> ValueCtx b
forall a. a -> ValueCtx a
Global (a -> b
fn a
a)

-- | Accessor for a 'ValueCtx''s value.

getValue :: ValueCtx a -> a
getValue :: ValueCtx a -> a
getValue (Field _ a :: a
a) = a
a
getValue (Global a :: a
a)  = a
a

-- | Replaces the existing value with a new one without changing the name, if one exists.

setValue :: ValueCtx a -> b -> ValueCtx b
setValue :: ValueCtx a -> b -> ValueCtx b
setValue v :: ValueCtx a
v b :: b
b = b
b b -> ValueCtx a -> ValueCtx b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ValueCtx a
v

-- | Performs some given validation using a 'Field' with a given name and value.

withField :: Name -> a -> (ValueCtx a -> VCtx f (ValueCtx b)) -> VCtx f b
withField :: Name -> a -> (ValueCtx a -> VCtx f (ValueCtx b)) -> VCtx f b
withField n :: Name
n a :: a
a fn :: ValueCtx a -> VCtx f (ValueCtx b)
fn = ValueCtx a -> VCtx f (ValueCtx b)
fn (Name -> a -> ValueCtx a
forall a. Name -> a -> ValueCtx a
Field Name
n a
a) VCtx f (ValueCtx b) -> (ValueCtx b -> VCtx f b) -> VCtx f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> VCtx f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> VCtx f b) -> (ValueCtx b -> b) -> ValueCtx b -> VCtx f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueCtx b -> b
forall a. ValueCtx a -> a
getValue

-- | Performs some given validation using a 'Global' with a given value.

withValue :: a -> (ValueCtx a -> VCtx f (ValueCtx b)) -> VCtx f b
withValue :: a -> (ValueCtx a -> VCtx f (ValueCtx b)) -> VCtx f b
withValue a :: a
a fn :: ValueCtx a -> VCtx f (ValueCtx b)
fn = ValueCtx a -> VCtx f (ValueCtx b)
fn (a -> ValueCtx a
forall a. a -> ValueCtx a
Global a
a) VCtx f (ValueCtx b) -> (ValueCtx b -> VCtx f b) -> VCtx f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> VCtx f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> VCtx f b) -> (ValueCtx b -> b) -> ValueCtx b -> VCtx f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueCtx b -> b
forall a. ValueCtx a -> a
getValue

{- $primitives
  Validating primitives is a special case because the validated type and unvalidated type are often the same.
  An email address is just a specially formatted string, so both the unvalidated email address and the validated one have the same types.
  To get around this, you can wrap a primitive in a `newtype`, hide the constructor, and create a smart constructor that validates the input.
  This allows for a kind of type safety known as `correct by construction`.
  Consider the following example.

  @
  module Primitives
  ( MyFailures
  , EmailAddress -- the constructors are not exported
  , mkEmailAddress
  ) where

  data MyFailures = EmptyEmail |

  mkEmailAddress :: String -> Proof MyFailures EmailAddress
  mkEmailAddress s = fromVCtx $ do              -- (1)
    v \<- withValue s $ \\v -> do                 -- (2)
      isNotNull EmptyEmail v                    -- (3)
      disputeWithFact InvalidEmail (elem '@') v -- (4)
    return $ EmailAddress v                     -- (5)
  @

  Starting with line (2), the 'withValue' function is used to create a 'ValueCtx' using string passed into the function.
  The lambda function that follows takes the 'ValueCtx' and runs it through several validators using `do` syntax.
  This is possible because 'VCtx' has a 'Monad' instance.

  Line (1) transforms the result from a 'VCtx' to a 'Proof' as discussed above.

  Line (3) and (4) demonstrate both a general validator and a custom validator.
  These will be covered in more detail later.

  Line (5) constructs the `EmailAddress` type and returns it.
  If any validation failures occur before this point, an 'Invalid' result is generated instead of the `EmailAddress`.

  It is important to note that no instances should be created for the `EmailAddress` type that allow construction.
  This includes the `FromJSON` type class from the `aeson` library.
-}

{- $complex_types
  In general, validating complex types works the same way as validating primitives.
  It starts with an unvalidated type that is transformed into a validated type.
  These unvalidated types are often called "view models".
  View models should be transformed into models when they are validated.
  So, like primitives, validating complex types should have the form validate :: a -> Proof f b.

  For complex types, this can be accomplished with the 'Validatable f a b' type class.
  This type class takes 3 parameters: the failure type, the view model type, and the final model type.
  It requires the implementation of a single function: 'validation'.
  Then the 'validate' function can be used to perform the actual validation.
  Consider the following example:

  @
  -- unvalidated type
  data UserCreatableVM
    = UserCreatableVM
    { userCreatableVMEmailAddress         :: String
    , userCreatableVMConfirmEmailAddress  :: String
    , userCreatableVMPassword             :: String
    , userCreatableVMConfirmPassword      :: String
    , userCreatableVMName                 :: Maybe String
    }

  -- validated type
  data UserCreatable
    = UserCreatable                                                                                     -- (1)
    { userCreatableEmailAddress :: EmailAddress
    , userCreatablePassword     :: Password
    , userCreatableName         :: Maybe Name
    }

  instance Validatable MyFailureType UserCreatableVM UserCreatable where                                -- (2)
    validation u =
      let ve = withField 'userCreatableVMEmailAddress (userCreatableVMEmailAddress u) $
            refuteWithProof mkEmailAddress                                                              -- (3)
          vce = withField 'userCreatableVMConfirmEmailAddress (userCreatableVMConfirmEmailAddress u) $
            \\ce -> refuteWithProof mkEmailAddress ce
            >>= isMatch MismatchedEmail ve                                                              -- (4)
          vp = withField 'userCreatableVMPassword (userCreatableVMPassword u) $
            refuteWithProof mkPassword
          vcp = withField 'userCreatableVMConfirmPassword (userCreatableVMConfirmPassword u) $
            \\ce -> refuteWithProof mkPassword ce
            >>= isMatch MismatchedPassword vp
          vn = optional (userCreatableVMName u) $ \\n ->
              withField 'userCreatableVMName n $ refuteWithProof mkName
          otherCheck = withValue u nameNotInPassword
      in pure UserCreatable \<*> ve \<*> vp \<*> vn <! vce <! vcp <! otherCheck                            -- (5)
    where nameNotInPassword = ...
  @

  The final model does not have all of the same fields on line (1).
  The confirmation fields were removed because they serve no purpose beyond validation.

  The validation function is implemented much like the smart constructors in the previous section.
  However, it is using the 'withField' function instead of 'withValue'.
  In addition, there is no call to 'fromVCtx' because validation is expected to return a 'VCtx'.
  Another function, 'validate', will use these validations to produce a 'Proof'.

  On line (2), the 'Validatable' instance is declared with an application specific failure type.
  The second and third parameter are the view model and final model types.
  This represents the transformation from the unvalidated type to the validated types.

  On line (3), there is a call to 'refuteWithProof' which validates and constructs a primitive using the smart constructor from the previous example.
  Line (4) uses the 'isMatch' function to prove that the email address and confirm email address fields match.
  The function accepts a 'VCtx' to match against making it very easy to compare validated field.

  Finally, line (5) is a bit interesting.
  It constructs the final type using applicative syntax.
  It uses the applicative instance on 'VCtx' to construct the final type.
  If all of the parameters are valid, the expression returns a valid `UserCreatable`.
  However, if any of the parameters are invalid, the whole expression becomes invalid and contains every failure from every field.
  This creates the aggregated result.

  There is also a call to the '(<!)' function.
  This function is read as 'aggregateFailures'.
  In English, it takes the failures from the second parameter, if any, and adds them to the first.
  This allows the aggregation of failures from fields that are not included in the final type.
-}

-- | A type class that represents a value that can be validated.

--

-- The parameters represent the following:

--

-- * @f@: the type of validation failures.

--

-- * @a@: the unvalidated type or view model.

--

-- * @b@: the validated type.

class Validatable f a b | a -> f b where
  validation :: a -> VCtx f b

-- | Runs the validations for a given value and returns the proof.

validate :: Validatable f a b => a -> Proof f b
validate :: a -> Proof f b
validate = VCtx f b -> Proof f b
forall f a. VCtx f a -> Proof f a
fromVCtx (VCtx f b -> Proof f b) -> (a -> VCtx f b) -> a -> Proof f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> VCtx f b
forall f a b. Validatable f a b => a -> VCtx f b
validation

{- $dispute_vs_refute
  Refuting a value stops all validation efforts on the value.
  This means that any future failures that could have been detected will not.
  Dispute, on the other hand, will allow validation to continue.
  So, why should one be chosen over the other?

  First, we have to look at how validation works.
  Validation transforms values from an unvalidated type to a validated type.
  So, when a value is being passed through a validation chain, it is being transformed.
  If a validation fails, the transform fails too; there is no way around this.
  The new value cannot be retrieved from the validation if it failed.

  Consider a @'Maybe' 'String'@ value that is required and must be at least 3 characters long.
  First, the value would pass through the 'isRequired' validator.
  If the value is a @'Just' a@, validation succeeds and the value a is passed to the next validator which checks its length.
  If the value is a 'Nothing', it is not possible to check its length.
  Therefore, the validation must be refuted.
  A refuted value results in an invalid 'Proof' but stops the execution of any further validation.

  Now, consider an 'Int' value that must be greater than 2 and even.
  First, the value would pass though the 'minValue' validator.
  If the value is greater than 2, validation succeeds and the `isEven` validator is called.
  If the value is 2 or less, the validation fails.
  However, rather than fail completely, the next validator can just use the same value that was passed into the 'minValue' validator.
  In that case, the validator should dispute the value so that the next validator can be run.
  This will still result in an invalid 'Proof' but allows for more failures to be detected.

  In general, if a validator has the form @a -> 'Either' f b@, a failure must be refuted because they transform the value.
  If it has the form @a -> 'Maybe' f@, it should be disputed because it does not transform the value.
-}

-- | Adds a validation failure to the result and ends validation.

refute :: ValueCtx a -> f -> VCtx f b
refute :: ValueCtx a -> f -> VCtx f b
refute (Field n :: Name
n _) f :: f
f = [f] -> Map [Name] [f] -> VCtx f b
forall f a. [f] -> Map [Name] [f] -> VCtx f a
RefutedCtx [] ([Name] -> [f] -> Map [Name] [f]
forall k a. k -> a -> Map k a
singleton [Name
n] [f
f])
refute (Global _) f :: f
f  = [f] -> Map [Name] [f] -> VCtx f b
forall f a. [f] -> Map [Name] [f] -> VCtx f a
RefutedCtx [f
f] Map [Name] [f]
forall k a. Map k a
empty

-- | Adds validation failures to the result and ends validation.

refuteMany :: ValueCtx a -> [f] -> VCtx f b
refuteMany :: ValueCtx a -> [f] -> VCtx f b
refuteMany (Field n :: Name
n _) fs :: [f]
fs = [f] -> Map [Name] [f] -> VCtx f b
forall f a. [f] -> Map [Name] [f] -> VCtx f a
RefutedCtx [] ([Name] -> [f] -> Map [Name] [f]
forall k a. k -> a -> Map k a
singleton [Name
n] [f]
fs)
refuteMany (Global _) fs :: [f]
fs  = [f] -> Map [Name] [f] -> VCtx f b
forall f a. [f] -> Map [Name] [f] -> VCtx f a
RefutedCtx [f]
fs Map [Name] [f]
forall k a. Map k a
empty

-- | Adds a validation failure to the result and continues validation.

dispute :: ValueCtx a -> f -> VCtx f (ValueCtx a)
dispute :: ValueCtx a -> f -> VCtx f (ValueCtx a)
dispute v :: ValueCtx a
v@(Field n :: Name
n _) f :: f
f = [f] -> Map [Name] [f] -> ValueCtx a -> VCtx f (ValueCtx a)
forall f a. [f] -> Map [Name] [f] -> a -> VCtx f a
DisputedCtx [] ([Name] -> [f] -> Map [Name] [f]
forall k a. k -> a -> Map k a
singleton [Name
n] [f
f]) ValueCtx a
v
dispute v :: ValueCtx a
v@(Global _) f :: f
f  = [f] -> Map [Name] [f] -> ValueCtx a -> VCtx f (ValueCtx a)
forall f a. [f] -> Map [Name] [f] -> a -> VCtx f a
DisputedCtx [f
f] Map [Name] [f]
forall k a. Map k a
empty ValueCtx a
v

-- | Adds validation failures to the result and continues validation.

disputeMany :: ValueCtx a -> [f] -> VCtx f (ValueCtx a)
disputeMany :: ValueCtx a -> [f] -> VCtx f (ValueCtx a)
disputeMany v :: ValueCtx a
v@(Field n :: Name
n _) fs :: [f]
fs = [f] -> Map [Name] [f] -> ValueCtx a -> VCtx f (ValueCtx a)
forall f a. [f] -> Map [Name] [f] -> a -> VCtx f a
DisputedCtx [] ([Name] -> [f] -> Map [Name] [f]
forall k a. k -> a -> Map k a
singleton [Name
n] [f]
fs) ValueCtx a
v
disputeMany v :: ValueCtx a
v@(Global _) fs :: [f]
fs  = [f] -> Map [Name] [f] -> ValueCtx a -> VCtx f (ValueCtx a)
forall f a. [f] -> Map [Name] [f] -> a -> VCtx f a
DisputedCtx [f]
fs Map [Name] [f]
forall k a. Map k a
empty ValueCtx a
v

-- | Performs a validation using a given function and handles the result.

-- If the result is `Just f`, a validation failure is added to the result and validation continues.

-- If the result is `Nothing`, validation continues with no failure.

disputeWith :: (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith :: (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith fn :: a -> Maybe f
fn v :: ValueCtx a
v = case a -> Maybe f
fn (ValueCtx a -> a
forall a. ValueCtx a -> a
getValue ValueCtx a
v) of
  Just f :: f
f  -> ValueCtx a -> f -> VCtx f (ValueCtx a)
forall a f. ValueCtx a -> f -> VCtx f (ValueCtx a)
dispute ValueCtx a
v f
f
  Nothing -> ValueCtx a -> VCtx f (ValueCtx a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValueCtx a
v

-- | Similar to 'disputeWith' except that the given failure is added if the given function returns False.

disputeWithFact :: f -> (a -> Bool) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWithFact :: f -> (a -> Bool) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWithFact f :: f
f fn :: a -> Bool
fn = (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith (Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (a -> Bool) -> a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
fn)

-- | Performs a validation using a given function and handles the result.

-- If the result is `Left f`, a validation failure is added to the result and validation ends.

-- If the result is `Right b`, validation continues with the new value.

refuteWith :: (a -> Either f b) -> ValueCtx a -> VCtx f (ValueCtx b)
refuteWith :: (a -> Either f b) -> ValueCtx a -> VCtx f (ValueCtx b)
refuteWith fn :: a -> Either f b
fn v :: ValueCtx a
v = case a -> Either f b
fn (ValueCtx a -> a
forall a. ValueCtx a -> a
getValue ValueCtx a
v) of
  Left f :: f
f  -> ValueCtx a -> f -> VCtx f (ValueCtx b)
forall a f b. ValueCtx a -> f -> VCtx f b
refute ValueCtx a
v f
f
  Right b :: b
b -> ValueCtx b -> VCtx f (ValueCtx b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueCtx b -> VCtx f (ValueCtx b))
-> ValueCtx b -> VCtx f (ValueCtx b)
forall a b. (a -> b) -> a -> b
$ ValueCtx a -> b -> ValueCtx b
forall a b. ValueCtx a -> b -> ValueCtx b
setValue ValueCtx a
v b
b

-- | Performs a validation using a given function and handles the result.

-- If the result is 'Invalid', the validation failures are added to the result and validation ends.

-- If the result is `Valid b`, validation continues with the new value.

refuteWithProof :: (a -> Proof f b) -> ValueCtx a -> VCtx f (ValueCtx b)
refuteWithProof :: (a -> Proof f b) -> ValueCtx a -> VCtx f (ValueCtx b)
refuteWithProof f :: a -> Proof f b
f (Global a :: a
a) = case a -> Proof f b
f a
a of
  Invalid gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs -> [f] -> Map [Name] [f] -> VCtx f (ValueCtx b)
forall f a. [f] -> Map [Name] [f] -> VCtx f a
RefutedCtx [f]
gfs Map [Name] [f]
lfs
  Valid b :: b
b         -> ValueCtx b -> VCtx f (ValueCtx b)
forall f a. a -> VCtx f a
ValidCtx (ValueCtx b -> VCtx f (ValueCtx b))
-> ValueCtx b -> VCtx f (ValueCtx b)
forall a b. (a -> b) -> a -> b
$ b -> ValueCtx b
forall a. a -> ValueCtx a
Global b
b
refuteWithProof f :: a -> Proof f b
f (Field n :: Name
n a :: a
a) = case a -> Proof f b
f a
a of
  Invalid gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs  -> [f] -> Map [Name] [f] -> VCtx f (ValueCtx b)
forall f a. [f] -> Map [Name] [f] -> VCtx f a
RefutedCtx [] (Map [Name] [f] -> VCtx f (ValueCtx b))
-> Map [Name] [f] -> VCtx f (ValueCtx b)
forall a b. (a -> b) -> a -> b
$ [Name] -> [f] -> Map [Name] [f] -> Map [Name] [f]
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert [Name
n] [f]
gfs Map [Name] [f]
lfs
  Valid b :: b
b          -> ValueCtx b -> VCtx f (ValueCtx b)
forall f a. a -> VCtx f a
ValidCtx (ValueCtx b -> VCtx f (ValueCtx b))
-> ValueCtx b -> VCtx f (ValueCtx b)
forall a b. (a -> b) -> a -> b
$ Name -> b -> ValueCtx b
forall a. Name -> a -> ValueCtx a
Field Name
n b
b

-- General Validators


-- | Checks that a 'Data.Maybe.Maybe' value is a 'Data.Maybe.Just'.

-- If not, it adds the given failure to the result and validation end.

isRequired :: f -> ValueCtx (Maybe a) -> VCtx f (ValueCtx a)
isRequired :: f -> ValueCtx (Maybe a) -> VCtx f (ValueCtx a)
isRequired f :: f
f = (Maybe a -> Either f a)
-> ValueCtx (Maybe a) -> VCtx f (ValueCtx a)
forall a f b.
(a -> Either f b) -> ValueCtx a -> VCtx f (ValueCtx b)
refuteWith ((Maybe a -> Either f a)
 -> ValueCtx (Maybe a) -> VCtx f (ValueCtx a))
-> (Maybe a -> Either f a)
-> ValueCtx (Maybe a)
-> VCtx f (ValueCtx a)
forall a b. (a -> b) -> a -> b
$ \ma :: Maybe a
ma -> case Maybe a
ma of
  Nothing -> f -> Either f a
forall a b. a -> Either a b
Left f
f
  Just a :: a
a  -> a -> Either f a
forall a b. b -> Either a b
Right a
a

-- | Checks that a 'Data.Maybe.Maybe' value is a 'Data.Maybe.Just' when some condition is true.

-- If the condition is met and the value is 'Data.Maybe.Just', 

-- it adds the given failure to the result and validation continues.

isRequiredWhen :: f -> Bool -> ValueCtx (Maybe a) -> VCtx f (ValueCtx (Maybe a))
isRequiredWhen :: f -> Bool -> ValueCtx (Maybe a) -> VCtx f (ValueCtx (Maybe a))
isRequiredWhen _ False v :: ValueCtx (Maybe a)
v = ValueCtx (Maybe a) -> VCtx f (ValueCtx (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return ValueCtx (Maybe a)
v
isRequiredWhen f :: f
f True v :: ValueCtx (Maybe a)
v  = ((Maybe a -> Maybe f)
 -> ValueCtx (Maybe a) -> VCtx f (ValueCtx (Maybe a)))
-> ValueCtx (Maybe a)
-> (Maybe a -> Maybe f)
-> VCtx f (ValueCtx (Maybe a))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe a -> Maybe f)
-> ValueCtx (Maybe a) -> VCtx f (ValueCtx (Maybe a))
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ValueCtx (Maybe a)
v ((Maybe a -> Maybe f) -> VCtx f (ValueCtx (Maybe a)))
-> (Maybe a -> Maybe f) -> VCtx f (ValueCtx (Maybe a))
forall a b. (a -> b) -> a -> b
$ \ma :: Maybe a
ma -> case Maybe a
ma of
  Nothing -> f -> Maybe f
forall a. a -> Maybe a
Just f
f
  Just _  -> Maybe f
forall a. Maybe a
Nothing

-- | Checks that a 'Data.Maybe.Maybe' value is a 'Data.Maybe.Just' when some condition is false.

-- If the condition is not met and the value is 'Data.Maybe.Just', 

-- it adds the given failure to the result and validation continues.

isRequiredUnless :: f -> Bool -> ValueCtx (Maybe a) -> VCtx f (ValueCtx (Maybe a))
isRequiredUnless :: f -> Bool -> ValueCtx (Maybe a) -> VCtx f (ValueCtx (Maybe a))
isRequiredUnless f :: f
f b :: Bool
b v :: ValueCtx (Maybe a)
v = f -> Bool -> ValueCtx (Maybe a) -> VCtx f (ValueCtx (Maybe a))
forall f a.
f -> Bool -> ValueCtx (Maybe a) -> VCtx f (ValueCtx (Maybe a))
isRequiredWhen f
f (Bool -> Bool
not Bool
b) ValueCtx (Maybe a)
v

-- | Checks that a 'Data.Either.Either' value is a 'Data.Either.Left'.

-- If not, it adds the given failure to the result and validation end.

isLeft :: f -> ValueCtx (Either a b) -> VCtx f (ValueCtx a)
isLeft :: f -> ValueCtx (Either a b) -> VCtx f (ValueCtx a)
isLeft f :: f
f = (Either a b -> Either f a)
-> ValueCtx (Either a b) -> VCtx f (ValueCtx a)
forall a f b.
(a -> Either f b) -> ValueCtx a -> VCtx f (ValueCtx b)
refuteWith ((Either a b -> Either f a)
 -> ValueCtx (Either a b) -> VCtx f (ValueCtx a))
-> (Either a b -> Either f a)
-> ValueCtx (Either a b)
-> VCtx f (ValueCtx a)
forall a b. (a -> b) -> a -> b
$ \e :: Either a b
e -> case Either a b
e of
  Left a :: a
a  -> a -> Either f a
forall a b. b -> Either a b
Right a
a
  Right _ -> f -> Either f a
forall a b. a -> Either a b
Left f
f

-- | Checks that a 'Data.Either.Either' value is a 'Data.Either.Right'.

-- If not, it adds the given failure to the result and validation end.

isRight :: f -> ValueCtx (Either a b) -> VCtx f (ValueCtx b)
isRight :: f -> ValueCtx (Either a b) -> VCtx f (ValueCtx b)
isRight f :: f
f = (Either a b -> Either f b)
-> ValueCtx (Either a b) -> VCtx f (ValueCtx b)
forall a f b.
(a -> Either f b) -> ValueCtx a -> VCtx f (ValueCtx b)
refuteWith ((Either a b -> Either f b)
 -> ValueCtx (Either a b) -> VCtx f (ValueCtx b))
-> (Either a b -> Either f b)
-> ValueCtx (Either a b)
-> VCtx f (ValueCtx b)
forall a b. (a -> b) -> a -> b
$ \e :: Either a b
e -> case Either a b
e of
  Right b :: b
b -> b -> Either f b
forall a b. b -> Either a b
Right b
b
  Left _  -> f -> Either f b
forall a b. a -> Either a b
Left f
f

-- | Checks that the 'Foldable' is empty.

-- If not, it adds the given failure to the result and validation continues.

isNull :: Foldable t => f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
isNull :: f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
isNull f :: f
f = (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ((t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a)))
-> (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a b. (a -> b) -> a -> b
$ Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (t a -> Bool) -> t a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

-- | Checks that the 'Foldable' is not empty.

-- If empty, it adds the given failure to the result and validation continues.

isNotNull :: Foldable t => f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
isNotNull :: f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
isNotNull f :: f
f = (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ((t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a)))
-> (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a b. (a -> b) -> a -> b
$ Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (t a -> Bool) -> t a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (t a -> Bool) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

-- | Checks that a 'Foldable' has a length equal to or greater than the given value.

-- If not, it adds the given failure to the result and validation continues.

minLength :: Foldable t => Int -> f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
minLength :: Int -> f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
minLength l :: Int
l f :: f
f = (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ((t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a)))
-> (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a b. (a -> b) -> a -> b
$ Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (t a -> Bool) -> t a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=) Int
l (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

-- | Checks that a 'Foldable' has a length equal to or less than the given value.

-- If not, it adds the given failure to the result and validation continues.

maxLength :: Foldable t => Int -> f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
maxLength :: Int -> f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
maxLength l :: Int
l f :: f
f = (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ((t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a)))
-> (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a b. (a -> b) -> a -> b
$ Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (t a -> Bool) -> t a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>=) Int
l (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

-- | Checks that a 'Foldable' has a length equal to the given value.

-- If not, it adds the given failure to the result and validation continues.

isLength :: Foldable t => Int -> f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
isLength :: Int -> f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
isLength l :: Int
l f :: f
f = (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ((t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a)))
-> (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a b. (a -> b) -> a -> b
$ Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (t a -> Bool) -> t a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) Int
l (Int -> Bool) -> (t a -> Int) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

-- | Checks that a value is equal to another.

-- If not, it adds the given failure to the result and validation continues.

isEqual :: Eq a => a -> f -> ValueCtx a -> VCtx f (ValueCtx a)
isEqual :: a -> f -> ValueCtx a -> VCtx f (ValueCtx a)
isEqual a :: a
a f :: f
f = (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ((a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a))
-> (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a b. (a -> b) -> a -> b
$ Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (a -> Bool) -> a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) a
a

-- | Checks that a value is not equal to another.

-- If equal, it adds the given failure to the result and validation continues.

isNotEqual :: Eq a => a -> f -> ValueCtx a -> VCtx f (ValueCtx a)
isNotEqual :: a -> f -> ValueCtx a -> VCtx f (ValueCtx a)
isNotEqual a :: a
a f :: f
f = (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ((a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a))
-> (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a b. (a -> b) -> a -> b
$ Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (a -> Bool) -> a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=) a
a

-- | Checks that a value is less than another.

-- If not, it adds the given failure to the result and validation continues.

isLessThan :: Ord a => a -> f -> ValueCtx a -> VCtx f (ValueCtx a)
isLessThan :: a -> f -> ValueCtx a -> VCtx f (ValueCtx a)
isLessThan a :: a
a f :: f
f = (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ((a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a))
-> (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a b. (a -> b) -> a -> b
$ Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (a -> Bool) -> a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) a
a

-- | Checks that a value is greater than another.

-- If not, it adds the given failure to the result and validation continues.

isGreaterThan :: Ord a => a -> f -> ValueCtx a -> VCtx f (ValueCtx a)
isGreaterThan :: a -> f -> ValueCtx a -> VCtx f (ValueCtx a)
isGreaterThan a :: a
a f :: f
f = (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ((a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a))
-> (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a b. (a -> b) -> a -> b
$ Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (a -> Bool) -> a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) a
a

-- | Checks that a value is less than or equal to another.

-- If not, it adds the given failure to the result and validation continues.

isLessThanOrEqual :: Ord a => a -> f -> ValueCtx a -> VCtx f (ValueCtx a)
isLessThanOrEqual :: a -> f -> ValueCtx a -> VCtx f (ValueCtx a)
isLessThanOrEqual a :: a
a f :: f
f = (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ((a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a))
-> (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a b. (a -> b) -> a -> b
$ Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (a -> Bool) -> a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) a
a

-- | Checks that a value is greater than or equal to another.

-- If not, it adds the given failure to the result and validation continues.

isGreaterThanOrEqual :: Ord a => a -> f -> ValueCtx a -> VCtx f (ValueCtx a)
isGreaterThanOrEqual :: a -> f -> ValueCtx a -> VCtx f (ValueCtx a)
isGreaterThanOrEqual a :: a
a f :: f
f = (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ((a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a))
-> (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a b. (a -> b) -> a -> b
$ Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (a -> Bool) -> a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) a
a

-- | Checks that a 'Foldable' has a given element.

-- If not, it adds the given failure to the result and validation continues.

hasElem :: (Foldable t, Eq a) => a -> f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
hasElem :: a -> f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
hasElem e :: a
e f :: f
f = (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ((t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a)))
-> (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a b. (a -> b) -> a -> b
$ Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (t a -> Bool) -> t a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
e

-- | Checks that a 'Foldable' does not have a given element.

-- If it has element, it adds the given failure to the result and validation continues.

doesNotHaveElem :: (Foldable t, Eq a) => a -> f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
doesNotHaveElem :: a -> f -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
doesNotHaveElem e :: a
e f :: f
f = (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith ((t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a)))
-> (t a -> Maybe f) -> ValueCtx (t a) -> VCtx f (ValueCtx (t a))
forall a b. (a -> b) -> a -> b
$ Maybe f -> Maybe f -> Bool -> Maybe f
forall a. a -> a -> Bool -> a
bool (f -> Maybe f
forall a. a -> Maybe a
Just f
f) Maybe f
forall a. Maybe a
Nothing (Bool -> Maybe f) -> (t a -> Bool) -> t a -> Maybe f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (t a -> Bool) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
e

-- | If any element is valid, the entire value is valid.

ifAny :: (a -> Maybe f) -> ValueCtx [a] -> VCtx f (ValueCtx [a])
ifAny :: (a -> Maybe f) -> ValueCtx [a] -> VCtx f (ValueCtx [a])
ifAny fn :: a -> Maybe f
fn v :: ValueCtx [a]
v =
  let
    xs :: [a]
xs = ValueCtx [a] -> [a]
forall a. ValueCtx a -> a
getValue ValueCtx [a]
v
    fs :: [f]
fs = [Maybe f] -> [f]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe f] -> [f]) -> [Maybe f] -> [f]
forall a b. (a -> b) -> a -> b
$ (a -> Maybe f) -> [a] -> [Maybe f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe f
fn [a]
xs
  in if [f] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [f]
fs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
    then ValueCtx [a] -> [f] -> VCtx f (ValueCtx [a])
forall a f. ValueCtx a -> [f] -> VCtx f (ValueCtx a)
disputeMany ValueCtx [a]
v [f]
fs
    else ValueCtx [a] -> VCtx f (ValueCtx [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValueCtx [a]
v

-- | Every element must be valid.

ifAll :: (a -> Maybe f) -> ValueCtx [a] -> VCtx f (ValueCtx [a])
ifAll :: (a -> Maybe f) -> ValueCtx [a] -> VCtx f (ValueCtx [a])
ifAll fn :: a -> Maybe f
fn v :: ValueCtx [a]
v = case [Maybe f] -> [f]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe f] -> [f]) -> ([a] -> [Maybe f]) -> [a] -> [f]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe f) -> [a] -> [Maybe f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe f
fn ([a] -> [f]) -> [a] -> [f]
forall a b. (a -> b) -> a -> b
$ ValueCtx [a] -> [a]
forall a. ValueCtx a -> a
getValue ValueCtx [a]
v of
  [] -> ValueCtx [a] -> VCtx f (ValueCtx [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValueCtx [a]
v
  fs :: [f]
fs -> ValueCtx [a] -> [f] -> VCtx f (ValueCtx [a])
forall a f. ValueCtx a -> [f] -> VCtx f (ValueCtx a)
disputeMany ValueCtx [a]
v [f]
fs

-- | Validate each element with a given function.

ifEach :: (a -> Either f b) -> ValueCtx [a] -> VCtx f (ValueCtx [b])
ifEach :: (a -> Either f b) -> ValueCtx [a] -> VCtx f (ValueCtx [b])
ifEach fn :: a -> Either f b
fn v :: ValueCtx [a]
v =
  let es :: [Either f b]
es = (a -> Either f b) -> [a] -> [Either f b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either f b
fn ([a] -> [Either f b]) -> [a] -> [Either f b]
forall a b. (a -> b) -> a -> b
$ ValueCtx [a] -> [a]
forall a. ValueCtx a -> a
getValue ValueCtx [a]
v
  in case [Either f b] -> [f]
forall a b. [Either a b] -> [a]
lefts [Either f b]
es of
    []  -> ValueCtx [b] -> VCtx f (ValueCtx [b])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueCtx [b] -> VCtx f (ValueCtx [b]))
-> ([b] -> ValueCtx [b]) -> [b] -> VCtx f (ValueCtx [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueCtx [a] -> [b] -> ValueCtx [b]
forall a b. ValueCtx a -> b -> ValueCtx b
setValue ValueCtx [a]
v ([b] -> VCtx f (ValueCtx [b])) -> [b] -> VCtx f (ValueCtx [b])
forall a b. (a -> b) -> a -> b
$ [Either f b] -> [b]
forall a b. [Either a b] -> [b]
rights [Either f b]
es
    fs :: [f]
fs -> ValueCtx [a] -> [f] -> VCtx f (ValueCtx [b])
forall a f b. ValueCtx a -> [f] -> VCtx f b
refuteMany ValueCtx [a]
v [f]
fs

-- | Validate each element with a given function.

ifEachProven :: (a -> Proof f b) -> ValueCtx [a] -> VCtx f (ValueCtx [b])
ifEachProven :: (a -> Proof f b) -> ValueCtx [a] -> VCtx f (ValueCtx [b])
ifEachProven fn :: a -> Proof f b
fn v :: ValueCtx [a]
v =
  let p :: Proof f [b]
p = [Proof f [b]] -> Proof f [b]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Proof f [b]] -> Proof f [b]) -> [Proof f [b]] -> Proof f [b]
forall a b. (a -> b) -> a -> b
$ (a -> Proof f [b]) -> [a] -> [Proof f [b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> [b]) -> Proof f b -> Proof f [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b :: b
b -> [b
b]) (Proof f b -> Proof f [b]) -> (a -> Proof f b) -> a -> Proof f [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Proof f b
fn) ([a] -> [Proof f [b]]) -> [a] -> [Proof f [b]]
forall a b. (a -> b) -> a -> b
$ ValueCtx [a] -> [a]
forall a. ValueCtx a -> a
getValue ValueCtx [a]
v
  in case Proof f [b]
p of
    Valid es :: [b]
es -> ValueCtx [b] -> VCtx f (ValueCtx [b])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueCtx [b] -> VCtx f (ValueCtx [b]))
-> ValueCtx [b] -> VCtx f (ValueCtx [b])
forall a b. (a -> b) -> a -> b
$ ValueCtx [a] -> [b] -> ValueCtx [b]
forall a b. ValueCtx a -> b -> ValueCtx b
setValue ValueCtx [a]
v [b]
es
    Invalid gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs -> case ValueCtx [a]
v of
      Global _  -> [f] -> Map [Name] [f] -> VCtx f (ValueCtx [b])
forall f a. [f] -> Map [Name] [f] -> VCtx f a
RefutedCtx [f]
gfs Map [Name] [f]
lfs
      Field n :: Name
n _ -> [f] -> Map [Name] [f] -> VCtx f (ValueCtx [b])
forall f a. [f] -> Map [Name] [f] -> VCtx f a
RefutedCtx [] (Map [Name] [f] -> VCtx f (ValueCtx [b]))
-> Map [Name] [f] -> VCtx f (ValueCtx [b])
forall a b. (a -> b) -> a -> b
$ [Name] -> [f] -> Map [Name] [f] -> Map [Name] [f]
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert [Name
n] [f]
gfs Map [Name] [f]
lfs

-- | Checks that two fields are equal.

-- If not, it adds the given failure to the result and validation continues.

isMatch :: Eq a => f -> VCtx f a -> ValueCtx a -> VCtx f (ValueCtx a)
isMatch :: f -> VCtx f a -> ValueCtx a -> VCtx f (ValueCtx a)
isMatch f :: f
f (ValidCtx a :: a
a)        = (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith (f -> a -> a -> Maybe f
forall a f. Eq a => f -> a -> a -> Maybe f
testMatch f
f a
a)
isMatch f :: f
f (DisputedCtx _ _ a :: a
a) = (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
forall a f. (a -> Maybe f) -> ValueCtx a -> VCtx f (ValueCtx a)
disputeWith (f -> a -> a -> Maybe f
forall a f. Eq a => f -> a -> a -> Maybe f
testMatch f
f a
a)
isMatch _ (RefutedCtx _ _)    = ValueCtx a -> VCtx f (ValueCtx a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

{- | Validates a value that implements 'Validatable' and includes any failures under the parent field.

Consider the following example:

@
  data ContactVM = ContactVM { phoneNumber :: String }
  data Contact = ...
  instance Validatable MyFailureType ContactVM Contact where
    ...

  data UserCreatableVM
    = UserCreatableVM
    { userCreatableVMEmailAddress         :: String
    , userCreatableVMConfirmEmailAddress  :: String
    , userCreatableVMPassword             :: String
    , userCreatableVMConfirmPassword      :: String
    , userCreatableVMContact              :: ContactVM
    }
  data UserCreatable = ...

  instance Validatable MyFailureType UserCreatableVM UserCreatable where
    validation u =
      let vc = withField 'userCreatableVMContact (userCreatableVMContact u) $
            validateField                                                      -- (1)
          ...
      in pure UserCreatable \<*> ve \<*> vp \<*> vc <! vce <! vcp
  @

  In line (1), the 'validateField' function uses the 'Validatable' instance on `ContactVM` to validate the type.
  All field specific validation failures are stored in a map where the key is the name of the field.
  However, in this case, there are the fields in the `ContactVM` and the parent field in `UserCreatableVM`.
  These names need to be combined so that the consumer can see if any errors came from nested fields.
  Using the 'validateField' function, any validation failures found in the `ContactVM` value have field names that include the parent field.
  A `ContactVM` with an invalid phone number might have a result like this: `Invalid [] [(['phoneNumber], [InvalidPhoneNumber])]` where `['phoneNumber]` is the key to the map.
  The 'validationField' merges this with the `UserCreatable` result to create something like this: `Invalid [] [(['contact, 'phoneNumber], [InvalidPhoneNumber])]`.
  This allows the consumer to determine exactly what field caused the failure.
-}
validateField :: Validatable f a b => ValueCtx a -> VCtx f (ValueCtx b)
validateField :: ValueCtx a -> VCtx f (ValueCtx b)
validateField (Global a :: a
a) = case a -> VCtx f b
forall f a b. Validatable f a b => a -> VCtx f b
validation a
a of
  ValidCtx b :: b
b            -> ValueCtx b -> VCtx f (ValueCtx b)
forall f a. a -> VCtx f a
ValidCtx (b -> ValueCtx b
forall a. a -> ValueCtx a
Global b
b)
  DisputedCtx gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs b :: b
b -> [f] -> Map [Name] [f] -> ValueCtx b -> VCtx f (ValueCtx b)
forall f a. [f] -> Map [Name] [f] -> a -> VCtx f a
DisputedCtx [f]
gfs Map [Name] [f]
lfs (b -> ValueCtx b
forall a. a -> ValueCtx a
Global b
b)
  RefutedCtx gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs    -> [f] -> Map [Name] [f] -> VCtx f (ValueCtx b)
forall f a. [f] -> Map [Name] [f] -> VCtx f a
RefutedCtx [f]
gfs Map [Name] [f]
lfs
validateField (Field n :: Name
n a :: a
a) = case a -> VCtx f b
forall f a b. Validatable f a b => a -> VCtx f b
validation a
a of
  ValidCtx b :: b
b            -> ValueCtx b -> VCtx f (ValueCtx b)
forall f a. a -> VCtx f a
ValidCtx (Name -> b -> ValueCtx b
forall a. Name -> a -> ValueCtx a
Field Name
n b
b)
  DisputedCtx [] lfs :: Map [Name] [f]
lfs b :: b
b -> [f] -> Map [Name] [f] -> ValueCtx b -> VCtx f (ValueCtx b)
forall f a. [f] -> Map [Name] [f] -> a -> VCtx f a
DisputedCtx [] (([Name] -> [Name]) -> Map [Name] [f] -> Map [Name] [f]
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeys (\k :: [Name]
k -> [Name
n] [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
k) Map [Name] [f]
lfs) (Name -> b -> ValueCtx b
forall a. Name -> a -> ValueCtx a
Field Name
n b
b)
  DisputedCtx gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs b :: b
b -> [f] -> Map [Name] [f] -> ValueCtx b -> VCtx f (ValueCtx b)
forall f a. [f] -> Map [Name] [f] -> a -> VCtx f a
DisputedCtx [] ([Name] -> [f] -> Map [Name] [f] -> Map [Name] [f]
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert [Name
n] [f]
gfs (Map [Name] [f] -> Map [Name] [f])
-> Map [Name] [f] -> Map [Name] [f]
forall a b. (a -> b) -> a -> b
$ ([Name] -> [Name]) -> Map [Name] [f] -> Map [Name] [f]
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeys (\k :: [Name]
k -> [Name
n] [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
k) Map [Name] [f]
lfs) (Name -> b -> ValueCtx b
forall a. Name -> a -> ValueCtx a
Field Name
n b
b)
  RefutedCtx [] lfs :: Map [Name] [f]
lfs    -> [f] -> Map [Name] [f] -> VCtx f (ValueCtx b)
forall f a. [f] -> Map [Name] [f] -> VCtx f a
RefutedCtx [] (([Name] -> [Name]) -> Map [Name] [f] -> Map [Name] [f]
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeys (\k :: [Name]
k -> [Name
n] [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
k) Map [Name] [f]
lfs)
  RefutedCtx gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs    -> [f] -> Map [Name] [f] -> VCtx f (ValueCtx b)
forall f a. [f] -> Map [Name] [f] -> VCtx f a
RefutedCtx [] ([Name] -> [f] -> Map [Name] [f] -> Map [Name] [f]
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert [Name
n] [f]
gfs (Map [Name] [f] -> Map [Name] [f])
-> Map [Name] [f] -> Map [Name] [f]
forall a b. (a -> b) -> a -> b
$ ([Name] -> [Name]) -> Map [Name] [f] -> Map [Name] [f]
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeys (\k :: [Name]
k -> [Name
n] [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
k) Map [Name] [f]
lfs)

-- | Allows for validation of an optional value.

-- See `Validating Complex Types` for an example.

optional :: Maybe a -> (a -> VCtx f b) -> VCtx f (Maybe b)
optional :: Maybe a -> (a -> VCtx f b) -> VCtx f (Maybe b)
optional Nothing _  = Maybe b -> VCtx f (Maybe b)
forall f a. a -> VCtx f a
ValidCtx Maybe b
forall a. Maybe a
Nothing
optional (Just a :: a
a) f :: a -> VCtx f b
f =
  case a -> VCtx f b
f a
a of
    ValidCtx b :: b
b            -> Maybe b -> VCtx f (Maybe b)
forall f a. a -> VCtx f a
ValidCtx (b -> Maybe b
forall a. a -> Maybe a
Just b
b)
    DisputedCtx gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs b :: b
b -> [f] -> Map [Name] [f] -> Maybe b -> VCtx f (Maybe b)
forall f a. [f] -> Map [Name] [f] -> a -> VCtx f a
DisputedCtx [f]
gfs Map [Name] [f]
lfs (b -> Maybe b
forall a. a -> Maybe a
Just b
b)
    RefutedCtx gfs :: [f]
gfs lfs :: Map [Name] [f]
lfs    -> [f] -> Map [Name] [f] -> VCtx f (Maybe b)
forall f a. [f] -> Map [Name] [f] -> VCtx f a
RefutedCtx [f]
gfs Map [Name] [f]
lfs

-- | Allows for validation of an optional value.

-- See `Validating Complex Types` for an example.

whenJust :: (ValueCtx a -> VCtx f (ValueCtx b)) -> ValueCtx (Maybe a) -> VCtx f (ValueCtx (Maybe b))
whenJust :: (ValueCtx a -> VCtx f (ValueCtx b))
-> ValueCtx (Maybe a) -> VCtx f (ValueCtx (Maybe b))
whenJust fn :: ValueCtx a -> VCtx f (ValueCtx b)
fn v :: ValueCtx (Maybe a)
v = case ValueCtx (Maybe a) -> Maybe a
forall a. ValueCtx a -> a
getValue ValueCtx (Maybe a)
v of
  Nothing -> ValueCtx (Maybe b) -> VCtx f (ValueCtx (Maybe b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueCtx (Maybe b) -> VCtx f (ValueCtx (Maybe b)))
-> ValueCtx (Maybe b) -> VCtx f (ValueCtx (Maybe b))
forall a b. (a -> b) -> a -> b
$ Maybe b
forall a. Maybe a
Nothing Maybe b -> ValueCtx (Maybe a) -> ValueCtx (Maybe b)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ValueCtx (Maybe a)
v
  Just a :: a
a  -> (ValueCtx b -> ValueCtx (Maybe b))
-> VCtx f (ValueCtx b) -> VCtx f (ValueCtx (Maybe b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> Maybe b) -> ValueCtx b -> ValueCtx (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe b
forall a. a -> Maybe a
Just) (VCtx f (ValueCtx b) -> VCtx f (ValueCtx (Maybe b)))
-> VCtx f (ValueCtx b) -> VCtx f (ValueCtx (Maybe b))
forall a b. (a -> b) -> a -> b
$ ValueCtx a -> VCtx f (ValueCtx b)
fn (ValueCtx a -> VCtx f (ValueCtx b))
-> ValueCtx a -> VCtx f (ValueCtx b)
forall a b. (a -> b) -> a -> b
$ a
a a -> ValueCtx (Maybe a) -> ValueCtx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ValueCtx (Maybe a)
v

-- | tests if a 'Proof' is valid.

isValid :: Proof f a -> Bool
isValid :: Proof f a -> Bool
isValid (Valid _)     = Bool
True
isValid (Invalid _ _) = Bool
False

-- | tests if a 'Proof' is invalid.

isInvalid :: Proof f a -> Bool
isInvalid :: Proof f a -> Bool
isInvalid = Bool -> Bool
not (Bool -> Bool) -> (Proof f a -> Bool) -> Proof f a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof f a -> Bool
forall f a. Proof f a -> Bool
isValid

-- | Flatten a list of proofs into a proof of the list

flattenProofs :: [Proof f a] -> Proof f [a]
flattenProofs :: [Proof f a] -> Proof f [a]
flattenProofs al :: [Proof f a]
al = [Proof f [a]] -> Proof f [a]
forall a. Monoid a => [a] -> a
mconcat ([Proof f [a]] -> Proof f [a]) -> [Proof f [a]] -> Proof f [a]
forall a b. (a -> b) -> a -> b
$ (a -> [a]) -> Proof f a -> Proof f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[]) (Proof f a -> Proof f [a]) -> [Proof f a] -> [Proof f [a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Proof f a]
al