{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveLift #-}
-- | Elr definition

module Predicate.Elr (
 -- definition

    Elr(..)

 -- ** prisms

  , _ENone
  , _ELeft
  , _ERight
  , _EBoth

 -- ** isos

  , _elr2Maybe
  , _elr2These

 -- ** boolean predicates

  , isENone
  , isELeft
  , isERight
  , isEBoth

 -- ** type families

  , ENoneT
  , ELeftT
  , ERightT
  , EBothT

 -- ** miscellaneous

  , getBifoldInfo
  , showElr
  , GetElr(..)
  , partitionElr
  , fromElr
  , mergeElrWith
  , elr
 ) where
import Predicate.Misc
import qualified GHC.TypeLits as GL
import GHC.TypeLits (ErrorMessage((:$$:),(:<>:)))
import Control.Lens
import Data.Bitraversable (Bitraversable(..))
import Data.Bifoldable (Bifoldable(bifoldMap))
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import Control.Monad (ap)
import qualified Language.Haskell.TH.Lift as TH
import Data.These (These(..))
-- $setup

-- >>> import Predicate.Prelude

-- >>> import qualified Data.Semigroup as SG


-- | similar to 'Data.These' with an additional empty constructor to support a Monoid instance

data Elr a b =
     ENone -- ^ empty constructor

   | ELeft !a  -- ^ similar to 'Data.These.This'

   | ERight !b -- ^ similar to 'Data.These.That'

   | EBoth !a !b -- ^ similar to 'Data.These.These'

   deriving stock (Int -> Elr a b -> ShowS
[Elr a b] -> ShowS
Elr a b -> String
(Int -> Elr a b -> ShowS)
-> (Elr a b -> String) -> ([Elr a b] -> ShowS) -> Show (Elr a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Elr a b -> ShowS
forall a b. (Show a, Show b) => [Elr a b] -> ShowS
forall a b. (Show a, Show b) => Elr a b -> String
showList :: [Elr a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Elr a b] -> ShowS
show :: Elr a b -> String
$cshow :: forall a b. (Show a, Show b) => Elr a b -> String
showsPrec :: Int -> Elr a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Elr a b -> ShowS
Show,Elr a b -> Elr a b -> Bool
(Elr a b -> Elr a b -> Bool)
-> (Elr a b -> Elr a b -> Bool) -> Eq (Elr a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Elr a b -> Elr a b -> Bool
/= :: Elr a b -> Elr a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Elr a b -> Elr a b -> Bool
== :: Elr a b -> Elr a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Elr a b -> Elr a b -> Bool
Eq,Eq (Elr a b)
Eq (Elr a b)
-> (Elr a b -> Elr a b -> Ordering)
-> (Elr a b -> Elr a b -> Bool)
-> (Elr a b -> Elr a b -> Bool)
-> (Elr a b -> Elr a b -> Bool)
-> (Elr a b -> Elr a b -> Bool)
-> (Elr a b -> Elr a b -> Elr a b)
-> (Elr a b -> Elr a b -> Elr a b)
-> Ord (Elr a b)
Elr a b -> Elr a b -> Bool
Elr a b -> Elr a b -> Ordering
Elr a b -> Elr a b -> Elr a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (Elr a b)
forall a b. (Ord a, Ord b) => Elr a b -> Elr a b -> Bool
forall a b. (Ord a, Ord b) => Elr a b -> Elr a b -> Ordering
forall a b. (Ord a, Ord b) => Elr a b -> Elr a b -> Elr a b
min :: Elr a b -> Elr a b -> Elr a b
$cmin :: forall a b. (Ord a, Ord b) => Elr a b -> Elr a b -> Elr a b
max :: Elr a b -> Elr a b -> Elr a b
$cmax :: forall a b. (Ord a, Ord b) => Elr a b -> Elr a b -> Elr a b
>= :: Elr a b -> Elr a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => Elr a b -> Elr a b -> Bool
> :: Elr a b -> Elr a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => Elr a b -> Elr a b -> Bool
<= :: Elr a b -> Elr a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => Elr a b -> Elr a b -> Bool
< :: Elr a b -> Elr a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => Elr a b -> Elr a b -> Bool
compare :: Elr a b -> Elr a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => Elr a b -> Elr a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (Elr a b)
Ord,Elr a a -> Bool
(a -> m) -> Elr a a -> m
(a -> b -> b) -> b -> Elr a a -> b
(forall m. Monoid m => Elr a m -> m)
-> (forall m a. Monoid m => (a -> m) -> Elr a a -> m)
-> (forall m a. Monoid m => (a -> m) -> Elr a a -> m)
-> (forall a b. (a -> b -> b) -> b -> Elr a a -> b)
-> (forall a b. (a -> b -> b) -> b -> Elr a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Elr a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Elr a a -> b)
-> (forall a. (a -> a -> a) -> Elr a a -> a)
-> (forall a. (a -> a -> a) -> Elr a a -> a)
-> (forall a. Elr a a -> [a])
-> (forall a. Elr a a -> Bool)
-> (forall a. Elr a a -> Int)
-> (forall a. Eq a => a -> Elr a a -> Bool)
-> (forall a. Ord a => Elr a a -> a)
-> (forall a. Ord a => Elr a a -> a)
-> (forall a. Num a => Elr a a -> a)
-> (forall a. Num a => Elr a a -> a)
-> Foldable (Elr a)
forall a. Eq a => a -> Elr a a -> Bool
forall a. Num a => Elr a a -> a
forall a. Ord a => Elr a a -> a
forall m. Monoid m => Elr a m -> m
forall a. Elr a a -> Bool
forall a. Elr a a -> Int
forall a. Elr a a -> [a]
forall a. (a -> a -> a) -> Elr a a -> a
forall a a. Eq a => a -> Elr a a -> Bool
forall a a. Num a => Elr a a -> a
forall a a. Ord a => Elr a a -> a
forall m a. Monoid m => (a -> m) -> Elr a a -> m
forall a m. Monoid m => Elr a m -> m
forall a a. Elr a a -> Bool
forall a a. Elr a a -> Int
forall a a. Elr a a -> [a]
forall b a. (b -> a -> b) -> b -> Elr a a -> b
forall a b. (a -> b -> b) -> b -> Elr a a -> b
forall a a. (a -> a -> a) -> Elr a a -> a
forall a m a. Monoid m => (a -> m) -> Elr a a -> m
forall a b a. (b -> a -> b) -> b -> Elr a a -> b
forall a a b. (a -> b -> b) -> b -> Elr a a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Elr a a -> a
$cproduct :: forall a a. Num a => Elr a a -> a
sum :: Elr a a -> a
$csum :: forall a a. Num a => Elr a a -> a
minimum :: Elr a a -> a
$cminimum :: forall a a. Ord a => Elr a a -> a
maximum :: Elr a a -> a
$cmaximum :: forall a a. Ord a => Elr a a -> a
elem :: a -> Elr a a -> Bool
$celem :: forall a a. Eq a => a -> Elr a a -> Bool
length :: Elr a a -> Int
$clength :: forall a a. Elr a a -> Int
null :: Elr a a -> Bool
$cnull :: forall a a. Elr a a -> Bool
toList :: Elr a a -> [a]
$ctoList :: forall a a. Elr a a -> [a]
foldl1 :: (a -> a -> a) -> Elr a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> Elr a a -> a
foldr1 :: (a -> a -> a) -> Elr a a -> a
$cfoldr1 :: forall a a. (a -> a -> a) -> Elr a a -> a
foldl' :: (b -> a -> b) -> b -> Elr a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> Elr a a -> b
foldl :: (b -> a -> b) -> b -> Elr a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> Elr a a -> b
foldr' :: (a -> b -> b) -> b -> Elr a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> Elr a a -> b
foldr :: (a -> b -> b) -> b -> Elr a a -> b
$cfoldr :: forall a a b. (a -> b -> b) -> b -> Elr a a -> b
foldMap' :: (a -> m) -> Elr a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> Elr a a -> m
foldMap :: (a -> m) -> Elr a a -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> Elr a a -> m
fold :: Elr a m -> m
$cfold :: forall a m. Monoid m => Elr a m -> m
Foldable,a -> Elr a b -> Elr a a
(a -> b) -> Elr a a -> Elr a b
(forall a b. (a -> b) -> Elr a a -> Elr a b)
-> (forall a b. a -> Elr a b -> Elr a a) -> Functor (Elr a)
forall a b. a -> Elr a b -> Elr a a
forall a b. (a -> b) -> Elr a a -> Elr a b
forall a a b. a -> Elr a b -> Elr a a
forall a a b. (a -> b) -> Elr a a -> Elr a b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Elr a b -> Elr a a
$c<$ :: forall a a b. a -> Elr a b -> Elr a a
fmap :: (a -> b) -> Elr a a -> Elr a b
$cfmap :: forall a a b. (a -> b) -> Elr a a -> Elr a b
Functor,Functor (Elr a)
Foldable (Elr a)
Functor (Elr a)
-> Foldable (Elr a)
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Elr a a -> f (Elr a b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    Elr a (f a) -> f (Elr a a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> Elr a a -> m (Elr a b))
-> (forall (m :: Type -> Type) a.
    Monad m =>
    Elr a (m a) -> m (Elr a a))
-> Traversable (Elr a)
(a -> f b) -> Elr a a -> f (Elr a b)
forall a. Functor (Elr a)
forall a. Foldable (Elr a)
forall a (m :: Type -> Type) a.
Monad m =>
Elr a (m a) -> m (Elr a a)
forall a (f :: Type -> Type) a.
Applicative f =>
Elr a (f a) -> f (Elr a a)
forall a (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Elr a a -> m (Elr a b)
forall a (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Elr a a -> f (Elr a b)
forall (t :: Type -> Type).
Functor t
-> Foldable t
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    t (f a) -> f (t a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: Type -> Type) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: Type -> Type) a. Monad m => Elr a (m a) -> m (Elr a a)
forall (f :: Type -> Type) a.
Applicative f =>
Elr a (f a) -> f (Elr a a)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Elr a a -> m (Elr a b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Elr a a -> f (Elr a b)
sequence :: Elr a (m a) -> m (Elr a a)
$csequence :: forall a (m :: Type -> Type) a.
Monad m =>
Elr a (m a) -> m (Elr a a)
mapM :: (a -> m b) -> Elr a a -> m (Elr a b)
$cmapM :: forall a (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Elr a a -> m (Elr a b)
sequenceA :: Elr a (f a) -> f (Elr a a)
$csequenceA :: forall a (f :: Type -> Type) a.
Applicative f =>
Elr a (f a) -> f (Elr a a)
traverse :: (a -> f b) -> Elr a a -> f (Elr a b)
$ctraverse :: forall a (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Elr a a -> f (Elr a b)
$cp2Traversable :: forall a. Foldable (Elr a)
$cp1Traversable :: forall a. Functor (Elr a)
Traversable,(forall x. Elr a b -> Rep (Elr a b) x)
-> (forall x. Rep (Elr a b) x -> Elr a b) -> Generic (Elr a b)
forall x. Rep (Elr a b) x -> Elr a b
forall x. Elr a b -> Rep (Elr a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (Elr a b) x -> Elr a b
forall a b x. Elr a b -> Rep (Elr a b) x
$cto :: forall a b x. Rep (Elr a b) x -> Elr a b
$cfrom :: forall a b x. Elr a b -> Rep (Elr a b) x
Generic,Elr a b -> Q Exp
Elr a b -> Q (TExp (Elr a b))
(Elr a b -> Q Exp)
-> (Elr a b -> Q (TExp (Elr a b))) -> Lift (Elr a b)
forall a b. (Lift a, Lift b) => Elr a b -> Q Exp
forall a b. (Lift a, Lift b) => Elr a b -> Q (TExp (Elr a b))
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Elr a b -> Q (TExp (Elr a b))
$cliftTyped :: forall a b. (Lift a, Lift b) => Elr a b -> Q (TExp (Elr a b))
lift :: Elr a b -> Q Exp
$clift :: forall a b. (Lift a, Lift b) => Elr a b -> Q Exp
TH.Lift)
   deriving anyclass Elr a b -> ()
(Elr a b -> ()) -> NFData (Elr a b)
forall a. (a -> ()) -> NFData a
forall a b. (NFData a, NFData b) => Elr a b -> ()
rnf :: Elr a b -> ()
$crnf :: forall a b. (NFData a, NFData b) => Elr a b -> ()
NFData

makePrisms ''Elr

instance (Semigroup a, Semigroup b) => Semigroup (Elr a b) where
  Elr a b
ENone <> :: Elr a b -> Elr a b -> Elr a b
<> Elr a b
x' = Elr a b
x'
  Elr a b
x <> Elr a b
ENone = Elr a b
x
  ELeft a
a <> ELeft a
a' = a -> Elr a b
forall a b. a -> Elr a b
ELeft (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a')
  ELeft a
a <> ERight b
b' = a -> b -> Elr a b
forall a b. a -> b -> Elr a b
EBoth a
a b
b'
  ELeft a
a <> EBoth a
a' b
b' = a -> b -> Elr a b
forall a b. a -> b -> Elr a b
EBoth (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a') b
b'
  ERight b
b <> ELeft a
a' = a -> b -> Elr a b
forall a b. a -> b -> Elr a b
EBoth a
a' b
b
  ERight b
b <> ERight b
b' = b -> Elr a b
forall a b. b -> Elr a b
ERight (b
b b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
b')
  ERight b
b <> EBoth a
a' b
b' = a -> b -> Elr a b
forall a b. a -> b -> Elr a b
EBoth a
a' (b
b b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
b')
  EBoth a
a b
b <> ELeft a
a' = a -> b -> Elr a b
forall a b. a -> b -> Elr a b
EBoth (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a') b
b
  EBoth a
a b
b <> ERight b
b' = a -> b -> Elr a b
forall a b. a -> b -> Elr a b
EBoth a
a (b
b b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
b')
  EBoth a
a b
b <> EBoth a
a' b
b' = a -> b -> Elr a b
forall a b. a -> b -> Elr a b
EBoth (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a') (b
b b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
b')

instance (Monoid a, Monoid b) => Monoid (Elr a b) where
  mempty :: Elr a b
mempty = Elr a b
forall a b. Elr a b
ENone

instance Semigroup x => Applicative (Elr x) where
  pure :: a -> Elr x a
pure = a -> Elr x a
forall a b. b -> Elr a b
ERight
  <*> :: Elr x (a -> b) -> Elr x a -> Elr x b
(<*>) = Elr x (a -> b) -> Elr x a -> Elr x b
forall (m :: Type -> Type) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Semigroup x => Monad (Elr x) where
  return :: a -> Elr x a
return = a -> Elr x a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
  Elr x a
ENone >>= :: Elr x a -> (a -> Elr x b) -> Elr x b
>>= a -> Elr x b
_ = Elr x b
forall a b. Elr a b
ENone
  ELeft x
x >>= a -> Elr x b
_ = x -> Elr x b
forall a b. a -> Elr a b
ELeft x
x
  ERight a
a >>= a -> Elr x b
amb = a -> Elr x b
amb a
a
  EBoth x
x a
a >>= a -> Elr x b
amb =
    case a -> Elr x b
amb a
a of
      Elr x b
ENone -> x -> Elr x b
forall a b. a -> Elr a b
ELeft x
x
      ELeft x
y -> x -> Elr x b
forall a b. a -> Elr a b
ELeft (x
x x -> x -> x
forall a. Semigroup a => a -> a -> a
<> x
y)
      ERight b
b -> x -> b -> Elr x b
forall a b. a -> b -> Elr a b
EBoth x
x b
b
      EBoth x
y b
b -> x -> b -> Elr x b
forall a b. a -> b -> Elr a b
EBoth (x
x x -> x -> x
forall a. Semigroup a => a -> a -> a
<> x
y) b
b

instance Bifunctor Elr where
  bimap :: (a -> b) -> (c -> d) -> Elr a c -> Elr b d
bimap a -> b
f c -> d
g =
    \case
      Elr a c
ENone -> Elr b d
forall a b. Elr a b
ENone
      ELeft a
a -> b -> Elr b d
forall a b. a -> Elr a b
ELeft (a -> b
f a
a)
      ERight c
b -> d -> Elr b d
forall a b. b -> Elr a b
ERight (c -> d
g c
b)
      EBoth a
a c
b -> b -> d -> Elr b d
forall a b. a -> b -> Elr a b
EBoth (a -> b
f a
a) (c -> d
g c
b)

instance Bifoldable Elr where
  bifoldMap :: (a -> m) -> (b -> m) -> Elr a b -> m
bifoldMap a -> m
f b -> m
g =
    \case
      Elr a b
ENone -> m
forall a. Monoid a => a
mempty
      ELeft a
a -> a -> m
f a
a
      ERight b
b -> b -> m
g b
b
      EBoth a
a b
b -> a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
b

instance Bitraversable Elr where
  bitraverse :: (a -> f c) -> (b -> f d) -> Elr a b -> f (Elr c d)
bitraverse a -> f c
f b -> f d
g =
    \case
      Elr a b
ENone -> Elr c d -> f (Elr c d)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Elr c d
forall a b. Elr a b
ENone
      ELeft a
a -> c -> Elr c d
forall a b. a -> Elr a b
ELeft (c -> Elr c d) -> f c -> f (Elr c d)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a
      ERight b
b -> d -> Elr c d
forall a b. b -> Elr a b
ERight (d -> Elr c d) -> f d -> f (Elr c d)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
b
      EBoth a
a b
b -> c -> d -> Elr c d
forall a b. a -> b -> Elr a b
EBoth (c -> d -> Elr c d) -> f c -> f (d -> Elr c d)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a f (d -> Elr c d) -> f d -> f (Elr c d)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> b -> f d
g b
b

-- | display constructor name for 'Elr'

showElr :: Elr a b -> String
showElr :: Elr a b -> String
showElr = \case
  Elr a b
ENone -> String
"ENone"
  ELeft {} -> String
"ELeft"
  ERight {} -> String
"ERight"
  EBoth {} -> String
"EBoth"

-- | get 'Elr' from typelevel [type application order is a b then th if explicit kind for th else is first parameter!

class GetElr (th :: Elr k k1) where
  getElr :: (String, Elr w v -> Bool)
instance GetElr 'ENone where
  getElr :: (String, Elr w v -> Bool)
getElr = (String
"ENone", Elr w v -> Bool
forall a a. Elr a a -> Bool
isENone)
instance GetElr ('ELeft x) where
  getElr :: (String, Elr w v -> Bool)
getElr = (String
"ELeft", Elr w v -> Bool
forall a a. Elr a a -> Bool
isELeft)
instance GetElr ('ERight y) where
  getElr :: (String, Elr w v -> Bool)
getElr = (String
"ERight", Elr w v -> Bool
forall a a. Elr a a -> Bool
isERight)
instance GetElr ('EBoth x y) where
  getElr :: (String, Elr w v -> Bool)
getElr = (String
"EBoth", Elr w v -> Bool
forall a a. Elr a a -> Bool
isEBoth)

isENone, isELeft, isERight, isEBoth :: Elr a b -> Bool
-- | predicate on ENone

isENone :: Elr a b -> Bool
isENone Elr a b
ENone = Bool
True
isENone Elr a b
_ = Bool
False

-- | predicate on ELeft

isELeft :: Elr a b -> Bool
isELeft ELeft {} = Bool
True
isELeft Elr a b
_ = Bool
False

-- | predicate on ERight

isERight :: Elr a b -> Bool
isERight ERight {} = Bool
True
isERight Elr a b
_ = Bool
False

-- | predicate on EBoth

isEBoth :: Elr a b -> Bool
isEBoth EBoth {} = Bool
True
isEBoth Elr a b
_ = Bool
False

-- | extract the relevant type for 'ENone'

type family ENoneT lr where
  ENoneT (Elr _ _) = ()
  ENoneT o = GL.TypeError (
      'GL.Text "ENoneT: expected 'Elr a b' "
      ':$$: 'GL.Text "o = "
      ':<>: 'GL.ShowType o)

-- | extract the relevant type for 'ELeft'

type family ELeftT lr where
  ELeftT (Elr a _) = a
  ELeftT o = GL.TypeError (
      'GL.Text "ELeftT: expected 'Elr a b' "
      ':$$: 'GL.Text "o = "
      ':<>: 'GL.ShowType o)

-- | extract the relevant type for 'ERight'

type family ERightT lr where
  ERightT (Elr _ b) = b
  ERightT o = GL.TypeError (
      'GL.Text "ERightT: expected 'Elr a b' "
      ':$$: 'GL.Text "o = "
      ':<>: 'GL.ShowType o)

-- | extract the relevant types for 'EBoth'

type family EBothT lr where
  EBothT (Elr a b) = (a,b)
  EBothT o = GL.TypeError (
      'GL.Text "EBothT: expected 'Elr a b' "
      ':$$: 'GL.Text "o = "
      ':<>: 'GL.ShowType o)

-- | partition Elr into 4 lists for each constructor: foldMap (yep ...)

partitionElr :: [Elr a b] -> ([()], [a], [b], [(a,b)])
partitionElr :: [Elr a b] -> ([()], [a], [b], [(a, b)])
partitionElr = (Elr a b -> ([()], [a], [b], [(a, b)]))
-> [Elr a b] -> ([()], [a], [b], [(a, b)])
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapStrict ((Elr a b -> ([()], [a], [b], [(a, b)]))
 -> [Elr a b] -> ([()], [a], [b], [(a, b)]))
-> (Elr a b -> ([()], [a], [b], [(a, b)]))
-> [Elr a b]
-> ([()], [a], [b], [(a, b)])
forall a b. (a -> b) -> a -> b
$
  \case
    Elr a b
ENone -> ([()],[],[],[])
    ELeft a
a -> ([],[a
a],[],[])
    ERight b
b -> ([],[],[b
b],[])
    EBoth a
a b
b -> ([],[],[],[(a
a,b
b)])

-- | convert Elr to a tuple with default values

fromElr :: a -> b -> Elr a b -> (a,b)
fromElr :: a -> b -> Elr a b -> (a, b)
fromElr a
a b
b =
  \case
    Elr a b
ENone -> (a
a,b
b)
    ELeft a
v -> (a
v,b
b)
    ERight b
w -> (a
a,b
w)
    EBoth a
v b
w -> (a
v,b
w)

-- | iso from 'Elr' to 'These'

--

-- >>> ENone & _elr2These .~ Just (This 12)

-- ELeft 12

--

-- >>> ELeft 123 & _elr2These %~ fmap swapC

-- ERight 123

--

_elr2These :: Iso (Elr a b) (Elr a' b') (Maybe (These a b)) (Maybe (These a' b'))
_elr2These :: p (Maybe (These a b)) (f (Maybe (These a' b')))
-> p (Elr a b) (f (Elr a' b'))
_elr2These = (Elr a b -> Maybe (These a b))
-> (Maybe (These a' b') -> Elr a' b')
-> Iso
     (Elr a b) (Elr a' b') (Maybe (These a b)) (Maybe (These a' b'))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Elr a b -> Maybe (These a b)
forall a b. Elr a b -> Maybe (These a b)
fw Maybe (These a' b') -> Elr a' b'
forall a b. Maybe (These a b) -> Elr a b
bw
  where
  fw :: Elr a b -> Maybe (These a b)
fw = \case
         Elr a b
ENone -> Maybe (These a b)
forall a. Maybe a
Nothing
         ELeft a
a -> These a b -> Maybe (These a b)
forall a. a -> Maybe a
Just (a -> These a b
forall a b. a -> These a b
This a
a)
         ERight b
b -> These a b -> Maybe (These a b)
forall a. a -> Maybe a
Just (b -> These a b
forall a b. b -> These a b
That b
b)
         EBoth a
a b
b -> These a b -> Maybe (These a b)
forall a. a -> Maybe a
Just (a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b)
  bw :: Maybe (These a b) -> Elr a b
bw = \case
         Maybe (These a b)
Nothing -> Elr a b
forall a b. Elr a b
ENone
         Just (This a
a) -> a -> Elr a b
forall a b. a -> Elr a b
ELeft a
a
         Just (That b
b) -> b -> Elr a b
forall a b. b -> Elr a b
ERight b
b
         Just (These a
a b
b) -> a -> b -> Elr a b
forall a b. a -> b -> Elr a b
EBoth a
a b
b

-- | iso from 'Elr' to a pair of 'Maybe's

--

-- >>> ENone ^. _elr2Maybe

-- (Nothing,Nothing)

--

-- >>> ELeft 123 ^. _elr2Maybe

-- (Just 123,Nothing)

--

-- >>> EBoth 1 'a' ^. _elr2Maybe

-- (Just 1,Just 'a')

--

_elr2Maybe :: Iso (Elr a b) (Elr a' b') (Maybe a, Maybe b) (Maybe a', Maybe b')
_elr2Maybe :: p (Maybe a, Maybe b) (f (Maybe a', Maybe b'))
-> p (Elr a b) (f (Elr a' b'))
_elr2Maybe = (Elr a b -> (Maybe a, Maybe b))
-> ((Maybe a', Maybe b') -> Elr a' b')
-> Iso
     (Elr a b) (Elr a' b') (Maybe a, Maybe b) (Maybe a', Maybe b')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Elr a b -> (Maybe a, Maybe b)
forall a a. Elr a a -> (Maybe a, Maybe a)
fw (Maybe a', Maybe b') -> Elr a' b'
forall a b. (Maybe a, Maybe b) -> Elr a b
bw
  where
  fw :: Elr a a -> (Maybe a, Maybe a)
fw = \case
          Elr a a
ENone -> (Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
          ELeft a
a -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, Maybe a
forall a. Maybe a
Nothing)
          ERight a
b -> (Maybe a
forall a. Maybe a
Nothing, a -> Maybe a
forall a. a -> Maybe a
Just a
b)
          EBoth a
a a
b -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, a -> Maybe a
forall a. a -> Maybe a
Just a
b)
  bw :: (Maybe a, Maybe b) -> Elr a b
bw = \case
          (Maybe a
Nothing, Maybe b
Nothing) -> Elr a b
forall a b. Elr a b
ENone
          (Just a
a, Maybe b
Nothing) -> a -> Elr a b
forall a b. a -> Elr a b
ELeft a
a
          (Maybe a
Nothing, Just b
b) -> b -> Elr a b
forall a b. b -> Elr a b
ERight b
b
          (Just a
a, Just b
b) -> a -> b -> Elr a b
forall a b. a -> b -> Elr a b
EBoth a
a b
b

-- | 'GetLen' instances for 'Elr'

instance GetLen 'ENone where
  getLen :: Int
getLen = Int
0
instance GetLen ('ELeft a) where
  getLen :: Int
getLen = Int
0
instance GetLen ('ERight b) where
  getLen :: Int
getLen = Int
1
instance GetLen ('EBoth a b) where
  getLen :: Int
getLen = Int
1

-- | 'AssocC' instances for 'Elr'

instance AssocC Elr where
  assoc :: Elr (Elr a b) c -> Elr a (Elr b c)
assoc Elr (Elr a b) c
ENone = Elr a (Elr b c)
forall a b. Elr a b
ENone
  assoc (ELeft Elr a b
ENone) = Elr a (Elr b c)
forall a b. Elr a b
ENone
  assoc (ELeft (ELeft a
a)) = a -> Elr a (Elr b c)
forall a b. a -> Elr a b
ELeft a
a
  assoc (ELeft (ERight b
b)) = Elr b c -> Elr a (Elr b c)
forall a b. b -> Elr a b
ERight (b -> Elr b c
forall a b. a -> Elr a b
ELeft b
b)
  assoc (ELeft (EBoth a
a b
b)) = a -> Elr b c -> Elr a (Elr b c)
forall a b. a -> b -> Elr a b
EBoth a
a (b -> Elr b c
forall a b. a -> Elr a b
ELeft b
b)
  assoc (ERight c
c) = Elr b c -> Elr a (Elr b c)
forall a b. b -> Elr a b
ERight (c -> Elr b c
forall a b. b -> Elr a b
ERight c
c)
  assoc (EBoth Elr a b
ENone c
c) = Elr b c -> Elr a (Elr b c)
forall a b. b -> Elr a b
ERight (c -> Elr b c
forall a b. b -> Elr a b
ERight c
c)
  assoc (EBoth (ELeft a
a) c
c) = a -> Elr b c -> Elr a (Elr b c)
forall a b. a -> b -> Elr a b
EBoth a
a (c -> Elr b c
forall a b. b -> Elr a b
ERight c
c)
  assoc (EBoth (ERight b
b) c
c) = Elr b c -> Elr a (Elr b c)
forall a b. b -> Elr a b
ERight (b -> c -> Elr b c
forall a b. a -> b -> Elr a b
EBoth b
b c
c)
  assoc (EBoth (EBoth a
a b
b) c
c) = a -> Elr b c -> Elr a (Elr b c)
forall a b. a -> b -> Elr a b
EBoth a
a (b -> c -> Elr b c
forall a b. a -> b -> Elr a b
EBoth b
b c
c)

  unassoc :: Elr a (Elr b c) -> Elr (Elr a b) c
unassoc Elr a (Elr b c)
ENone = Elr (Elr a b) c
forall a b. Elr a b
ENone
  unassoc (ELeft a
a) = Elr a b -> Elr (Elr a b) c
forall a b. a -> Elr a b
ELeft (a -> Elr a b
forall a b. a -> Elr a b
ELeft a
a)
  unassoc (ERight Elr b c
ENone) = Elr a b -> Elr (Elr a b) c
forall a b. a -> Elr a b
ELeft Elr a b
forall a b. Elr a b
ENone
  unassoc (ERight (ELeft b
b)) = Elr a b -> Elr (Elr a b) c
forall a b. a -> Elr a b
ELeft (b -> Elr a b
forall a b. b -> Elr a b
ERight b
b)
  unassoc (ERight (ERight c
c)) = c -> Elr (Elr a b) c
forall a b. b -> Elr a b
ERight c
c
  unassoc (ERight (EBoth b
b c
c)) = Elr a b -> c -> Elr (Elr a b) c
forall a b. a -> b -> Elr a b
EBoth (b -> Elr a b
forall a b. b -> Elr a b
ERight b
b) c
c
  unassoc (EBoth a
a Elr b c
ENone) = Elr a b -> Elr (Elr a b) c
forall a b. a -> Elr a b
ELeft (a -> Elr a b
forall a b. a -> Elr a b
ELeft a
a)
  unassoc (EBoth a
a (ELeft b
b)) = Elr a b -> Elr (Elr a b) c
forall a b. a -> Elr a b
ELeft (a -> b -> Elr a b
forall a b. a -> b -> Elr a b
EBoth a
a b
b)
  unassoc (EBoth a
a (ERight c
c)) = Elr a b -> c -> Elr (Elr a b) c
forall a b. a -> b -> Elr a b
EBoth (a -> Elr a b
forall a b. a -> Elr a b
ELeft a
a) c
c
  unassoc (EBoth a
a (EBoth b
b c
c)) = Elr a b -> c -> Elr (Elr a b) c
forall a b. a -> b -> Elr a b
EBoth (a -> b -> Elr a b
forall a b. a -> b -> Elr a b
EBoth a
a b
b) c
c

instance SwapC Elr where
  swapC :: Elr a b -> Elr b a
swapC =
    \case
      Elr a b
ENone -> Elr b a
forall a b. Elr a b
ENone
      ELeft a
a -> a -> Elr b a
forall a b. b -> Elr a b
ERight a
a
      ERight b
b -> b -> Elr b a
forall a b. a -> Elr a b
ELeft b
b
      EBoth a
a b
b -> b -> a -> Elr b a
forall a b. a -> b -> Elr a b
EBoth b
b a
a

-- | returns the filled status of a Bifoldable container

getBifoldInfo :: Bifoldable bi => bi a b -> String
getBifoldInfo :: bi a b -> String
getBifoldInfo bi a b
bi =
  case (a -> Elr () ()) -> (b -> Elr () ()) -> bi a b -> Elr () ()
forall (p :: Type -> Type -> Type) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (Elr () () -> a -> Elr () ()
forall a b. a -> b -> a
const (() -> Elr () ()
forall a b. a -> Elr a b
ELeft ())) (Elr () () -> b -> Elr () ()
forall a b. a -> b -> a
const (() -> Elr () ()
forall a b. b -> Elr a b
ERight ())) bi a b
bi of
    Elr () ()
ENone -> String
" <skipped>"
    ELeft () -> String
"(L)"
    ERight () -> String
"(R)"
    EBoth () () -> String
"(B)"

-- | similar to 'elr' without a separate EBoth combinator

mergeElrWith :: c -> (a -> c) -> (b -> c) -> (c -> c -> c) -> Elr a b -> c
mergeElrWith :: c -> (a -> c) -> (b -> c) -> (c -> c -> c) -> Elr a b -> c
mergeElrWith c
c a -> c
fa b -> c
fb c -> c -> c
fcc =
  \case
    Elr a b
ENone -> c
c
    ELeft a
a -> a -> c
fa a
a
    ERight b
b -> b -> c
fb b
b
    EBoth a
a b
b -> c -> c -> c
fcc (a -> c
fa a
a) (b -> c
fb b
b)

-- | destruct 'Elr'

elr :: c -> (a -> c) -> (b -> c) -> (a -> b -> c) -> Elr a b -> c
elr :: c -> (a -> c) -> (b -> c) -> (a -> b -> c) -> Elr a b -> c
elr c
c a -> c
fa b -> c
fb a -> b -> c
fab =
  \case
    Elr a b
ENone -> c
c
    ELeft a
a -> a -> c
fa a
a
    ERight b
b -> b -> c
fb b
b
    EBoth a
a b
b -> a -> b -> c
fab a
a b
b