{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-|
Module      : Validation
Description : Validation types/typeclass that allow for effectful validation and easy composition.
Copyright   : (c) Fabian Birkmann 2020
License     : GPL-3
Maintainer  : 99fabianb@sis.gl
Stability   : experimental
Portability : POSIX

Types and functions to check properties of your data. To make best use of these functions you should check out "Data.Functor.Contravariant". For an introduction see the [README](https://gitlab.com/Birkmann/validation-check/-/blob/master/README.md).
-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE PolyKinds                  #-}

{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeOperators              #-}
module Control.Validation.Check(
    -- * Unvalidated values
    -- $unvalidated
    --
    Unvalidated(..), unvalidated,

    -- * Types for checks
    --

    -- ** Check results
    -- $checkResults
    --
    CheckResult(..),
    checkResult, failsWith, failsNoMsg,  passed, failed, checkResultToEither,

    -- ** The Check type
    -- $check
    --
    Check(..), Check', pass,
    passOnRight, mapError, generalizeCheck,
    validateBy, validateBy',

    -- *** Constructing checks
        -- $constructingChecks
    checking, checking',
    -- $constructionByPredicate
    test,  (?~>),
    test', (?>),
    test_, (?~>>),
    test'_,(?>>),
    -- ** Lifting Checks
    -- $derivHelper
    foldWithCheck, traverseWithCheck,

    -- ** For ADTs
    -- $adts
    MultiCheck,
    joinMultiCheck, mapErrorsWithInfo, constructorCheck,

    -- * Reexports

    -- ** General
    hoist, contramap,

    -- ** SOP
    NP(..), DatatypeName, ConstructorName, FieldName
)

where

import           Data.Kind                            (Type)
import Control.Validation.Internal.SOP(errMsgPOP)
import           GHC.Generics                          as GHC(Generic)
import Generics.SOP as SOP(POP(..), unPOP, mapIK, hliftA2, unK, hcfoldMap, NP(..), Generic(..), Top, HasDatatypeInfo(..), DatatypeName, ConstructorName, FieldName, NS(..), SListI, hcexpand, hpure)
import Data.Proxy(Proxy(..))
import           Control.Monad.Morph                  (MFunctor (..))
import           Data.Functor                         ((<&>))
import           Data.Functor.Contravariant           (Contravariant (..),
                                                       Op (..))
import           Data.Functor.Contravariant.Divisible (Decidable (..),
                                                       Divisible (..))
import           Data.Functor.Identity                (Identity (..))

import           Data.Foldable                        (fold)
import           Data.Monoid                          (Ap (..))


import           Data.Sequence                        (Seq)
import qualified Data.Sequence                        as Seq (singleton)

----------------------------------------------------------------------------------
-- = 'Unvalidated'
-- $unvalidated
-- A newtype around unvalidated values so one cannot use the value until it is validated.
-- You can create an 'Unvalidated' via 'unvalidated'
--
-- __/WARNING/__ The 'Unvalidated' data construcotr should __/NOT/__ be used in real code and is exported solely to be used in @-XDeriving@-clauses
--
-- , but it is often more convient to write an orphan instance:
-- If for example you have a JSON api and want to validate incoming data, you can
-- write (using @-XStandaloneDeriving, -XDerivingStrategies, -XDerivingVia@):
--
-- > import Data.Aeson(FromJSON)
-- > deriving via (a :: Type) instance (FromJSON a) => FromJSON (Unvalidated a)

newtype Unvalidated (a :: Type) =
    MkUnvalidated { Unvalidated a -> a
unsafeValidate :: a }
    deriving (Unvalidated a -> Unvalidated a -> Bool
(Unvalidated a -> Unvalidated a -> Bool)
-> (Unvalidated a -> Unvalidated a -> Bool) -> Eq (Unvalidated a)
forall a. Eq a => Unvalidated a -> Unvalidated a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unvalidated a -> Unvalidated a -> Bool
$c/= :: forall a. Eq a => Unvalidated a -> Unvalidated a -> Bool
== :: Unvalidated a -> Unvalidated a -> Bool
$c== :: forall a. Eq a => Unvalidated a -> Unvalidated a -> Bool
Eq, Eq (Unvalidated a)
Eq (Unvalidated a) =>
(Unvalidated a -> Unvalidated a -> Ordering)
-> (Unvalidated a -> Unvalidated a -> Bool)
-> (Unvalidated a -> Unvalidated a -> Bool)
-> (Unvalidated a -> Unvalidated a -> Bool)
-> (Unvalidated a -> Unvalidated a -> Bool)
-> (Unvalidated a -> Unvalidated a -> Unvalidated a)
-> (Unvalidated a -> Unvalidated a -> Unvalidated a)
-> Ord (Unvalidated a)
Unvalidated a -> Unvalidated a -> Bool
Unvalidated a -> Unvalidated a -> Ordering
Unvalidated a -> Unvalidated a -> Unvalidated a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Unvalidated a)
forall a. Ord a => Unvalidated a -> Unvalidated a -> Bool
forall a. Ord a => Unvalidated a -> Unvalidated a -> Ordering
forall a. Ord a => Unvalidated a -> Unvalidated a -> Unvalidated a
min :: Unvalidated a -> Unvalidated a -> Unvalidated a
$cmin :: forall a. Ord a => Unvalidated a -> Unvalidated a -> Unvalidated a
max :: Unvalidated a -> Unvalidated a -> Unvalidated a
$cmax :: forall a. Ord a => Unvalidated a -> Unvalidated a -> Unvalidated a
>= :: Unvalidated a -> Unvalidated a -> Bool
$c>= :: forall a. Ord a => Unvalidated a -> Unvalidated a -> Bool
> :: Unvalidated a -> Unvalidated a -> Bool
$c> :: forall a. Ord a => Unvalidated a -> Unvalidated a -> Bool
<= :: Unvalidated a -> Unvalidated a -> Bool
$c<= :: forall a. Ord a => Unvalidated a -> Unvalidated a -> Bool
< :: Unvalidated a -> Unvalidated a -> Bool
$c< :: forall a. Ord a => Unvalidated a -> Unvalidated a -> Bool
compare :: Unvalidated a -> Unvalidated a -> Ordering
$ccompare :: forall a. Ord a => Unvalidated a -> Unvalidated a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Unvalidated a)
Ord, Int -> Unvalidated a -> ShowS
[Unvalidated a] -> ShowS
Unvalidated a -> String
(Int -> Unvalidated a -> ShowS)
-> (Unvalidated a -> String)
-> ([Unvalidated a] -> ShowS)
-> Show (Unvalidated a)
forall a. Show a => Int -> Unvalidated a -> ShowS
forall a. Show a => [Unvalidated a] -> ShowS
forall a. Show a => Unvalidated a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unvalidated a] -> ShowS
$cshowList :: forall a. Show a => [Unvalidated a] -> ShowS
show :: Unvalidated a -> String
$cshow :: forall a. Show a => Unvalidated a -> String
showsPrec :: Int -> Unvalidated a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Unvalidated a -> ShowS
Show, a -> Unvalidated b -> Unvalidated a
(a -> b) -> Unvalidated a -> Unvalidated b
(forall a b. (a -> b) -> Unvalidated a -> Unvalidated b)
-> (forall a b. a -> Unvalidated b -> Unvalidated a)
-> Functor Unvalidated
forall a b. a -> Unvalidated b -> Unvalidated a
forall a b. (a -> b) -> Unvalidated a -> Unvalidated b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Unvalidated b -> Unvalidated a
$c<$ :: forall a b. a -> Unvalidated b -> Unvalidated a
fmap :: (a -> b) -> Unvalidated a -> Unvalidated b
$cfmap :: forall a b. (a -> b) -> Unvalidated a -> Unvalidated b
Functor, (forall x. Unvalidated a -> Rep (Unvalidated a) x)
-> (forall x. Rep (Unvalidated a) x -> Unvalidated a)
-> Generic (Unvalidated a)
forall x. Rep (Unvalidated a) x -> Unvalidated a
forall x. Unvalidated a -> Rep (Unvalidated a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Unvalidated a) x -> Unvalidated a
forall a x. Unvalidated a -> Rep (Unvalidated a) x
$cto :: forall a x. Rep (Unvalidated a) x -> Unvalidated a
$cfrom :: forall a x. Unvalidated a -> Rep (Unvalidated a) x
GHC.Generic)
    deriving (Functor Unvalidated
a -> Unvalidated a
Functor Unvalidated =>
(forall a. a -> Unvalidated a)
-> (forall a b.
    Unvalidated (a -> b) -> Unvalidated a -> Unvalidated b)
-> (forall a b c.
    (a -> b -> c) -> Unvalidated a -> Unvalidated b -> Unvalidated c)
-> (forall a b. Unvalidated a -> Unvalidated b -> Unvalidated b)
-> (forall a b. Unvalidated a -> Unvalidated b -> Unvalidated a)
-> Applicative Unvalidated
Unvalidated a -> Unvalidated b -> Unvalidated b
Unvalidated a -> Unvalidated b -> Unvalidated a
Unvalidated (a -> b) -> Unvalidated a -> Unvalidated b
(a -> b -> c) -> Unvalidated a -> Unvalidated b -> Unvalidated c
forall a. a -> Unvalidated a
forall a b. Unvalidated a -> Unvalidated b -> Unvalidated a
forall a b. Unvalidated a -> Unvalidated b -> Unvalidated b
forall a b. Unvalidated (a -> b) -> Unvalidated a -> Unvalidated b
forall a b c.
(a -> b -> c) -> Unvalidated a -> Unvalidated b -> Unvalidated c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Unvalidated a -> Unvalidated b -> Unvalidated a
$c<* :: forall a b. Unvalidated a -> Unvalidated b -> Unvalidated a
*> :: Unvalidated a -> Unvalidated b -> Unvalidated b
$c*> :: forall a b. Unvalidated a -> Unvalidated b -> Unvalidated b
liftA2 :: (a -> b -> c) -> Unvalidated a -> Unvalidated b -> Unvalidated c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Unvalidated a -> Unvalidated b -> Unvalidated c
<*> :: Unvalidated (a -> b) -> Unvalidated a -> Unvalidated b
$c<*> :: forall a b. Unvalidated (a -> b) -> Unvalidated a -> Unvalidated b
pure :: a -> Unvalidated a
$cpure :: forall a. a -> Unvalidated a
$cp1Applicative :: Functor Unvalidated
Applicative, Applicative Unvalidated
a -> Unvalidated a
Applicative Unvalidated =>
(forall a b.
 Unvalidated a -> (a -> Unvalidated b) -> Unvalidated b)
-> (forall a b. Unvalidated a -> Unvalidated b -> Unvalidated b)
-> (forall a. a -> Unvalidated a)
-> Monad Unvalidated
Unvalidated a -> (a -> Unvalidated b) -> Unvalidated b
Unvalidated a -> Unvalidated b -> Unvalidated b
forall a. a -> Unvalidated a
forall a b. Unvalidated a -> Unvalidated b -> Unvalidated b
forall a b. Unvalidated a -> (a -> Unvalidated b) -> Unvalidated b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Unvalidated a
$creturn :: forall a. a -> Unvalidated a
>> :: Unvalidated a -> Unvalidated b -> Unvalidated b
$c>> :: forall a b. Unvalidated a -> Unvalidated b -> Unvalidated b
>>= :: Unvalidated a -> (a -> Unvalidated b) -> Unvalidated b
$c>>= :: forall a b. Unvalidated a -> (a -> Unvalidated b) -> Unvalidated b
$cp1Monad :: Applicative Unvalidated
Monad) via Identity
{-# WARNING MkUnvalidated "Use 'unvalidated'. The data constructor 'Unvalidated' is not to be used in code and is only exported for use in deriving clauses" #-}

{-# INLINE unvalidated #-}
unvalidated :: a -> Unvalidated a
unvalidated :: a -> Unvalidated a
unvalidated = a -> Unvalidated a
forall a. a -> Unvalidated a
MkUnvalidated





----------------------------------------------------------------------------------
-- = Types for checks

-- == Check results
-- $checkResults
-- The result of (possibly many) checks. It is either valid or a sequence of
-- all the errors that occurred during the check.
-- The semigroup operation is eager to collect all possible erros.

data CheckResult (e :: Type)
    = Passed
    | Failed !(Seq e)
    deriving (Int -> CheckResult e -> ShowS
[CheckResult e] -> ShowS
CheckResult e -> String
(Int -> CheckResult e -> ShowS)
-> (CheckResult e -> String)
-> ([CheckResult e] -> ShowS)
-> Show (CheckResult e)
forall e. Show e => Int -> CheckResult e -> ShowS
forall e. Show e => [CheckResult e] -> ShowS
forall e. Show e => CheckResult e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckResult e] -> ShowS
$cshowList :: forall e. Show e => [CheckResult e] -> ShowS
show :: CheckResult e -> String
$cshow :: forall e. Show e => CheckResult e -> String
showsPrec :: Int -> CheckResult e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> CheckResult e -> ShowS
Show, CheckResult e -> CheckResult e -> Bool
(CheckResult e -> CheckResult e -> Bool)
-> (CheckResult e -> CheckResult e -> Bool) -> Eq (CheckResult e)
forall e. Eq e => CheckResult e -> CheckResult e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckResult e -> CheckResult e -> Bool
$c/= :: forall e. Eq e => CheckResult e -> CheckResult e -> Bool
== :: CheckResult e -> CheckResult e -> Bool
$c== :: forall e. Eq e => CheckResult e -> CheckResult e -> Bool
Eq, (forall x. CheckResult e -> Rep (CheckResult e) x)
-> (forall x. Rep (CheckResult e) x -> CheckResult e)
-> Generic (CheckResult e)
forall x. Rep (CheckResult e) x -> CheckResult e
forall x. CheckResult e -> Rep (CheckResult e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (CheckResult e) x -> CheckResult e
forall e x. CheckResult e -> Rep (CheckResult e) x
$cto :: forall e x. Rep (CheckResult e) x -> CheckResult e
$cfrom :: forall e x. CheckResult e -> Rep (CheckResult e) x
GHC.Generic, a -> CheckResult b -> CheckResult a
(a -> b) -> CheckResult a -> CheckResult b
(forall a b. (a -> b) -> CheckResult a -> CheckResult b)
-> (forall a b. a -> CheckResult b -> CheckResult a)
-> Functor CheckResult
forall a b. a -> CheckResult b -> CheckResult a
forall a b. (a -> b) -> CheckResult a -> CheckResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CheckResult b -> CheckResult a
$c<$ :: forall a b. a -> CheckResult b -> CheckResult a
fmap :: (a -> b) -> CheckResult a -> CheckResult b
$cfmap :: forall a b. (a -> b) -> CheckResult a -> CheckResult b
Functor)

instance Semigroup (CheckResult e) where
    Passed <> :: CheckResult e -> CheckResult e -> CheckResult e
<> x :: CheckResult e
x = CheckResult e
x
    Failed s1 :: Seq e
s1 <> Passed = Seq e -> CheckResult e
forall e. Seq e -> CheckResult e
Failed Seq e
s1
    Failed s1 :: Seq e
s1 <> Failed s2 :: Seq e
s2 = Seq e -> CheckResult e
forall e. Seq e -> CheckResult e
Failed (Seq e
s1 Seq e -> Seq e -> Seq e
forall a. Semigroup a => a -> a -> a
<> Seq e
s2)

instance Monoid (CheckResult e) where
    mempty :: CheckResult e
mempty = CheckResult e
forall e. CheckResult e
Passed



failsWith :: e -> CheckResult e
failsWith :: e -> CheckResult e
failsWith = Seq e -> CheckResult e
forall e. Seq e -> CheckResult e
Failed (Seq e -> CheckResult e) -> (e -> Seq e) -> e -> CheckResult e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Seq e
forall a. a -> Seq a
Seq.singleton

-- | Throwing an error without a message.
failsNoMsg :: CheckResult e
failsNoMsg :: CheckResult e
failsNoMsg = Seq e -> CheckResult e
forall e. Seq e -> CheckResult e
Failed Seq e
forall a. Monoid a => a
mempty

-- | A fold for 'CheckResult'
checkResult :: a -> (Seq e -> a) -> CheckResult e -> a
checkResult :: a -> (Seq e -> a) -> CheckResult e -> a
checkResult x :: a
x _ Passed     = a
x
checkResult _ f :: Seq e -> a
f (Failed e :: Seq e
e) = Seq e -> a
f Seq e
e

passed, failed :: CheckResult e -> Bool
passed :: CheckResult e -> Bool
passed = Bool -> (Seq e -> Bool) -> CheckResult e -> Bool
forall a e. a -> (Seq e -> a) -> CheckResult e -> a
checkResult Bool
True (Bool -> Seq e -> Bool
forall a b. a -> b -> a
const Bool
False)
failed :: CheckResult e -> Bool
failed = Bool -> (Seq e -> Bool) -> CheckResult e -> Bool
forall a e. a -> (Seq e -> a) -> CheckResult e -> a
checkResult Bool
False (Bool -> Seq e -> Bool
forall a b. a -> b -> a
const Bool
True)


checkResultToEither :: a -- ^ default value
                    -> CheckResult e
                    -> Either (Seq e) a
checkResultToEither :: a -> CheckResult e -> Either (Seq e) a
checkResultToEither x :: a
x = Either (Seq e) a
-> (Seq e -> Either (Seq e) a) -> CheckResult e -> Either (Seq e) a
forall a e. a -> (Seq e -> a) -> CheckResult e -> a
checkResult (a -> Either (Seq e) a
forall a b. b -> Either a b
Right a
x) Seq e -> Either (Seq e) a
forall a b. a -> Either a b
Left




----------------------------------------------------------------------------------
-- ** The Check type
-- $check
-- The type of a (lifted) check. A 'Check' takes an unvalidated data and produces
-- a 'CheckResult'. It may need an additional context `m`. If the context is trivial
-- ('m ≡ Identity') helper types/functions are postfixed by an apostrophe `'`.
-- A 'Check' is not a validation function, as it does not produce any values
-- (to validated data using a 'Check' use 'validateBy'). The reason for this is that
-- it gives 'Check' some useful instances, as it now is contravariant in `a`
-- and not invariant in `a` like e.g. `a -> Either b a`
--
-- * Contravariant
--
-- > newtype Even = Even { getEven :: Int }
-- > checkEven :: Check' Text Even
-- > checkEven = (== 0) . (`mod` 2) . getEven ?> mappend "Number is not even: " . show
-- >
-- > newtype Odd = Odd { getOdd :: Int }
-- > checkOdd :: Check' Text Odd
-- > checkOdd = Even . (+1) . getOdd >$< checkEven
--
-- * Semigroup/Monoid: Allows for easy composition of checks
--
-- > newtype EvenAndOdd = EvenAndOdd { getEvenAndOdd :: Int }
-- > checkevenAndOdd :: Check' Text EvenAndOdd
-- > checkEvenAndOdd = contramap (Even . getEvenAndOdd) checkEven
-- >                   <> contramap (Odd . getEvenAndOdd) checkOdd
--
-- * MFunctor: Changing the effect
--
-- > import Data.List(isPrefixOf)
-- > newtype Url = Url { getUrl :: String }
-- >
-- > check404 :: Check () IO Url -- checks if the url returns 404
-- >
-- > checkHttps :: Check' () Identity Url
-- > checkHttps = ("https" `isPrefixOf`) ?>> ()
-- >
-- > checkUrl :: Check () IO Url
-- > checkUrl = check404 <> hoist generalize checkHttps
--
-- For more information see the README.

newtype Check (e :: Type) (m :: Type -> Type) (a :: Type)
    = Check { Check e m a -> Unvalidated a -> m (CheckResult e)
runCheck :: Unvalidated a -> m (CheckResult e) }
        deriving ( Semigroup (Check e m a)
Check e m a
Semigroup (Check e m a) =>
Check e m a
-> (Check e m a -> Check e m a -> Check e m a)
-> ([Check e m a] -> Check e m a)
-> Monoid (Check e m a)
[Check e m a] -> Check e m a
Check e m a -> Check e m a -> Check e m a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall e (m :: * -> *) a. Applicative m => Semigroup (Check e m a)
forall e (m :: * -> *) a. Applicative m => Check e m a
forall e (m :: * -> *) a.
Applicative m =>
[Check e m a] -> Check e m a
forall e (m :: * -> *) a.
Applicative m =>
Check e m a -> Check e m a -> Check e m a
mconcat :: [Check e m a] -> Check e m a
$cmconcat :: forall e (m :: * -> *) a.
Applicative m =>
[Check e m a] -> Check e m a
mappend :: Check e m a -> Check e m a -> Check e m a
$cmappend :: forall e (m :: * -> *) a.
Applicative m =>
Check e m a -> Check e m a -> Check e m a
mempty :: Check e m a
$cmempty :: forall e (m :: * -> *) a. Applicative m => Check e m a
$cp1Monoid :: forall e (m :: * -> *) a. Applicative m => Semigroup (Check e m a)
Monoid, b -> Check e m a -> Check e m a
NonEmpty (Check e m a) -> Check e m a
Check e m a -> Check e m a -> Check e m a
(Check e m a -> Check e m a -> Check e m a)
-> (NonEmpty (Check e m a) -> Check e m a)
-> (forall b. Integral b => b -> Check e m a -> Check e m a)
-> Semigroup (Check e m a)
forall b. Integral b => b -> Check e m a -> Check e m a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall e (m :: * -> *) a.
Applicative m =>
NonEmpty (Check e m a) -> Check e m a
forall e (m :: * -> *) a.
Applicative m =>
Check e m a -> Check e m a -> Check e m a
forall e (m :: * -> *) a b.
(Applicative m, Integral b) =>
b -> Check e m a -> Check e m a
stimes :: b -> Check e m a -> Check e m a
$cstimes :: forall e (m :: * -> *) a b.
(Applicative m, Integral b) =>
b -> Check e m a -> Check e m a
sconcat :: NonEmpty (Check e m a) -> Check e m a
$csconcat :: forall e (m :: * -> *) a.
Applicative m =>
NonEmpty (Check e m a) -> Check e m a
<> :: Check e m a -> Check e m a -> Check e m a
$c<> :: forall e (m :: * -> *) a.
Applicative m =>
Check e m a -> Check e m a -> Check e m a
Semigroup ) via (a -> Ap m (CheckResult e))
        deriving ( b -> Check e m b -> Check e m a
(a -> b) -> Check e m b -> Check e m a
(forall a b. (a -> b) -> Check e m b -> Check e m a)
-> (forall b a. b -> Check e m b -> Check e m a)
-> Contravariant (Check e m)
forall b a. b -> Check e m b -> Check e m a
forall a b. (a -> b) -> Check e m b -> Check e m a
forall e (m :: * -> *) b a. b -> Check e m b -> Check e m a
forall e (m :: * -> *) a b. (a -> b) -> Check e m b -> Check e m a
forall (f :: * -> *).
(forall a b. (a -> b) -> f b -> f a)
-> (forall b a. b -> f b -> f a) -> Contravariant f
>$ :: b -> Check e m b -> Check e m a
$c>$ :: forall e (m :: * -> *) b a. b -> Check e m b -> Check e m a
contramap :: (a -> b) -> Check e m b -> Check e m a
$ccontramap :: forall e (m :: * -> *) a b. (a -> b) -> Check e m b -> Check e m a
Contravariant, Contravariant (Check e m)
Check e m a
Contravariant (Check e m) =>
(forall a b c.
 (a -> (b, c)) -> Check e m b -> Check e m c -> Check e m a)
-> (forall a. Check e m a) -> Divisible (Check e m)
(a -> (b, c)) -> Check e m b -> Check e m c -> Check e m a
forall a. Check e m a
forall a b c.
(a -> (b, c)) -> Check e m b -> Check e m c -> Check e m a
forall e (m :: * -> *). Applicative m => Contravariant (Check e m)
forall e (m :: * -> *) a. Applicative m => Check e m a
forall e (m :: * -> *) a b c.
Applicative m =>
(a -> (b, c)) -> Check e m b -> Check e m c -> Check e m a
forall (f :: * -> *).
Contravariant f =>
(forall a b c. (a -> (b, c)) -> f b -> f c -> f a)
-> (forall a. f a) -> Divisible f
conquer :: Check e m a
$cconquer :: forall e (m :: * -> *) a. Applicative m => Check e m a
divide :: (a -> (b, c)) -> Check e m b -> Check e m c -> Check e m a
$cdivide :: forall e (m :: * -> *) a b c.
Applicative m =>
(a -> (b, c)) -> Check e m b -> Check e m c -> Check e m a
$cp1Divisible :: forall e (m :: * -> *). Applicative m => Contravariant (Check e m)
Divisible, Divisible (Check e m)
Divisible (Check e m) =>
(forall a. (a -> Void) -> Check e m a)
-> (forall a b c.
    (a -> Either b c) -> Check e m b -> Check e m c -> Check e m a)
-> Decidable (Check e m)
(a -> Void) -> Check e m a
(a -> Either b c) -> Check e m b -> Check e m c -> Check e m a
forall a. (a -> Void) -> Check e m a
forall a b c.
(a -> Either b c) -> Check e m b -> Check e m c -> Check e m a
forall e (m :: * -> *). Applicative m => Divisible (Check e m)
forall e (m :: * -> *) a.
Applicative m =>
(a -> Void) -> Check e m a
forall e (m :: * -> *) a b c.
Applicative m =>
(a -> Either b c) -> Check e m b -> Check e m c -> Check e m a
forall (f :: * -> *).
Divisible f =>
(forall a. (a -> Void) -> f a)
-> (forall a b c. (a -> Either b c) -> f b -> f c -> f a)
-> Decidable f
choose :: (a -> Either b c) -> Check e m b -> Check e m c -> Check e m a
$cchoose :: forall e (m :: * -> *) a b c.
Applicative m =>
(a -> Either b c) -> Check e m b -> Check e m c -> Check e m a
lose :: (a -> Void) -> Check e m a
$close :: forall e (m :: * -> *) a.
Applicative m =>
(a -> Void) -> Check e m a
$cp1Decidable :: forall e (m :: * -> *). Applicative m => Divisible (Check e m)
Decidable) via (Op (Ap m (CheckResult e)))

instance MFunctor (Check e) where
    hoist :: (forall a. m a -> n a) -> Check e m b -> Check e n b
hoist f :: forall a. m a -> n a
f = ((Unvalidated b -> m (CheckResult e))
 -> Unvalidated b -> n (CheckResult e))
-> Check e m b -> Check e n b
forall a (m :: * -> *) d b (n :: * -> *) e.
((Unvalidated a -> m (CheckResult d))
 -> Unvalidated b -> n (CheckResult e))
-> Check d m a -> Check e n b
withCheck (m (CheckResult e) -> n (CheckResult e)
forall a. m a -> n a
f (m (CheckResult e) -> n (CheckResult e))
-> (Unvalidated b -> m (CheckResult e))
-> Unvalidated b
-> n (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

withCheck :: ( (Unvalidated a -> m (CheckResult d))
             -> Unvalidated b -> n (CheckResult e))
             -> Check d m a -> Check e n b
withCheck :: ((Unvalidated a -> m (CheckResult d))
 -> Unvalidated b -> n (CheckResult e))
-> Check d m a -> Check e n b
withCheck f :: (Unvalidated a -> m (CheckResult d))
-> Unvalidated b -> n (CheckResult e)
f = (Unvalidated b -> n (CheckResult e)) -> Check e n b
forall e (m :: * -> *) a.
(Unvalidated a -> m (CheckResult e)) -> Check e m a
Check ((Unvalidated b -> n (CheckResult e)) -> Check e n b)
-> (Check d m a -> Unvalidated b -> n (CheckResult e))
-> Check d m a
-> Check e n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unvalidated a -> m (CheckResult d))
-> Unvalidated b -> n (CheckResult e)
f ((Unvalidated a -> m (CheckResult d))
 -> Unvalidated b -> n (CheckResult e))
-> (Check d m a -> Unvalidated a -> m (CheckResult d))
-> Check d m a
-> Unvalidated b
-> n (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Check d m a -> Unvalidated a -> m (CheckResult d)
forall e (m :: * -> *) a.
Check e m a -> Unvalidated a -> m (CheckResult e)
runCheck

-- | The trivial 'Check' that always succeeds.
pass :: Applicative m => Check e m a
pass :: Check e m a
pass = Check e m a
forall a. Monoid a => a
mempty

-- | Validate 'Unvalidated' data using a check.
validateBy :: Functor m => Check e m a -> Unvalidated a -> m (Either (Seq e) a)
validateBy :: Check e m a -> Unvalidated a -> m (Either (Seq e) a)
validateBy c :: Check e m a
c u :: Unvalidated a
u@(MkUnvalidated x :: a
x) = (CheckResult e -> Either (Seq e) a)
-> m (CheckResult e) -> m (Either (Seq e) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> CheckResult e -> Either (Seq e) a
forall a e. a -> CheckResult e -> Either (Seq e) a
checkResultToEither a
x) (m (CheckResult e) -> m (Either (Seq e) a))
-> (Unvalidated a -> m (CheckResult e))
-> Unvalidated a
-> m (Either (Seq e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Check e m a -> Unvalidated a -> m (CheckResult e)
forall e (m :: * -> *) a.
Check e m a -> Unvalidated a -> m (CheckResult e)
runCheck Check e m a
c (Unvalidated a -> m (Either (Seq e) a))
-> Unvalidated a -> m (Either (Seq e) a)
forall a b. (a -> b) -> a -> b
$ Unvalidated a
u

-- | 'validateBy' for trivial context.
validateBy' :: Check' e a -> Unvalidated a -> Either (Seq e) a
validateBy' :: Check' e a -> Unvalidated a -> Either (Seq e) a
validateBy' c :: Check' e a
c = Identity (Either (Seq e) a) -> Either (Seq e) a
forall a. Identity a -> a
runIdentity (Identity (Either (Seq e) a) -> Either (Seq e) a)
-> (Unvalidated a -> Identity (Either (Seq e) a))
-> Unvalidated a
-> Either (Seq e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Check' e a -> Unvalidated a -> Identity (Either (Seq e) a)
forall (m :: * -> *) e a.
Functor m =>
Check e m a -> Unvalidated a -> m (Either (Seq e) a)
validateBy Check' e a
c

-- | A 'Check' with a trivial context
type Check' e = Check e Identity

-- | Generalize a 'Check' without context to any 'Check' with an applicative context
generalizeCheck :: Applicative m => Check' e a -> Check e m a
generalizeCheck :: Check' e a -> Check e m a
generalizeCheck = (forall a. Identity a -> m a) -> Check' e a -> Check e m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> (Identity a -> a) -> Identity a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity)

-- | 'passOnRight `ignoreWhen` `check` lets the argument pass when
-- `ignoreWhen` returns `Right ()` and otherwise checks
-- with `check`. It is a special case of 'choose' from 'Decidable'.
-- It gives an example for how 'Check's expand to other datatypes since they are
-- 'Divisible' and 'Decidable', see generalizing a check to lists:
--
-- > checkList :: Applicative m => Check e m a -> Check e m [a]
-- > checkList c = passOnRight (\case
-- >                             [] -> Right ()
-- >                             x:xs -> Left (x, xs))
-- >                           ( divide id c (checkList c))
passOnRight :: Applicative m => (a -> Either b ()) -> Check e m b -> Check e m a
passOnRight :: (a -> Either b ()) -> Check e m b -> Check e m a
passOnRight f :: a -> Either b ()
f c :: Check e m b
c = (a -> Either b ()) -> Check e m b -> Check e m () -> Check e m a
forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose a -> Either b ()
f Check e m b
c Check e m ()
forall a. Monoid a => a
mempty

-- | Mapping over the error type.
mapError :: Functor m => (e -> e') -> Check e m a -> Check e' m a
mapError :: (e -> e') -> Check e m a -> Check e' m a
mapError f :: e -> e'
f = ((Unvalidated a -> m (CheckResult e))
 -> Unvalidated a -> m (CheckResult e'))
-> Check e m a -> Check e' m a
forall a (m :: * -> *) d b (n :: * -> *) e.
((Unvalidated a -> m (CheckResult d))
 -> Unvalidated b -> n (CheckResult e))
-> Check d m a -> Check e n b
withCheck ((CheckResult e -> CheckResult e')
-> m (CheckResult e) -> m (CheckResult e')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> e') -> CheckResult e -> CheckResult e'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e'
f) (m (CheckResult e) -> m (CheckResult e'))
-> (Unvalidated a -> m (CheckResult e))
-> Unvalidated a
-> m (CheckResult e')
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)




------------------------------------------------------------------------------------------------------
-- === Construction of 'Check's
-- $constructingChecks
-- The general way to construct a 'Check': Take the data to be checked and return a 'CheckResult'.
--
-- ==== Construction by predicates
-- $constructionByPredicate
-- Constructing a check from a predicate (if a prediceate returns 'True', the check passes) and a function constructing the error from the input. Naming conventions:
--
-- * Functions that work on trivial contexts are postfixed by an apostrophe `'`.
-- * Check constructors that discard the argument on error end with `_`.
-- * All infix operators start with `?` and end with `>` (So `?>` is the "normal" version).
-- * Additional >: discards its argument: `?>>`, `?~>>`.
-- * Tilde works with non-trivial contexts: `?~>`, `?~>>`.

checking :: (a -> m (CheckResult e)) -> Check e m a
checking :: (a -> m (CheckResult e)) -> Check e m a
checking = (Unvalidated a -> m (CheckResult e)) -> Check e m a
forall e (m :: * -> *) a.
(Unvalidated a -> m (CheckResult e)) -> Check e m a
Check ((Unvalidated a -> m (CheckResult e)) -> Check e m a)
-> ((a -> m (CheckResult e)) -> Unvalidated a -> m (CheckResult e))
-> (a -> m (CheckResult e))
-> Check e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ((a -> m (CheckResult e))
-> (Unvalidated a -> a) -> Unvalidated a -> m (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unvalidated a -> a
forall a. Unvalidated a -> a
unsafeValidate)

checking' :: (a -> CheckResult e) -> Check' e a
checking' :: (a -> CheckResult e) -> Check' e a
checking' = (a -> Identity (CheckResult e)) -> Check' e a
forall a (m :: * -> *) e. (a -> m (CheckResult e)) -> Check e m a
checking ((a -> Identity (CheckResult e)) -> Check' e a)
-> ((a -> CheckResult e) -> a -> Identity (CheckResult e))
-> (a -> CheckResult e)
-> Check' e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CheckResult e -> Identity (CheckResult e)
forall a. a -> Identity a
Identity (CheckResult e -> Identity (CheckResult e))
-> (a -> CheckResult e) -> a -> Identity (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

test', (?>) :: Applicative m => (a -> Bool) -> (a -> e) -> Check e m a
test' :: (a -> Bool) -> (a -> e) -> Check e m a
test' p :: a -> Bool
p onErr :: a -> e
onErr = (Unvalidated a -> m (CheckResult e)) -> Check e m a
forall e (m :: * -> *) a.
(Unvalidated a -> m (CheckResult e)) -> Check e m a
Check ((Unvalidated a -> m (CheckResult e)) -> Check e m a)
-> (Unvalidated a -> m (CheckResult e)) -> Check e m a
forall a b. (a -> b) -> a -> b
$ \(MkUnvalidated x :: a
x) -> CheckResult e -> m (CheckResult e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CheckResult e -> m (CheckResult e))
-> CheckResult e -> m (CheckResult e)
forall a b. (a -> b) -> a -> b
$ if a -> Bool
p a
x
    then CheckResult e
forall e. CheckResult e
Passed
    else e -> CheckResult e
forall e. e -> CheckResult e
failsWith (a -> e
onErr a
x)
infix 7 `test'`
{-# INLINE (?>) #-}
?> :: (a -> Bool) -> (a -> e) -> Check e m a
(?>) = (a -> Bool) -> (a -> e) -> Check e m a
forall (m :: * -> *) a e.
Applicative m =>
(a -> Bool) -> (a -> e) -> Check e m a
test'
infix 7 ?>


--
-- > test'_ p e = test' p onErr
-- >   where onErr = const e
{-# INLINE test'_ #-}
test'_,(?>>) :: Applicative m => (a -> Bool) -> e -> Check e m a
test'_ :: (a -> Bool) -> e -> Check e m a
test'_ p :: a -> Bool
p = (a -> Bool) -> (a -> e) -> Check e m a
forall (m :: * -> *) a e.
Applicative m =>
(a -> Bool) -> (a -> e) -> Check e m a
test' a -> Bool
p ((a -> e) -> Check e m a) -> (e -> a -> e) -> e -> Check e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> a -> e
forall a b. a -> b -> a
const
infix 7 `test'_`
{-# INLINE (?>>) #-}
?>> :: (a -> Bool) -> e -> Check e m a
(?>>) = (a -> Bool) -> e -> Check e m a
forall (m :: * -> *) a e.
Applicative m =>
(a -> Bool) -> e -> Check e m a
test'_
infix 7 ?>>

test, (?~>) :: Functor m => (a -> m Bool) -> (a -> e) -> Check e m a
test :: (a -> m Bool) -> (a -> e) -> Check e m a
test p :: a -> m Bool
p onErr :: a -> e
onErr = (Unvalidated a -> m (CheckResult e)) -> Check e m a
forall e (m :: * -> *) a.
(Unvalidated a -> m (CheckResult e)) -> Check e m a
Check ((Unvalidated a -> m (CheckResult e)) -> Check e m a)
-> (Unvalidated a -> m (CheckResult e)) -> Check e m a
forall a b. (a -> b) -> a -> b
$ \(MkUnvalidated x :: a
x) -> a -> m Bool
p a
x m Bool -> (Bool -> CheckResult e) -> m (CheckResult e)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    True  -> CheckResult e
forall e. CheckResult e
Passed
    False -> e -> CheckResult e
forall e. e -> CheckResult e
failsWith (e -> CheckResult e) -> (a -> e) -> a -> CheckResult e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> e
onErr (a -> CheckResult e) -> a -> CheckResult e
forall a b. (a -> b) -> a -> b
$ a
x
infix 7 `test`
{-# INLINE (?~>) #-}
?~> :: (a -> m Bool) -> (a -> e) -> Check e m a
(?~>) = (a -> m Bool) -> (a -> e) -> Check e m a
forall (m :: * -> *) a e.
Functor m =>
(a -> m Bool) -> (a -> e) -> Check e m a
test
infix 7 ?~>

-- > test_ p e = test p onErr
-- >   where onErr = const e
{-# INLINE test_ #-}
test_, (?~>>) :: Monad m => (a -> m Bool) -> e -> Check e m a
test_ :: (a -> m Bool) -> e -> Check e m a
test_ p :: a -> m Bool
p = (a -> m Bool) -> (a -> e) -> Check e m a
forall (m :: * -> *) a e.
Functor m =>
(a -> m Bool) -> (a -> e) -> Check e m a
test a -> m Bool
p ((a -> e) -> Check e m a) -> (e -> a -> e) -> e -> Check e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> a -> e
forall a b. a -> b -> a
const
infix 7 `test_`
{-# INLINE (?~>>) #-}
?~>> :: (a -> m Bool) -> e -> Check e m a
(?~>>) = (a -> m Bool) -> e -> Check e m a
forall (m :: * -> *) a e.
Monad m =>
(a -> m Bool) -> e -> Check e m a
test_
infix 7 ?~>>


-- | Lift a check to a foldable
foldWithCheck :: (Foldable f, Applicative m) => Check e m a -> Check e m (f a)
foldWithCheck :: Check e m a -> Check e m (f a)
foldWithCheck c :: Check e m a
c = (f a -> m (CheckResult e)) -> Check e m (f a)
forall a (m :: * -> *) e. (a -> m (CheckResult e)) -> Check e m a
checking ((f a -> m (CheckResult e)) -> Check e m (f a))
-> (f a -> m (CheckResult e)) -> Check e m (f a)
forall a b. (a -> b) -> a -> b
$ Ap m (CheckResult e) -> m (CheckResult e)
forall k (f :: k -> *) (a :: k). Ap f a -> f a
getAp (Ap m (CheckResult e) -> m (CheckResult e))
-> (f a -> Ap m (CheckResult e)) -> f a -> m (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Ap m (CheckResult e)) -> f a -> Ap m (CheckResult e)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (m (CheckResult e) -> Ap m (CheckResult e)
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (m (CheckResult e) -> Ap m (CheckResult e))
-> (a -> m (CheckResult e)) -> a -> Ap m (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Check e m a -> Unvalidated a -> m (CheckResult e)
forall e (m :: * -> *) a.
Check e m a -> Unvalidated a -> m (CheckResult e)
runCheck Check e m a
c (Unvalidated a -> m (CheckResult e))
-> (a -> Unvalidated a) -> a -> m (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Unvalidated a
forall a. a -> Unvalidated a
unvalidated)

-- | Lift a check to a traversable
traverseWithCheck :: (Traversable t, Applicative m) => Check e m a -> Check e m (t a)
traverseWithCheck :: Check e m a -> Check e m (t a)
traverseWithCheck c :: Check e m a
c = (t a -> m (CheckResult e)) -> Check e m (t a)
forall a (m :: * -> *) e. (a -> m (CheckResult e)) -> Check e m a
checking ((t a -> m (CheckResult e)) -> Check e m (t a))
-> (t a -> m (CheckResult e)) -> Check e m (t a)
forall a b. (a -> b) -> a -> b
$ (t (CheckResult e) -> CheckResult e)
-> m (t (CheckResult e)) -> m (CheckResult e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t (CheckResult e) -> CheckResult e
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (m (t (CheckResult e)) -> m (CheckResult e))
-> (t a -> m (t (CheckResult e))) -> t a -> m (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m (CheckResult e)) -> t a -> m (t (CheckResult e))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Check e m a -> Unvalidated a -> m (CheckResult e)
forall e (m :: * -> *) a.
Check e m a -> Unvalidated a -> m (CheckResult e)
runCheck Check e m a
c (Unvalidated a -> m (CheckResult e))
-> (a -> Unvalidated a) -> a -> m (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Unvalidated a
forall a. a -> Unvalidated a
unvalidated)

-- == Lift 'Check's to ADTs
-- $adts
-- A 'MultiCheck' is a list of a list of checks, one for each field of each constructor. Do not be
-- scared by the types but read the section in the [README](https://gitlab.com/Birkmann/validation-check/-/blob/master/README.md)
-- | A "Multi"-'Check' for an ADT, one 'Check e m' for each field of each constructor, organized in Lists (see examples for construction)
type MultiCheck e m a = NP (NP (Check e m)) (Code a)


-- | Combine all 'Check's from a 'MultiCheck' into a single 'Check' for the datatype 'a' (given it has a 'Generic' instance).
joinMultiCheck :: forall a m e. (Applicative m, SOP.Generic a) => MultiCheck e m a -> Check e m a
joinMultiCheck :: MultiCheck e m a -> Check e m a
joinMultiCheck checks :: MultiCheck e m a
checks = (a -> m (CheckResult e)) -> Check e m a
forall a (m :: * -> *) e. (a -> m (CheckResult e)) -> Check e m a
checking ((a -> m (CheckResult e)) -> Check e m a)
-> (a -> m (CheckResult e)) -> Check e m a
forall a b. (a -> b) -> a -> b
$ Ap m (CheckResult e) -> m (CheckResult e)
forall k (f :: k -> *) (a :: k). Ap f a -> f a
getAp
                           (Ap m (CheckResult e) -> m (CheckResult e))
-> (a -> Ap m (CheckResult e)) -> a -> m (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Top
-> (forall a.
    Top a =>
    K (m (CheckResult e)) a -> Ap m (CheckResult e))
-> SOP (K (m (CheckResult e))) (Code a)
-> Ap m (CheckResult e)
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) m (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HTraverse_ h, AllN h c xs, Monoid m) =>
proxy c -> (forall (a :: k). c a => f a -> m) -> h f xs -> m
hcfoldMap (Proxy Top
forall k (t :: k). Proxy t
Proxy @Top) (m (CheckResult e) -> Ap m (CheckResult e)
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (m (CheckResult e) -> Ap m (CheckResult e))
-> (K (m (CheckResult e)) a -> m (CheckResult e))
-> K (m (CheckResult e)) a
-> Ap m (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K (m (CheckResult e)) a -> m (CheckResult e)
forall k a (b :: k). K a b -> a
unK)
                           (SOP (K (m (CheckResult e))) (Code a) -> Ap m (CheckResult e))
-> (a -> SOP (K (m (CheckResult e))) (Code a))
-> a
-> Ap m (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Check e m a -> I a -> K (m (CheckResult e)) a)
-> Prod SOP (Check e m) (Code a)
-> SOP I (Code a)
-> SOP (K (m (CheckResult e))) (Code a)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(SListIN (Prod h) xs, HAp h, HAp (Prod h)) =>
(forall (a :: k). f a -> f' a -> f'' a)
-> Prod h f xs -> h f' xs -> h f'' xs
hliftA2 (\c :: Check e m a
c -> (a -> m (CheckResult e)) -> I a -> K (m (CheckResult e)) a
forall k a b (c :: k). (a -> b) -> I a -> K b c
mapIK ((a -> m (CheckResult e)) -> I a -> K (m (CheckResult e)) a)
-> (a -> m (CheckResult e)) -> I a -> K (m (CheckResult e)) a
forall a b. (a -> b) -> a -> b
$ Check e m a -> Unvalidated a -> m (CheckResult e)
forall e (m :: * -> *) a.
Check e m a -> Unvalidated a -> m (CheckResult e)
runCheck Check e m a
c (Unvalidated a -> m (CheckResult e))
-> (a -> Unvalidated a) -> a -> m (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Unvalidated a
forall a. a -> Unvalidated a
unvalidated)
                                     (MultiCheck e m a -> Prod SOP (Check e m) (Code a)
forall k (f :: k -> *) (xss :: [[k]]). NP (NP f) xss -> POP f xss
POP (MultiCheck e m a -> Prod SOP (Check e m) (Code a))
-> MultiCheck e m a -> Prod SOP (Check e m) (Code a)
forall a b. (a -> b) -> a -> b
$ MultiCheck e m a
checks)
                           (SOP I (Code a) -> SOP (K (m (CheckResult e))) (Code a))
-> (a -> SOP I (Code a))
-> a
-> SOP (K (m (CheckResult e))) (Code a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SOP I (Code a)
forall a. Generic a => a -> Rep a
from

-- | === __Examples__
--
-- > checkNotEmpty = not . null ?>> "No name given"
-- > checkAdult  = (>= 18) ?> printf "%s is too young; must be at least 18 years old" . show
-- >
-- > checkHttps = ("https://" `isPrefixOf`) ?> printf "Website '%s' is not secure: Missing 'https'"
-- >
-- > checkPet :: Check' Err Pet
-- > checkPet = joinMultiCheck
  -- > (  (checkNotEmpty :* mempty :* Nil) -- checks for the fields of the first constructor
  -- > :* (checkNotEmpty :* Nil) -- checks for the fields of the second constructor
  -- > :* Nil ) -- outer list is also terminated by `Nil`
-- >
-- > checkProfile :: Check' Err Profile
-- > checkProfile = joinMultiCheck
  -- > (  checkNotEmpty
  -- > :* checkAdult
  -- > :* checkPet
  -- > :* foldWithCheck checkHttps -- `foldWithCheck` lifts a `Check` to a `Foldable`, in this case a list
  -- > :* Nil ) -- only one constructor, so the outer list is a singleton list
  -- > :* Nil
--


-- | Change the error of a 'MultiCheck' using the information about the datatype.
mapErrorsWithInfo :: forall e e' a m. (Functor m, HasDatatypeInfo a) => Proxy a -> (DatatypeName -> ConstructorName -> FieldName -> e -> e') -> MultiCheck e m  a -> MultiCheck e' m a
mapErrorsWithInfo :: Proxy a
-> (String -> String -> String -> e -> e')
-> MultiCheck e m a
-> MultiCheck e' m a
mapErrorsWithInfo p :: Proxy a
p f :: String -> String -> String -> e -> e'
f = POP (Check e' m) (Code a) -> MultiCheck e' m a
forall k (f :: k -> *) (xss :: [[k]]). POP f xss -> NP (NP f) xss
unPOP (POP (Check e' m) (Code a) -> MultiCheck e' m a)
-> (MultiCheck e m a -> POP (Check e' m) (Code a))
-> MultiCheck e m a
-> MultiCheck e' m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. K (e -> e') a -> Check e m a -> Check e' m a)
-> Prod POP (K (e -> e')) (Code a)
-> POP (Check e m) (Code a)
-> POP (Check e' m) (Code a)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(SListIN (Prod h) xs, HAp h, HAp (Prod h)) =>
(forall (a :: k). f a -> f' a -> f'' a)
-> Prod h f xs -> h f' xs -> h f'' xs
hliftA2 ((e -> e') -> Check e m a -> Check e' m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> Check e m a -> Check e' m a
mapError ((e -> e') -> Check e m a -> Check e' m a)
-> (K (e -> e') a -> e -> e')
-> K (e -> e') a
-> Check e m a
-> Check e' m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K (e -> e') a -> e -> e'
forall k a (b :: k). K a b -> a
unK) (Proxy a
-> (String -> String -> String -> e -> e')
-> POP (K (e -> e')) (Code a)
forall e a e'.
HasDatatypeInfo a =>
Proxy a
-> (String -> String -> String -> e -> e')
-> POP (K (e -> e')) (Code a)
errMsgPOP Proxy a
p String -> String -> String -> e -> e'
f) (POP (Check e m) (Code a) -> POP (Check e' m) (Code a))
-> (MultiCheck e m a -> POP (Check e m) (Code a))
-> MultiCheck e m a
-> POP (Check e' m) (Code a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiCheck e m a -> POP (Check e m) (Code a)
forall k (f :: k -> *) (xss :: [[k]]). NP (NP f) xss -> POP f xss
POP

-- | === __Examples__
--
-- > addInfo :: DatatypeName -> ConstructorName -> FieldName -> (Err -> Err)
-- > -- we are ignoring the constructorname as it is only one constructor anyway
-- > addInfo d _ f err = printf "%s [Field %s]: %s" d f err
-- >
-- > checkProfile :: Check' Err Profile
-- > checkProfile = joinMultiCheck . mapErrorsWithInfo addInfo $
  -- > (  checkNotEmpty
  -- > :* checkAdult
  -- > :* checkPet
  -- > :* foldWithCheck checkHttps
  -- > :* Nil ) -- only one constructor, so the outer list is a singleton list
  -- > :* Nil
--
-- $ validateBy' checkProfile (unvalidated $ Profile "" 23 (Cat "haskell") ["http://badsite.com"])
-- >>> Left (fromList ["Profile: [Field _name]: No name given", "Profile: [Field _websites]: Website ... not secure ..."])


-- | Make a 'Check' for that only checks a single constructor by suppling a list containing a 'Check' for each field
constructorCheck :: forall a m e xs. (Applicative m, SOP.Generic a)
                                              => (NP (Check e m) xs -> NS (NP (Check e m)) (Code a)) -- ^ The function deciding the constructor, 'Z' for the zeroth, 'S . Z' for the first, etc.
                                              -> NP (Check e m) xs -- ^ Product of 'Checkes', one for each constructor
                                              -> Check e m a
constructorCheck :: (NP (Check e m) xs -> NS (NP (Check e m)) (Code a))
-> NP (Check e m) xs -> Check e m a
constructorCheck f :: NP (Check e m) xs -> NS (NP (Check e m)) (Code a)
f ps :: NP (Check e m) xs
ps  = NP (NP (Check e m)) (Code a) -> Check e m a
forall a (m :: * -> *) e.
(Applicative m, Generic a) =>
MultiCheck e m a -> Check e m a
joinMultiCheck (NP (NP (Check e m)) (Code a) -> Check e m a)
-> (NP (Check e m) xs -> NP (NP (Check e m)) (Code a))
-> NP (Check e m) xs
-> Check e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SListI
-> (forall (x :: [*]). SListI x => NP (Check e m) x)
-> NS (NP (Check e m)) (Code a)
-> Prod NS (NP (Check e m)) (Code a)
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HExpand h, AllN (Prod h) c xs) =>
proxy c -> (forall (x :: k). c x => f x) -> h f xs -> Prod h f xs
hcexpand (Proxy SListI
forall k (t :: k). Proxy t
Proxy @SListI) ((forall a. Check e m a) -> NP (Check e m) x
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure  forall a. Check e m a
forall a. Monoid a => a
mempty) (NS (NP (Check e m)) (Code a) -> NP (NP (Check e m)) (Code a))
-> (NP (Check e m) xs -> NS (NP (Check e m)) (Code a))
-> NP (Check e m) xs
-> NP (NP (Check e m)) (Code a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP (Check e m) xs -> NS (NP (Check e m)) (Code a)
f (NP (Check e m) xs -> Check e m a)
-> NP (Check e m) xs -> Check e m a
forall a b. (a -> b) -> a -> b
$ NP (Check e m) xs
ps

-- | === __Examples__
--
-- > data X = A | B | C | D | E | F | Other String
-- > checkOtherField = constructorCheck (S.S.S.S.S.S.Z) (checkNotEmpty :* Nil)
--