{-|
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 documentation see the (README)[https://gitlab.com/Birkmann/validation-check/-/blob/master/README.md].
-}
{-# LANGUAGE 
 PolyKinds, TypeOperators, LambdaCase, 
 DerivingStrategies, DerivingVia, StandaloneDeriving, GeneralizedNewtypeDeriving, DeriveFunctor, DeriveGeneric
 #-}
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', 
    passOnRight, mapError, generalizeCheck,
    validateBy, validateBy',

    -- *** Constructing checks
    -- $constructingChecks
    --
    checking, checking',
    test,  (?~>),
    test', (?>),  
    test_, (?~>>), 
    test'_,(?>>),
    -- ** Helper for deriving Checkable
    -- $derivHelper
    foldWithCheck, traverseWithCheck, 

    -- * Reexports
    hoist, contramap

) where

import           Data.Kind (Type)
import           GHC.Generics (Generic)

import           Control.Monad.Morph (MFunctor(..))
import           Data.Functor ((<&>))
import           Data.Functor.Contravariant (Contravariant(..), Op(..))
import           Data.Functor.Contravariant.Divisible (Divisible(..), Decidable(..))
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', but it is often more convient 
-- 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) = 
    Unvalidated { 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
Generic)

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





----------------------------------------------------------------------------------
-- = 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
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 prefixed by a `'`.
-- 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


-- | 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@(Unvalidated 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 `Nothing` 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
-- Constructing a check from a predicate. Naming conventions: 
--
-- * Functions that work on trivial contexts are prefixed 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: `?~>`, `?~>>`.

-- | General construction function for checks.
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
$ \(Unvalidated 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
$ \(Unvalidated 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)