{-# 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 )

{-|
  A wrapper around values which can accommodate a list of
  (potential) errors that have (maybe) occurred during the computation
  of a value.  A value may be missing, leaving only the error(s).

  Such error collection allows one to write expressions with partial
  functions (ie functions that fail for some inputs) instead of
  branching after each application of such function.
  Dealing with the errors can be moved outside the expression.
  If the error data contain enough information, their list can be used
  to trace the source of the errors.
-}
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

{-| Take a CE-value, add new errors into it and remove the value, if any -}
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)

{-| Unsafe way to get a value out of the CollectErrors wrapper. -}
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

{-| Unsafe way to get a value out of the CollectErrors wrapper. -}
(~!) :: Show es => CollectErrors es p -> p
~! :: CollectErrors es p -> p
(~!) = CollectErrors es p -> p
forall es p. Show es => CollectErrors es p -> p
unCollectErrors

{-| A safe way to get a value out of the CollectErrors wrapper. -}
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



-- functor instances:

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

-- Various lifts:

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)