{-# 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 #-}
module Predicate.Elr (
Elr(..)
, _ENone
, _ELeft
, _ERight
, _EBoth
, _elr2Maybe
, _elr2These
, isENone
, isELeft
, isERight
, isEBoth
, ENoneT
, ELeftT
, ERightT
, EBothT
, 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(..))
data Elr a b =
ENone
| ELeft !a
| ERight !b
| EBoth !a !b
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
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"
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
isENone :: Elr a b -> Bool
isENone Elr a b
ENone = Bool
True
isENone Elr a b
_ = Bool
False
isELeft :: Elr a b -> Bool
isELeft ELeft {} = Bool
True
isELeft Elr a b
_ = Bool
False
isERight :: Elr a b -> Bool
isERight ERight {} = Bool
True
isERight Elr a b
_ = Bool
False
isEBoth :: Elr a b -> Bool
isEBoth EBoth {} = Bool
True
isEBoth Elr a b
_ = Bool
False
type family ENoneT lr where
ENoneT (Elr _ _) = ()
ENoneT o = GL.TypeError (
'GL.Text "ENoneT: expected 'Elr a b' "
':$$: 'GL.Text "o = "
':<>: 'GL.ShowType o)
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)
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)
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)
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)])
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)
_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
_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
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
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
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)"
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)
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