{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
module Control.Validation.Patch(

-- * Patch
-- $patch
Patch(..), patch, noPatch,
-- * CheckPatch
-- $checkPatch
CheckPatch(..), CheckPatch', runCheckPatch, runCheckPatch',
liftPatch, liftNoPatch, demotePatch, mapErrorPatch, overCheck, Patched(..), validateByPatch, validateByPatch',

-- * Lens-variants of functions on 'Check's
-- $lens-variants
contramapL, chooseL, divideL,

-- * Construction of 'CheckPatch'es
-- $construction

    checkingPatch, checkingPatch',
    -- $constructionByPredicate
    testPatch,
    testPatch',
    testPatch_,
    testPatch'_,
    testPatchDefault,


    MultiCheckPatch,
    constructorCheckPatch,
    joinMultiCheckPatch,
    mapErrorsWithInfoPatch,
   
    -- * Reexports
    NP(..), DatatypeName, ConstructorName, FieldName
 ) where


import           Control.Validation.Check             (Check(..), unsafeValidate,
                                                       CheckResult (Passed),
                                                       Unvalidated,
                                                       failsWith, mapError, checking, unsafeValidate,
                                                       unvalidated, validateBy)
import Control.Validation.Internal.SOP
import           Data.Bifunctor                       (Bifunctor (second),
                                                       first)
import Generics.SOP as SOP(POP(..), unPOP, hliftA2, unK, NP(..), Generic(..), HasDatatypeInfo(..), DatatypeName, ConstructorName, FieldName, NS(..), SListI, hcexpand, hpure, SOP(..), I(..), unSOP, unI, hd, tl)
import Data.Foldable (Foldable (fold))
import Data.Functor ((<&>))
import Data.Functor.Contravariant (Contravariant (contramap))
import Data.Functor.Identity (Identity(..))
import Data.Monoid (Ap (..))
import Data.Sequence as Seq (Seq)
import qualified GHC.Generics  as GHC(Generic)
import Data.Proxy(Proxy(..))
import Lens.Micro (Lens')
import Lens.Micro.Extras (view)
import Control.Monad ((<=<))
import Data.Bitraversable (Bitraversable(bitraverse))

-- $checkPatch
-- The 'CheckPatch' type is similar to 'Check' but accumulates a function that "fixes" your data i.e. corrects it where it fails a 'Check'. To do so, some
-- of the combinators take 'Lens'es instead of normal functions (see below). To lift a normal 'Check' to a 'CheckPatch' use 'checkPatch'.
-- to validate and fix your data with a 'CheckPatch' use 'validateByPatch'.

newtype Patch a = Patch { Patch a -> a -> Maybe a
runPatch :: a -> Maybe a }

instance Semigroup (Patch a) where
  {-# INLINE (<>) #-}
  Patch f :: a -> Maybe a
f <> :: Patch a -> Patch a -> Patch a
<> Patch g :: a -> Maybe a
g = (a -> Maybe a) -> Patch a
forall a. (a -> Maybe a) -> Patch a
Patch (a -> Maybe a
f (a -> Maybe a) -> (a -> Maybe a) -> a -> Maybe a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> Maybe a
g)

instance Monoid (Patch a) where
  {-# INLINE mempty #-}
  mempty :: Patch a
mempty = (a -> Maybe a) -> Patch a
forall a. (a -> Maybe a) -> Patch a
Patch a -> Maybe a
forall a. a -> Maybe a
Just


-- | Helper functions to construct Patches.
patch :: (a -> a) -> Patch a
patch :: (a -> a) -> Patch a
patch = (a -> Maybe a) -> Patch a
forall a. (a -> Maybe a) -> Patch a
Patch ((a -> Maybe a) -> Patch a)
-> ((a -> a) -> a -> Maybe a) -> (a -> a) -> Patch a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. )

noPatch :: Patch a
noPatch :: Patch a
noPatch = (a -> Maybe a) -> Patch a
forall a. (a -> Maybe a) -> Patch a
Patch ((a -> Maybe a) -> Patch a) -> (a -> Maybe a) -> Patch a
forall a b. (a -> b) -> a -> b
$ Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing


-- | A 'Check' that also corrects the errors in your data.
newtype CheckPatch e m a = CheckPatch (Check (e, Patch a) m a)
  deriving (Semigroup (CheckPatch e m a)
CheckPatch e m a
Semigroup (CheckPatch e m a) =>
CheckPatch e m a
-> (CheckPatch e m a -> CheckPatch e m a -> CheckPatch e m a)
-> ([CheckPatch e m a] -> CheckPatch e m a)
-> Monoid (CheckPatch e m a)
[CheckPatch e m a] -> CheckPatch e m a
CheckPatch e m a -> CheckPatch e m a -> CheckPatch e m a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall e (m :: * -> *) a.
Applicative m =>
Semigroup (CheckPatch e m a)
forall e (m :: * -> *) a. Applicative m => CheckPatch e m a
forall e (m :: * -> *) a.
Applicative m =>
[CheckPatch e m a] -> CheckPatch e m a
forall e (m :: * -> *) a.
Applicative m =>
CheckPatch e m a -> CheckPatch e m a -> CheckPatch e m a
mconcat :: [CheckPatch e m a] -> CheckPatch e m a
$cmconcat :: forall e (m :: * -> *) a.
Applicative m =>
[CheckPatch e m a] -> CheckPatch e m a
mappend :: CheckPatch e m a -> CheckPatch e m a -> CheckPatch e m a
$cmappend :: forall e (m :: * -> *) a.
Applicative m =>
CheckPatch e m a -> CheckPatch e m a -> CheckPatch e m a
mempty :: CheckPatch e m a
$cmempty :: forall e (m :: * -> *) a. Applicative m => CheckPatch e m a
$cp1Monoid :: forall e (m :: * -> *) a.
Applicative m =>
Semigroup (CheckPatch e m a)
Monoid, b -> CheckPatch e m a -> CheckPatch e m a
NonEmpty (CheckPatch e m a) -> CheckPatch e m a
CheckPatch e m a -> CheckPatch e m a -> CheckPatch e m a
(CheckPatch e m a -> CheckPatch e m a -> CheckPatch e m a)
-> (NonEmpty (CheckPatch e m a) -> CheckPatch e m a)
-> (forall b.
    Integral b =>
    b -> CheckPatch e m a -> CheckPatch e m a)
-> Semigroup (CheckPatch e m a)
forall b. Integral b => b -> CheckPatch e m a -> CheckPatch 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 (CheckPatch e m a) -> CheckPatch e m a
forall e (m :: * -> *) a.
Applicative m =>
CheckPatch e m a -> CheckPatch e m a -> CheckPatch e m a
forall e (m :: * -> *) a b.
(Applicative m, Integral b) =>
b -> CheckPatch e m a -> CheckPatch e m a
stimes :: b -> CheckPatch e m a -> CheckPatch e m a
$cstimes :: forall e (m :: * -> *) a b.
(Applicative m, Integral b) =>
b -> CheckPatch e m a -> CheckPatch e m a
sconcat :: NonEmpty (CheckPatch e m a) -> CheckPatch e m a
$csconcat :: forall e (m :: * -> *) a.
Applicative m =>
NonEmpty (CheckPatch e m a) -> CheckPatch e m a
<> :: CheckPatch e m a -> CheckPatch e m a -> CheckPatch e m a
$c<> :: forall e (m :: * -> *) a.
Applicative m =>
CheckPatch e m a -> CheckPatch e m a -> CheckPatch e m a
Semigroup)
type CheckPatch' e = CheckPatch e Identity

runCheckPatch :: CheckPatch e m a -> Unvalidated a -> m (CheckResult (e, Patch a))
runCheckPatch :: CheckPatch e m a -> Unvalidated a -> m (CheckResult (e, Patch a))
runCheckPatch (CheckPatch p :: Check (e, Patch a) m a
p) = Check (e, Patch a) m a
-> Unvalidated a -> m (CheckResult (e, Patch a))
forall e (m :: * -> *) a.
Check e m a -> Unvalidated a -> m (CheckResult e)
runCheck Check (e, Patch a) m a
p

runCheckPatch' :: CheckPatch' e a -> Unvalidated a -> CheckResult (e, Patch a)
runCheckPatch' :: CheckPatch' e a -> Unvalidated a -> CheckResult (e, Patch a)
runCheckPatch' (CheckPatch p :: Check (e, Patch a) Identity a
p) = Identity (CheckResult (e, Patch a)) -> CheckResult (e, Patch a)
forall a. Identity a -> a
runIdentity (Identity (CheckResult (e, Patch a)) -> CheckResult (e, Patch a))
-> (Unvalidated a -> Identity (CheckResult (e, Patch a)))
-> Unvalidated a
-> CheckResult (e, Patch a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Check (e, Patch a) Identity a
-> Unvalidated a -> Identity (CheckResult (e, Patch a))
forall e (m :: * -> *) a.
Check e m a -> Unvalidated a -> m (CheckResult e)
runCheck Check (e, Patch a) Identity a
p

overCheck :: (Check (e, Patch a) m a -> Check (e', Patch a') m' a') -> CheckPatch e m a -> CheckPatch e' m' a'
overCheck :: (Check (e, Patch a) m a -> Check (e', Patch a') m' a')
-> CheckPatch e m a -> CheckPatch e' m' a'
overCheck f :: Check (e, Patch a) m a -> Check (e', Patch a') m' a'
f (CheckPatch c :: Check (e, Patch a) m a
c) = Check (e', Patch a') m' a' -> CheckPatch e' m' a'
forall e (m :: * -> *) a.
Check (e, Patch a) m a -> CheckPatch e m a
CheckPatch (Check (e, Patch a) m a -> Check (e', Patch a') m' a'
f Check (e, Patch a) m a
c)



-- | Lift a 'Check' to a 'CheckPatch' without a patch.
liftNoPatch :: Functor m => Check e m a -> CheckPatch e m a
liftNoPatch :: Check e m a -> CheckPatch e m a
liftNoPatch = Check (e, Patch a) m a -> CheckPatch e m a
forall e (m :: * -> *) a.
Check (e, Patch a) m a -> CheckPatch e m a
CheckPatch (Check (e, Patch a) m a -> CheckPatch e m a)
-> (Check e m a -> Check (e, Patch a) m a)
-> Check e m a
-> CheckPatch e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (e -> (e, Patch a)) -> Check e m a -> Check (e, Patch a) m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> Check e m a -> Check e' m a
mapError (, Patch a
forall a. Patch a
noPatch)


-- | Lift a 'Check' to a 'CheckPatch' with a patch
liftPatch :: Functor m => (a -> Maybe a) -> Check e m a -> CheckPatch e m a
liftPatch :: (a -> Maybe a) -> Check e m a -> CheckPatch e m a
liftPatch p :: a -> Maybe a
p = Check (e, Patch a) m a -> CheckPatch e m a
forall e (m :: * -> *) a.
Check (e, Patch a) m a -> CheckPatch e m a
CheckPatch (Check (e, Patch a) m a -> CheckPatch e m a)
-> (Check e m a -> Check (e, Patch a) m a)
-> Check e m a
-> CheckPatch e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> (e, Patch a)) -> Check e m a -> Check (e, Patch a) m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> Check e m a -> Check e' m a
mapError (, (a -> Maybe a) -> Patch a
forall a. (a -> Maybe a) -> Patch a
Patch a -> Maybe a
p)

-- | Demote a 'CheckPatch' into a 'Check' by throwing the patch away
demotePatch :: Functor m => CheckPatch e m a -> Check e m a
demotePatch :: CheckPatch e m a -> Check e m a
demotePatch (CheckPatch c :: Check (e, Patch a) m a
c) = ((e, Patch a) -> e) -> Check (e, Patch a) 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, Patch a) -> e
forall a b. (a, b) -> a
fst Check (e, Patch a) m a
c

newtype Patched a = Patched { Patched a -> a
getPatched :: a } deriving (Int -> Patched a -> ShowS
[Patched a] -> ShowS
Patched a -> String
(Int -> Patched a -> ShowS)
-> (Patched a -> String)
-> ([Patched a] -> ShowS)
-> Show (Patched a)
forall a. Show a => Int -> Patched a -> ShowS
forall a. Show a => [Patched a] -> ShowS
forall a. Show a => Patched a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Patched a] -> ShowS
$cshowList :: forall a. Show a => [Patched a] -> ShowS
show :: Patched a -> String
$cshow :: forall a. Show a => Patched a -> String
showsPrec :: Int -> Patched a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Patched a -> ShowS
Show, Patched a -> Patched a -> Bool
(Patched a -> Patched a -> Bool)
-> (Patched a -> Patched a -> Bool) -> Eq (Patched a)
forall a. Eq a => Patched a -> Patched a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Patched a -> Patched a -> Bool
$c/= :: forall a. Eq a => Patched a -> Patched a -> Bool
== :: Patched a -> Patched a -> Bool
$c== :: forall a. Eq a => Patched a -> Patched a -> Bool
Eq, ReadPrec [Patched a]
ReadPrec (Patched a)
Int -> ReadS (Patched a)
ReadS [Patched a]
(Int -> ReadS (Patched a))
-> ReadS [Patched a]
-> ReadPrec (Patched a)
-> ReadPrec [Patched a]
-> Read (Patched a)
forall a. Read a => ReadPrec [Patched a]
forall a. Read a => ReadPrec (Patched a)
forall a. Read a => Int -> ReadS (Patched a)
forall a. Read a => ReadS [Patched a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Patched a]
$creadListPrec :: forall a. Read a => ReadPrec [Patched a]
readPrec :: ReadPrec (Patched a)
$creadPrec :: forall a. Read a => ReadPrec (Patched a)
readList :: ReadS [Patched a]
$creadList :: forall a. Read a => ReadS [Patched a]
readsPrec :: Int -> ReadS (Patched a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Patched a)
Read, All SListI (Code (Patched a))
All SListI (Code (Patched a)) =>
(Patched a -> Rep (Patched a))
-> (Rep (Patched a) -> Patched a) -> Generic (Patched a)
Rep (Patched a) -> Patched a
Patched a -> Rep (Patched a)
forall a. Generic a => All SListI (Code (Patched a))
forall a. Generic a => Rep (Patched a) -> Patched a
forall a. Generic a => Patched a -> Rep (Patched a)
forall a.
All SListI (Code a) =>
(a -> Rep a) -> (Rep a -> a) -> Generic a
to :: Rep (Patched a) -> Patched a
$cto :: forall a. Generic a => Rep (Patched a) -> Patched a
from :: Patched a -> Rep (Patched a)
$cfrom :: forall a. Generic a => Patched a -> Rep (Patched a)
$cp1Generic :: forall a. Generic a => All SListI (Code (Patched a))
Generic)
-- | 'validateByPatch' takes a 'CheckPatch' and the unvalidated data and either returns the validated data or returns the errors in the data
-- and ─ if a fix exists ─  the fixed data.
validateByPatch :: forall m e a. Functor m => CheckPatch e m a -> Unvalidated a -> m (Either (Seq e, Maybe (Patched a)) a)
validateByPatch :: CheckPatch e m a
-> Unvalidated a -> m (Either (Seq e, Maybe (Patched a)) a)
validateByPatch (CheckPatch c :: Check (e, Patch a) m a
c) v :: Unvalidated a
v = Either (Seq (e, Patch a)) a -> Either (Seq e, Maybe (Patched a)) a
applyChanges (Either (Seq (e, Patch a)) a
 -> Either (Seq e, Maybe (Patched a)) a)
-> m (Either (Seq (e, Patch a)) a)
-> m (Either (Seq e, Maybe (Patched a)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Check (e, Patch a) m a
-> Unvalidated a -> m (Either (Seq (e, Patch a)) a)
forall (m :: * -> *) e a.
Functor m =>
Check e m a -> Unvalidated a -> m (Either (Seq e) a)
validateBy Check (e, Patch a) m a
c Unvalidated a
v
  where
    applyChanges :: Either (Seq (e, Patch a)) a -> Either (Seq e, Maybe (Patched a)) a
    applyChanges :: Either (Seq (e, Patch a)) a -> Either (Seq e, Maybe (Patched a)) a
applyChanges (Right a :: a
a) = a -> Either (Seq e, Maybe (Patched a)) a
forall a b. b -> Either a b
Right a
a
    applyChanges (Left s :: Seq (e, Patch a)
s) =
      let errs :: Seq e
errs = ((e, Patch a) -> e) -> Seq (e, Patch a) -> Seq e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (e, Patch a) -> e
forall a b. (a, b) -> a
fst Seq (e, Patch a)
s :: Seq e
          x' :: Maybe (Patched a)
x' =  a -> Patched a
forall a. a -> Patched a
Patched (a -> Patched a) -> Maybe a -> Maybe (Patched a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Patch a -> a -> Maybe a
forall a. Patch a -> a -> Maybe a
runPatch (Seq (Patch a) -> Patch a
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Seq (Patch a) -> Patch a)
-> (Seq (e, Patch a) -> Seq (Patch a))
-> Seq (e, Patch a)
-> Patch a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((e, Patch a) -> Patch a) -> Seq (e, Patch a) -> Seq (Patch a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (e, Patch a) -> Patch a
forall a b. (a, b) -> b
snd (Seq (e, Patch a) -> Patch a) -> Seq (e, Patch a) -> Patch a
forall a b. (a -> b) -> a -> b
$ Seq (e, Patch a)
s) (Unvalidated a -> a
forall a. Unvalidated a -> a
unsafeValidate Unvalidated a
v)
       in (Seq e, Maybe (Patched a)) -> Either (Seq e, Maybe (Patched a)) a
forall a b. a -> Either a b
Left (Seq e
errs, Maybe (Patched a)
x')

-- | 'validateByPatch' with trivial context
validateByPatch' :: CheckPatch' e a -> Unvalidated a -> Either (Seq e, Maybe (Patched a)) a
validateByPatch' :: CheckPatch' e a
-> Unvalidated a -> Either (Seq e, Maybe (Patched a)) a
validateByPatch' c :: CheckPatch' e a
c d :: Unvalidated a
d = Identity (Either (Seq e, Maybe (Patched a)) a)
-> Either (Seq e, Maybe (Patched a)) a
forall a. Identity a -> a
runIdentity (Identity (Either (Seq e, Maybe (Patched a)) a)
 -> Either (Seq e, Maybe (Patched a)) a)
-> (Unvalidated a
    -> Identity (Either (Seq e, Maybe (Patched a)) a))
-> Unvalidated a
-> Either (Seq e, Maybe (Patched a)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckPatch' e a
-> Unvalidated a -> Identity (Either (Seq e, Maybe (Patched a)) a)
forall (m :: * -> *) e a.
Functor m =>
CheckPatch e m a
-> Unvalidated a -> m (Either (Seq e, Maybe (Patched a)) a)
validateByPatch CheckPatch' e a
c (Unvalidated a -> Either (Seq e, Maybe (Patched a)) a)
-> Unvalidated a -> Either (Seq e, Maybe (Patched a)) a
forall a b. (a -> b) -> a -> b
$ Unvalidated a
d

mapErrorPatch :: Functor m => (e -> e') -> CheckPatch e m a -> CheckPatch e' m a
mapErrorPatch :: (e -> e') -> CheckPatch e m a -> CheckPatch e' m a
mapErrorPatch f :: e -> e'
f (CheckPatch c :: Check (e, Patch a) m a
c) = Check (e', Patch a) m a -> CheckPatch e' m a
forall e (m :: * -> *) a.
Check (e, Patch a) m a -> CheckPatch e m a
CheckPatch (Check (e', Patch a) m a -> CheckPatch e' m a)
-> Check (e', Patch a) m a -> CheckPatch e' m a
forall a b. (a -> b) -> a -> b
$ ((e, Patch a) -> (e', Patch a))
-> Check (e, Patch a) m a -> Check (e', Patch a) m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> Check e m a -> Check e' m a
mapError ((e -> e') -> (e, Patch a) -> (e', Patch a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first e -> e'
f) Check (e, Patch a) m a
c


-- * Variants of functions from "Control.Validation.Check"
-- $lens-variants
-- The functions 'contramapL', 'chooseL' and 'divideL' are the counterparts that take a lens instead of a simple function so they can patch their data if needed.
contramapL :: Functor m => Lens' s a -> CheckPatch e m a -> CheckPatch e m s
contramapL :: Lens' s a -> CheckPatch e m a -> CheckPatch e m s
contramapL l :: Lens' s a
l =
  (Check (e, Patch a) m a -> Check (e, Patch s) m s)
-> CheckPatch e m a -> CheckPatch e m s
forall e a (m :: * -> *) e' a' (m' :: * -> *).
(Check (e, Patch a) m a -> Check (e', Patch a') m' a')
-> CheckPatch e m a -> CheckPatch e' m' a'
overCheck ((Check (e, Patch a) m a -> Check (e, Patch s) m s)
 -> CheckPatch e m a -> CheckPatch e m s)
-> (Check (e, Patch a) m a -> Check (e, Patch s) m s)
-> CheckPatch e m a
-> CheckPatch e m s
forall a b. (a -> b) -> a -> b
$ ((e, Patch a) -> (e, Patch s))
-> Check (e, Patch a) m s -> Check (e, Patch s) m s
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> Check e m a -> Check e' m a
mapError ((Patch a -> Patch s) -> (e, Patch a) -> (e, Patch s)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Patch a -> Patch s) -> (e, Patch a) -> (e, Patch s))
-> (Patch a -> Patch s) -> (e, Patch a) -> (e, Patch s)
forall a b. (a -> b) -> a -> b
$ (s -> Maybe s) -> Patch s
forall a. (a -> Maybe a) -> Patch a
Patch ((s -> Maybe s) -> Patch s)
-> (Patch a -> s -> Maybe s) -> Patch a -> Patch s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a) -> s -> Maybe s
Lens' s a
l ((a -> Maybe a) -> s -> Maybe s)
-> (Patch a -> a -> Maybe a) -> Patch a -> s -> Maybe s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Patch a -> a -> Maybe a
forall a. Patch a -> a -> Maybe a
runPatch)
  (Check (e, Patch a) m s -> Check (e, Patch s) m s)
-> (Check (e, Patch a) m a -> Check (e, Patch a) m s)
-> Check (e, Patch a) m a
-> Check (e, Patch s) m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> a) -> Check (e, Patch a) m a -> Check (e, Patch a) m s
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (Getting a s a -> s -> a
forall a s. Getting a s a -> s -> a
view Getting a s a
Lens' s a
l)


traverseFirst :: forall f x x' y b. (Bitraversable b, Applicative f) => (x -> f x') -> b x y -> f (b x' y)
traverseFirst :: (x -> f x') -> b x y -> f (b x' y)
traverseFirst = ((x -> f x') -> (y -> f y) -> b x y -> f (b x' y))
-> (y -> f y) -> (x -> f x') -> b x y -> f (b x' y)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> f x') -> (y -> f y) -> b x y -> f (b x' y)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse y -> f y
forall (f :: * -> *) a. Applicative f => a -> f a
pure

traverseSecond :: (Bitraversable b, Applicative f) => (y -> f y') -> b x y -> f (b x y')
traverseSecond :: (y -> f y') -> b x y -> f (b x y')
traverseSecond = (x -> f x) -> (y -> f y') -> b x y -> f (b x y')
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse x -> f x
forall (f :: * -> *) a. Applicative f => a -> f a
pure


chooseL :: forall m a b c e. (Functor m) => (Lens' a (Either b c)) -> CheckPatch e m b -> CheckPatch e m c -> CheckPatch e m a
chooseL :: Lens' a (Either b c)
-> CheckPatch e m b -> CheckPatch e m c -> CheckPatch e m a
chooseL p :: Lens' a (Either b c)
p (CheckPatch c1 :: Check (e, Patch b) m b
c1) (CheckPatch c2 :: Check (e, Patch c) m c
c2) = Check (e, Patch a) m a -> CheckPatch e m a
forall e (m :: * -> *) a.
Check (e, Patch a) m a -> CheckPatch e m a
CheckPatch (Check (e, Patch a) m a -> CheckPatch e m a)
-> Check (e, Patch a) m a -> CheckPatch e m a
forall a b. (a -> b) -> a -> b
$ (Unvalidated a -> m (CheckResult (e, Patch a)))
-> Check (e, Patch a) m a
forall e (m :: * -> *) a.
(Unvalidated a -> m (CheckResult e)) -> Check e m a
Check ((Unvalidated a -> m (CheckResult (e, Patch a)))
 -> Check (e, Patch a) m a)
-> (Unvalidated a -> m (CheckResult (e, Patch a)))
-> Check (e, Patch a) m a
forall a b. (a -> b) -> a -> b
$
  (b -> m (CheckResult (e, Patch a)))
-> (c -> m (CheckResult (e, Patch a)))
-> Either b c
-> m (CheckResult (e, Patch a))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (\input :: b
input ->
       ((e, Patch b) -> (e, Patch a))
-> CheckResult (e, Patch b) -> CheckResult (e, Patch a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Patch b -> Patch a) -> (e, Patch b) -> (e, Patch a)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Patch b -> Patch a) -> (e, Patch b) -> (e, Patch a))
-> (Patch b -> Patch a) -> (e, Patch b) -> (e, Patch a)
forall a b. (a -> b) -> a -> b
$ \(Patch f :: b -> Maybe b
f) -> (a -> Maybe a) -> Patch a
forall a. (a -> Maybe a) -> Patch a
Patch ((Either b c -> Maybe (Either b c)) -> a -> Maybe a
Lens' a (Either b c)
p ((Either b c -> Maybe (Either b c)) -> a -> Maybe a)
-> (Either b c -> Maybe (Either b c)) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (b -> Maybe b) -> Either b c -> Maybe (Either b c)
forall (f :: * -> *) x x' y (b :: * -> * -> *).
(Bitraversable b, Applicative f) =>
(x -> f x') -> b x y -> f (b x' y)
traverseFirst b -> Maybe b
f))
         (CheckResult (e, Patch b) -> CheckResult (e, Patch a))
-> m (CheckResult (e, Patch b)) -> m (CheckResult (e, Patch a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Check (e, Patch b) m b
-> Unvalidated b -> m (CheckResult (e, Patch b))
forall e (m :: * -> *) a.
Check e m a -> Unvalidated a -> m (CheckResult e)
runCheck Check (e, Patch b) m b
c1 (b -> Unvalidated b
forall a. a -> Unvalidated a
unvalidated b
input)                         )
    (\input :: c
input ->
        ((e, Patch c) -> (e, Patch a))
-> CheckResult (e, Patch c) -> CheckResult (e, Patch a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Patch c -> Patch a) -> (e, Patch c) -> (e, Patch a)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Patch c -> Patch a) -> (e, Patch c) -> (e, Patch a))
-> (Patch c -> Patch a) -> (e, Patch c) -> (e, Patch a)
forall a b. (a -> b) -> a -> b
$ \(Patch f :: c -> Maybe c
f) -> (a -> Maybe a) -> Patch a
forall a. (a -> Maybe a) -> Patch a
Patch ((Either b c -> Maybe (Either b c)) -> a -> Maybe a
Lens' a (Either b c)
p ((Either b c -> Maybe (Either b c)) -> a -> Maybe a)
-> (Either b c -> Maybe (Either b c)) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (c -> Maybe c) -> Either b c -> Maybe (Either b c)
forall (b :: * -> * -> *) (f :: * -> *) y y' x.
(Bitraversable b, Applicative f) =>
(y -> f y') -> b x y -> f (b x y')
traverseSecond c -> Maybe c
f))
             (CheckResult (e, Patch c) -> CheckResult (e, Patch a))
-> m (CheckResult (e, Patch c)) -> m (CheckResult (e, Patch a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Check (e, Patch c) m c
-> Unvalidated c -> m (CheckResult (e, Patch c))
forall e (m :: * -> *) a.
Check e m a -> Unvalidated a -> m (CheckResult e)
runCheck Check (e, Patch c) m c
c2 (c -> Unvalidated c
forall a. a -> Unvalidated a
unvalidated c
input)
       )
  (Either b c -> m (CheckResult (e, Patch a)))
-> (Unvalidated a -> Either b c)
-> Unvalidated a
-> m (CheckResult (e, Patch a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Either b c) a (Either b c) -> a -> Either b c
forall a s. Getting a s a -> s -> a
view Getting (Either b c) a (Either b c)
Lens' a (Either b c)
p
  (a -> Either b c)
-> (Unvalidated a -> a) -> Unvalidated a -> Either b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unvalidated a -> a
forall a. Unvalidated a -> a
unsafeValidate


divideL :: forall m a b c e. (Applicative m) => (Lens' a (b, c)) -> CheckPatch e m b -> CheckPatch e m c -> CheckPatch e m a
divideL :: Lens' a (b, c)
-> CheckPatch e m b -> CheckPatch e m c -> CheckPatch e m a
divideL p :: Lens' a (b, c)
p (CheckPatch c1 :: Check (e, Patch b) m b
c1) (CheckPatch c2 :: Check (e, Patch c) m c
c2) = Check (e, Patch a) m a -> CheckPatch e m a
forall e (m :: * -> *) a.
Check (e, Patch a) m a -> CheckPatch e m a
CheckPatch (Check (e, Patch a) m a -> CheckPatch e m a)
-> Check (e, Patch a) m a -> CheckPatch e m a
forall a b. (a -> b) -> a -> b
$ (Unvalidated a -> m (CheckResult (e, Patch a)))
-> Check (e, Patch a) m a
forall e (m :: * -> *) a.
(Unvalidated a -> m (CheckResult e)) -> Check e m a
Check ((Unvalidated a -> m (CheckResult (e, Patch a)))
 -> Check (e, Patch a) m a)
-> (Unvalidated a -> m (CheckResult (e, Patch a)))
-> Check (e, Patch a) m a
forall a b. (a -> b) -> a -> b
$ \v :: Unvalidated a
v -> case Getting (b, c) a (b, c) -> a -> (b, c)
forall a s. Getting a s a -> s -> a
view Getting (b, c) a (b, c)
Lens' a (b, c)
p (a -> (b, c)) -> a -> (b, c)
forall a b. (a -> b) -> a -> b
$ Unvalidated a -> a
forall a. Unvalidated a -> a
unsafeValidate Unvalidated a
v of
  (b :: b
b, c :: c
c) -> Ap m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch a))
forall k (f :: k -> *) (a :: k). Ap f a -> f a
getAp (Ap m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch a)))
-> Ap m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch a))
forall a b. (a -> b) -> a -> b
$
    ( m (CheckResult (e, Patch a)) -> Ap m (CheckResult (e, Patch a))
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (m (CheckResult (e, Patch a)) -> Ap m (CheckResult (e, Patch a)))
-> m (CheckResult (e, Patch a)) -> Ap m (CheckResult (e, Patch a))
forall a b. (a -> b) -> a -> b
$ ((e, Patch b) -> (e, Patch a))
-> CheckResult (e, Patch b) -> CheckResult (e, Patch a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Patch b -> Patch a) -> (e, Patch b) -> (e, Patch a)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Patch b -> Patch a) -> (e, Patch b) -> (e, Patch a))
-> (Patch b -> Patch a) -> (e, Patch b) -> (e, Patch a)
forall a b. (a -> b) -> a -> b
$ \(Patch f :: b -> Maybe b
f) -> (a -> Maybe a) -> Patch a
forall a. (a -> Maybe a) -> Patch a
Patch (((b, c) -> Maybe (b, c)) -> a -> Maybe a
Lens' a (b, c)
p (((b, c) -> Maybe (b, c)) -> a -> Maybe a)
-> ((b, c) -> Maybe (b, c)) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (b -> Maybe b) -> (b, c) -> Maybe (b, c)
forall (f :: * -> *) x x' y (b :: * -> * -> *).
(Bitraversable b, Applicative f) =>
(x -> f x') -> b x y -> f (b x' y)
traverseFirst b -> Maybe b
f))
      (CheckResult (e, Patch b) -> CheckResult (e, Patch a))
-> m (CheckResult (e, Patch b)) -> m (CheckResult (e, Patch a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Check (e, Patch b) m b
-> Unvalidated b -> m (CheckResult (e, Patch b))
forall e (m :: * -> *) a.
Check e m a -> Unvalidated a -> m (CheckResult e)
runCheck Check (e, Patch b) m b
c1 (b -> Unvalidated b
forall a. a -> Unvalidated a
unvalidated b
b))
    Ap m (CheckResult (e, Patch a))
-> Ap m (CheckResult (e, Patch a))
-> Ap m (CheckResult (e, Patch a))
forall a. Semigroup a => a -> a -> a
<>
      (m (CheckResult (e, Patch a)) -> Ap m (CheckResult (e, Patch a))
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (m (CheckResult (e, Patch a)) -> Ap m (CheckResult (e, Patch a)))
-> m (CheckResult (e, Patch a)) -> Ap m (CheckResult (e, Patch a))
forall a b. (a -> b) -> a -> b
$ ((e, Patch c) -> (e, Patch a))
-> CheckResult (e, Patch c) -> CheckResult (e, Patch a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Patch c -> Patch a) -> (e, Patch c) -> (e, Patch a)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Patch c -> Patch a) -> (e, Patch c) -> (e, Patch a))
-> (Patch c -> Patch a) -> (e, Patch c) -> (e, Patch a)
forall a b. (a -> b) -> a -> b
$ \(Patch f :: c -> Maybe c
f) -> (a -> Maybe a) -> Patch a
forall a. (a -> Maybe a) -> Patch a
Patch (((b, c) -> Maybe (b, c)) -> a -> Maybe a
Lens' a (b, c)
p (((b, c) -> Maybe (b, c)) -> a -> Maybe a)
-> ((b, c) -> Maybe (b, c)) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (c -> Maybe c) -> (b, c) -> Maybe (b, c)
forall (b :: * -> * -> *) (f :: * -> *) y y' x.
(Bitraversable b, Applicative f) =>
(y -> f y') -> b x y -> f (b x y')
traverseSecond c -> Maybe c
f))
       (CheckResult (e, Patch c) -> CheckResult (e, Patch a))
-> m (CheckResult (e, Patch c)) -> m (CheckResult (e, Patch a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Check (e, Patch c) m c
-> Unvalidated c -> m (CheckResult (e, Patch c))
forall e (m :: * -> *) a.
Check e m a -> Unvalidated a -> m (CheckResult e)
runCheck Check (e, Patch c) m c
c2 (c -> Unvalidated c
forall a. a -> Unvalidated a
unvalidated c
c))







-- ** Construction of 'CheckPatch'es
-- $construction
-- Patch-variants for construction-functions. Functions have a `Patch` appended (e.g. 'test_' ~> 'testPatch_') and operators have an additional exclamation mark after the question mark
-- (e.g. '?>>' ~> '?!>>')
-- For documentation see "Control.Valiation.Check".
checkingPatch :: Functor m => (a -> (Maybe a, m (CheckResult e))) -> CheckPatch e m a
checkingPatch :: (a -> (Maybe a, m (CheckResult e))) -> CheckPatch e m a
checkingPatch f :: a -> (Maybe a, m (CheckResult e))
f = Check (e, Patch a) m a -> CheckPatch e m a
forall e (m :: * -> *) a.
Check (e, Patch a) m a -> CheckPatch e m a
CheckPatch (Check (e, Patch a) m a -> CheckPatch e m a)
-> Check (e, Patch a) m a -> CheckPatch e m a
forall a b. (a -> b) -> a -> b
$ (e -> (e, Patch a)) -> Check e m a -> Check (e, Patch a) m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> Check e m a -> Check e' m a
mapError ((, (a -> Maybe a) -> Patch a
forall a. (a -> Maybe a) -> Patch a
Patch ((a -> Maybe a) -> Patch a) -> (a -> Maybe a) -> Patch a
forall a b. (a -> b) -> a -> b
$ (Maybe a, m (CheckResult e)) -> Maybe a
forall a b. (a, b) -> a
fst ((Maybe a, m (CheckResult e)) -> Maybe a)
-> (a -> (Maybe a, m (CheckResult e))) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Maybe a, m (CheckResult e))
f)) (Check e m a -> Check (e, Patch a) m a)
-> Check e m a -> Check (e, Patch a) m a
forall a b. (a -> b) -> a -> b
$ (a -> m (CheckResult e)) -> Check e m a
forall a (m :: * -> *) e. (a -> m (CheckResult e)) -> Check e m a
checking ((Maybe a, m (CheckResult e)) -> m (CheckResult e)
forall a b. (a, b) -> b
snd ((Maybe a, m (CheckResult e)) -> m (CheckResult e))
-> (a -> (Maybe a, m (CheckResult e))) -> a -> m (CheckResult e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Maybe a, m (CheckResult e))
f)



checkingPatch' :: (a -> (Maybe a, CheckResult e)) -> CheckPatch' e a
checkingPatch' :: (a -> (Maybe a, CheckResult e)) -> CheckPatch' e a
checkingPatch' = (a -> (Maybe a, Identity (CheckResult e))) -> CheckPatch' e a
forall (m :: * -> *) a e.
Functor m =>
(a -> (Maybe a, m (CheckResult e))) -> CheckPatch e m a
checkingPatch ((a -> (Maybe a, Identity (CheckResult e))) -> CheckPatch' e a)
-> ((a -> (Maybe a, CheckResult e))
    -> a -> (Maybe a, Identity (CheckResult e)))
-> (a -> (Maybe a, CheckResult e))
-> CheckPatch' e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CheckResult e -> Identity (CheckResult e))
-> (Maybe a, CheckResult e) -> (Maybe a, Identity (CheckResult e))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second CheckResult e -> Identity (CheckResult e)
forall a. a -> Identity a
Identity ((Maybe a, CheckResult e) -> (Maybe a, Identity (CheckResult e)))
-> (a -> (Maybe a, CheckResult e))
-> a
-> (Maybe a, Identity (CheckResult e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

testPatch' :: Applicative m => (a -> Bool) -> (a -> e) -> Patch a -> CheckPatch e m a
testPatch' :: (a -> Bool) -> (a -> e) -> Patch a -> CheckPatch e m a
testPatch' p :: a -> Bool
p onErr :: a -> e
onErr fix :: Patch a
fix = Check (e, Patch a) m a -> CheckPatch e m a
forall e (m :: * -> *) a.
Check (e, Patch a) m a -> CheckPatch e m a
CheckPatch (Check (e, Patch a) m a -> CheckPatch e m a)
-> ((Unvalidated a -> m (CheckResult (e, Patch a)))
    -> Check (e, Patch a) m a)
-> (Unvalidated a -> m (CheckResult (e, Patch a)))
-> CheckPatch e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unvalidated a -> m (CheckResult (e, Patch a)))
-> Check (e, Patch a) m a
forall e (m :: * -> *) a.
(Unvalidated a -> m (CheckResult e)) -> Check e m a
Check ((Unvalidated a -> m (CheckResult (e, Patch a)))
 -> CheckPatch e m a)
-> (Unvalidated a -> m (CheckResult (e, Patch a)))
-> CheckPatch e m a
forall a b. (a -> b) -> a -> b
$ \x :: Unvalidated a
x -> CheckResult (e, Patch a) -> m (CheckResult (e, Patch a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CheckResult (e, Patch a) -> m (CheckResult (e, Patch a)))
-> CheckResult (e, Patch a) -> m (CheckResult (e, Patch a))
forall a b. (a -> b) -> a -> b
$ if a -> Bool
p (a -> Bool) -> (Unvalidated a -> a) -> Unvalidated a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unvalidated a -> a
forall a. Unvalidated a -> a
unsafeValidate (Unvalidated a -> Bool) -> Unvalidated a -> Bool
forall a b. (a -> b) -> a -> b
$ Unvalidated a
x
    then CheckResult (e, Patch a)
forall e. CheckResult e
Passed
    else (e, Patch a) -> CheckResult (e, Patch a)
forall e. e -> CheckResult e
failsWith (a -> e
onErr (a -> e) -> a -> e
forall a b. (a -> b) -> a -> b
$ Unvalidated a -> a
forall a. Unvalidated a -> a
unsafeValidate Unvalidated a
x, Patch a
fix)
infix 7 `testPatch'`


{-# INLINE testPatch'_ #-}
testPatch'_ :: Applicative m => (a -> Bool) -> e -> Patch a -> CheckPatch e m a
testPatch'_ :: (a -> Bool) -> e -> Patch a -> CheckPatch e m a
testPatch'_ p :: a -> Bool
p err :: e
err fix :: Patch a
fix = (a -> Bool) -> (a -> e) -> Patch a -> CheckPatch e m a
forall (m :: * -> *) a e.
Applicative m =>
(a -> Bool) -> (a -> e) -> Patch a -> CheckPatch e m a
testPatch' a -> Bool
p (e -> a -> e
forall a b. a -> b -> a
const e
err) Patch a
fix
infix 7 `testPatch'_`

testPatch :: Functor m => (a -> m Bool) -> (a -> e) -> Patch a -> CheckPatch e m a
testPatch :: (a -> m Bool) -> (a -> e) -> Patch a -> CheckPatch e m a
testPatch p :: a -> m Bool
p onErr :: a -> e
onErr fix :: Patch a
fix = Check (e, Patch a) m a -> CheckPatch e m a
forall e (m :: * -> *) a.
Check (e, Patch a) m a -> CheckPatch e m a
CheckPatch (Check (e, Patch a) m a -> CheckPatch e m a)
-> ((Unvalidated a -> m (CheckResult (e, Patch a)))
    -> Check (e, Patch a) m a)
-> (Unvalidated a -> m (CheckResult (e, Patch a)))
-> CheckPatch e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unvalidated a -> m (CheckResult (e, Patch a)))
-> Check (e, Patch a) m a
forall e (m :: * -> *) a.
(Unvalidated a -> m (CheckResult e)) -> Check e m a
Check ((Unvalidated a -> m (CheckResult (e, Patch a)))
 -> CheckPatch e m a)
-> (Unvalidated a -> m (CheckResult (e, Patch a)))
-> CheckPatch e m a
forall a b. (a -> b) -> a -> b
$ \x :: Unvalidated a
x -> a -> m Bool
p (Unvalidated a -> a
forall a. Unvalidated a -> a
unsafeValidate Unvalidated a
x) m Bool
-> (Bool -> CheckResult (e, Patch a))
-> m (CheckResult (e, Patch a))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    True  -> CheckResult (e, Patch a)
forall e. CheckResult e
Passed
    False -> (e, Patch a) -> CheckResult (e, Patch a)
forall e. e -> CheckResult e
failsWith (a -> e
onErr (a -> e) -> (Unvalidated a -> a) -> Unvalidated a -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unvalidated a -> a
forall a. Unvalidated a -> a
unsafeValidate (Unvalidated a -> e) -> Unvalidated a -> e
forall a b. (a -> b) -> a -> b
$ Unvalidated a
x, Patch a
fix)
infix 7 `testPatch`

{-# INLINE testPatch_ #-}
testPatch_ :: Monad m => (a -> m Bool) -> e -> Patch a  -> CheckPatch e m a
testPatch_ :: (a -> m Bool) -> e -> Patch a -> CheckPatch e m a
testPatch_ p :: a -> m Bool
p err :: e
err fix :: Patch a
fix = (a -> m Bool) -> (a -> e) -> Patch a -> CheckPatch e m a
forall (m :: * -> *) a e.
Functor m =>
(a -> m Bool) -> (a -> e) -> Patch a -> CheckPatch e m a
testPatch a -> m Bool
p (e -> a -> e
forall a b. a -> b -> a
const e
err) Patch a
fix
infix 7 `testPatch_`




-- | Patch by replacing with default value
testPatchDefault :: Applicative m => (a -> m Bool) -> (a -> e) -> a -> CheckPatch e m a
testPatchDefault :: (a -> m Bool) -> (a -> e) -> a -> CheckPatch e m a
testPatchDefault p :: a -> m Bool
p err :: a -> e
err def :: a
def = (a -> m Bool) -> (a -> e) -> Patch a -> CheckPatch e m a
forall (m :: * -> *) a e.
Functor m =>
(a -> m Bool) -> (a -> e) -> Patch a -> CheckPatch e m a
testPatch a -> m Bool
p a -> e
err ((a -> Maybe a) -> Patch a
forall a. (a -> Maybe a) -> Patch a
Patch ((a -> Maybe a) -> Patch a) -> (a -> Maybe a) -> Patch a
forall a b. (a -> b) -> a -> b
$ Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const (Maybe a -> a -> Maybe a) -> Maybe a -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
def)



-- * Multi-'CheckPatch'es
-- $multiCheckPatch

-- | A "Multi"-'CheckPatch' for an ADT, one 'CheckPatch e m' for each field of each constructor, organized in Lists (see examples for construction)
type MultiCheckPatch e m a =  NP (NP (CheckPatch e m)) (Code a)




-- | Combine all 'CheckPatch's from a 'MultiCheckPatch' into a single 'CheckPatch' for the datatype 'a' (given it has a 'Generic' instance).
joinMultiCheckPatch :: forall a m e. (Applicative m, SOP.Generic a)
                                  => MultiCheckPatch e m a
                                  -> CheckPatch e m a
joinMultiCheckPatch :: MultiCheckPatch e m a -> CheckPatch e m a
joinMultiCheckPatch = Lens' a (SOP I (Code a))
-> CheckPatch e m (SOP I (Code a)) -> CheckPatch e m a
forall (m :: * -> *) s a e.
Functor m =>
Lens' s a -> CheckPatch e m a -> CheckPatch e m s
contramapL Lens' a (SOP I (Code a))
forall (f :: * -> *) a. (Functor f, Generic a) => Optic f a (Rep a)
sopLensTo (CheckPatch e m (SOP I (Code a)) -> CheckPatch e m a)
-> (MultiCheckPatch e m a -> CheckPatch e m (SOP I (Code a)))
-> MultiCheckPatch e m a
-> CheckPatch e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiCheckPatch e m a -> CheckPatch e m (SOP I (Code a))
forall e (m :: * -> *) (xss :: [[*]]).
Applicative m =>
NP (NP (CheckPatch e m)) xss -> CheckPatch e m (SOP I xss)
joinCheckPatchPOP


-- | Change the error of a 'MultiCheckPatch' using the information about the datatype.
mapErrorsWithInfoPatch :: forall e e' a m. (Functor m, HasDatatypeInfo a) => Proxy a -> (DatatypeName -> ConstructorName -> FieldName -> e -> e') -> MultiCheckPatch e m a -> MultiCheckPatch e' m a
mapErrorsWithInfoPatch :: Proxy a
-> (String -> String -> String -> e -> e')
-> MultiCheckPatch e m a
-> MultiCheckPatch e' m a
mapErrorsWithInfoPatch p :: Proxy a
p f :: String -> String -> String -> e -> e'
f = POP (CheckPatch e' m) (Code a) -> MultiCheckPatch e' m a
forall k (f :: k -> *) (xss :: [[k]]). POP f xss -> NP (NP f) xss
unPOP (POP (CheckPatch e' m) (Code a) -> MultiCheckPatch e' m a)
-> (MultiCheckPatch e m a -> POP (CheckPatch e' m) (Code a))
-> MultiCheckPatch e m a
-> MultiCheckPatch e' m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. K (e -> e') a -> CheckPatch e m a -> CheckPatch e' m a)
-> Prod POP (K (e -> e')) (Code a)
-> POP (CheckPatch e m) (Code a)
-> POP (CheckPatch 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') -> CheckPatch e m a -> CheckPatch e' m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> CheckPatch e m a -> CheckPatch e' m a
mapErrorPatch ((e -> e') -> CheckPatch e m a -> CheckPatch e' m a)
-> (K (e -> e') a -> e -> e')
-> K (e -> e') a
-> CheckPatch e m a
-> CheckPatch 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 (CheckPatch e m) (Code a) -> POP (CheckPatch e' m) (Code a))
-> (MultiCheckPatch e m a -> POP (CheckPatch e m) (Code a))
-> MultiCheckPatch e m a
-> POP (CheckPatch e' m) (Code a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiCheckPatch e m a -> POP (CheckPatch e m) (Code a)
forall k (f :: k -> *) (xss :: [[k]]). NP (NP f) xss -> POP f xss
POP



constructorCheckPatch :: forall a m e xs. (Applicative m, Generic a)
                                              => (NP (CheckPatch e m) xs -> NS (NP (CheckPatch e m)) (Code a)) -- ^ The function deciding the constructor, 'Z' for the zeroth, 'S . Z' for the first, etc.
                                              -> NP (CheckPatch e m) xs -- ^ Product of 'CheckPatches', one for each constructor
                                              -> CheckPatch e m a
constructorCheckPatch :: (NP (CheckPatch e m) xs -> NS (NP (CheckPatch e m)) (Code a))
-> NP (CheckPatch e m) xs -> CheckPatch e m a
constructorCheckPatch f :: NP (CheckPatch e m) xs -> NS (NP (CheckPatch e m)) (Code a)
f = Lens' a (SOP I (Code a))
-> CheckPatch e m (SOP I (Code a)) -> CheckPatch e m a
forall (m :: * -> *) s a e.
Functor m =>
Lens' s a -> CheckPatch e m a -> CheckPatch e m s
contramapL Lens' a (SOP I (Code a))
forall (f :: * -> *) a. (Functor f, Generic a) => Optic f a (Rep a)
sopLensTo (CheckPatch e m (SOP I (Code a)) -> CheckPatch e m a)
-> (NP (CheckPatch e m) xs -> CheckPatch e m (SOP I (Code a)))
-> NP (CheckPatch e m) xs
-> CheckPatch e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  NP (NP (CheckPatch e m)) (Code a)
-> CheckPatch e m (SOP I (Code a))
forall e (m :: * -> *) (xss :: [[*]]).
Applicative m =>
NP (NP (CheckPatch e m)) xss -> CheckPatch e m (SOP I xss)
joinCheckPatchPOP (NP (NP (CheckPatch e m)) (Code a)
 -> CheckPatch e m (SOP I (Code a)))
-> (NP (CheckPatch e m) xs -> NP (NP (CheckPatch e m)) (Code a))
-> NP (CheckPatch e m) xs
-> CheckPatch e m (SOP I (Code a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SListI
-> (forall (x :: [*]). SListI x => NP (CheckPatch e m) x)
-> NS (NP (CheckPatch e m)) (Code a)
-> Prod NS (NP (CheckPatch 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. CheckPatch e m a) -> NP (CheckPatch 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. CheckPatch e m a
forall a. Monoid a => a
mempty) (NS (NP (CheckPatch e m)) (Code a)
 -> NP (NP (CheckPatch e m)) (Code a))
-> (NP (CheckPatch e m) xs -> NS (NP (CheckPatch e m)) (Code a))
-> NP (CheckPatch e m) xs
-> NP (NP (CheckPatch e m)) (Code a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP (CheckPatch e m) xs -> NS (NP (CheckPatch e m)) (Code a)
f


-- internal functions

joinCheckPatchPOP :: forall e m xss. (Applicative m)
                       => NP (NP (CheckPatch e m)) xss
                       -> CheckPatch e m (SOP I xss)
joinCheckPatchPOP :: NP (NP (CheckPatch e m)) xss -> CheckPatch e m (SOP I xss)
joinCheckPatchPOP Nil = CheckPatch e m (SOP I xss)
forall a. Monoid a => a
mempty
joinCheckPatchPOP (ps :: NP (CheckPatch e m) x
ps :* pss :: NP (NP (CheckPatch e m)) xs
pss) = Check (e, Patch (SOP I xss)) m (SOP I xss)
-> CheckPatch e m (SOP I xss)
forall e (m :: * -> *) a.
Check (e, Patch a) m a -> CheckPatch e m a
CheckPatch (Check (e, Patch (SOP I xss)) m (SOP I xss)
 -> CheckPatch e m (SOP I xss))
-> ((Unvalidated (SOP I xss)
     -> m (CheckResult (e, Patch (SOP I xss))))
    -> Check (e, Patch (SOP I xss)) m (SOP I xss))
-> (Unvalidated (SOP I xss)
    -> m (CheckResult (e, Patch (SOP I xss))))
-> CheckPatch e m (SOP I xss)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unvalidated (SOP I xss) -> m (CheckResult (e, Patch (SOP I xss))))
-> Check (e, Patch (SOP I xss)) m (SOP I xss)
forall e (m :: * -> *) a.
(Unvalidated a -> m (CheckResult e)) -> Check e m a
Check ((Unvalidated (SOP I xss)
  -> m (CheckResult (e, Patch (SOP I xss))))
 -> CheckPatch e m (SOP I xss))
-> (Unvalidated (SOP I xss)
    -> m (CheckResult (e, Patch (SOP I xss))))
-> CheckPatch e m (SOP I xss)
forall a b. (a -> b) -> a -> b
$ \uxss :: Unvalidated (SOP I xss)
uxss -> case SOP I xss -> NS (NP I) xss
forall k (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
unSOP (SOP I xss -> NS (NP I) xss) -> SOP I xss -> NS (NP I) xss
forall a b. (a -> b) -> a -> b
$ Unvalidated (SOP I xss) -> SOP I xss
forall a. Unvalidated a -> a
unsafeValidate Unvalidated (SOP I xss)
uxss of
  Z xs :: NP I x
xs -> ((NP I x -> Maybe (NP I x))
 -> SOP I (x : xs) -> Maybe (SOP I (x : xs)))
-> m (CheckResult (e, Patch (NP I x)))
-> m (CheckResult (e, Patch (SOP I (x : xs))))
forall (m :: * -> *) a b e.
Functor m =>
((a -> Maybe a) -> b -> Maybe b)
-> m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch b))
changePatch (\p :: NP I x -> Maybe (NP I x)
p -> (NS (NP I) (x : xs) -> SOP I (x : xs))
-> Maybe (NS (NP I) (x : xs)) -> Maybe (SOP I (x : xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NS (NP I) (x : xs) -> SOP I (x : xs)
forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP (Maybe (NS (NP I) (x : xs)) -> Maybe (SOP I (x : xs)))
-> (SOP I (x : xs) -> Maybe (NS (NP I) (x : xs)))
-> SOP I (x : xs)
-> Maybe (SOP I (x : xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic Maybe (NS (NP I) (x : xs)) (NP I x)
forall k (g :: k -> *) (x :: k) (xs :: [k]).
T' (NS g (x : xs)) (g x)
tZ NP I x -> Maybe (NP I x)
p (NS (NP I) (x : xs) -> Maybe (NS (NP I) (x : xs)))
-> (SOP I (x : xs) -> NS (NP I) (x : xs))
-> SOP I (x : xs)
-> Maybe (NS (NP I) (x : xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOP I (x : xs) -> NS (NP I) (x : xs)
forall k (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
unSOP) (m (CheckResult (e, Patch (NP I x)))
 -> m (CheckResult (e, Patch (SOP I xss))))
-> m (CheckResult (e, Patch (NP I x)))
-> m (CheckResult (e, Patch (SOP I xss)))
forall a b. (a -> b) -> a -> b
$ CheckPatch e m (NP I x)
-> Unvalidated (NP I x) -> m (CheckResult (e, Patch (NP I x)))
forall e (m :: * -> *) a.
CheckPatch e m a -> Unvalidated a -> m (CheckResult (e, Patch a))
runCheckPatch (NP (CheckPatch e m) x -> CheckPatch e m (NP I x)
forall e (m :: * -> *) (xs :: [*]).
Applicative m =>
NP (CheckPatch e m) xs -> CheckPatch e m (NP I xs)
joinCheckPatchNP NP (CheckPatch e m) x
ps) (NP I x -> Unvalidated (NP I x)
forall a. a -> Unvalidated a
unvalidated NP I x
xs)
  S xss :: NS (NP I) xs
xss -> ((SOP I xs -> Maybe (SOP I xs))
 -> SOP I (x : xs) -> Maybe (SOP I (x : xs)))
-> m (CheckResult (e, Patch (SOP I xs)))
-> m (CheckResult (e, Patch (SOP I (x : xs))))
forall (m :: * -> *) a b e.
Functor m =>
((a -> Maybe a) -> b -> Maybe b)
-> m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch b))
changePatch (\p :: SOP I xs -> Maybe (SOP I xs)
p -> (NS (NP I) (x : xs) -> SOP I (x : xs))
-> Maybe (NS (NP I) (x : xs)) -> Maybe (SOP I (x : xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NS (NP I) (x : xs) -> SOP I (x : xs)
forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP (Maybe (NS (NP I) (x : xs)) -> Maybe (SOP I (x : xs)))
-> (SOP I (x : xs) -> Maybe (NS (NP I) (x : xs)))
-> SOP I (x : xs)
-> Maybe (SOP I (x : xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic Maybe (NS (NP I) (x : xs)) (NS (NP I) xs)
forall k (g :: k -> *) (x :: k) (xs :: [k]).
T' (NS g (x : xs)) (NS g xs)
tS ((SOP I xs -> NS (NP I) xs)
-> Maybe (SOP I xs) -> Maybe (NS (NP I) xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SOP I xs -> NS (NP I) xs
forall k (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
unSOP (Maybe (SOP I xs) -> Maybe (NS (NP I) xs))
-> (NS (NP I) xs -> Maybe (SOP I xs))
-> NS (NP I) xs
-> Maybe (NS (NP I) xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOP I xs -> Maybe (SOP I xs)
p (SOP I xs -> Maybe (SOP I xs))
-> (NS (NP I) xs -> SOP I xs) -> NS (NP I) xs -> Maybe (SOP I xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (NP I) xs -> SOP I xs
forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP) (NS (NP I) (x : xs) -> Maybe (NS (NP I) (x : xs)))
-> (SOP I (x : xs) -> NS (NP I) (x : xs))
-> SOP I (x : xs)
-> Maybe (NS (NP I) (x : xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOP I (x : xs) -> NS (NP I) (x : xs)
forall k (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
unSOP)
                (m (CheckResult (e, Patch (SOP I xs)))
 -> m (CheckResult (e, Patch (SOP I xss))))
-> m (CheckResult (e, Patch (SOP I xs)))
-> m (CheckResult (e, Patch (SOP I xss)))
forall a b. (a -> b) -> a -> b
$ CheckPatch e m (SOP I xs)
-> Unvalidated (SOP I xs) -> m (CheckResult (e, Patch (SOP I xs)))
forall e (m :: * -> *) a.
CheckPatch e m a -> Unvalidated a -> m (CheckResult (e, Patch a))
runCheckPatch (NP (NP (CheckPatch e m)) xs -> CheckPatch e m (SOP I xs)
forall e (m :: * -> *) (xss :: [[*]]).
Applicative m =>
NP (NP (CheckPatch e m)) xss -> CheckPatch e m (SOP I xss)
joinCheckPatchPOP NP (NP (CheckPatch e m)) xs
pss) (SOP I xs -> Unvalidated (SOP I xs)
forall a. a -> Unvalidated a
unvalidated (SOP I xs -> Unvalidated (SOP I xs))
-> SOP I xs -> Unvalidated (SOP I xs)
forall a b. (a -> b) -> a -> b
$ NS (NP I) xs -> SOP I xs
forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP NS (NP I) xs
xss)


joinCheckPatchNP :: forall e m xs. (Applicative m) => NP (CheckPatch e m) xs -> CheckPatch e m (NP I xs)
joinCheckPatchNP :: NP (CheckPatch e m) xs -> CheckPatch e m (NP I xs)
joinCheckPatchNP Nil = CheckPatch e m (NP I xs)
forall a. Monoid a => a
mempty
joinCheckPatchNP (p :: CheckPatch e m x
p :* ps :: NP (CheckPatch e m) xs
ps) =
  Check (e, Patch (NP I (x : xs))) m (NP I (x : xs))
-> CheckPatch e m (NP I xs)
forall e (m :: * -> *) a.
Check (e, Patch a) m a -> CheckPatch e m a
CheckPatch (Check (e, Patch (NP I (x : xs))) m (NP I (x : xs))
 -> CheckPatch e m (NP I xs))
-> Check (e, Patch (NP I (x : xs))) m (NP I (x : xs))
-> CheckPatch e m (NP I xs)
forall a b. (a -> b) -> a -> b
$ (Unvalidated (NP I (x : xs))
 -> m (CheckResult (e, Patch (NP I (x : xs)))))
-> Check (e, Patch (NP I (x : xs))) m (NP I (x : xs))
forall e (m :: * -> *) a.
(Unvalidated a -> m (CheckResult e)) -> Check e m a
Check ((Unvalidated (NP I (x : xs))
  -> m (CheckResult (e, Patch (NP I (x : xs)))))
 -> Check (e, Patch (NP I (x : xs))) m (NP I (x : xs)))
-> (Unvalidated (NP I (x : xs))
    -> m (CheckResult (e, Patch (NP I (x : xs)))))
-> Check (e, Patch (NP I (x : xs))) m (NP I (x : xs))
forall a b. (a -> b) -> a -> b
$ \uxs :: Unvalidated (NP I (x : xs))
uxs ->
    let h :: m (CheckResult (e, Patch (NP I (x : xs))))
h = ((x -> Maybe x) -> NP I (x : xs) -> Maybe (NP I (x : xs)))
-> m (CheckResult (e, Patch x))
-> m (CheckResult (e, Patch (NP I (x : xs))))
forall (m :: * -> *) a b e.
Functor m =>
((a -> Maybe a) -> b -> Maybe b)
-> m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch b))
changePatch (Optic Maybe (NP I (x : xs)) (I x)
forall k (g :: k -> *) (x :: k) (xs :: [k]).
T' (NP g (x : xs)) (g x)
tH Optic Maybe (NP I (x : xs)) (I x)
-> ((x -> Maybe x) -> I x -> Maybe (I x))
-> (x -> Maybe x)
-> NP I (x : xs)
-> Maybe (NP I (x : xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> Maybe x) -> I x -> Maybe (I x)
forall a. T' (I a) a
tI) (m (CheckResult (e, Patch x))
 -> m (CheckResult (e, Patch (NP I (x : xs)))))
-> m (CheckResult (e, Patch x))
-> m (CheckResult (e, Patch (NP I (x : xs))))
forall a b. (a -> b) -> a -> b
$ CheckPatch e m x -> Unvalidated x -> m (CheckResult (e, Patch x))
forall e (m :: * -> *) a.
CheckPatch e m a -> Unvalidated a -> m (CheckResult (e, Patch a))
runCheckPatch CheckPatch e m x
p
                                    (Unvalidated x -> m (CheckResult (e, Patch x)))
-> (Unvalidated (NP I (x : xs)) -> Unvalidated x)
-> Unvalidated (NP I (x : xs))
-> m (CheckResult (e, Patch x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP I (x : xs) -> x)
-> Unvalidated (NP I (x : xs)) -> Unvalidated x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (I x -> x
forall a. I a -> a
unI (I x -> x) -> (NP I (x : xs) -> I x) -> NP I (x : xs) -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP I (x : xs) -> I x
forall k (f :: k -> *) (x :: k) (xs :: [k]). NP f (x : xs) -> f x
hd)
                                    (Unvalidated (NP I (x : xs)) -> m (CheckResult (e, Patch x)))
-> Unvalidated (NP I (x : xs)) -> m (CheckResult (e, Patch x))
forall a b. (a -> b) -> a -> b
$ Unvalidated (NP I (x : xs))
uxs
        t :: m (CheckResult (e, Patch (NP I (x : xs))))
t = ((NP I xs -> Maybe (NP I xs))
 -> NP I (x : xs) -> Maybe (NP I (x : xs)))
-> m (CheckResult (e, Patch (NP I xs)))
-> m (CheckResult (e, Patch (NP I (x : xs))))
forall (m :: * -> *) a b e.
Functor m =>
((a -> Maybe a) -> b -> Maybe b)
-> m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch b))
changePatch (NP I xs -> Maybe (NP I xs))
-> NP I (x : xs) -> Maybe (NP I (x : xs))
forall k (g :: k -> *) (x :: k) (xs :: [k]).
T' (NP g (x : xs)) (NP g xs)
tT (m (CheckResult (e, Patch (NP I xs)))
 -> m (CheckResult (e, Patch (NP I (x : xs)))))
-> m (CheckResult (e, Patch (NP I xs)))
-> m (CheckResult (e, Patch (NP I (x : xs))))
forall a b. (a -> b) -> a -> b
$ CheckPatch e m (NP I xs)
-> Unvalidated (NP I xs) -> m (CheckResult (e, Patch (NP I xs)))
forall e (m :: * -> *) a.
CheckPatch e m a -> Unvalidated a -> m (CheckResult (e, Patch a))
runCheckPatch (NP (CheckPatch e m) xs -> CheckPatch e m (NP I xs)
forall e (m :: * -> *) (xs :: [*]).
Applicative m =>
NP (CheckPatch e m) xs -> CheckPatch e m (NP I xs)
joinCheckPatchNP NP (CheckPatch e m) xs
ps) (Unvalidated (NP I xs) -> m (CheckResult (e, Patch (NP I xs))))
-> (Unvalidated (NP I (x : xs)) -> Unvalidated (NP I xs))
-> Unvalidated (NP I (x : xs))
-> m (CheckResult (e, Patch (NP I xs)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP I (x : xs) -> NP I xs)
-> Unvalidated (NP I (x : xs)) -> Unvalidated (NP I xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NP I (x : xs) -> NP I xs
forall k (f :: k -> *) (x :: k) (xs :: [k]).
NP f (x : xs) -> NP f xs
tl (Unvalidated (NP I (x : xs))
 -> m (CheckResult (e, Patch (NP I xs))))
-> Unvalidated (NP I (x : xs))
-> m (CheckResult (e, Patch (NP I xs)))
forall a b. (a -> b) -> a -> b
$ Unvalidated (NP I (x : xs))
uxs
    in Ap m (CheckResult (e, Patch (NP I (x : xs))))
-> m (CheckResult (e, Patch (NP I (x : xs))))
forall k (f :: k -> *) (a :: k). Ap f a -> f a
getAp (Ap m (CheckResult (e, Patch (NP I (x : xs))))
 -> m (CheckResult (e, Patch (NP I (x : xs)))))
-> Ap m (CheckResult (e, Patch (NP I (x : xs))))
-> m (CheckResult (e, Patch (NP I (x : xs))))
forall a b. (a -> b) -> a -> b
$ m (CheckResult (e, Patch (NP I (x : xs))))
-> Ap m (CheckResult (e, Patch (NP I (x : xs))))
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap m (CheckResult (e, Patch (NP I (x : xs))))
h Ap m (CheckResult (e, Patch (NP I (x : xs))))
-> Ap m (CheckResult (e, Patch (NP I (x : xs))))
-> Ap m (CheckResult (e, Patch (NP I (x : xs))))
forall a. Semigroup a => a -> a -> a
<> m (CheckResult (e, Patch (NP I (x : xs))))
-> Ap m (CheckResult (e, Patch (NP I (x : xs))))
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap m (CheckResult (e, Patch (NP I (x : xs))))
t



joinCheckPatchNS :: forall e m xs. Applicative m =>  NP (CheckPatch e m) xs -> CheckPatch e m (NS I xs)
joinCheckPatchNS :: NP (CheckPatch e m) xs -> CheckPatch e m (NS I xs)
joinCheckPatchNS Nil = CheckPatch e m (NS I xs)
forall a. Monoid a => a
mempty
joinCheckPatchNS (p :: CheckPatch e m x
p :* ps :: NP (CheckPatch e m) xs
ps) = Check (e, Patch (NS I xs)) m (NS I xs) -> CheckPatch e m (NS I xs)
forall e (m :: * -> *) a.
Check (e, Patch a) m a -> CheckPatch e m a
CheckPatch (Check (e, Patch (NS I xs)) m (NS I xs)
 -> CheckPatch e m (NS I xs))
-> Check (e, Patch (NS I xs)) m (NS I xs)
-> CheckPatch e m (NS I xs)
forall a b. (a -> b) -> a -> b
$ (Unvalidated (NS I xs) -> m (CheckResult (e, Patch (NS I xs))))
-> Check (e, Patch (NS I xs)) m (NS I xs)
forall e (m :: * -> *) a.
(Unvalidated a -> m (CheckResult e)) -> Check e m a
Check ((Unvalidated (NS I xs) -> m (CheckResult (e, Patch (NS I xs))))
 -> Check (e, Patch (NS I xs)) m (NS I xs))
-> (Unvalidated (NS I xs) -> m (CheckResult (e, Patch (NS I xs))))
-> Check (e, Patch (NS I xs)) m (NS I xs)
forall a b. (a -> b) -> a -> b
$ \uxs :: Unvalidated (NS I xs)
uxs -> case Unvalidated (NS I xs) -> NS I xs
forall a. Unvalidated a -> a
unsafeValidate Unvalidated (NS I xs)
uxs of
  Z (I x) -> ((x -> Maybe x) -> NS I (x : xs) -> Maybe (NS I (x : xs)))
-> m (CheckResult (e, Patch x))
-> m (CheckResult (e, Patch (NS I (x : xs))))
forall (m :: * -> *) a b e.
Functor m =>
((a -> Maybe a) -> b -> Maybe b)
-> m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch b))
changePatch (Optic Maybe (NS I (x : xs)) (I x)
forall k (g :: k -> *) (x :: k) (xs :: [k]).
T' (NS g (x : xs)) (g x)
tZ Optic Maybe (NS I (x : xs)) (I x)
-> ((x -> Maybe x) -> I x -> Maybe (I x))
-> (x -> Maybe x)
-> NS I (x : xs)
-> Maybe (NS I (x : xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> Maybe x) -> I x -> Maybe (I x)
forall a. T' (I a) a
tI) (m (CheckResult (e, Patch x))
 -> m (CheckResult (e, Patch (NS I xs))))
-> m (CheckResult (e, Patch x))
-> m (CheckResult (e, Patch (NS I xs)))
forall a b. (a -> b) -> a -> b
$  CheckPatch e m x -> Unvalidated x -> m (CheckResult (e, Patch x))
forall e (m :: * -> *) a.
CheckPatch e m a -> Unvalidated a -> m (CheckResult (e, Patch a))
runCheckPatch CheckPatch e m x
p (Unvalidated x -> m (CheckResult (e, Patch x)))
-> (x -> Unvalidated x) -> x -> m (CheckResult (e, Patch x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Unvalidated x
forall a. a -> Unvalidated a
unvalidated (x -> m (CheckResult (e, Patch x)))
-> x -> m (CheckResult (e, Patch x))
forall a b. (a -> b) -> a -> b
$ x
x
  S t :: NS I xs
t     -> ((NS I xs -> Maybe (NS I xs))
 -> NS I (x : xs) -> Maybe (NS I (x : xs)))
-> m (CheckResult (e, Patch (NS I xs)))
-> m (CheckResult (e, Patch (NS I (x : xs))))
forall (m :: * -> *) a b e.
Functor m =>
((a -> Maybe a) -> b -> Maybe b)
-> m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch b))
changePatch (NS I xs -> Maybe (NS I xs))
-> NS I (x : xs) -> Maybe (NS I (x : xs))
forall k (g :: k -> *) (x :: k) (xs :: [k]).
T' (NS g (x : xs)) (NS g xs)
tS (m (CheckResult (e, Patch (NS I xs)))
 -> m (CheckResult (e, Patch (NS I (x : xs)))))
-> (NS I xs -> m (CheckResult (e, Patch (NS I xs))))
-> NS I xs
-> m (CheckResult (e, Patch (NS I (x : xs))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckPatch e m (NS I xs)
-> Unvalidated (NS I xs) -> m (CheckResult (e, Patch (NS I xs)))
forall e (m :: * -> *) a.
CheckPatch e m a -> Unvalidated a -> m (CheckResult (e, Patch a))
runCheckPatch (NP (CheckPatch e m) xs -> CheckPatch e m (NS I xs)
forall e (m :: * -> *) (xs :: [*]).
Applicative m =>
NP (CheckPatch e m) xs -> CheckPatch e m (NS I xs)
joinCheckPatchNS NP (CheckPatch e m) xs
ps) (Unvalidated (NS I xs) -> m (CheckResult (e, Patch (NS I xs))))
-> (NS I xs -> Unvalidated (NS I xs))
-> NS I xs
-> m (CheckResult (e, Patch (NS I xs)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS I xs -> Unvalidated (NS I xs)
forall a. a -> Unvalidated a
unvalidated (NS I xs -> m (CheckResult (e, Patch (NS I xs))))
-> NS I xs -> m (CheckResult (e, Patch (NS I xs)))
forall a b. (a -> b) -> a -> b
$ NS I xs
NS I xs
t




changePatch :: Functor m => ((a -> Maybe a) -> (b -> Maybe b)) -> m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch b))
changePatch :: ((a -> Maybe a) -> b -> Maybe b)
-> m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch b))
changePatch f :: (a -> Maybe a) -> b -> Maybe b
f = (CheckResult (e, Patch a) -> CheckResult (e, Patch b))
-> m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CheckResult (e, Patch a) -> CheckResult (e, Patch b))
 -> m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch b)))
-> ((Patch a -> Patch b)
    -> CheckResult (e, Patch a) -> CheckResult (e, Patch b))
-> (Patch a -> Patch b)
-> m (CheckResult (e, Patch a))
-> m (CheckResult (e, Patch b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((e, Patch a) -> (e, Patch b))
-> CheckResult (e, Patch a) -> CheckResult (e, Patch b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((e, Patch a) -> (e, Patch b))
 -> CheckResult (e, Patch a) -> CheckResult (e, Patch b))
-> ((Patch a -> Patch b) -> (e, Patch a) -> (e, Patch b))
-> (Patch a -> Patch b)
-> CheckResult (e, Patch a)
-> CheckResult (e, Patch b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Patch a -> Patch b) -> (e, Patch a) -> (e, Patch b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Patch a -> Patch b)
 -> m (CheckResult (e, Patch a)) -> m (CheckResult (e, Patch b)))
-> (Patch a -> Patch b)
-> m (CheckResult (e, Patch a))
-> m (CheckResult (e, Patch b))
forall a b. (a -> b) -> a -> b
$ (b -> Maybe b) -> Patch b
forall a. (a -> Maybe a) -> Patch a
Patch ((b -> Maybe b) -> Patch b)
-> (Patch a -> b -> Maybe b) -> Patch a -> Patch b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a) -> b -> Maybe b
f ((a -> Maybe a) -> b -> Maybe b)
-> (Patch a -> a -> Maybe a) -> Patch a -> b -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Patch a -> a -> Maybe a
forall a. Patch a -> a -> Maybe a
runPatch