{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Control.CollectErrors.Type where
import Prelude
import Control.Applicative ( Applicative(liftA2), liftA )
import GHC.Generics
import Control.DeepSeq
import qualified Data.Set as Set
import Test.QuickCheck ( Arbitrary(arbitrary) )
import Text.Printf ( printf )
data CollectErrors es v =
CollectErrors
{ CollectErrors es v -> Maybe v
getMaybeValue :: Maybe v
, CollectErrors es v -> es
getErrors :: es }
deriving ((forall x. CollectErrors es v -> Rep (CollectErrors es v) x)
-> (forall x. Rep (CollectErrors es v) x -> CollectErrors es v)
-> Generic (CollectErrors es v)
forall x. Rep (CollectErrors es v) x -> CollectErrors es v
forall x. CollectErrors es v -> Rep (CollectErrors es v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall es v x. Rep (CollectErrors es v) x -> CollectErrors es v
forall es v x. CollectErrors es v -> Rep (CollectErrors es v) x
$cto :: forall es v x. Rep (CollectErrors es v) x -> CollectErrors es v
$cfrom :: forall es v x. CollectErrors es v -> Rep (CollectErrors es v) x
Generic, (forall a. CollectErrors es a -> Rep1 (CollectErrors es) a)
-> (forall a. Rep1 (CollectErrors es) a -> CollectErrors es a)
-> Generic1 (CollectErrors es)
forall a. Rep1 (CollectErrors es) a -> CollectErrors es a
forall a. CollectErrors es a -> Rep1 (CollectErrors es) a
forall es a. Rep1 (CollectErrors es) a -> CollectErrors es a
forall es a. CollectErrors es a -> Rep1 (CollectErrors es) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall es a. Rep1 (CollectErrors es) a -> CollectErrors es a
$cfrom1 :: forall es a. CollectErrors es a -> Rep1 (CollectErrors es) a
Generic1, CollectErrors es v -> ()
(CollectErrors es v -> ()) -> NFData (CollectErrors es v)
forall a. (a -> ()) -> NFData a
forall es v. (NFData v, NFData es) => CollectErrors es v -> ()
rnf :: CollectErrors es v -> ()
$crnf :: forall es v. (NFData v, NFData es) => CollectErrors es v -> ()
NFData, (forall a. (a -> ()) -> CollectErrors es a -> ())
-> NFData1 (CollectErrors es)
forall es a. NFData es => (a -> ()) -> CollectErrors es a -> ()
forall a. (a -> ()) -> CollectErrors es a -> ()
forall (f :: * -> *).
(forall a. (a -> ()) -> f a -> ()) -> NFData1 f
liftRnf :: (a -> ()) -> CollectErrors es a -> ()
$cliftRnf :: forall es a. NFData es => (a -> ()) -> CollectErrors es a -> ()
NFData1)
class CanTestErrorsCertain es where
hasCertainError :: es -> Bool
instance (CanTestErrorsCertain es) => CanTestErrorsCertain (CollectErrors es v) where
hasCertainError :: CollectErrors es v -> Bool
hasCertainError (CollectErrors Maybe v
_ es
es) = es -> Bool
forall es. CanTestErrorsCertain es => es -> Bool
hasCertainError es
es
instance (CanTestErrorsCertain es) => CanTestErrorsCertain [es] where
hasCertainError :: [es] -> Bool
hasCertainError = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> ([es] -> [Bool]) -> [es] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (es -> Bool) -> [es] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map es -> Bool
forall es. CanTestErrorsCertain es => es -> Bool
hasCertainError
instance (CanTestErrorsCertain es) => CanTestErrorsCertain (Set.Set es) where
hasCertainError :: Set es -> Bool
hasCertainError = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> (Set es -> [Bool]) -> Set es -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (es -> Bool) -> [es] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map es -> Bool
forall es. CanTestErrorsCertain es => es -> Bool
hasCertainError ([es] -> [Bool]) -> (Set es -> [es]) -> Set es -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set es -> [es]
forall a. Set a -> [a]
Set.toList
class CanTestErrorsPresent es where
hasError :: es -> Bool
instance (CanTestErrorsPresent es) => CanTestErrorsPresent (CollectErrors es v) where
hasError :: CollectErrors es v -> Bool
hasError (CollectErrors Maybe v
_ es
es) = es -> Bool
forall es. CanTestErrorsPresent es => es -> Bool
hasError es
es
instance CanTestErrorsPresent [es] where
hasError :: [es] -> Bool
hasError = Bool -> Bool
not (Bool -> Bool) -> ([es] -> Bool) -> [es] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [es] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
instance CanTestErrorsPresent (Set.Set es) where
hasError :: Set es -> Bool
hasError = Bool -> Bool
not (Bool -> Bool) -> (Set es -> Bool) -> Set es -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set es -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
type CanBeErrors es = (Monoid es, Eq es, Show es, CanTestErrorsCertain es, CanTestErrorsPresent es)
instance (Show v, CanBeErrors 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)
noValue :: es -> CollectErrors es v
noValue :: es -> CollectErrors es v
noValue 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
removeValue :: Monoid es => CollectErrors es v -> es -> CollectErrors es v
removeValue :: CollectErrors es v -> es -> CollectErrors es v
removeValue (CollectErrors Maybe v
_ es
es1) es
es2 =
Maybe v -> es -> CollectErrors es v
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe v
forall a. Maybe a
Nothing (es
es1 es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
es2)
prependErrors :: (Monoid es) => es -> CollectErrors es v -> CollectErrors es v
prependErrors :: es -> CollectErrors es v -> CollectErrors es v
prependErrors 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)
unCollectErrors :: Show es => CollectErrors es p -> p
unCollectErrors :: CollectErrors es p -> p
unCollectErrors (CollectErrors (Just p
v) es
_) = p
v
unCollectErrors (CollectErrors Maybe p
_ es
es) = String -> p
forall a. HasCallStack => String -> a
error (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ String
"CollectErrors: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ es -> String
forall a. Show a => a -> String
show es
es
(~!) :: Show es => CollectErrors es p -> p
~! :: CollectErrors es p -> p
(~!) = CollectErrors es p -> p
forall es p. Show es => CollectErrors es p -> p
unCollectErrors
toEither ::
(CanBeErrors es)
=>
CollectErrors es v -> Either es v
toEither :: CollectErrors es v -> Either es v
toEither (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 -> Either es v
forall a b. b -> Either a b
Right v
v
Maybe v
_ -> es -> Either es v
forall a b. a -> Either a b
Left es
es
withErrorOrValue ::
(CanBeErrors es)
=>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
withErrorOrValue :: (es -> t) -> (v -> t) -> CollectErrors es v -> t
withErrorOrValue es -> t
onError v -> t
onValue (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 -> t
onValue v
v
Maybe v
_ -> es -> t
onError es
es
filterValuesWithoutError ::
(CanBeErrors es)
=>
[CollectErrors es v] -> [v]
filterValuesWithoutError :: [CollectErrors es v] -> [v]
filterValuesWithoutError [] = []
filterValuesWithoutError (CollectErrors es v
vCE : [CollectErrors es v]
rest) =
(es -> [v]) -> (v -> [v]) -> CollectErrors es v -> [v]
forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
withErrorOrValue ([v] -> es -> [v]
forall a b. a -> b -> a
const [v]
restDone) (v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
restDone) CollectErrors es v
vCE
where
restDone :: [v]
restDone = [CollectErrors es v] -> [v]
forall es v. CanBeErrors es => [CollectErrors es v] -> [v]
filterValuesWithoutError [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
lift :: (Monoid es) => (a -> b) -> (CollectErrors es a) -> (CollectErrors es b)
lift :: (a -> b) -> CollectErrors es a -> CollectErrors es b
lift = (a -> b) -> CollectErrors es a -> CollectErrors es b
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA
liftCE :: (Monoid es) => (a -> (CollectErrors es c)) -> (CollectErrors es a) -> (CollectErrors es c)
liftCE :: (a -> CollectErrors es c)
-> CollectErrors es a -> CollectErrors es c
liftCE a -> CollectErrors es c
f (CollectErrors (Just a
a) es
ae) =
es -> CollectErrors es c -> CollectErrors es c
forall es v.
Monoid es =>
es -> CollectErrors es v -> CollectErrors es v
prependErrors es
ae (CollectErrors es c -> CollectErrors es c)
-> CollectErrors es c -> CollectErrors es c
forall a b. (a -> b) -> a -> b
$ a -> CollectErrors es c
f a
a
liftCE a -> CollectErrors es c
_ (CollectErrors Maybe a
_ es
ae) =
Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe c
forall a. Maybe a
Nothing es
ae
liftPair :: (Monoid es) => (a -> (c,d)) -> (CollectErrors es a) -> (CollectErrors es c, CollectErrors es d)
liftPair :: (a -> (c, d))
-> CollectErrors es a -> (CollectErrors es c, CollectErrors es d)
liftPair a -> (c, d)
f (CollectErrors (Just a
a) es
ae) =
(Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (c -> Maybe c
forall a. a -> Maybe a
Just c
c) es
ae, Maybe d -> es -> CollectErrors es d
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (d -> Maybe d
forall a. a -> Maybe a
Just d
d) es
ae)
where
(c
c,d
d) = a -> (c, d)
f a
a
liftPair a -> (c, d)
_ (CollectErrors Maybe a
_ es
ae) =
(Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe c
forall a. Maybe a
Nothing es
ae, Maybe d -> es -> CollectErrors es d
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe d
forall a. Maybe a
Nothing es
ae)
lift2 :: (Monoid es) => (a -> b -> c) -> (CollectErrors es a) -> (CollectErrors es b) -> (CollectErrors es c)
lift2 :: (a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
lift2 = (a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
lift2CE :: (Monoid es) => (a -> b -> (CollectErrors es c)) -> (CollectErrors es a) -> (CollectErrors es b) -> (CollectErrors es c)
lift2CE :: (a -> b -> CollectErrors es c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
lift2CE a -> b -> CollectErrors es c
f (CollectErrors (Just a
a) es
ae) (CollectErrors (Just b
b) es
be) =
es -> CollectErrors es c -> CollectErrors es c
forall es v.
Monoid es =>
es -> CollectErrors es v -> CollectErrors es v
prependErrors (es
ae es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
be) (CollectErrors es c -> CollectErrors es c)
-> CollectErrors es c -> CollectErrors es c
forall a b. (a -> b) -> a -> b
$ a -> b -> CollectErrors es c
f a
a b
b
lift2CE a -> b -> CollectErrors es c
_ (CollectErrors Maybe a
_ es
ae) (CollectErrors Maybe b
_ es
be) =
Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe c
forall a. Maybe a
Nothing (es
ae es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
be)
lift1T :: (Monoid es) => (a -> b -> c) -> (CollectErrors es a) -> b -> (CollectErrors es c)
lift1T :: (a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
lift1T a -> b -> c
fn (CollectErrors (Just a
a) es
ae) b
b = Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (c -> Maybe c
forall a. a -> Maybe a
Just (a -> b -> c
fn a
a b
b)) es
ae
lift1T a -> b -> c
_ (CollectErrors Maybe a
_ es
ae) b
_ = Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe c
forall a. Maybe a
Nothing es
ae
lift1TCE :: (Monoid es) => (a -> b -> (CollectErrors es c)) -> (CollectErrors es a) -> b -> (CollectErrors es c)
lift1TCE :: (a -> b -> CollectErrors es c)
-> CollectErrors es a -> b -> CollectErrors es c
lift1TCE a -> b -> CollectErrors es c
fn (CollectErrors (Just a
a) es
ae) b
b = es -> CollectErrors es c -> CollectErrors es c
forall es v.
Monoid es =>
es -> CollectErrors es v -> CollectErrors es v
prependErrors es
ae (CollectErrors es c -> CollectErrors es c)
-> CollectErrors es c -> CollectErrors es c
forall a b. (a -> b) -> a -> b
$ a -> b -> CollectErrors es c
fn a
a b
b
lift1TCE a -> b -> CollectErrors es c
_ (CollectErrors Maybe a
_ es
ae) b
_ = Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe c
forall a. Maybe a
Nothing es
ae
liftT1 :: (Monoid es) => (a -> b -> c) -> a -> (CollectErrors es b) -> (CollectErrors es c)
liftT1 :: (a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
liftT1 a -> b -> c
fn a
a (CollectErrors (Just b
b) es
be) = Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (c -> Maybe c
forall a. a -> Maybe a
Just (a -> b -> c
fn a
a b
b)) es
be
liftT1 a -> b -> c
_ a
_ (CollectErrors Maybe b
_ es
be) = Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe c
forall a. Maybe a
Nothing es
be
liftT1CE :: (Monoid es) => (a -> b -> (CollectErrors es c)) -> a -> (CollectErrors es b) -> (CollectErrors es c)
liftT1CE :: (a -> b -> CollectErrors es c)
-> a -> CollectErrors es b -> CollectErrors es c
liftT1CE a -> b -> CollectErrors es c
fn a
a (CollectErrors (Just b
b) es
be) = es -> CollectErrors es c -> CollectErrors es c
forall es v.
Monoid es =>
es -> CollectErrors es v -> CollectErrors es v
prependErrors es
be (CollectErrors es c -> CollectErrors es c)
-> CollectErrors es c -> CollectErrors es c
forall a b. (a -> b) -> a -> b
$ a -> b -> CollectErrors es c
fn a
a b
b
liftT1CE a -> b -> CollectErrors es c
_ a
_ (CollectErrors Maybe b
_ es
be) = Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe c
forall a. Maybe a
Nothing es
be
lift2pair :: (Monoid es) => (a -> b -> (c,d)) -> (CollectErrors es a) -> (CollectErrors es b) -> (CollectErrors es c, CollectErrors es d)
lift2pair :: (a -> b -> (c, d))
-> CollectErrors es a
-> CollectErrors es b
-> (CollectErrors es c, CollectErrors es d)
lift2pair a -> b -> (c, d)
f (CollectErrors (Just a
a) es
ae) (CollectErrors (Just b
b) es
be) =
(Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (c -> Maybe c
forall a. a -> Maybe a
Just c
c) es
abe, Maybe d -> es -> CollectErrors es d
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (d -> Maybe d
forall a. a -> Maybe a
Just d
d) es
abe)
where
(c
c,d
d) = a -> b -> (c, d)
f a
a b
b
abe :: es
abe = es
ae es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
be
lift2pair a -> b -> (c, d)
_ (CollectErrors Maybe a
_ es
ae) (CollectErrors Maybe b
_ es
be) =
(Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe c
forall a. Maybe a
Nothing es
abe, Maybe d -> es -> CollectErrors es d
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe d
forall a. Maybe a
Nothing es
abe)
where
abe :: es
abe = es
ae es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
be
lift1Tpair :: (Monoid es) => (a -> b -> (c,d)) -> (CollectErrors es a) -> b -> (CollectErrors es c, CollectErrors es d)
lift1Tpair :: (a -> b -> (c, d))
-> CollectErrors es a
-> b
-> (CollectErrors es c, CollectErrors es d)
lift1Tpair a -> b -> (c, d)
f (CollectErrors (Just a
a) es
ae) b
b =
(Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (c -> Maybe c
forall a. a -> Maybe a
Just c
c) es
ae, Maybe d -> es -> CollectErrors es d
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (d -> Maybe d
forall a. a -> Maybe a
Just d
d) es
ae)
where
(c
c,d
d) = a -> b -> (c, d)
f a
a b
b
lift1Tpair a -> b -> (c, d)
_ (CollectErrors Maybe a
_ es
ae) b
_ =
(Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe c
forall a. Maybe a
Nothing es
ae, Maybe d -> es -> CollectErrors es d
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe d
forall a. Maybe a
Nothing es
ae)
liftT1pair :: (Monoid es) => (a -> b -> (c,d)) -> a -> (CollectErrors es b) -> (CollectErrors es c, CollectErrors es d)
liftT1pair :: (a -> b -> (c, d))
-> a
-> CollectErrors es b
-> (CollectErrors es c, CollectErrors es d)
liftT1pair a -> b -> (c, d)
f a
a (CollectErrors (Just b
b) es
be) =
(Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (c -> Maybe c
forall a. a -> Maybe a
Just c
c) es
be, Maybe d -> es -> CollectErrors es d
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (d -> Maybe d
forall a. a -> Maybe a
Just d
d) es
be)
where
(c
c,d
d) = a -> b -> (c, d)
f a
a b
b
liftT1pair a -> b -> (c, d)
_ a
_ (CollectErrors Maybe b
_ es
be) =
(Maybe c -> es -> CollectErrors es c
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe c
forall a. Maybe a
Nothing es
be, Maybe d -> es -> CollectErrors es d
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe d
forall a. Maybe a
Nothing es
be)
liftTakeErrors :: (CanTakeErrors es t2) => (t1 -> t2) -> (CollectErrors es t1 -> t2)
liftTakeErrors :: (t1 -> t2) -> CollectErrors es t1 -> t2
liftTakeErrors t1 -> t2
f (CollectErrors (Just t1
v) es
e) =
es -> t2 -> t2
forall es t. CanTakeErrors es t => es -> t -> t
takeErrors es
e (t2 -> t2) -> t2 -> t2
forall a b. (a -> b) -> a -> b
$ t1 -> t2
f t1
v
liftTakeErrors t1 -> t2
_f (CollectErrors Maybe t1
_ es
e) =
es -> t2
forall es t. CanTakeErrors es t => es -> t
takeErrorsNoValue es
e
class CanTakeErrors es t where
takeErrors :: es -> t -> t
takeErrorsNoValue :: es -> t
instance (Monoid es) => CanTakeErrors es (CollectErrors es t) where
takeErrors :: es -> CollectErrors es t -> CollectErrors es t
takeErrors es
es1 (CollectErrors Maybe t
v es
es2) = Maybe t -> es -> CollectErrors es t
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe t
v (es
es1 es -> es -> es
forall a. Semigroup a => a -> a -> a
<> es
es2)
takeErrorsNoValue :: es -> CollectErrors es t
takeErrorsNoValue es
es = Maybe t -> es -> CollectErrors es t
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe t
forall a. Maybe a
Nothing es
es
instance (CanTakeErrors es t1, CanTakeErrors es t2) => CanTakeErrors es (t1,t2) where
takeErrors :: es -> (t1, t2) -> (t1, t2)
takeErrors es
es (t1
v1,t2
v2) = (es -> t1 -> t1
forall es t. CanTakeErrors es t => es -> t -> t
takeErrors es
es t1
v1, es -> t2 -> t2
forall es t. CanTakeErrors es t => es -> t -> t
takeErrors es
es t2
v2)
takeErrorsNoValue :: es -> (t1, t2)
takeErrorsNoValue es
es = (es -> t1
forall es t. CanTakeErrors es t => es -> t
takeErrorsNoValue es
es, es -> t2
forall es t. CanTakeErrors es t => es -> t
takeErrorsNoValue es
es)