{-# LANGUAGE TemplateHaskell #-}
module Control.CollectErrors
(
CollectErrors(..), SuitableForCE
, CanTestErrorsCertain(..), hasCertainErrorCE
, CanTestErrorsPresent(..), hasErrorCE
, noValueCE, prependErrorsCE
, filterValuesWithoutErrorCE, getValueIfNoErrorCE
, ce2ConvertResult
, CanEnsureCE(..)
, getValueOrThrowErrorsNCE
, lift1CE, lift2CE, lift2TCE, lift2TLCE, lift3CE
, CanExtractCE(..)
)
where
import Prelude
(Functor(..), Applicative(..), Monad(..), (<$>), ($), (.)
, error, const, flip, not, fst, snd, foldMap, (++)
, Int, Integer, Rational, Double, Bool, Char
, Maybe(..), Either(..)
, Show(..), Eq(..)
, Traversable(..))
import Text.Printf
import Control.Monad (join)
import Data.Monoid
import Data.Maybe (fromJust)
import Data.Convertible.Base
import Data.Typeable
import Test.QuickCheck
data CollectErrors es v =
CollectErrors
{ CollectErrors es v -> Maybe v
getMaybeValueCE :: Maybe v
, CollectErrors es v -> es
getErrorsCE :: es }
class CanTestErrorsCertain es where
hasCertainError :: es -> Bool
hasCertainErrorCE :: (CanTestErrorsCertain es) => (CollectErrors es v) -> Bool
hasCertainErrorCE :: CollectErrors es v -> Bool
hasCertainErrorCE (CollectErrors Maybe v
_ es
es) = es -> Bool
forall es. CanTestErrorsCertain es => es -> Bool
hasCertainError es
es
class CanTestErrorsPresent es where
hasError :: es -> Bool
hasErrorCE :: (CanTestErrorsPresent es) => (CollectErrors es v) -> Bool
hasErrorCE :: CollectErrors es v -> Bool
hasErrorCE (CollectErrors Maybe v
_ es
es) = es -> Bool
forall es. CanTestErrorsPresent es => es -> Bool
hasError es
es
type SuitableForCE es = (Monoid es, Eq es, Show es, CanTestErrorsCertain es)
instance (Show v, SuitableForCE es) => (Show (CollectErrors es v)) where
show :: CollectErrors es v -> String
show (CollectErrors Maybe v
mv es
es) =
case Maybe v
mv of
Just v
v | es
es es -> es -> Bool
forall a. Eq a => a -> a -> Bool
== es
forall a. Monoid a => a
mempty -> v -> String
forall a. Show a => a -> String
show v
v
Just v
v -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%s{%s}" (v -> String
forall a. Show a => a -> String
show v
v) (es -> String
forall a. Show a => a -> String
show es
es)
Maybe v
Nothing -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"{%s}" (es -> String
forall a. Show a => a -> String
show es
es)
noValueCE :: es -> CollectErrors es v
noValueCE :: es -> CollectErrors es v
noValueCE es
es = Maybe v -> es -> CollectErrors es v
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe v
forall a. Maybe a
Nothing es
es
prependErrorsCE :: (Monoid es) => es -> CollectErrors es v -> CollectErrors es v
prependErrorsCE :: es -> CollectErrors es v -> CollectErrors es v
prependErrorsCE es
es1 (CollectErrors Maybe v
mv es
es2) = Maybe v -> es -> CollectErrors es v
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe v
mv (es
es1 es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
es2)
ce2ConvertResult ::
(Typeable t, Show t, SuitableForCE es)
=>
CollectErrors es t -> Either ConvertError t
ce2ConvertResult :: CollectErrors es t -> Either ConvertError t
ce2ConvertResult (CollectErrors Maybe t
mv es
es) =
case Maybe t
mv of
Just t
v | es
es es -> es -> Bool
forall a. Eq a => a -> a -> Bool
== es
forall a. Monoid a => a
mempty -> t -> Either ConvertError t
forall a b. b -> Either a b
Right t
v
Maybe t
_ -> String -> Maybe t -> Either ConvertError t
forall a b.
(Show a, Typeable a, Typeable b) =>
String -> a -> ConvertResult b
convError (es -> String
forall a. Show a => a -> String
show es
es) Maybe t
mv
getValueIfNoErrorCE ::
(SuitableForCE es)
=>
CollectErrors es v -> (v -> t) -> (es -> t) -> t
getValueIfNoErrorCE :: CollectErrors es v -> (v -> t) -> (es -> t) -> t
getValueIfNoErrorCE (CollectErrors Maybe v
mv es
es) v -> t
withValue es -> t
withErrors =
case Maybe v
mv of
Just v
v | es
es es -> es -> Bool
forall a. Eq a => a -> a -> Bool
== es
forall a. Monoid a => a
mempty -> v -> t
withValue v
v
Maybe v
_ -> es -> t
withErrors es
es
filterValuesWithoutErrorCE ::
(SuitableForCE es)
=>
[CollectErrors es v] -> [v]
filterValuesWithoutErrorCE :: [CollectErrors es v] -> [v]
filterValuesWithoutErrorCE [] = []
filterValuesWithoutErrorCE (CollectErrors es v
vCE : [CollectErrors es v]
rest) =
CollectErrors es v -> (v -> [v]) -> (es -> [v]) -> [v]
forall es v t.
SuitableForCE es =>
CollectErrors es v -> (v -> t) -> (es -> t) -> t
getValueIfNoErrorCE CollectErrors es v
vCE (v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
restDone) ([v] -> es -> [v]
forall a b. a -> b -> a
const [v]
restDone)
where
restDone :: [v]
restDone = [CollectErrors es v] -> [v]
forall es v. SuitableForCE es => [CollectErrors es v] -> [v]
filterValuesWithoutErrorCE [CollectErrors es v]
rest
instance Functor (CollectErrors es) where
fmap :: (a -> b) -> CollectErrors es a -> CollectErrors es b
fmap a -> b
f (CollectErrors Maybe a
mv es
es) =
Maybe b -> es -> CollectErrors es b
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
mv) es
es
instance (Monoid es) => Applicative (CollectErrors es) where
pure :: a -> CollectErrors es a
pure a
v = Maybe a -> es -> CollectErrors es a
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (a -> Maybe a
forall a. a -> Maybe a
Just a
v) es
forall a. Monoid a => a
mempty
(CollectErrors (Just a -> b
a) es
ae) <*> :: CollectErrors es (a -> b)
-> CollectErrors es a -> CollectErrors es b
<*> (CollectErrors (Just a
b) es
be) =
Maybe b -> es -> CollectErrors es b
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (b -> Maybe b
forall a. a -> Maybe a
Just (a -> b
a a
b)) (es
ae es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
be)
(CollectErrors Maybe (a -> b)
_ es
ae) <*> (CollectErrors Maybe a
_ es
be) =
Maybe b -> es -> CollectErrors es b
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe b
forall a. Maybe a
Nothing (es
ae es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
be)
instance (Monoid es) => Monad (CollectErrors es) where
CollectErrors es a
ae >>= :: CollectErrors es a
-> (a -> CollectErrors es b) -> CollectErrors es b
>>= a -> CollectErrors es b
f =
case CollectErrors es a
ae of
CollectErrors (Just a
a) es
es1 ->
let (CollectErrors Maybe b
mv es
es2) = a -> CollectErrors es b
f a
a in
Maybe b -> es -> CollectErrors es b
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe b
mv (es
es1 es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
es2)
CollectErrors Maybe a
_ es
es ->
Maybe b -> es -> CollectErrors es b
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe b
forall a. Maybe a
Nothing es
es
instance (Arbitrary t, Monoid es) => Arbitrary (CollectErrors es t) where
arbitrary :: Gen (CollectErrors es t)
arbitrary = (\t
v -> Maybe t -> es -> CollectErrors es t
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (t -> Maybe t
forall a. a -> Maybe a
Just t
v) es
forall a. Monoid a => a
mempty) (t -> CollectErrors es t) -> Gen t -> Gen (CollectErrors es t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen t
forall a. Arbitrary a => Gen a
arbitrary
class
(Monoid es
, EnsureCE es (EnsureCE es a) ~ EnsureCE es a
, EnsureCE es (EnsureNoCE es a) ~ EnsureCE es a
, EnsureNoCE es (EnsureCE es a) ~ EnsureNoCE es a
, EnsureNoCE es (EnsureNoCE es a) ~ EnsureNoCE es a)
=>
CanEnsureCE es a where
type EnsureCE es a
type EnsureCE es a = CollectErrors es a
type EnsureNoCE es a
type EnsureNoCE es a = a
ensureCE ::
Maybe es ->
a -> EnsureCE es a
default ensureCE ::
(EnsureCE es a ~ CollectErrors es a)
=>
Maybe es ->
a -> EnsureCE es a
ensureCE Maybe es
_ = a -> EnsureCE es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
deEnsureCE ::
Maybe es ->
EnsureCE es a -> Either es a
default deEnsureCE ::
(EnsureCE es a ~ CollectErrors es a, Eq es) =>
Maybe es ->
EnsureCE es a -> Either es a
deEnsureCE Maybe es
_ (CollectErrors mv es) =
case Maybe a
mv of
Just a
v | es
es es -> es -> Bool
forall a. Eq a => a -> a -> Bool
== es
forall a. Monoid a => a
mempty -> a -> Either es a
forall a b. b -> Either a b
Right a
v
Maybe a
_ -> es -> Either es a
forall a b. a -> Either a b
Left es
es
ensureNoCE ::
Maybe es ->
a -> (Maybe (EnsureNoCE es a), es)
default ensureNoCE ::
(EnsureNoCE es a ~ a, Eq es, Monoid es) =>
Maybe es ->
a -> (Maybe (EnsureNoCE es a), es)
ensureNoCE Maybe es
_ a
a = (a -> Maybe a
forall a. a -> Maybe a
Just a
a, es
forall a. Monoid a => a
mempty)
noValueECE ::
Maybe a ->
es -> EnsureCE es a
default noValueECE ::
(EnsureCE es a ~ CollectErrors es a)
=>
Maybe a ->
es -> EnsureCE es a
noValueECE Maybe a
_ = es -> EnsureCE es a
forall es v. es -> CollectErrors es v
noValueCE
prependErrorsECE ::
Maybe a ->
es -> EnsureCE es a -> EnsureCE es a
default prependErrorsECE ::
(EnsureCE es a ~ CollectErrors es a)
=>
Maybe a ->
es -> EnsureCE es a -> EnsureCE es a
prependErrorsECE Maybe a
_ = es -> EnsureCE es a -> EnsureCE es a
forall es v.
Monoid es =>
es -> CollectErrors es v -> CollectErrors es v
prependErrorsCE
instance
(SuitableForCE es, CanEnsureCE es a)
=>
CanEnsureCE es (CollectErrors es a)
where
type EnsureCE es (CollectErrors es a) = EnsureCE es a
type EnsureNoCE es (CollectErrors es a) = EnsureNoCE es a
ensureCE :: Maybe es -> CollectErrors es a -> EnsureCE es (CollectErrors es a)
ensureCE Maybe es
sample_es (CollectErrors Maybe a
mv es
es) =
case Maybe a
mv of
Just a
v -> Maybe a -> es -> EnsureCE es a -> EnsureCE es a
forall es a.
CanEnsureCE es a =>
Maybe a -> es -> EnsureCE es a -> EnsureCE es a
prependErrorsECE (a -> Maybe a
forall a. a -> Maybe a
Just a
v) es
es (EnsureCE es a -> EnsureCE es a) -> EnsureCE es a -> EnsureCE es a
forall a b. (a -> b) -> a -> b
$ Maybe es -> a -> EnsureCE es a
forall es a. CanEnsureCE es a => Maybe es -> a -> EnsureCE es a
ensureCE Maybe es
sample_es a
v
Maybe a
_ -> Maybe a -> es -> EnsureCE es a
forall es a. CanEnsureCE es a => Maybe a -> es -> EnsureCE es a
noValueECE Maybe a
mv es
es
deEnsureCE :: Maybe es
-> EnsureCE es (CollectErrors es a)
-> Either es (CollectErrors es a)
deEnsureCE Maybe es
sample_es EnsureCE es (CollectErrors es a)
vCE =
case Maybe es -> EnsureCE es a -> Either es a
forall es a.
CanEnsureCE es a =>
Maybe es -> EnsureCE es a -> Either es a
deEnsureCE Maybe es
sample_es EnsureCE es a
EnsureCE es (CollectErrors es a)
vCE of
Right a
v -> CollectErrors es a -> Either es (CollectErrors es a)
forall a b. b -> Either a b
Right (CollectErrors es a -> Either es (CollectErrors es a))
-> CollectErrors es a -> Either es (CollectErrors es a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> es -> CollectErrors es a
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (a -> Maybe a
forall a. a -> Maybe a
Just a
v) es
forall a. Monoid a => a
mempty
Left es
es -> es -> Either es (CollectErrors es a)
forall a b. a -> Either a b
Left es
es
ensureNoCE :: Maybe es
-> CollectErrors es a
-> (Maybe (EnsureNoCE es (CollectErrors es a)), es)
ensureNoCE Maybe es
sample_es (CollectErrors Maybe a
mv es
es) =
case (a -> (Maybe (EnsureNoCE es a), es))
-> Maybe a -> Maybe (Maybe (EnsureNoCE es a), es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe es -> a -> (Maybe (EnsureNoCE es a), es)
forall es a.
CanEnsureCE es a =>
Maybe es -> a -> (Maybe (EnsureNoCE es a), es)
ensureNoCE Maybe es
sample_es) Maybe a
mv of
Just (Just EnsureNoCE es a
v, es
es2) -> (EnsureNoCE es a -> Maybe (EnsureNoCE es a)
forall a. a -> Maybe a
Just EnsureNoCE es a
v, es
es2 es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
es)
Just (Maybe (EnsureNoCE es a)
_, es
es2) -> (Maybe (EnsureNoCE es (CollectErrors es a))
forall a. Maybe a
Nothing, es
es2 es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
es)
Maybe (Maybe (EnsureNoCE es a), es)
_ -> (Maybe (EnsureNoCE es (CollectErrors es a))
forall a. Maybe a
Nothing, es
forall a. Monoid a => a
mempty)
noValueECE :: Maybe (CollectErrors es a)
-> es -> EnsureCE es (CollectErrors es a)
noValueECE Maybe (CollectErrors es a)
sample_vCE es
es =
Maybe a -> es -> EnsureCE es a
forall es a. CanEnsureCE es a => Maybe a -> es -> EnsureCE es a
noValueECE (Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> Maybe a) -> Maybe (Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$ (CollectErrors es a -> Maybe a)
-> Maybe (CollectErrors es a) -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CollectErrors es a -> Maybe a
forall es v. CollectErrors es v -> Maybe v
getMaybeValueCE Maybe (CollectErrors es a)
sample_vCE) es
es
prependErrorsECE :: Maybe (CollectErrors es a)
-> es
-> EnsureCE es (CollectErrors es a)
-> EnsureCE es (CollectErrors es a)
prependErrorsECE Maybe (CollectErrors es a)
sample_vCE =
Maybe a -> es -> EnsureCE es a -> EnsureCE es a
forall es a.
CanEnsureCE es a =>
Maybe a -> es -> EnsureCE es a -> EnsureCE es a
prependErrorsECE (Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> Maybe a) -> Maybe (Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$ (CollectErrors es a -> Maybe a)
-> Maybe (CollectErrors es a) -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CollectErrors es a -> Maybe a
forall es v. CollectErrors es v -> Maybe v
getMaybeValueCE Maybe (CollectErrors es a)
sample_vCE)
instance (SuitableForCE es) => CanEnsureCE es Int
instance (SuitableForCE es) => CanEnsureCE es Integer
instance (SuitableForCE es) => CanEnsureCE es Rational
instance (SuitableForCE es) => CanEnsureCE es Double
instance (SuitableForCE es) => CanEnsureCE es Bool
instance (SuitableForCE es) => CanEnsureCE es Char
instance (SuitableForCE es) => CanEnsureCE es ()
instance
(SuitableForCE es, CanEnsureCE es a)
=>
CanEnsureCE es (Maybe a)
where
type EnsureCE es (Maybe a) = Maybe (EnsureCE es a)
type EnsureNoCE es (Maybe a) = Maybe (EnsureNoCE es a)
ensureCE :: Maybe es -> Maybe a -> EnsureCE es (Maybe a)
ensureCE Maybe es
sample_es = (a -> EnsureCE es a) -> Maybe a -> Maybe (EnsureCE es a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe es -> a -> EnsureCE es a
forall es a. CanEnsureCE es a => Maybe es -> a -> EnsureCE es a
ensureCE Maybe es
sample_es)
deEnsureCE :: Maybe es -> EnsureCE es (Maybe a) -> Either es (Maybe a)
deEnsureCE Maybe es
sample_es (Just vCE) = (a -> Maybe a) -> Either es a -> Either es (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Maybe es -> EnsureCE es a -> Either es a
forall es a.
CanEnsureCE es a =>
Maybe es -> EnsureCE es a -> Either es a
deEnsureCE Maybe es
sample_es EnsureCE es a
vCE)
deEnsureCE Maybe es
_sample_es EnsureCE es (Maybe a)
Nothing = Maybe a -> Either es (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
ensureNoCE :: Maybe es -> Maybe a -> (Maybe (EnsureNoCE es (Maybe a)), es)
ensureNoCE Maybe es
sample_es (Just a
vCE) =
case Maybe es -> a -> (Maybe (EnsureNoCE es a), es)
forall es a.
CanEnsureCE es a =>
Maybe es -> a -> (Maybe (EnsureNoCE es a), es)
ensureNoCE Maybe es
sample_es a
vCE of
(Just EnsureNoCE es a
v, es
es) -> (Maybe (EnsureNoCE es a) -> Maybe (Maybe (EnsureNoCE es a))
forall a. a -> Maybe a
Just (EnsureNoCE es a -> Maybe (EnsureNoCE es a)
forall a. a -> Maybe a
Just EnsureNoCE es a
v), es
es)
(Maybe (EnsureNoCE es a)
_, es
es) -> (Maybe (EnsureNoCE es (Maybe a))
forall a. Maybe a
Nothing, es
es)
ensureNoCE Maybe es
_sample_es Maybe a
Nothing = (Maybe (EnsureNoCE es (Maybe a))
forall a. Maybe a
Nothing, es
forall a. Monoid a => a
mempty)
noValueECE :: Maybe (Maybe a) -> es -> EnsureCE es (Maybe a)
noValueECE Maybe (Maybe a)
sample_vCE es
es = EnsureCE es a -> Maybe (EnsureCE es a)
forall a. a -> Maybe a
Just (Maybe a -> es -> EnsureCE es a
forall es a. CanEnsureCE es a => Maybe a -> es -> EnsureCE es a
noValueECE (Maybe (Maybe a) -> Maybe a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Maybe a)
sample_vCE) es
es)
prependErrorsECE :: Maybe (Maybe a)
-> es -> EnsureCE es (Maybe a) -> EnsureCE es (Maybe a)
prependErrorsECE Maybe (Maybe a)
sample_vCE es
es (Just vCE) =
EnsureCE es a -> Maybe (EnsureCE es a)
forall a. a -> Maybe a
Just (EnsureCE es a -> Maybe (EnsureCE es a))
-> EnsureCE es a -> Maybe (EnsureCE es a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> es -> EnsureCE es a -> EnsureCE es a
forall es a.
CanEnsureCE es a =>
Maybe a -> es -> EnsureCE es a -> EnsureCE es a
prependErrorsECE (Maybe (Maybe a) -> Maybe a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Maybe a)
sample_vCE) es
es EnsureCE es a
vCE
prependErrorsECE Maybe (Maybe a)
_sample_vCE es
_es EnsureCE es (Maybe a)
Nothing = EnsureCE es (Maybe a)
forall a. Maybe a
Nothing
instance
(SuitableForCE es, CanEnsureCE es a)
=>
CanEnsureCE es (b -> a)
where
type EnsureCE es (b -> a) = b -> (EnsureCE es a)
type EnsureNoCE es (b -> a) = b -> (EnsureNoCE es a)
ensureCE :: Maybe es -> (b -> a) -> EnsureCE es (b -> a)
ensureCE Maybe es
sample_es = ((Maybe es -> a -> EnsureCE es a
forall es a. CanEnsureCE es a => Maybe es -> a -> EnsureCE es a
ensureCE Maybe es
sample_es) (a -> EnsureCE es a) -> (b -> a) -> b -> EnsureCE es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
deEnsureCE :: Maybe es -> EnsureCE es (b -> a) -> Either es (b -> a)
deEnsureCE Maybe es
sample_es EnsureCE es (b -> a)
f =
(b -> a) -> Either es (b -> a)
forall a b. b -> Either a b
Right ((b -> a) -> Either es (b -> a)) -> (b -> a) -> Either es (b -> a)
forall a b. (a -> b) -> a -> b
$ \ b
a ->
case Maybe es -> EnsureCE es a -> Either es a
forall es a.
CanEnsureCE es a =>
Maybe es -> EnsureCE es a -> Either es a
deEnsureCE Maybe es
sample_es (EnsureCE es (b -> a)
b -> EnsureCE es a
f b
a) of
Right a
v -> a
v
Left es
es -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"deEnsureCE for function: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ es -> String
forall a. Show a => a -> String
show es
es
ensureNoCE :: Maybe es -> (b -> a) -> (Maybe (EnsureNoCE es (b -> a)), es)
ensureNoCE Maybe es
sample_es b -> a
f = ((b -> EnsureNoCE es a) -> Maybe (b -> EnsureNoCE es a)
forall a. a -> Maybe a
Just b -> EnsureNoCE es a
f', es
forall a. Monoid a => a
mempty)
where
f' :: b -> EnsureNoCE es a
f' b
a =
case Maybe es -> a -> (Maybe (EnsureNoCE es a), es)
forall es a.
CanEnsureCE es a =>
Maybe es -> a -> (Maybe (EnsureNoCE es a), es)
ensureNoCE Maybe es
sample_es (b -> a
f b
a) of
(Just EnsureNoCE es a
v, es
_) -> EnsureNoCE es a
v
(Maybe (EnsureNoCE es a)
_, es
es) -> String -> EnsureNoCE es a
forall a. HasCallStack => String -> a
error (String -> EnsureNoCE es a) -> String -> EnsureNoCE es a
forall a b. (a -> b) -> a -> b
$ String
"ensureNoCE for function: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ es -> String
forall a. Show a => a -> String
show es
es
noValueECE :: Maybe (b -> a) -> es -> EnsureCE es (b -> a)
noValueECE (Maybe (b -> a)
_fvCE :: Maybe (b -> a)) es
es =
EnsureCE es a -> b -> EnsureCE es a
forall a b. a -> b -> a
const (Maybe a -> es -> EnsureCE es a
forall es a. CanEnsureCE es a => Maybe a -> es -> EnsureCE es a
noValueECE (Maybe a
forall a. Maybe a
Nothing :: Maybe a) es
es)
prependErrorsECE :: Maybe (b -> a)
-> es -> EnsureCE es (b -> a) -> EnsureCE es (b -> a)
prependErrorsECE (Maybe (b -> a)
_fvCE :: Maybe (b -> a)) es
es =
((Maybe a -> es -> EnsureCE es a -> EnsureCE es a
forall es a.
CanEnsureCE es a =>
Maybe a -> es -> EnsureCE es a -> EnsureCE es a
prependErrorsECE (Maybe a
forall a. Maybe a
Nothing :: Maybe a) es
es) (EnsureCE es a -> EnsureCE es a)
-> (b -> EnsureCE es a) -> b -> EnsureCE es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
getValueOrThrowErrorsNCE ::
(SuitableForCE es, CanEnsureCE es v, Show v)
=>
Maybe es ->
v -> (EnsureNoCE es v)
getValueOrThrowErrorsNCE :: Maybe es -> v -> EnsureNoCE es v
getValueOrThrowErrorsNCE Maybe es
sample_es v
v =
case Maybe es -> v -> (Maybe (EnsureNoCE es v), es)
forall es a.
CanEnsureCE es a =>
Maybe es -> a -> (Maybe (EnsureNoCE es a), es)
ensureNoCE Maybe es
sample_es v
v of
(Just EnsureNoCE es v
vNCE, es
es) | Bool -> Bool
not (es -> Bool
forall es. CanTestErrorsCertain es => es -> Bool
hasCertainError es
es) -> EnsureNoCE es v
vNCE
(Maybe (EnsureNoCE es v), es)
_ -> String -> EnsureNoCE es v
forall a. HasCallStack => String -> a
error (v -> String
forall a. Show a => a -> String
show v
v)
lift1CE ::
(SuitableForCE es
, CanEnsureCE es a, CanEnsureCE es c)
=>
(a -> c) ->
(CollectErrors es a) -> (EnsureCE es c)
lift1CE :: (a -> c) -> CollectErrors es a -> EnsureCE es c
lift1CE a -> c
fn CollectErrors es a
aCE =
case Maybe a
ma of
Just a
a ->
Maybe c -> es -> EnsureCE es c -> EnsureCE es c
forall es a.
CanEnsureCE es a =>
Maybe a -> es -> EnsureCE es a -> EnsureCE es a
prependErrorsECE Maybe c
sample_c es
a_es (EnsureCE es c -> EnsureCE es c) -> EnsureCE es c -> EnsureCE es c
forall a b. (a -> b) -> a -> b
$ Maybe es -> c -> EnsureCE es c
forall es a. CanEnsureCE es a => Maybe es -> a -> EnsureCE es a
ensureCE Maybe es
sample_es (c -> EnsureCE es c) -> c -> EnsureCE es c
forall a b. (a -> b) -> a -> b
$ a -> c
fn a
a
Maybe a
_ ->
Maybe c -> es -> EnsureCE es c
forall es a. CanEnsureCE es a => Maybe a -> es -> EnsureCE es a
noValueECE Maybe c
sample_c es
a_es
where
CollectErrors Maybe a
ma es
a_es = CollectErrors es a
aCE
sample_es :: Maybe es
sample_es = es -> Maybe es
forall a. a -> Maybe a
Just es
a_es
sample_c :: Maybe c
sample_c = a -> c
fn (a -> c) -> Maybe a -> Maybe c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
ma
lift2CE ::
(SuitableForCE es
, CanEnsureCE es a, CanEnsureCE es b, CanEnsureCE es c)
=>
(a -> b -> c) ->
(CollectErrors es a) -> (CollectErrors es b) -> (EnsureCE es c)
lift2CE :: (a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> EnsureCE es c
lift2CE a -> b -> c
fn CollectErrors es a
aCE CollectErrors es b
bCE =
case (Maybe a
ma, Maybe b
mb) of
(Just a
a, Just b
b) ->
Maybe c -> es -> EnsureCE es c -> EnsureCE es c
forall es a.
CanEnsureCE es a =>
Maybe a -> es -> EnsureCE es a -> EnsureCE es a
prependErrorsECE Maybe c
sample_c es
ab_es (EnsureCE es c -> EnsureCE es c) -> EnsureCE es c -> EnsureCE es c
forall a b. (a -> b) -> a -> b
$ Maybe es -> c -> EnsureCE es c
forall es a. CanEnsureCE es a => Maybe es -> a -> EnsureCE es a
ensureCE Maybe es
sample_es (c -> EnsureCE es c) -> c -> EnsureCE es c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
fn a
a b
b
(Maybe a, Maybe b)
_ ->
Maybe c -> es -> EnsureCE es c
forall es a. CanEnsureCE es a => Maybe a -> es -> EnsureCE es a
noValueECE Maybe c
sample_c es
ab_es
where
CollectErrors Maybe a
ma es
a_es = CollectErrors es a
aCE
CollectErrors Maybe b
mb es
b_es = CollectErrors es b
bCE
ab_es :: es
ab_es = es
a_es es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
b_es
sample_es :: Maybe es
sample_es = es -> Maybe es
forall a. a -> Maybe a
Just es
a_es
sample_c :: Maybe c
sample_c = a -> b -> c
fn (a -> b -> c) -> Maybe a -> Maybe (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
ma Maybe (b -> c) -> Maybe b -> Maybe c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe b
mb
lift2TCE ::
(SuitableForCE es
, CanEnsureCE es a, CanEnsureCE es c)
=>
(a -> b -> c) ->
(CollectErrors es a) -> b -> (EnsureCE es c)
lift2TCE :: (a -> b -> c) -> CollectErrors es a -> b -> EnsureCE es c
lift2TCE a -> b -> c
fn CollectErrors es a
aCE b
b =
case Maybe a
ma of
(Just a
a) ->
Maybe c -> es -> EnsureCE es c -> EnsureCE es c
forall es a.
CanEnsureCE es a =>
Maybe a -> es -> EnsureCE es a -> EnsureCE es a
prependErrorsECE Maybe c
sample_c es
a_es (EnsureCE es c -> EnsureCE es c) -> EnsureCE es c -> EnsureCE es c
forall a b. (a -> b) -> a -> b
$ Maybe es -> c -> EnsureCE es c
forall es a. CanEnsureCE es a => Maybe es -> a -> EnsureCE es a
ensureCE Maybe es
sample_es (c -> EnsureCE es c) -> c -> EnsureCE es c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
fn a
a b
b
Maybe a
_ ->
Maybe c -> es -> EnsureCE es c
forall es a. CanEnsureCE es a => Maybe a -> es -> EnsureCE es a
noValueECE Maybe c
sample_c es
a_es
where
CollectErrors Maybe a
ma es
a_es = CollectErrors es a
aCE
sample_es :: Maybe es
sample_es = es -> Maybe es
forall a. a -> Maybe a
Just es
a_es
sample_c :: Maybe c
sample_c = a -> b -> c
fn (a -> b -> c) -> Maybe a -> Maybe (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
ma Maybe (b -> c) -> Maybe b -> Maybe c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b -> Maybe b
forall a. a -> Maybe a
Just b
b)
lift2TLCE ::
(SuitableForCE es
, CanEnsureCE es b, CanEnsureCE es c)
=>
(a -> b -> c) ->
a -> (CollectErrors es b) -> (EnsureCE es c)
lift2TLCE :: (a -> b -> c) -> a -> CollectErrors es b -> EnsureCE es c
lift2TLCE a -> b -> c
f = (CollectErrors es b -> a -> EnsureCE es c)
-> a -> CollectErrors es b -> EnsureCE es c
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((CollectErrors es b -> a -> EnsureCE es c)
-> a -> CollectErrors es b -> EnsureCE es c)
-> (CollectErrors es b -> a -> EnsureCE es c)
-> a
-> CollectErrors es b
-> EnsureCE es c
forall a b. (a -> b) -> a -> b
$ (b -> a -> c) -> CollectErrors es b -> a -> EnsureCE es c
forall es a c b.
(SuitableForCE es, CanEnsureCE es a, CanEnsureCE es c) =>
(a -> b -> c) -> CollectErrors es a -> b -> EnsureCE es c
lift2TCE ((a -> b -> c) -> b -> a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> c
f)
lift3CE ::
(SuitableForCE es
, CanEnsureCE es a, CanEnsureCE es b, CanEnsureCE es c, CanEnsureCE es d)
=>
(a -> b -> c -> d) ->
(CollectErrors es a) -> (CollectErrors es b) -> (CollectErrors es c) -> (EnsureCE es d)
lift3CE :: (a -> b -> c -> d)
-> CollectErrors es a
-> CollectErrors es b
-> CollectErrors es c
-> EnsureCE es d
lift3CE a -> b -> c -> d
fn CollectErrors es a
aCE CollectErrors es b
bCE CollectErrors es c
cCE =
case (Maybe a
ma, Maybe b
mb, Maybe c
mc) of
(Just a
a, Just b
b, Just c
c) ->
Maybe d -> es -> EnsureCE es d -> EnsureCE es d
forall es a.
CanEnsureCE es a =>
Maybe a -> es -> EnsureCE es a -> EnsureCE es a
prependErrorsECE Maybe d
sample_d es
abc_es (EnsureCE es d -> EnsureCE es d) -> EnsureCE es d -> EnsureCE es d
forall a b. (a -> b) -> a -> b
$ Maybe es -> d -> EnsureCE es d
forall es a. CanEnsureCE es a => Maybe es -> a -> EnsureCE es a
ensureCE Maybe es
sample_es (d -> EnsureCE es d) -> d -> EnsureCE es d
forall a b. (a -> b) -> a -> b
$ a -> b -> c -> d
fn a
a b
b c
c
(Maybe a, Maybe b, Maybe c)
_ ->
Maybe d -> es -> EnsureCE es d
forall es a. CanEnsureCE es a => Maybe a -> es -> EnsureCE es a
noValueECE Maybe d
sample_d es
abc_es
where
CollectErrors Maybe a
ma es
a_es = CollectErrors es a
aCE
CollectErrors Maybe b
mb es
b_es = CollectErrors es b
bCE
CollectErrors Maybe c
mc es
c_es = CollectErrors es c
cCE
abc_es :: es
abc_es = es
a_es es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
b_es es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
c_es
sample_es :: Maybe es
sample_es = es -> Maybe es
forall a. a -> Maybe a
Just es
a_es
sample_d :: Maybe d
sample_d = a -> b -> c -> d
fn (a -> b -> c -> d) -> Maybe a -> Maybe (b -> c -> d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
ma Maybe (b -> c -> d) -> Maybe b -> Maybe (c -> d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe b
mb Maybe (c -> d) -> Maybe c -> Maybe d
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe c
mc
class (SuitableForCE es) => es f where
::
(CanEnsureCE es c) =>
Maybe es ->
f c -> CollectErrors es (f (EnsureNoCE es c))
default ::
(CanEnsureCE es c, Traversable f) =>
Maybe es ->
f c -> CollectErrors es (f (EnsureNoCE es c))
extractCE Maybe es
sample_es f c
fc =
case ((Maybe (EnsureNoCE es c), es) -> Maybe (EnsureNoCE es c))
-> f (Maybe (EnsureNoCE es c), es) -> Maybe (f (EnsureNoCE es c))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe (EnsureNoCE es c), es) -> Maybe (EnsureNoCE es c)
forall a b. (a, b) -> a
fst f (Maybe (EnsureNoCE es c), es)
fcNoCE of
Just f (EnsureNoCE es c)
fec -> f (EnsureNoCE es c) -> CollectErrors es (f (EnsureNoCE es c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure f (EnsureNoCE es c)
fec
Maybe (f (EnsureNoCE es c))
_ -> es -> CollectErrors es (f (EnsureNoCE es c))
forall es v. es -> CollectErrors es v
noValueCE (es -> CollectErrors es (f (EnsureNoCE es c)))
-> es -> CollectErrors es (f (EnsureNoCE es c))
forall a b. (a -> b) -> a -> b
$ ((Maybe (EnsureNoCE es c), es) -> es)
-> f (Maybe (EnsureNoCE es c), es) -> es
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe (EnsureNoCE es c), es) -> es
forall a b. (a, b) -> b
snd f (Maybe (EnsureNoCE es c), es)
fcNoCE
where
fcNoCE :: f (Maybe (EnsureNoCE es c), es)
fcNoCE = (c -> (Maybe (EnsureNoCE es c), es))
-> f c -> f (Maybe (EnsureNoCE es c), es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe es -> c -> (Maybe (EnsureNoCE es c), es)
forall es a.
CanEnsureCE es a =>
Maybe es -> a -> (Maybe (EnsureNoCE es a), es)
ensureNoCE Maybe es
sample_es) f c
fc