{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Safe #-}
module Valida.Validator
( Validator (..)
) where
import Data.List.NonEmpty (NonEmpty)
import Data.Profunctor (Profunctor (lmap, rmap))
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Valida.Validation (Validation (..))
newtype Validator e inp a = Validator { Validator e inp a -> inp -> Validation e a
runValidator :: inp -> Validation e a }
deriving (Typeable, (forall x. Validator e inp a -> Rep (Validator e inp a) x)
-> (forall x. Rep (Validator e inp a) x -> Validator e inp a)
-> Generic (Validator e inp a)
forall x. Rep (Validator e inp a) x -> Validator e inp a
forall x. Validator e inp a -> Rep (Validator e inp a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e inp a x. Rep (Validator e inp a) x -> Validator e inp a
forall e inp a x. Validator e inp a -> Rep (Validator e inp a) x
$cto :: forall e inp a x. Rep (Validator e inp a) x -> Validator e inp a
$cfrom :: forall e inp a x. Validator e inp a -> Rep (Validator e inp a) x
Generic)
instance Functor (Validator e inp) where
fmap :: (a -> b) -> Validator e inp a -> Validator e inp b
fmap a -> b
f (Validator inp -> Validation e a
v) = (inp -> Validation e b) -> Validator e inp b
forall e inp a. (inp -> Validation e a) -> Validator e inp a
Validator ((inp -> Validation e b) -> Validator e inp b)
-> (inp -> Validation e b) -> Validator e inp b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Validation e a -> Validation e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Validation e a -> Validation e b)
-> (inp -> Validation e a) -> inp -> Validation e b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. inp -> Validation e a
v
instance Semigroup e => Applicative (Validator e inp) where
{-# SPECIALIZE instance Applicative (Validator (NonEmpty err) inp) #-}
{-# SPECIALIZE instance Applicative (Validator () inp) #-}
{-# SPECIALIZE instance Applicative (Validator [err] inp) #-}
pure :: a -> Validator e inp a
pure = (inp -> Validation e a) -> Validator e inp a
forall e inp a. (inp -> Validation e a) -> Validator e inp a
Validator ((inp -> Validation e a) -> Validator e inp a)
-> (a -> inp -> Validation e a) -> a -> Validator e inp a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation e a -> inp -> Validation e a
forall a b. a -> b -> a
const (Validation e a -> inp -> Validation e a)
-> (a -> Validation e a) -> a -> inp -> Validation e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Validation e a
forall e a. a -> Validation e a
Success
{-# INLINEABLE pure #-}
Validator inp -> Validation e (a -> b)
ff <*> :: Validator e inp (a -> b) -> Validator e inp a -> Validator e inp b
<*> Validator inp -> Validation e a
v = (inp -> Validation e b) -> Validator e inp b
forall e inp a. (inp -> Validation e a) -> Validator e inp a
Validator ((inp -> Validation e b) -> Validator e inp b)
-> (inp -> Validation e b) -> Validator e inp b
forall a b. (a -> b) -> a -> b
$ \inp
x -> inp -> Validation e (a -> b)
ff inp
x Validation e (a -> b) -> Validation e a -> Validation e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> inp -> Validation e a
v inp
x
{-# INLINEABLE (<*>) #-}
instance Semigroup (Validator e inp a) where
Validator inp -> Validation e a
v1 <> :: Validator e inp a -> Validator e inp a -> Validator e inp a
<> Validator inp -> Validation e a
v2 = (inp -> Validation e a) -> Validator e inp a
forall e inp a. (inp -> Validation e a) -> Validator e inp a
Validator ((inp -> Validation e a) -> Validator e inp a)
-> (inp -> Validation e a) -> Validator e inp a
forall a b. (a -> b) -> a -> b
$ \inp
x -> case (inp -> Validation e a
v1 inp
x, inp -> Validation e a
v2 inp
x) of
(f :: Validation e a
f@(Failure e
_), Validation e a
_) -> Validation e a
f
(Validation e a
_, Validation e a
b) -> Validation e a
b
instance Monoid (Validator e inp ()) where
mempty :: Validator e inp ()
mempty = (inp -> Validation e ()) -> Validator e inp ()
forall e inp a. (inp -> Validation e a) -> Validator e inp a
Validator ((inp -> Validation e ()) -> Validator e inp ())
-> (inp -> Validation e ()) -> Validator e inp ()
forall a b. (a -> b) -> a -> b
$ Validation e () -> inp -> Validation e ()
forall a b. a -> b -> a
const (Validation e () -> inp -> Validation e ())
-> Validation e () -> inp -> Validation e ()
forall a b. (a -> b) -> a -> b
$ () -> Validation e ()
forall e a. a -> Validation e a
Success ()
instance Profunctor (Validator e) where
lmap :: (a -> b) -> Validator e b c -> Validator e a c
lmap a -> b
selector (Validator b -> Validation e c
v) = (a -> Validation e c) -> Validator e a c
forall e inp a. (inp -> Validation e a) -> Validator e inp a
Validator ((a -> Validation e c) -> Validator e a c)
-> (a -> Validation e c) -> Validator e a c
forall a b. (a -> b) -> a -> b
$ b -> Validation e c
v (b -> Validation e c) -> (a -> b) -> a -> Validation e c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
selector
rmap :: (b -> c) -> Validator e a b -> Validator e a c
rmap = (b -> c) -> Validator e a b -> Validator e a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap