{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
module Vary.VEither (
  -- * General Usage
  -- $setup

  -- * Core type definition
  VEither(VLeft, VRight), 
  -- * Conversion
  toVary, 
  fromVary,
  fromLeft,
  fromRight,
  toEither,
  fromEither,
  veither,
  intoOnly,

  -- * case analysis ("pattern matching"):

  -- |
  --
  -- Besides the 'VLeft' and 'VRight' patterns,
  -- 'VEither' supports a bunch of handy combinator functions,
  -- similar to "Vary".'Vary.on' and co.
  onLeft,
  onRight,

  -- * Transforming
  mapLeftOn,
  mapLeft,
  mapRight,
  morph,
  morphed,
) where

import Control.Category ((>>>))
import Control.DeepSeq (NFData (..))
import qualified Data.Either
import Data.Kind (Type)
import Vary.Core (Vary(..))
import Vary.Utils (Subset, Mappable)
import Vary ((:|))
import qualified Vary
import GHC.Generics

-- $setup
--
-- This module is intended to be used qualified:
--
-- >>> import Vary.VEither (VEither(VLeft, VRight))
-- >>> import qualified Vary.VEither as VEither
-- 
-- And for many functions, it is useful or outright necessary to enable the following extensions:
--
-- >>> :set -XGHC2021
-- >>> :set -XDataKinds

newtype VEither (errs :: [Type]) a = VEither (Vary (a : errs))

-- | Turns the 'VEither' into a normal Vary, no longer considering the @a@ a \'preferred\' value.
toVary :: VEither errs a -> Vary (a : errs)
{-# INLINE toVary #-}
toVary :: forall (errs :: [*]) a. VEither errs a -> Vary (a : errs)
toVary (VEither Vary (a : errs)
vary) = Vary (a : errs)
vary

-- | Turns a 'Vary' into a 'VEither'. Now the @a@ is considered the \'preferred\' value.
fromVary :: Vary (a : errs) -> VEither errs a
{-# INLINE fromVary #-}
fromVary :: forall a (errs :: [*]). Vary (a : errs) -> VEither errs a
fromVary Vary (a : errs)
vary = Vary (a : errs) -> VEither errs a
forall (errs :: [*]) a. Vary (a : errs) -> VEither errs a
VEither Vary (a : errs)
vary

-- | Turns a 'VEither' into a normal 'Either'.
toEither :: VEither errs a -> Either (Vary errs) a
{-# INLINE toEither #-}
toEither :: forall (errs :: [*]) a. VEither errs a -> Either (Vary errs) a
toEither = VEither errs a -> Vary (a : errs)
forall (errs :: [*]) a. VEither errs a -> Vary (a : errs)
toVary (VEither errs a -> Vary (a : errs))
-> (Vary (a : errs) -> Either (Vary errs) a)
-> VEither errs a
-> Either (Vary errs) a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Vary (a : errs) -> Either (Vary errs) a
forall a (as :: [*]). Vary (a : as) -> Either (Vary as) a
Vary.pop

-- | Turns a normal 'Either' into a 'VEither'.
fromEither :: Either (Vary errs) a -> VEither errs a
{-# INLINE fromEither #-}
fromEither :: forall (errs :: [*]) a. Either (Vary errs) a -> VEither errs a
fromEither = (Vary errs -> Vary (a : errs))
-> (a -> Vary (a : errs))
-> Either (Vary errs) a
-> Vary (a : errs)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either Vary errs -> Vary (a : errs)
forall (ys :: [*]) (xs :: [*]). Subset xs ys => Vary xs -> Vary ys
Vary.morph a -> Vary (a : errs)
forall a (l :: [*]). (a :| l) => a -> Vary l
Vary.from (Either (Vary errs) a -> Vary (a : errs))
-> (Vary (a : errs) -> VEither errs a)
-> Either (Vary errs) a
-> VEither errs a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Vary (a : errs) -> VEither errs a
forall a (errs :: [*]). Vary (a : errs) -> VEither errs a
fromVary

-- | Shorthand to construct a 'VEither' from a single error value.
--
-- Instead of:
--
-- >>> (VLeft (Vary.from @Bool True)) :: VEither '[Bool] String
-- VLeft (Vary.from @Bool True) 
--
-- You can just write:
--
-- >>> VEither.fromLeft @Bool True :: VEither '[Bool] String
-- VLeft (Vary.from @Bool True) 
fromLeft :: forall err errs a. err :| errs => err -> VEither errs a
fromLeft :: forall err (errs :: [*]) a. (err :| errs) => err -> VEither errs a
fromLeft = forall a (l :: [*]). (a :| l) => a -> Vary l
Vary.from @err (err -> Vary errs)
-> (Vary errs -> VEither errs a) -> err -> VEither errs a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Vary errs -> VEither errs a
forall a (errs :: [*]). Vary errs -> VEither errs a
VLeft

-- | Construct a 'VEither' from an @a@.
--
-- Exists for symmetry with 'fromLeft'.
-- Indeed, this is just another name for 'VRight'.
fromRight :: forall a errs. a -> VEither errs a
fromRight :: forall a (errs :: [*]). a -> VEither errs a
fromRight = a -> VEither errs a
forall a (errs :: [*]). a -> VEither errs a
VRight

-- | Case analysis on a 'VEither'. Similar to 'Data.Either.either'.
--
-- See also "VEither".'mapLeft', "VEither".'mapLeftOn' and "VEither".'mapRight'.
veither :: (Vary errs -> c) -> (a -> c) -> VEither errs a -> c
veither :: forall (errs :: [*]) c a.
(Vary errs -> c) -> (a -> c) -> VEither errs a -> c
veither Vary errs -> c
f a -> c
_ (VLeft Vary errs
x)     =  Vary errs -> c
f Vary errs
x
veither Vary errs -> c
_ a -> c
g (VRight a
y)    =  a -> c
g a
y

{-# COMPLETE VLeft, VRight #-}

pattern VLeft :: forall a errs. Vary errs -> VEither errs a
{-# INLINE VLeft #-}
pattern $mVLeft :: forall {r} {a} {errs :: [*]}.
VEither errs a -> (Vary errs -> r) -> ((# #) -> r) -> r
$bVLeft :: forall a (errs :: [*]). Vary errs -> VEither errs a
VLeft errs <- (toEither -> Left errs)
   where
      VLeft (Vary Word
tag Any
err) = Vary (a : errs) -> VEither errs a
forall (errs :: [*]) a. Vary (a : errs) -> VEither errs a
VEither ((Word -> Any -> Vary (a : errs)
forall (possibilities :: [*]). Word -> Any -> Vary possibilities
Vary (Word
tagWord -> Word -> Word
forall a. Num a => a -> a -> a
+Word
1) Any
err))

pattern VRight :: forall a errs. a -> VEither errs a
{-# INLINE VRight #-}
pattern $mVRight :: forall {r} {a} {errs :: [*]}.
VEither errs a -> (a -> r) -> ((# #) -> r) -> r
$bVRight :: forall a (errs :: [*]). a -> VEither errs a
VRight a <- (toEither -> Right a)
  where
    VRight a
a = Vary (a : errs) -> VEither errs a
forall (errs :: [*]) a. Vary (a : errs) -> VEither errs a
VEither (forall a (l :: [*]). (a :| l) => a -> Vary l
Vary.from @a a
a)

onLeft :: forall err b errs a. (err -> b) -> (VEither errs a -> b) -> VEither (err : errs) a -> b
onLeft :: forall err b (errs :: [*]) a.
(err -> b) -> (VEither errs a -> b) -> VEither (err : errs) a -> b
onLeft err -> b
thiserrFun VEither errs a -> b
restfun VEither (err : errs) a
ve = case VEither (err : errs) a
ve of
  VLeft Vary (err : errs)
e -> forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on @err err -> b
thiserrFun (\Vary errs
otherErr -> VEither errs a -> b
restfun (Vary errs -> VEither errs a
forall a (errs :: [*]). Vary errs -> VEither errs a
VLeft Vary errs
otherErr)) Vary (err : errs)
e
  VRight a
a -> VEither errs a -> b
restfun (a -> VEither errs a
forall a (errs :: [*]). a -> VEither errs a
VRight a
a)

onRight :: (a -> b) -> (VEither errs a -> b) -> VEither errs a -> b
onRight :: forall a b (errs :: [*]).
(a -> b) -> (VEither errs a -> b) -> VEither errs a -> b
onRight a -> b
valfun VEither errs a -> b
restfun VEither errs a
ve = case VEither errs a
ve of
  VRight a
a -> a -> b
valfun a
a
  VLeft Vary errs
err -> VEither errs a -> b
restfun (Vary errs -> VEither errs a
forall a (errs :: [*]). Vary errs -> VEither errs a
VLeft Vary errs
err)

-- | If you have a VEither which does not actually contain any errors,
-- you can be sure it always contains an @a@.
--
-- Similar to "Vary".'Vary.intoOnly'.
intoOnly :: forall a. VEither '[] a -> a
intoOnly :: forall a. VEither '[] a -> a
intoOnly (VRight a
a) = a
a
intoOnly (VLeft Vary '[]
emptyVary) = Vary '[] -> a
forall anything. Vary '[] -> anything
Vary.exhaustiveCase Vary '[]
emptyVary


morph :: forall ys xs a. Subset (a : xs) (a : ys) => VEither xs a -> VEither ys a
morph :: forall (ys :: [*]) (xs :: [*]) a.
Subset (a : xs) (a : ys) =>
VEither xs a -> VEither ys a
morph = VEither xs a -> Vary (a : xs)
forall (errs :: [*]) a. VEither errs a -> Vary (a : errs)
toVary (VEither xs a -> Vary (a : xs))
-> (Vary (a : xs) -> VEither ys a) -> VEither xs a -> VEither ys a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Vary (a : xs) -> Vary (a : ys)
forall (ys :: [*]) (xs :: [*]). Subset xs ys => Vary xs -> Vary ys
Vary.morph (Vary (a : xs) -> Vary (a : ys))
-> (Vary (a : ys) -> VEither ys a) -> Vary (a : xs) -> VEither ys a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Vary (a : ys) -> VEither ys a
forall a (errs :: [*]). Vary (a : errs) -> VEither errs a
fromVary

-- | Execute a function expecting a larger (or differently-ordered) variant
-- with a smaller (or differently-ordered) variant,
-- by calling `morph` on it before running the function.
morphed :: forall xs ys a res. Subset (a : xs) (a : ys) => (VEither ys a -> res) -> VEither xs a -> res
{-# INLINE morphed #-}
morphed :: forall (xs :: [*]) (ys :: [*]) a res.
Subset (a : xs) (a : ys) =>
(VEither ys a -> res) -> VEither xs a -> res
morphed VEither ys a -> res
fun = VEither ys a -> res
fun (VEither ys a -> res)
-> (VEither xs a -> VEither ys a) -> VEither xs a -> res
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VEither xs a -> VEither ys a
forall (ys :: [*]) (xs :: [*]) a.
Subset (a : xs) (a : ys) =>
VEither xs a -> VEither ys a
morph

-- | Map a function over one of the error values inside the 'VEither'.
--
-- Any other 'VLeft' and  also 'VRight' are kept untouched.
--
-- Similar to "Vary".'Vary.mapOn'.
mapLeftOn :: forall x y xs ys a. (Mappable x y xs ys) => (x -> y) -> VEither xs a -> VEither ys a
mapLeftOn :: forall x y (xs :: [*]) (ys :: [*]) a.
Mappable x y xs ys =>
(x -> y) -> VEither xs a -> VEither ys a
mapLeftOn x -> y
_ (VRight a
val) = a -> VEither ys a
forall a (errs :: [*]). a -> VEither errs a
VRight a
val
mapLeftOn x -> y
fun (VLeft Vary xs
err) = Vary ys -> VEither ys a
forall a (errs :: [*]). Vary errs -> VEither errs a
VLeft (Vary ys -> VEither ys a) -> Vary ys -> VEither ys a
forall a b. (a -> b) -> a -> b
$ (x -> y) -> Vary xs -> Vary ys
forall a b (xs :: [*]) (ys :: [*]).
Mappable a b xs ys =>
(a -> b) -> Vary xs -> Vary ys
Vary.mapOn x -> y
fun Vary xs
err

-- | Map a function over the 'VEither' if it contains a 'VLeft', otherwise leave it alone.
--
-- See also "VEither".'mapLeftOn', "VEither".'mapRight' and "VEither".'veither'.
--
mapLeft :: (Vary xs -> Vary ys) -> VEither xs a -> VEither ys a
mapLeft :: forall (xs :: [*]) (ys :: [*]) a.
(Vary xs -> Vary ys) -> VEither xs a -> VEither ys a
mapLeft Vary xs -> Vary ys
fun VEither xs a
ve = case VEither xs a
ve of 
    VRight a
a -> a -> VEither ys a
forall a (errs :: [*]). a -> VEither errs a
VRight a
a
    VLeft Vary xs
errs -> Vary ys -> VEither ys a
forall a (errs :: [*]). Vary errs -> VEither errs a
VLeft (Vary xs -> Vary ys
fun Vary xs
errs)

-- | Map a function over the 'VEither' if it contains a 'VRight', otherwise leave it alone.
--
-- Exists for symmetry with "VEither".'mapLeft' and "VEither".'mapLeftOn'.
--
-- Indeed, it is just another name for 'fmap'.
--
-- See also "VEither".'veither'.
mapRight :: (x -> y) -> VEither errs x -> VEither errs y
mapRight :: forall x y (errs :: [*]).
(x -> y) -> VEither errs x -> VEither errs y
mapRight x -> y
fun VEither errs x
ve = case VEither errs x
ve of 
    VRight x
a -> y -> VEither errs y
forall a (errs :: [*]). a -> VEither errs a
VRight (x -> y
fun x
a)
    VLeft Vary errs
errs -> Vary errs -> VEither errs y
forall a (errs :: [*]). Vary errs -> VEither errs a
VLeft Vary errs
errs

instance (Show a, Show (Vary errs)) => Show (VEither errs a) where
  show :: VEither errs a -> String
show (VLeft Vary errs
errs) = String
"VLeft (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Vary errs -> String
forall a. Show a => a -> String
show Vary errs
errs String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  show (VRight a
a) = String
"VRight " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
a

instance (Eq a, Eq (Vary errs)) => Eq (VEither errs a) where
  VEither errs a
a == :: VEither errs a -> VEither errs a -> Bool
== VEither errs a
b = VEither errs a -> Vary (a : errs)
forall (errs :: [*]) a. VEither errs a -> Vary (a : errs)
toVary VEither errs a
a Vary (a : errs) -> Vary (a : errs) -> Bool
forall a. Eq a => a -> a -> Bool
== VEither errs a -> Vary (a : errs)
forall (errs :: [*]) a. VEither errs a -> Vary (a : errs)
toVary VEither errs a
b

instance (Ord a, Ord (Vary errs)) => Ord (VEither errs a) where
  compare :: VEither errs a -> VEither errs a -> Ordering
compare VEither errs a
a VEither errs a
b = Vary (a : errs) -> Vary (a : errs) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (VEither errs a -> Vary (a : errs)
forall (errs :: [*]) a. VEither errs a -> Vary (a : errs)
toVary VEither errs a
a) (VEither errs a -> Vary (a : errs)
forall (errs :: [*]) a. VEither errs a -> Vary (a : errs)
toVary VEither errs a
b)

instance (NFData a, NFData (Vary errs)) => NFData (VEither errs a) where
  rnf :: VEither errs a -> ()
rnf = VEither errs a -> Vary (a : errs)
forall (errs :: [*]) a. VEither errs a -> Vary (a : errs)
toVary (VEither errs a -> Vary (a : errs))
-> (Vary (a : errs) -> ()) -> VEither errs a -> ()
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Vary (a : errs) -> ()
forall a. NFData a => a -> ()
rnf

instance Functor (VEither errs) where
  fmap :: forall a b. (a -> b) -> VEither errs a -> VEither errs b
  {-# INLINE fmap #-}
  fmap :: forall a b. (a -> b) -> VEither errs a -> VEither errs b
fmap = (a -> b) -> VEither errs a -> VEither errs b
forall x y (errs :: [*]).
(x -> y) -> VEither errs x -> VEither errs y
mapRight

instance Applicative (VEither errs) where
  {-# INLINE pure #-}
  pure :: forall a. a -> VEither errs a
pure = a -> VEither errs a
forall a (errs :: [*]). a -> VEither errs a
VRight

  {-# INLINE (<*>) #-}
  (VRight a -> b
fun) <*> :: forall a b.
VEither errs (a -> b) -> VEither errs a -> VEither errs b
<*> (VRight a
val) = b -> VEither errs b
forall a (errs :: [*]). a -> VEither errs a
VRight (a -> b
fun a
val)
  (VLeft Vary errs
err) <*> VEither errs a
_ = (Vary errs -> VEither errs b
forall a (errs :: [*]). Vary errs -> VEither errs a
VLeft Vary errs
err)
  VEither errs (a -> b)
_ <*> (VLeft Vary errs
err) = (Vary errs -> VEither errs b
forall a (errs :: [*]). Vary errs -> VEither errs a
VLeft Vary errs
err)

instance Monad (VEither errs) where
  (>>=) :: forall a b. VEither errs a -> (a -> VEither errs b) -> VEither errs b
  (VRight a
a) >>= :: forall a b.
VEither errs a -> (a -> VEither errs b) -> VEither errs b
>>= a -> VEither errs b
fun = a -> VEither errs b
fun a
a
  (VLeft Vary errs
err) >>= a -> VEither errs b
_  = (Vary errs -> VEither errs b
forall a (errs :: [*]). Vary errs -> VEither errs a
VLeft Vary errs
err)

instance Foldable (VEither errs) where
    foldMap :: forall m a. Monoid m => (a -> m) -> VEither errs a -> m
foldMap a -> m
_ (VLeft Vary errs
_) = m
forall a. Monoid a => a
mempty
    foldMap a -> m
f (VRight a
y) = a -> m
f a
y

    foldr :: forall a b. (a -> b -> b) -> b -> VEither errs a -> b
foldr a -> b -> b
_ b
z (VLeft Vary errs
_) = b
z
    foldr a -> b -> b
f b
z (VRight a
y) = a -> b -> b
f a
y b
z

    length :: forall a. VEither errs a -> Int
length (VLeft Vary errs
_)  = Int
0
    length (VRight a
_) = Int
1

instance Traversable (VEither errs) where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> VEither errs a -> f (VEither errs b)
traverse a -> f b
_ (VLeft Vary errs
x) = VEither errs b -> f (VEither errs b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vary errs -> VEither errs b
forall a (errs :: [*]). Vary errs -> VEither errs a
VLeft Vary errs
x)
    traverse a -> f b
f (VRight a
y) = b -> VEither errs b
forall a (errs :: [*]). a -> VEither errs a
VRight (b -> VEither errs b) -> f b -> f (VEither errs b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
y

instance Semigroup (VEither errs a) where
  (VRight a
a) <> :: VEither errs a -> VEither errs a -> VEither errs a
<> VEither errs a
_ = (a -> VEither errs a
forall a (errs :: [*]). a -> VEither errs a
VRight a
a)
  VEither errs a
_ <> VEither errs a
b = VEither errs a
b

-- Look ma! A Hand-written Generic instance!
instance Generic (VEither errs a) where
  type (Rep (VEither errs a)) =  D1
       (MetaData "VEither" "Vary.VEither" "vary" False)
       (C1
          (MetaCons "VLeft" PrefixI False)
          (S1
             (MetaSel
                Nothing NoSourceUnpackedness NoSourceStrictness DecidedLazy)
             (Rec0 (Vary errs)))
        :+: C1
              (MetaCons "VRight" PrefixI False)
              (S1
                 (MetaSel
                    Nothing NoSourceUnpackedness NoSourceStrictness DecidedLazy)
                 (Rec0 a)))

  from :: VEither errs a -> Rep (VEither errs a) x
  from :: forall x. VEither errs a -> Rep (VEither errs a) x
from VEither errs a
ve =
    case VEither errs a
ve of
      (VLeft Vary errs
err) -> (:+:)
  (M1
     C
     ('MetaCons "VLeft" 'PrefixI 'False)
     (M1
        S
        ('MetaSel
           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
        (K1 R (Vary errs))))
  (C1
     ('MetaCons "VRight" 'PrefixI 'False)
     (S1
        ('MetaSel
           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
        (Rec0 a)))
  x
-> M1
     D
     ('MetaData "VEither" "Vary.VEither" "vary" 'False)
     (M1
        C
        ('MetaCons "VLeft" 'PrefixI 'False)
        (M1
           S
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (K1 R (Vary errs)))
      :+: C1
            ('MetaCons "VRight" 'PrefixI 'False)
            (S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 a)))
     x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((:+:)
   (M1
      C
      ('MetaCons "VLeft" 'PrefixI 'False)
      (M1
         S
         ('MetaSel
            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
         (K1 R (Vary errs))))
   (C1
      ('MetaCons "VRight" 'PrefixI 'False)
      (S1
         ('MetaSel
            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
         (Rec0 a)))
   x
 -> M1
      D
      ('MetaData "VEither" "Vary.VEither" "vary" 'False)
      (M1
         C
         ('MetaCons "VLeft" 'PrefixI 'False)
         (M1
            S
            ('MetaSel
               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
            (K1 R (Vary errs)))
       :+: C1
             ('MetaCons "VRight" 'PrefixI 'False)
             (S1
                ('MetaSel
                   'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                (Rec0 a)))
      x)
-> (:+:)
     (M1
        C
        ('MetaCons "VLeft" 'PrefixI 'False)
        (M1
           S
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (K1 R (Vary errs))))
     (C1
        ('MetaCons "VRight" 'PrefixI 'False)
        (S1
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (Rec0 a)))
     x
-> M1
     D
     ('MetaData "VEither" "Vary.VEither" "vary" 'False)
     (M1
        C
        ('MetaCons "VLeft" 'PrefixI 'False)
        (M1
           S
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (K1 R (Vary errs)))
      :+: C1
            ('MetaCons "VRight" 'PrefixI 'False)
            (S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 a)))
     x
forall a b. (a -> b) -> a -> b
$ M1
  C
  ('MetaCons "VLeft" 'PrefixI 'False)
  (M1
     S
     ('MetaSel
        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
     (K1 R (Vary errs)))
  x
-> (:+:)
     (M1
        C
        ('MetaCons "VLeft" 'PrefixI 'False)
        (M1
           S
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (K1 R (Vary errs))))
     (C1
        ('MetaCons "VRight" 'PrefixI 'False)
        (S1
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (Rec0 a)))
     x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (M1
   C
   ('MetaCons "VLeft" 'PrefixI 'False)
   (M1
      S
      ('MetaSel
         'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
      (K1 R (Vary errs)))
   x
 -> (:+:)
      (M1
         C
         ('MetaCons "VLeft" 'PrefixI 'False)
         (M1
            S
            ('MetaSel
               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
            (K1 R (Vary errs))))
      (C1
         ('MetaCons "VRight" 'PrefixI 'False)
         (S1
            ('MetaSel
               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
            (Rec0 a)))
      x)
-> M1
     C
     ('MetaCons "VLeft" 'PrefixI 'False)
     (M1
        S
        ('MetaSel
           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
        (K1 R (Vary errs)))
     x
-> (:+:)
     (M1
        C
        ('MetaCons "VLeft" 'PrefixI 'False)
        (M1
           S
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (K1 R (Vary errs))))
     (C1
        ('MetaCons "VRight" 'PrefixI 'False)
        (S1
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (Rec0 a)))
     x
forall a b. (a -> b) -> a -> b
$ M1
  S
  ('MetaSel
     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
  (K1 R (Vary errs))
  x
-> M1
     C
     ('MetaCons "VLeft" 'PrefixI 'False)
     (M1
        S
        ('MetaSel
           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
        (K1 R (Vary errs)))
     x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1
   S
   ('MetaSel
      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
   (K1 R (Vary errs))
   x
 -> M1
      C
      ('MetaCons "VLeft" 'PrefixI 'False)
      (M1
         S
         ('MetaSel
            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
         (K1 R (Vary errs)))
      x)
-> M1
     S
     ('MetaSel
        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
     (K1 R (Vary errs))
     x
-> M1
     C
     ('MetaCons "VLeft" 'PrefixI 'False)
     (M1
        S
        ('MetaSel
           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
        (K1 R (Vary errs)))
     x
forall a b. (a -> b) -> a -> b
$ K1 R (Vary errs) x
-> M1
     S
     ('MetaSel
        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
     (K1 R (Vary errs))
     x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R (Vary errs) x
 -> M1
      S
      ('MetaSel
         'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
      (K1 R (Vary errs))
      x)
-> K1 R (Vary errs) x
-> M1
     S
     ('MetaSel
        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
     (K1 R (Vary errs))
     x
forall a b. (a -> b) -> a -> b
$ Vary errs -> K1 R (Vary errs) x
forall k i c (p :: k). c -> K1 i c p
K1 Vary errs
err
      (VRight a
val) -> (:+:)
  (M1
     C
     ('MetaCons "VLeft" 'PrefixI 'False)
     (M1
        S
        ('MetaSel
           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
        (K1 R (Vary errs))))
  (C1
     ('MetaCons "VRight" 'PrefixI 'False)
     (S1
        ('MetaSel
           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
        (Rec0 a)))
  x
-> M1
     D
     ('MetaData "VEither" "Vary.VEither" "vary" 'False)
     (M1
        C
        ('MetaCons "VLeft" 'PrefixI 'False)
        (M1
           S
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (K1 R (Vary errs)))
      :+: C1
            ('MetaCons "VRight" 'PrefixI 'False)
            (S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 a)))
     x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((:+:)
   (M1
      C
      ('MetaCons "VLeft" 'PrefixI 'False)
      (M1
         S
         ('MetaSel
            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
         (K1 R (Vary errs))))
   (C1
      ('MetaCons "VRight" 'PrefixI 'False)
      (S1
         ('MetaSel
            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
         (Rec0 a)))
   x
 -> M1
      D
      ('MetaData "VEither" "Vary.VEither" "vary" 'False)
      (M1
         C
         ('MetaCons "VLeft" 'PrefixI 'False)
         (M1
            S
            ('MetaSel
               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
            (K1 R (Vary errs)))
       :+: C1
             ('MetaCons "VRight" 'PrefixI 'False)
             (S1
                ('MetaSel
                   'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                (Rec0 a)))
      x)
-> (:+:)
     (M1
        C
        ('MetaCons "VLeft" 'PrefixI 'False)
        (M1
           S
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (K1 R (Vary errs))))
     (C1
        ('MetaCons "VRight" 'PrefixI 'False)
        (S1
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (Rec0 a)))
     x
-> M1
     D
     ('MetaData "VEither" "Vary.VEither" "vary" 'False)
     (M1
        C
        ('MetaCons "VLeft" 'PrefixI 'False)
        (M1
           S
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (K1 R (Vary errs)))
      :+: C1
            ('MetaCons "VRight" 'PrefixI 'False)
            (S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 a)))
     x
forall a b. (a -> b) -> a -> b
$ M1
  C
  ('MetaCons "VRight" 'PrefixI 'False)
  (S1
     ('MetaSel
        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
     (Rec0 a))
  x
-> (:+:)
     (M1
        C
        ('MetaCons "VLeft" 'PrefixI 'False)
        (M1
           S
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (K1 R (Vary errs))))
     (C1
        ('MetaCons "VRight" 'PrefixI 'False)
        (S1
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (Rec0 a)))
     x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (M1
   C
   ('MetaCons "VRight" 'PrefixI 'False)
   (S1
      ('MetaSel
         'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
      (Rec0 a))
   x
 -> (:+:)
      (M1
         C
         ('MetaCons "VLeft" 'PrefixI 'False)
         (M1
            S
            ('MetaSel
               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
            (K1 R (Vary errs))))
      (C1
         ('MetaCons "VRight" 'PrefixI 'False)
         (S1
            ('MetaSel
               'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
            (Rec0 a)))
      x)
-> M1
     C
     ('MetaCons "VRight" 'PrefixI 'False)
     (S1
        ('MetaSel
           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
        (Rec0 a))
     x
-> (:+:)
     (M1
        C
        ('MetaCons "VLeft" 'PrefixI 'False)
        (M1
           S
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (K1 R (Vary errs))))
     (C1
        ('MetaCons "VRight" 'PrefixI 'False)
        (S1
           ('MetaSel
              'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
           (Rec0 a)))
     x
forall a b. (a -> b) -> a -> b
$ M1
  S
  ('MetaSel
     'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
  (Rec0 a)
  x
-> M1
     C
     ('MetaCons "VRight" 'PrefixI 'False)
     (S1
        ('MetaSel
           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
        (Rec0 a))
     x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1
   S
   ('MetaSel
      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
   (Rec0 a)
   x
 -> M1
      C
      ('MetaCons "VRight" 'PrefixI 'False)
      (S1
         ('MetaSel
            'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
         (Rec0 a))
      x)
-> M1
     S
     ('MetaSel
        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
     (Rec0 a)
     x
-> M1
     C
     ('MetaCons "VRight" 'PrefixI 'False)
     (S1
        ('MetaSel
           'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
        (Rec0 a))
     x
forall a b. (a -> b) -> a -> b
$ K1 R a x
-> M1
     S
     ('MetaSel
        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
     (Rec0 a)
     x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R a x
 -> M1
      S
      ('MetaSel
         'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
      (Rec0 a)
      x)
-> K1 R a x
-> M1
     S
     ('MetaSel
        'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
     (Rec0 a)
     x
forall a b. (a -> b) -> a -> b
$ a -> K1 R a x
forall k i c (p :: k). c -> K1 i c p
K1 a
val

  to :: Rep (VEither errs a) x -> VEither errs a 
  to :: forall x. Rep (VEither errs a) x -> VEither errs a
to Rep (VEither errs a) x
rep = case Rep (VEither errs a) x
rep of
    (M1 (L1 (M1 (M1 (K1 Vary errs
err))))) -> (Vary errs -> VEither errs a
forall a (errs :: [*]). Vary errs -> VEither errs a
VLeft Vary errs
err)
    (M1 (R1 (M1 (M1 (K1 a
val))))) -> (a -> VEither errs a
forall a (errs :: [*]). a -> VEither errs a
VRight a
val)


-- Conceptually VEither is a Bifunctor,
-- but the kind does not align :-(
-- p has to be Type -> Type -> Type
-- But in the case of VEither it is [Type] -> Type -> Type
--
-- instance Bifunctor VEither where
--   first = mapLeft
--   second = mapRight
--   bimap = veither