{- |
  The idea behind Valor is to provide a simple but powerful data validation
  library that is easy to understand quickly.

  It achieves those goals by providing the 'Applicative' and 'Monad' instances
  along with very few, well documented, core combinators. This allows you to
  figure out what's important and to create your own purpose specific
  combinators as you need them, instead of searching through a plethora of
  predefined combinators whose naming scheme might not match your intuition.

  Also, do check the __TUTORIAL__ at the bottom.
-}
module Data.Valor
  ( {- * Core -}
    {- | Core data types used in the validation process. -}

    {- ** Valid -}
    Valid
  , unValid

    {- ** Valor -}
  , Valor

    {- * Make -}
    {- | Utilities for making validators. -}

    {- ** Operations -}
  , con
  , app
  , alt
  , acc

    {- ** Primitives -}
  , pass
  , passIf
  , passIfM
  , fail
  , failIf
  , failIfM

    {- ** Constructors -}
  , test
  , make
  , peek
  , poke

    {- * Modify -}
    {- | Functions used to modify the behavior of validators. -}
  , nerf
  , peer
  , adapt
  , check1
  , checkN

    {- * Validate -}
    {- | Functions used to apply your validators to the data. -}
  , validateP
  , validateM

    {- * Tutorial -}
    -- $tutorial
  )
  where
--
import Prelude hiding ( fail )
--
import Data.Bool ( bool )
import Data.Valor.Internal ( Valid (..) , unValid , Valor (..) , Wrong (..) , altW , accW , valW , wrong , isInert )
import Data.Functor.Identity ( Identity (..) )
--

{- |
  An alias for 'mappend' (<>).
-}
con :: ( Monad m , Semigroup e ) => Valor i m e -> Valor i m e -> Valor i m e
con :: Valor i m e -> Valor i m e -> Valor i m e
con = Valor i m e -> Valor i m e -> Valor i m e
forall a. Semigroup a => a -> a -> a
(<>)

{- |
  An alias for '<*>'.
-}
app :: Monad m => Valor i m (a -> b) -> Valor i m a -> Valor i m b
app :: Valor i m (a -> b) -> Valor i m a -> Valor i m b
app = Valor i m (a -> b) -> Valor i m a -> Valor i m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

{- |
  As an alternative to the 'Alternative' type class and the '<|>' operator 'alt'
  is provided. It will result in an error only if both arguments are
  'Wrong.Wrong', however, only the last error will be returned.
-}
alt :: Monad m => Valor i m e -> Valor i m e -> Valor i m e
alt :: Valor i m e -> Valor i m e -> Valor i m e
alt ( Valor i -> m (Wrong e)
b ) ( Valor i -> m (Wrong e)
d ) = (i -> m (Wrong e)) -> Valor i m e
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong e)) -> Valor i m e)
-> (i -> m (Wrong e)) -> Valor i m e
forall a b. (a -> b) -> a -> b
$ \ i
i -> Wrong e -> Wrong e -> Wrong e
forall e. Wrong e -> Wrong e -> Wrong e
altW (Wrong e -> Wrong e -> Wrong e)
-> m (Wrong e) -> m (Wrong e -> Wrong e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( i -> m (Wrong e)
b i
i ) m (Wrong e -> Wrong e) -> m (Wrong e) -> m (Wrong e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( i -> m (Wrong e)
d i
i )

{- |
  Accumulating version of 'alt' where if both operands are 'Wrong.Wrong' they
  will be 'mappend'ed.
-}
acc :: ( Monad m , Semigroup e ) => Valor i m e -> Valor i m e -> Valor i m e
acc :: Valor i m e -> Valor i m e -> Valor i m e
acc ( Valor i -> m (Wrong e)
b ) ( Valor i -> m (Wrong e)
d ) = (i -> m (Wrong e)) -> Valor i m e
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong e)) -> Valor i m e)
-> (i -> m (Wrong e)) -> Valor i m e
forall a b. (a -> b) -> a -> b
$ \ i
i -> Wrong e -> Wrong e -> Wrong e
forall e. Semigroup e => Wrong e -> Wrong e -> Wrong e
accW (Wrong e -> Wrong e -> Wrong e)
-> m (Wrong e) -> m (Wrong e -> Wrong e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( i -> m (Wrong e)
b i
i ) m (Wrong e -> Wrong e) -> m (Wrong e) -> m (Wrong e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( i -> m (Wrong e)
d i
i )

--

{- |
  A validator that always 'pass'es the test. Essentially just an alias for
  'mempty'. If you want to create a validator that always passes for a type that
  isn't a 'Monoid', then you can use 'pure', however you will have to provide it
  a "dummy" error value that you yourself will manage as "neutral".

  ==== __Example__

  >>> validateP pass 1
  Left (Valid 1)

-}
pass :: ( Monad m , Monoid e ) => Valor i m e
pass :: Valor i m e
pass = Valor i m e
forall a. Monoid a => a
mempty

{- |
  A validator that fails with @e@ if the predicate returns 'False'.

  ==== __Example__

  >>> validateP ( passIf "must be greater than 0" (>0) ) 1
  Left (Valid 1)

  >>> validateP ( passIf "must be greater than 0" (>0) ) 0
  Right "must be greater than 0"
-}
passIf :: ( Monad m , Monoid e ) => e -> ( i -> Bool ) -> Valor i m e
passIf :: e -> (i -> Bool) -> Valor i m e
passIf e
e i -> Bool
p = e -> (i -> m Bool) -> Valor i m e
forall (m :: * -> *) e i.
(Monad m, Monoid e) =>
e -> (i -> m Bool) -> Valor i m e
passIfM e
e ( Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> (i -> Bool) -> i -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Bool
p )

{- |
  A monadic version of 'passIf'.
-}
passIfM :: ( Monad m , Monoid e ) => e -> ( i -> m Bool ) -> Valor i m e
passIfM :: e -> (i -> m Bool) -> Valor i m e
passIfM e
e = Valor i m e -> Valor i m e -> (i -> m Bool) -> Valor i m e
forall (m :: * -> *) i e.
Monad m =>
Valor i m e -> Valor i m e -> (i -> m Bool) -> Valor i m e
test ( e -> Valor i m e
forall (m :: * -> *) e i. Monad m => e -> Valor i m e
fail e
e ) Valor i m e
forall (m :: * -> *) e i. (Monad m, Monoid e) => Valor i m e
pass

{- |
  Constructs a validator that always fails with provided error @e@.

  ==== __Example__

  >>> validateP ( fail "YOU SHALL NOT PASS!!!" ) 1
  Right "YOU SHALL NOT PASS!!!"

-}
fail :: Monad m => e -> Valor i m e
fail :: e -> Valor i m e
fail = (i -> m (Wrong e)) -> Valor i m e
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong e)) -> Valor i m e)
-> (e -> i -> m (Wrong e)) -> e -> Valor i m e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Wrong e) -> i -> m (Wrong e)
forall a b. a -> b -> a
const (m (Wrong e) -> i -> m (Wrong e))
-> (e -> m (Wrong e)) -> e -> i -> m (Wrong e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrong e -> m (Wrong e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Wrong e -> m (Wrong e)) -> (e -> Wrong e) -> e -> m (Wrong e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Wrong e
forall e. e -> Wrong e
Wrong

{- |
  A validator that fails with @e@ if the predicate returns 'True'.

  ==== __Example__

  >>> validateP ( failIf "must be less than or equal to 0" (>0) ) 1
  Right "must be less than or equal to 0"

  >>> validateP ( failIf "must be less than or equal to 0" (>0) ) (-20)
  Left (Valid (-20))
-}
failIf :: ( Monad m , Monoid e ) => e -> ( i -> Bool ) -> Valor i m e
failIf :: e -> (i -> Bool) -> Valor i m e
failIf e
e i -> Bool
p = e -> (i -> m Bool) -> Valor i m e
forall (m :: * -> *) e i.
(Monad m, Monoid e) =>
e -> (i -> m Bool) -> Valor i m e
failIfM e
e ( Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> (i -> Bool) -> i -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Bool
p )

{- |
  A monadic version of 'failIf'.
-}
failIfM :: ( Monad m , Monoid e ) => e -> ( i -> m Bool ) -> Valor i m e
failIfM :: e -> (i -> m Bool) -> Valor i m e
failIfM e
e i -> m Bool
p = Valor i m e -> Valor i m e -> (i -> m Bool) -> Valor i m e
forall (m :: * -> *) i e.
Monad m =>
Valor i m e -> Valor i m e -> (i -> m Bool) -> Valor i m e
test Valor i m e
forall (m :: * -> *) e i. (Monad m, Monoid e) => Valor i m e
pass ( e -> Valor i m e
forall (m :: * -> *) e i. Monad m => e -> Valor i m e
fail e
e ) i -> m Bool
p

--

{- |
  Apply one or the other validator depending on the result of a test.

  ==== __Example__

  >>> let exV = test pass (fail "I'm a failure") (pure . (>3))

  >>> validateP exV 3
  Left (Valid 3)

  >>> validateP exV 4
  Right "I'm a failure"
-}
test
  :: Monad m
  => Valor i m e      -- ^ validator to use on 'False'
  -> Valor i m e      -- ^ validator to use on 'True'
  -> ( i -> m Bool )  -- ^ a predicate
  -> Valor i m e
test :: Valor i m e -> Valor i m e -> (i -> m Bool) -> Valor i m e
test ( Valor i -> m (Wrong e)
f ) ( Valor i -> m (Wrong e)
p ) i -> m Bool
t = (i -> m (Wrong e)) -> Valor i m e
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong e)) -> Valor i m e)
-> (i -> m (Wrong e)) -> Valor i m e
forall a b. (a -> b) -> a -> b
$ \ i
i -> i -> m Bool
t i
i m Bool -> (Bool -> m (Wrong e)) -> m (Wrong e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Wrong e) -> m (Wrong e) -> Bool -> m (Wrong e)
forall a. a -> a -> Bool -> a
bool ( i -> m (Wrong e)
f i
i ) ( i -> m (Wrong e)
p i
i )

{- |
  Construct a validator that checks the input @i@ and 'Maybe' results in an
  error @e@.

  ==== __Example__

  >>> let exV = make $ \ i -> pure $ if i > 3 then Nothing else Just "I'm 3 or less failure"

  >>> validateP exV 3
  Right "I'm 3 or less failure"

  >>> validateP exV 4
  Left (Valid 4)
-}
make :: ( Monad m , Monoid e ) => ( i -> m ( Maybe e ) ) -> Valor i m e
make :: (i -> m (Maybe e)) -> Valor i m e
make i -> m (Maybe e)
ime = (i -> m (Wrong e)) -> Valor i m e
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong e)) -> Valor i m e)
-> (i -> m (Wrong e)) -> Valor i m e
forall a b. (a -> b) -> a -> b
$ \ i
i -> i -> m (Maybe e)
ime i
i m (Maybe e) -> (Maybe e -> m (Wrong e)) -> m (Wrong e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Valor i m e -> i -> m (Wrong e))
-> i -> Valor i m e -> m (Wrong e)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Valor i m e -> i -> m (Wrong e)
forall i (m :: * -> *) e. Valor i m e -> i -> m (Wrong e)
unValor i
i (Valor i m e -> m (Wrong e))
-> (Maybe e -> Valor i m e) -> Maybe e -> m (Wrong e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Valor i m e -> (e -> Valor i m e) -> Maybe e -> Valor i m e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Valor i m e
forall (m :: * -> *) e i. (Monad m, Monoid e) => Valor i m e
pass e -> Valor i m e
forall (m :: * -> *) e i. Monad m => e -> Valor i m e
fail

{- |
  Construct a validator that applies another validator depending on the result
  from a test validator. If both the "test" and the "fail" validator fail, then
  only the error from the "fail" validator is returned.

  ==== __Example__

  >>> let failV = failIf "I'm less than 3" (<3)
  >>> let passV = failIf "I'm greater than 4" (>4)
  >>> let testV = failIf "I'm not divisible by 2" odd
  >>> let exV = peek failV passV testV

  >>> validateP exV 7
  Left (Valid 7)

  >>> validateP exV 6
  Right "I'm greater than 4"

  >>> validateP exV 2
  Left (Valid 2)

  >>> validateP exV 1
  Right "I'm less than 3"
-}
peek :: ( Monad m , Semigroup e ) => Valor i m e -> Valor i m e -> Valor i m e -> Valor i m e
peek :: Valor i m e -> Valor i m e -> Valor i m e -> Valor i m e
peek ( Valor i -> m (Wrong e)
f ) ( Valor i -> m (Wrong e)
p ) ( Valor i -> m (Wrong e)
t ) = (i -> m (Wrong e)) -> Valor i m e
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong e)) -> Valor i m e)
-> (i -> m (Wrong e)) -> Valor i m e
forall a b. (a -> b) -> a -> b
$ \ i
i -> i -> m (Wrong e)
t i
i m (Wrong e) -> (Wrong e -> m (Wrong e)) -> m (Wrong e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> m (Wrong e)) -> (e -> m (Wrong e)) -> Wrong e -> m (Wrong e)
forall e a. (e -> a) -> (e -> a) -> Wrong e -> a
wrong ( m (Wrong e) -> e -> m (Wrong e)
forall a b. a -> b -> a
const (m (Wrong e) -> e -> m (Wrong e))
-> m (Wrong e) -> e -> m (Wrong e)
forall a b. (a -> b) -> a -> b
$ i -> m (Wrong e)
f i
i ) ( m (Wrong e) -> e -> m (Wrong e)
forall a b. a -> b -> a
const (m (Wrong e) -> e -> m (Wrong e))
-> m (Wrong e) -> e -> m (Wrong e)
forall a b. (a -> b) -> a -> b
$ i -> m (Wrong e)
p i
i )

{- |
  Just like 'peek', except if both the "test" and the "fail" validators fail,
  their results are 'mappend'ed ('<>').

  ==== __Example__

  >>> let failV = failIf ["I'm less than 3"] (<3)
  >>> let passV = failIf ["I'm greater than 4"] (>4)
  >>> let testV = failIf ["I'm not divisible by 2"] odd
  >>> let exV = poke failV passV testV

  >>> validateP exV 7
  Left (Valid 7)

  >>> validateP exV 6
  Right ["I'm greater than 4"]

  >>> validateP exV 2
  Left (Valid 2)

  >>> validateP exV 1
  Right ["I'm not divisible by 2","I'm less than 3"]
-}
poke :: ( Monad m , Semigroup e ) => Valor i m e -> Valor i m e -> Valor i m e -> Valor i m e
poke :: Valor i m e -> Valor i m e -> Valor i m e -> Valor i m e
poke ( Valor i -> m (Wrong e)
f ) ( Valor i -> m (Wrong e)
p ) ( Valor i -> m (Wrong e)
t ) = (i -> m (Wrong e)) -> Valor i m e
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong e)) -> Valor i m e)
-> (i -> m (Wrong e)) -> Valor i m e
forall a b. (a -> b) -> a -> b
$ \ i
i -> do
  Wrong e
tr <- i -> m (Wrong e)
t i
i
  case Wrong e
tr of
    Inert e
_ -> i -> m (Wrong e)
p i
i
    Wrong e
b -> do
      Wrong e
tr' <- i -> m (Wrong e)
f i
i
      Wrong e -> m (Wrong e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Wrong e -> m (Wrong e)) -> Wrong e -> m (Wrong e)
forall a b. (a -> b) -> a -> b
$ case Wrong e
tr' of
        Inert e
e -> e -> Wrong e
forall e. e -> Wrong e
Inert e
e
        Wrong e
d -> e -> Wrong e
forall e. e -> Wrong e
Wrong (e -> Wrong e) -> e -> Wrong e
forall a b. (a -> b) -> a -> b
$ e
b e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
d

--

{- |
  If a validator fails with an error 'nerf' will make that error 'Wrong.Inert'
  essentially making it pass.

  Use of this function is discouraged, however it might come in handy in
  combination with 'peer' within the 'Monad'ic context when you want to check
  the result of a validation without failing the whole 'Monad'ic computation.

  Be careful though, @nerf . peer@ is not the same as @peer . nerf@ (which is
  essentially useless and will always result in 'Nothing').

  ==== __Example__

  >>> validateP (nerf $ fail "I'm an error that will never appear") 0
  Left (Valid 0)
-}
nerf :: Monad m => Valor i m e -> Valor i m e
nerf :: Valor i m e -> Valor i m e
nerf ( Valor i -> m (Wrong e)
v ) = (i -> m (Wrong e)) -> Valor i m e
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong e)) -> Valor i m e)
-> (i -> m (Wrong e)) -> Valor i m e
forall a b. (a -> b) -> a -> b
$ \ i
i -> i -> m (Wrong e)
v i
i m (Wrong e) -> (Wrong e -> m (Wrong e)) -> m (Wrong e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Wrong e -> m (Wrong e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Wrong e -> m (Wrong e))
-> (Wrong e -> Wrong e) -> Wrong e -> m (Wrong e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Wrong e
forall e. e -> Wrong e
Inert (e -> Wrong e) -> (Wrong e -> e) -> Wrong e -> Wrong e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrong e -> e
forall e. Wrong e -> e
valW

{- |
  Allows you to 'peer' into the 'Wrong' contained within the 'Valor' (how
  poetic) and if there is nothing 'Wrong.Wrong' it will return 'Nothing'.

  It might be useful in the 'Monad'ic context to know if the validator has
  failed (in which case @'Just' e@ is returned) or if it has succeeded.

  ==== __Example__

  >>> validateP (peer $ fail "I have failed") 0
  Right (Just "I have failed")

  >>> validateP (peer pass) 0
  Left (Valid 0)

  >>> let exV = peer (failIf "I'm less than 3" (<3)) >>= maybe (fail "I fail if previous validator succeeds") fail

  >>> validateP exV 3
  Right "I fail if previous validator succeeds"

  >>> validateP exV 2
  Right "I'm less than 3"
-}
peer :: Monad m => Valor i m e -> Valor i m ( Maybe e )
peer :: Valor i m e -> Valor i m (Maybe e)
peer ( Valor i -> m (Wrong e)
v ) = (i -> m (Wrong (Maybe e))) -> Valor i m (Maybe e)
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong (Maybe e))) -> Valor i m (Maybe e))
-> (i -> m (Wrong (Maybe e))) -> Valor i m (Maybe e)
forall a b. (a -> b) -> a -> b
$ \ i
i -> i -> m (Wrong e)
v i
i m (Wrong e)
-> (Wrong e -> m (Wrong (Maybe e))) -> m (Wrong (Maybe e))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Wrong (Maybe e) -> m (Wrong (Maybe e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Wrong (Maybe e) -> m (Wrong (Maybe e)))
-> (Wrong e -> Wrong (Maybe e)) -> Wrong e -> m (Wrong (Maybe e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Wrong (Maybe e))
-> (e -> Wrong (Maybe e)) -> Wrong e -> Wrong (Maybe e)
forall e a. (e -> a) -> (e -> a) -> Wrong e -> a
wrong ( Maybe e -> Wrong (Maybe e)
forall e. e -> Wrong e
Wrong (Maybe e -> Wrong (Maybe e))
-> (e -> Maybe e) -> e -> Wrong (Maybe e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Maybe e
forall a. a -> Maybe a
Just ) ( Wrong (Maybe e) -> e -> Wrong (Maybe e)
forall a b. a -> b -> a
const (Wrong (Maybe e) -> e -> Wrong (Maybe e))
-> Wrong (Maybe e) -> e -> Wrong (Maybe e)
forall a b. (a -> b) -> a -> b
$ Maybe e -> Wrong (Maybe e)
forall e. e -> Wrong e
Inert Maybe e
forall a. Maybe a
Nothing )

--

{- |
  It can 'adapt' a validator to the new input type given a conversion function,
  making it useful for working with records (think field selectors) or newtypes.

  This is essentially a 'Data.Functor.Contravariant.contramap' from
  "Data.Functor.Contravariant", however, due to the placement of arguments in
  the 'Valor' type constructor it is not possible to write that instance.

  ==== __Example__

  >>> newtype Age = Age { unAge :: Int } deriving Show

  >>> validateP (adapt unAge $ failIf "under aged" (<18)) (Age 78)
  Left (Valid (Age {unAge = 78}))

  >>> validateP (adapt unAge $ failIf "under aged" (<18)) (Age 14)
  Right "under aged"
-}
adapt :: Monad m => ( i -> x ) -> Valor x m e -> Valor i m e
adapt :: (i -> x) -> Valor x m e -> Valor i m e
adapt i -> x
s ( Valor x -> m (Wrong e)
v ) = (i -> m (Wrong e)) -> Valor i m e
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong e)) -> Valor i m e)
-> (i -> m (Wrong e)) -> Valor i m e
forall a b. (a -> b) -> a -> b
$ x -> m (Wrong e)
v (x -> m (Wrong e)) -> (i -> x) -> i -> m (Wrong e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> x
s

{- |
  Useful for constructing structured errors / error records. By using 'Maybe'
  you can specify for which exact field an error has occurred. It is implemented
  using 'peer' and 'adapt'.

  ==== __Example__

  >>> data ID = ID {unID :: Int} deriving Show
  >>> data User = User {userID :: ID, userName :: String} deriving Show
  >>> data UserError = UserError {ueID :: Maybe [String], ueName :: Maybe [String]} deriving Show

  >>> userValidator = UserError <$> check1 (unID . userID) (passIf ["invalid ID"] (>0)) <*> check1 userName (failIf ["username can't be empty"] null)

  >>> validateP userValidator $ User (ID (-1)) ""
  Right (UserError {ueID = Just ["invalid ID"], ueName = Just ["username can't be empty"]})

  >>> validateP userValidator $ User (ID 0) "username"
  Right (UserError {ueID = Just ["invalid ID"], ueName = Nothing})

  >>> validateP userValidator $ User (ID 11) "mastarija"
  Left (Valid (User {userID = ID {unID = 11}, userName = "mastarija"}))
-}
check1 :: Monad m => ( i -> x ) -> Valor x m e -> Valor i m ( Maybe e )
check1 :: (i -> x) -> Valor x m e -> Valor i m (Maybe e)
check1 i -> x
s = Valor i m e -> Valor i m (Maybe e)
forall (m :: * -> *) i e.
Monad m =>
Valor i m e -> Valor i m (Maybe e)
peer (Valor i m e -> Valor i m (Maybe e))
-> (Valor x m e -> Valor i m e)
-> Valor x m e
-> Valor i m (Maybe e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> x) -> Valor x m e -> Valor i m e
forall (m :: * -> *) i x e.
Monad m =>
(i -> x) -> Valor x m e -> Valor i m e
adapt i -> x
s

{- |
  Similar to 'check1', except it will apply a validator to each element of a
  'Traversable', e.g. a list. If every element of a list is valid, then we get
  'Nothing', otherwise we get a list of 'Maybe's for each validated value.

  This allows us to know in which exact element of a list an error has occurred
  (if you trust your 'Traversable' to maintain the original order after the
  traversal).

  ==== __Example__

  >>> data ID = ID {unID :: Int} deriving Show
  >>> data User = User {userID :: ID, userName :: String} deriving Show
  >>> data UserError = UserError {ueID :: Maybe [String], ueName :: Maybe [String]} deriving Show

  >>> userValidator = UserError <$> check1 (unID . userID) (passIf ["invalid ID"] (>0)) <*> check1 userName (failIf ["username can't be empty"] null)

  >>> validUser01 = User (ID 11) "mastarija"
  >>> validUser02 = User (ID 13) "reygoch"

  >>> invalidUser01 = User (ID 0) ""
  >>> invalidUser02 = User (ID (-1)) "badboy"

  >>> validateP (checkN id userValidator) [validUser01, invalidUser01, validUser02, invalidUser02]
  Right (Just [Nothing,Just (UserError {ueID = Just ["invalid ID"], ueName = Just ["username can't be empty"]}),Nothing,Just (UserError {ueID = Just ["invalid ID"], ueName = Nothing})])
-}
checkN :: ( Monad m , Traversable t ) => ( i -> t x ) -> Valor x m e -> Valor i m ( Maybe ( t ( Maybe e ) ) )
checkN :: (i -> t x) -> Valor x m e -> Valor i m (Maybe (t (Maybe e)))
checkN i -> t x
s Valor x m e
v = (i -> m (Wrong (Maybe (t (Maybe e)))))
-> Valor i m (Maybe (t (Maybe e)))
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong (Maybe (t (Maybe e)))))
 -> Valor i m (Maybe (t (Maybe e))))
-> (i -> m (Wrong (Maybe (t (Maybe e)))))
-> Valor i m (Maybe (t (Maybe e)))
forall a b. (a -> b) -> a -> b
$ \ i
i -> do
  t (Wrong (Maybe e))
ws <- (x -> m (Wrong (Maybe e))) -> t x -> m (t (Wrong (Maybe e)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ( Valor x m (Maybe e) -> x -> m (Wrong (Maybe e))
forall i (m :: * -> *) e. Valor i m e -> i -> m (Wrong e)
unValor (Valor x m (Maybe e) -> x -> m (Wrong (Maybe e)))
-> Valor x m (Maybe e) -> x -> m (Wrong (Maybe e))
forall a b. (a -> b) -> a -> b
$ Valor x m e -> Valor x m (Maybe e)
forall (m :: * -> *) i e.
Monad m =>
Valor i m e -> Valor i m (Maybe e)
peer Valor x m e
v ) ( i -> t x
s i
i )
  Wrong (Maybe (t (Maybe e))) -> m (Wrong (Maybe (t (Maybe e))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Wrong (Maybe (t (Maybe e))) -> m (Wrong (Maybe (t (Maybe e)))))
-> Wrong (Maybe (t (Maybe e))) -> m (Wrong (Maybe (t (Maybe e))))
forall a b. (a -> b) -> a -> b
$ if (Wrong (Maybe e) -> Bool) -> t (Wrong (Maybe e)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Wrong (Maybe e) -> Bool
forall e. Wrong e -> Bool
isInert t (Wrong (Maybe e))
ws
    then Maybe (t (Maybe e)) -> Wrong (Maybe (t (Maybe e)))
forall e. e -> Wrong e
Inert (Maybe (t (Maybe e)) -> Wrong (Maybe (t (Maybe e))))
-> Maybe (t (Maybe e)) -> Wrong (Maybe (t (Maybe e)))
forall a b. (a -> b) -> a -> b
$ Maybe (t (Maybe e))
forall a. Maybe a
Nothing
    else Maybe (t (Maybe e)) -> Wrong (Maybe (t (Maybe e)))
forall e. e -> Wrong e
Wrong (Maybe (t (Maybe e)) -> Wrong (Maybe (t (Maybe e))))
-> Maybe (t (Maybe e)) -> Wrong (Maybe (t (Maybe e)))
forall a b. (a -> b) -> a -> b
$ t (Maybe e) -> Maybe (t (Maybe e))
forall a. a -> Maybe a
Just (t (Maybe e) -> Maybe (t (Maybe e)))
-> t (Maybe e) -> Maybe (t (Maybe e))
forall a b. (a -> b) -> a -> b
$ (Wrong (Maybe e) -> Maybe e) -> t (Wrong (Maybe e)) -> t (Maybe e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Wrong (Maybe e) -> Maybe e
forall e. Wrong e -> e
valW t (Wrong (Maybe e))
ws

--

{- |
  Runs a validator within the 'Identity' 'Monad', essentially making it a "pure"
  validation.
-}
validateP :: Valor i Identity e -> i -> Either ( Valid i ) e
validateP :: Valor i Identity e -> i -> Either (Valid i) e
validateP Valor i Identity e
v = Identity (Either (Valid i) e) -> Either (Valid i) e
forall a. Identity a -> a
runIdentity (Identity (Either (Valid i) e) -> Either (Valid i) e)
-> (i -> Identity (Either (Valid i) e)) -> i -> Either (Valid i) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Valor i Identity e -> i -> Identity (Either (Valid i) e)
forall (m :: * -> *) i e.
Monad m =>
Valor i m e -> i -> m (Either (Valid i) e)
validateM Valor i Identity e
v

{- |
  Runs a validator within the user provided 'Monad' @m@ allowing you to perform
  side effects during the validation, e.g. check with the application database
  if the username is already registered.

  ==== __Example__

  >>> newtype Database = Database { someData :: Int }
  >>> let check = \ i -> someData >>= \ d -> pure $ if d < i then Nothing else Just "'DB' data is greater than input"

  >>> validateM (make check) 5 (Database 14)
  Right "'DB' data is greater than input"

  >>> validateM (make check) 5 (Database 3)
  Left (Valid 5)
-}
validateM :: Monad m => Valor i m e -> i -> m ( Either ( Valid i ) e )
validateM :: Valor i m e -> i -> m (Either (Valid i) e)
validateM ( Valor i -> m (Wrong e)
v ) i
i = i -> m (Wrong e)
v i
i m (Wrong e)
-> (Wrong e -> m (Either (Valid i) e)) -> m (Either (Valid i) e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Valid i) e -> m (Either (Valid i) e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Valid i) e -> m (Either (Valid i) e))
-> (Wrong e -> Either (Valid i) e)
-> Wrong e
-> m (Either (Valid i) e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Either (Valid i) e)
-> (e -> Either (Valid i) e) -> Wrong e -> Either (Valid i) e
forall e a. (e -> a) -> (e -> a) -> Wrong e -> a
wrong e -> Either (Valid i) e
forall a b. b -> Either a b
Right ( Either (Valid i) e -> e -> Either (Valid i) e
forall a b. a -> b -> a
const (Either (Valid i) e -> e -> Either (Valid i) e)
-> Either (Valid i) e -> e -> Either (Valid i) e
forall a b. (a -> b) -> a -> b
$ Valid i -> Either (Valid i) e
forall a b. a -> Either a b
Left (Valid i -> Either (Valid i) e) -> Valid i -> Either (Valid i) e
forall a b. (a -> b) -> a -> b
$ i -> Valid i
forall a. a -> Valid a
Valid i
i )

--

{- $tutorial

  Let's say we want to validate an application form for a team competition in
  which teams from different countries compete.

  We want each application to consist of a:

  * team name
  * team country
  * team captain
  * team members

  == Example domain

  Here's how our domain might look for such usecase:

  >>> :{
    data State = State
      { teams     :: [String]
      , countries :: [String]
      } deriving ( Eq , Show )
  :}

  >>> :{
    newtype Age = Age
      { unAge :: Int
      } deriving ( Eq , Show )
  :}

  >>> :{
    newtype Team = Team
      { unTeam :: String
      } deriving ( Eq , Show )
  :}

  >>> :{
    newtype Email = Email
      { unEmail :: String
      } deriving ( Eq , Show )
  :}

  >>> :{
    newtype Country = Country
      { unCountry :: String
      } deriving ( Eq , Show )
  :}

  >>> :{
    data Participant = Participant
      { age     :: Age
      , name    :: String
      , surname :: String
      , email   :: Email
      } deriving ( Eq , Show )
  :}

  >>> :{
    data Application = Application
      { team    :: Team
      , country :: Country
      , captain :: Participant
      , members :: [Participant]
      } deriving ( Eq , Show )
  :}

  The @State@ data type will represent our \"database\" in which we will check
  if the team with a certain name is already registered, or if applicants
  country is on allowed country list.

  We've created a few @newtype@s to make it clear what we are validating. Let's
  say we want to limit participants age within a certain range.

  == Error values

  First we will define another data type for errors that can occur during the
  age validation process. Age will be limited between 18 and 65 years, meaning
  our applicants can be over or under age:

  >>> :{
    data AgeError = AgeUnder | AgeOver
      deriving ( Eq , Show )
  :}

  == Simple validators

  Now we can work on constructing our validator. If we want our applicants to be
  over 18 years old we can write @'passIf' \[AgeUnder\] (>18)@. Similarly, we
  can restrict the age to under 65 by writing @'failIf' \[AgeOver\] (>65)@.
  Because 'Valor' is a 'Monoid' we can combine two validators into one like
  this:

  >>> :{
    ageV :: Monad m => Valor Age m [ AgeError ]
    ageV = adapt unAge $ passIf [ AgeUnder ] (>18) <> failIf [ AgeOver ] (>65)
  :}

  Here we've used the 'adapt' function to adapt our simple validators that work
  with plain integers to the @Age@ @newtype@ that wraps an 'Int' value. This way
  we can write @(>18)@ instead of @((>18) . unAge)@ in our validation predicate.

  Let's write a validator for @Team@. We don't want the team name to be empty,
  shorter than 4 letters, longer than 50 or already registered. To make those
  cases clearer, here's the @TeamError@:

  >>> :{
    data TeamError = TeamEmpty | TeamShort | TeamLong | TeamTaken
      deriving ( Eq , Show )
  :}

  == Adapting validators and monadic checks

  We'll use the 'adapt' function again to simplify our validator construction,
  along with the 'mconcat' which will allow us to avoid manually combining
  validators with '<>':

  >>> :{
    teamV :: Valor Team ( (->) State ) [ TeamError ]
    teamV = adapt unTeam $ mconcat
      [ failIf [ TeamEmpty ] null
      , passIf [ TeamShort ] ((>3) . length)
      , failIf [ TeamLong ] ((>50) . length)
      , make $ \ i -> do
          ts <- teams
          pure $ if i `elem` ts
            then Just [ TeamTaken ]
            else Nothing
      ]
  :}

  Here we are using the @-> r@ 'Monad' which is essentially just a reader
  monad. It simulates our database in which we can check for already registered
  teams, or allowed countries.

  Instead of 'failIf' and 'passIf' the 'make' function was used to construct a
  validator that checks if the team was already registered, as it allows us to
  perform 'Monad'ic computation. There are also 'failIfM' and 'passIfM' which
  also allow us to perform a 'Monad'ic computation.

  Here's another simple example of constructing a very basic validator for
  @Email@:

  >>> :{
    data EmailError = EmailEmpty | EmailNoAt | EmailNoDot
      deriving ( Eq , Show )
  :}

  >>> :{
    emailV :: Monad m => Valor Email m [ EmailError ]
    emailV = adapt unEmail $ mconcat
      [ failIf [ EmailEmpty ] null
      , passIf [ EmailNoAt ] (any (=='@'))
      , passIf [ EmailNoDot ] (any (=='.'))
      ]
  :}

  And another 'Monad'ic example checking if the @Country@ is allowed:

  >>> :{
    data CountryError = CountryEmpty | CountryNotAllowed
      deriving ( Eq , Show )
  :}

  >>> :{
    countryV :: Valor Country ( (->) State ) [ CountryError ]
    countryV = adapt unCountry $ mconcat
      [ failIf [ CountryEmpty ] null
      , make $ \ i -> do
          cs <- countries
          pure $ if i `elem` cs
            then Nothing
            else Just [ CountryNotAllowed ]
      ]
  :}

  == Structured errors

  Now let's try to create validate a more complex data type like @Participant@:

  @
  data Participant = Participant
    { age     :: Age
    , name    :: String
    , surname :: String
    , email   :: Email
    } deriving ( Eq , Show )
  @

  It has many fields of different data types. For each field we'd like to know
  if it has failed, and how. That way we can report to the user where exactly
  is the error and what it is. To do so, let's construct the @ParticipantError@
  record data type which will mirror the @Participant@:

  >>> :{
    data ParticipantError = ParticipantError
      { ageE      :: Maybe [ AgeError ]
      , nameE     :: Maybe [ String ]
      , surnameE  :: Maybe [ String ]
      , emailE    :: Maybe [ EmailError ]
      } deriving ( Eq , Show )
  :}

  Notice how each field has 'Maybe', this is because each individual field can
  be valid or invalid. If there is no error, then we will get 'Nothing',
  otherwise we'll get 'Just' the error value from a \"sub\" validator.

  Here's how we can construct our @Participant@ validator using 'check1' and
  previously defined validators along with some ad-hoc validators:

  >>> :{
    participantV :: Monad m => Valor Participant m ParticipantError
    participantV = ParticipantError
      <$> check1 age ageV
      <*> check1 name (failIf ["name can't be empty"] null)
      <*> check1 surname (failIf ["surname can't be empty"] null)
      <*> check1 email emailV
  :}

  We can use 'checkN' to validate every value in a list. Let's put together a
  validator for the @Application@. Similarly to the @Participant@, we first
  define the @ApplicationError@ to store our @Application@ errors:

  >>> :{
    data ApplicationError = ApplicationError
      { teamE     :: Maybe [ TeamError ]
      , countryE  :: Maybe [ CountryError ]
      , captainE  :: Maybe ParticipantError
      , membersE  :: Maybe [ Maybe ParticipantError ]
      } deriving ( Eq , Show )
  :}

  Notice that @membersE@ field is of type @Maybe [ Maybe ParticipantError ]@.
  This way, if even a single participant is erroneous we get back a 'Just' a
  list of 'Maybe's where 'Nothing' represents no error on that position in a
  list and 'Just' states that error occured on that element in a list.

  Finally, this is how we construct the @Application@ validator:

  >>> :{
    applicationV :: Valor Application ( (->) State ) ApplicationError
    applicationV = ApplicationError
      <$> check1 team teamV
      <*> check1 country countryV
      <*> check1 captain participantV
      <*> checkN members participantV
  :}

  And because we are using the @countryV@ we have to fix our 'Monad' to
  @(->) State@.

  == Usage examples

  Now we can create some test data and check out our validation results. Here is
  our \"database\":

  >>> :{
    state :: State
    state = State
      { teams = [ "Taken" ]
      , countries = [ "Croatia" , "Germany" , "USA" , "Japan" ]
      }
  :}

  a few participants:

  >>> :{
    exParticipantValid1 :: Participant
    exParticipantValid1 = Participant
      { age = Age 30
      , name = "Pero"
      , surname = "Perić"
      , email = Email "pero.peric@email.com"
      }
  :}

  >>> :{
    exParticipantValid2 :: Participant
    exParticipantValid2 = Participant
      { age = Age 51
      , name = "Marko"
      , surname = "Marić"
      , email = Email "marko.maric@email.com"
      }
  :}

  >>> :{
    exParticipantValid3 :: Participant
    exParticipantValid3 = Participant
      { age = Age 29
      , name = "Jane"
      , surname = "Doe"
      , email = Email "jane.doe@email.com"
      }
  :}

  >>> :{
    exParticipantInvalid1 :: Participant
    exParticipantInvalid1 = Participant
      { age = Age 48
      , name = ""
      , surname = "Perić"
      , email = Email "peropericemailcom"
      }
  :}

  >>> :{
    exParticipantInvalid2 :: Participant
    exParticipantInvalid2 = Participant
      { age = Age 73
      , name = "John"
      , surname = "Doe"
      , email = Email "john.doe@mail.com"
      }
  :}

  >>> :{
    exParticipantInvalid3 :: Participant
    exParticipantInvalid3 = Participant
      { age = Age 17
      , name = "Mini"
      , surname = "Morris"
      , email = Email ""
      }
  :}

  and finally some applications:

  >>> :{
    exApplicationValid :: Application
    exApplicationValid = Application
      { team = Team "Valor"
      , country = Country "Croatia"
      , captain = exParticipantValid1
      , members = [ exParticipantValid2 , exParticipantValid3 ]
      }
  :}

  >>> :{
    exApplicationInvalid1 :: Application
    exApplicationInvalid1 = Application
      { team = Team "Taken"
      , country = Country ""
      , captain = exParticipantValid1
      , members = [ exParticipantInvalid1 , exParticipantValid3 ]
      }
  :}

  >>> :{
    exApplicationInvalid2 :: Application
    exApplicationInvalid2 = Application
      { team = Team "srt"
      , country = Country "Murica!"
      , captain = exParticipantInvalid1
      , members = [ exParticipantInvalid2 , exParticipantValid1 , exParticipantValid3 , exParticipantValid2 ]
      }
  :}

  And we can check the results

  >>> validateM applicationV exApplicationValid state
  Left (Valid (Application {team = Team {unTeam = "Valor"}, country = Country {unCountry = "Croatia"}, captain = Participant {age = Age {unAge = 30}, name = "Pero", surname = "Peri\263", email = Email {unEmail = "pero.peric@email.com"}}, members = [Participant {age = Age {unAge = 51}, name = "Marko", surname = "Mari\263", email = Email {unEmail = "marko.maric@email.com"}},Participant {age = Age {unAge = 29}, name = "Jane", surname = "Doe", email = Email {unEmail = "jane.doe@email.com"}}]}))

  >>> validateM applicationV exApplicationInvalid1 state
  Right (ApplicationError {teamE = Just [TeamTaken], countryE = Just [CountryEmpty,CountryNotAllowed], captainE = Nothing, membersE = Just [Just (ParticipantError {ageE = Nothing, nameE = Just ["name can't be empty"], surnameE = Nothing, emailE = Just [EmailNoAt,EmailNoDot]}),Nothing]})

  >>> validateM applicationV exApplicationInvalid2 state
  Right (ApplicationError {teamE = Just [TeamShort], countryE = Just [CountryNotAllowed], captainE = Just (ParticipantError {ageE = Nothing, nameE = Just ["name can't be empty"], surnameE = Nothing, emailE = Just [EmailNoAt,EmailNoDot]}), membersE = Just [Just (ParticipantError {ageE = Just [AgeOver], nameE = Nothing, surnameE = Nothing, emailE = Nothing}),Nothing,Nothing,Nothing]})

  That's all folks!
-}