{-# LANGUAGE DataKinds,
TypeOperators,
ConstraintKinds,
PolyKinds,
TypeFamilies,
GADTs,
MultiParamTypeClasses,
FunctionalDependencies,
FlexibleInstances,
FlexibleContexts,
UndecidableInstances,
UndecidableSuperClasses,
TypeApplications,
ScopedTypeVariables,
AllowAmbiguousTypes,
ExplicitForAll,
RankNTypes,
DefaultSignatures,
PartialTypeSignatures,
LambdaCase,
EmptyCase,
StandaloneKindSignatures
#-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
module Data.RBR.Internal where
import Data.Proxy
import Data.Kind
import Data.Typeable
import Data.Coerce
import Data.Functor.Contravariant (Contravariant(contramap))
import Data.Bifunctor (first)
import Data.Monoid (Endo(..))
import Data.List (intersperse)
import Data.Foldable (asum)
import GHC.TypeLits
import GHC.Generics (D1,C1,S1(..),M1(..),K1(..),Rec0(..), Generically(..))
import qualified GHC.Generics as G
import Data.SOP (I(..),K(..),unI,unK,NP(..),NS(..),All,SListI,type (-.->)(Fn,apFn),mapKIK,(:.:)(..),Top)
import Data.SOP.NP (collapse_NP,liftA_NP,liftA2_NP,cliftA_NP,cliftA2_NP,pure_NP,sequence_NP,sequence'_NP)
import Data.SOP.NS (collapse_NS,ap_NS,injections,Injection)
data Color = R
| B
deriving (Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Color -> ShowS
showsPrec :: Int -> Color -> ShowS
$cshow :: Color -> String
show :: Color -> String
$cshowList :: [Color] -> ShowS
showList :: [Color] -> ShowS
Show,Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: Color -> Color -> Bool
Eq)
data Map symbol q = E
| N Color (Map symbol q) symbol q (Map symbol q)
deriving (Int -> Map symbol q -> ShowS
[Map symbol q] -> ShowS
Map symbol q -> String
(Int -> Map symbol q -> ShowS)
-> (Map symbol q -> String)
-> ([Map symbol q] -> ShowS)
-> Show (Map symbol q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall symbol q.
(Show symbol, Show q) =>
Int -> Map symbol q -> ShowS
forall symbol q. (Show symbol, Show q) => [Map symbol q] -> ShowS
forall symbol q. (Show symbol, Show q) => Map symbol q -> String
$cshowsPrec :: forall symbol q.
(Show symbol, Show q) =>
Int -> Map symbol q -> ShowS
showsPrec :: Int -> Map symbol q -> ShowS
$cshow :: forall symbol q. (Show symbol, Show q) => Map symbol q -> String
show :: Map symbol q -> String
$cshowList :: forall symbol q. (Show symbol, Show q) => [Map symbol q] -> ShowS
showList :: [Map symbol q] -> ShowS
Show,Map symbol q -> Map symbol q -> Bool
(Map symbol q -> Map symbol q -> Bool)
-> (Map symbol q -> Map symbol q -> Bool) -> Eq (Map symbol q)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall symbol q.
(Eq symbol, Eq q) =>
Map symbol q -> Map symbol q -> Bool
$c== :: forall symbol q.
(Eq symbol, Eq q) =>
Map symbol q -> Map symbol q -> Bool
== :: Map symbol q -> Map symbol q -> Bool
$c/= :: forall symbol q.
(Eq symbol, Eq q) =>
Map symbol q -> Map symbol q -> Bool
/= :: Map symbol q -> Map symbol q -> Bool
Eq)
type Empty = E
type KeysValuesAllF :: (symbol -> q -> Constraint) -> Map symbol q -> Constraint
type family
KeysValuesAllF c t :: Constraint where
KeysValuesAllF _ E = ()
KeysValuesAllF c (N color left k v right) = (c k v, KeysValuesAll c left, KeysValuesAll c right)
type KeysValuesAll :: (symbol -> q -> Constraint) -> Map symbol q -> Constraint
class KeysValuesAllF c t => KeysValuesAll (c :: symbol -> q -> Constraint) (t :: Map symbol q) where
cpara_Map ::
proxy c
-> r E
-> (forall left k v right color . (c k v, KeysValuesAll c left, KeysValuesAll c right)
=> r left -> r right -> r (N color left k v right))
-> r t
type Maplike :: Map Symbol Type -> Constraint
class Maplike (t :: Map Symbol Type) where
pure_Record :: (forall v. f v) -> Record f t
sequence_Record :: Applicative f => Record f t -> f (Record I t)
sequence'_Record :: Applicative f => Record (f :.: g) t -> f (Record g t)
liftA_Record :: (forall a. f a -> g a) -> Record f t -> Record g t
liftA2_Record :: (forall a. f a -> g a -> h a) -> Record f t -> Record g t -> Record h t
liftA_Variant :: (forall a. f a -> g a) -> Variant f t -> Variant g t
liftA2_Variant :: (forall a. f a -> g a -> h a) -> Record f t -> Variant g t -> Variant h t
injections'_Variant :: Record (Case f (Variant f t)) t
injections_Record :: Record (Case f (Endo (Record f t))) t
collapse'_Record :: Monoid a => Record (K a) t -> a
collapse_Variant :: Variant (K a) t -> a
instance Maplike E where
pure_Record :: forall (f :: * -> *). (forall v. f v) -> Record f 'E
pure_Record forall v. f v
_ = Record f 'E
forall {q} (f :: q -> *). Record f 'E
Empty
sequence_Record :: forall (f :: * -> *).
Applicative f =>
Record f 'E -> f (Record I 'E)
sequence_Record Record f 'E
Empty = Record I 'E -> f (Record I 'E)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Record I 'E
forall {q} (f :: q -> *). Record f 'E
Empty
sequence'_Record :: forall (f :: * -> *) (g :: * -> *).
Applicative f =>
Record (f :.: g) 'E -> f (Record g 'E)
sequence'_Record Record (f :.: g) 'E
Empty = Record g 'E -> f (Record g 'E)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Record g 'E
forall {q} (f :: q -> *). Record f 'E
Empty
liftA_Record :: forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> Record f 'E -> Record g 'E
liftA_Record forall a. f a -> g a
_ Record f 'E
Empty = Record g 'E
forall {q} (f :: q -> *). Record f 'E
Empty
liftA2_Record :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(forall a. f a -> g a -> h a)
-> Record f 'E -> Record g 'E -> Record h 'E
liftA2_Record forall a. f a -> g a -> h a
_ Record f 'E
Empty Record g 'E
Empty = Record h 'E
forall {q} (f :: q -> *). Record f 'E
Empty
liftA_Variant :: forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> Variant f 'E -> Variant g 'E
liftA_Variant forall a. f a -> g a
_ Variant f 'E
neverHappens = Variant f 'E -> Variant g 'E
forall {q} (f :: q -> *) b. Variant f Empty -> b
impossible Variant f 'E
neverHappens
liftA2_Variant :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(forall a. f a -> g a -> h a)
-> Record f 'E -> Variant g 'E -> Variant h 'E
liftA2_Variant forall a. f a -> g a -> h a
_ Record f 'E
Empty Variant g 'E
neverHappens = Variant g 'E -> Variant h 'E
forall {q} (f :: q -> *) b. Variant f Empty -> b
impossible Variant g 'E
neverHappens
injections'_Variant :: forall (f :: * -> *). Record (Case f (Variant f 'E)) 'E
injections'_Variant = Record (Case f (Variant f 'E)) 'E
forall {q} (f :: q -> *). Record f 'E
Empty
injections_Record :: forall (f :: * -> *). Record (Case f (Endo (Record f 'E))) 'E
injections_Record = Record (Case f (Endo (Record f 'E))) 'E
forall {q} (f :: q -> *). Record f 'E
Empty
collapse'_Record :: forall a. Monoid a => Record (K a) 'E -> a
collapse'_Record Record (K a) 'E
Empty = a
forall a. Monoid a => a
mempty
collapse_Variant :: forall a. Variant (K a) 'E -> a
collapse_Variant = Variant (K a) 'E -> a
forall {q} (f :: q -> *) b. Variant f Empty -> b
impossible
instance (Maplike left, Maplike right) => Maplike (N color left k v right) where
pure_Record :: forall (f :: * -> *).
(forall v. f v) -> Record f ('N color left k v right)
pure_Record forall v. f v
f = Record f left
-> f v -> Record f right -> Record f ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node ((forall v. f v) -> Record f left
forall (t :: Map Symbol (*)) (f :: * -> *).
Maplike t =>
(forall v. f v) -> Record f t
forall (f :: * -> *). (forall v. f v) -> Record f left
pure_Record f v
forall v. f v
f) f v
forall v. f v
f ((forall v. f v) -> Record f right
forall (t :: Map Symbol (*)) (f :: * -> *).
Maplike t =>
(forall v. f v) -> Record f t
forall (f :: * -> *). (forall v. f v) -> Record f right
pure_Record f v
forall v. f v
f)
sequence_Record :: forall (f :: * -> *).
Applicative f =>
Record f ('N color left k v right)
-> f (Record I ('N color left k v right))
sequence_Record (Node Record f left
left f v
v Record f right
right) = (\Record I left
l v
x Record I right
r -> Record I left
-> I v -> Record I right -> Record I ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record I left
l (v -> I v
forall a. a -> I a
I v
x) Record I right
r) (Record I left
-> v -> Record I right -> Record I ('N color left k v right))
-> f (Record I left)
-> f (v -> Record I right -> Record I ('N color left k v right))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record f left -> f (Record I left)
forall (t :: Map Symbol (*)) (f :: * -> *).
(Maplike t, Applicative f) =>
Record f t -> f (Record I t)
forall (f :: * -> *).
Applicative f =>
Record f left -> f (Record I left)
sequence_Record Record f left
Record f left
left f (v -> Record I right -> Record I ('N color left k v right))
-> f v -> f (Record I right -> Record I ('N color left k v right))
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f v
f v
v f (Record I right -> Record I ('N color left k v right))
-> f (Record I right) -> f (Record I ('N color left k v right))
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Record f right -> f (Record I right)
forall (t :: Map Symbol (*)) (f :: * -> *).
(Maplike t, Applicative f) =>
Record f t -> f (Record I t)
forall (f :: * -> *).
Applicative f =>
Record f right -> f (Record I right)
sequence_Record Record f right
Record f right
right
sequence'_Record :: forall (f :: * -> *) (g :: * -> *).
Applicative f =>
Record (f :.: g) ('N color left k v right)
-> f (Record g ('N color left k v right))
sequence'_Record (Node Record (f :.: g) left
left (Comp f (g v)
v) Record (f :.: g) right
right) = (\Record g left
l g v
x Record g right
r -> Record g left
-> g v -> Record g right -> Record g ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record g left
l g v
x Record g right
r) (Record g left
-> g v -> Record g right -> Record g ('N color left k v right))
-> f (Record g left)
-> f (g v -> Record g right -> Record g ('N color left k v right))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record (f :.: g) left -> f (Record g left)
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *).
(Maplike t, Applicative f) =>
Record (f :.: g) t -> f (Record g t)
forall (f :: * -> *) (g :: * -> *).
Applicative f =>
Record (f :.: g) left -> f (Record g left)
sequence'_Record Record (f :.: g) left
Record (f :.: g) left
left f (g v -> Record g right -> Record g ('N color left k v right))
-> f (g v)
-> f (Record g right -> Record g ('N color left k v right))
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (g v)
f (g v)
v f (Record g right -> Record g ('N color left k v right))
-> f (Record g right) -> f (Record g ('N color left k v right))
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Record (f :.: g) right -> f (Record g right)
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *).
(Maplike t, Applicative f) =>
Record (f :.: g) t -> f (Record g t)
forall (f :: * -> *) (g :: * -> *).
Applicative f =>
Record (f :.: g) right -> f (Record g right)
sequence'_Record Record (f :.: g) right
Record (f :.: g) right
right
liftA_Record :: forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a)
-> Record f ('N color left k v right)
-> Record g ('N color left k v right)
liftA_Record forall a. f a -> g a
trans (Node Record f left
left1 f v
v1 Record f right
right1) = Record g left
-> g v -> Record g right -> Record g ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node ((forall a. f a -> g a) -> Record f left -> Record g left
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *).
Maplike t =>
(forall a. f a -> g a) -> Record f t -> Record g t
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> Record f left -> Record g left
liftA_Record f a -> g a
forall a. f a -> g a
trans Record f left
Record f left
left1) (f v -> g v
forall a. f a -> g a
trans f v
f v
v1) ((forall a. f a -> g a) -> Record f right -> Record g right
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *).
Maplike t =>
(forall a. f a -> g a) -> Record f t -> Record g t
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> Record f right -> Record g right
liftA_Record f a -> g a
forall a. f a -> g a
trans Record f right
Record f right
right1)
liftA2_Record :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(forall a. f a -> g a -> h a)
-> Record f ('N color left k v right)
-> Record g ('N color left k v right)
-> Record h ('N color left k v right)
liftA2_Record forall a. f a -> g a -> h a
trans (Node Record f left
left1 f v
v1 Record f right
right1) (Node Record g left
left2 g v
v2 Record g right
right2) = Record h left
-> h v -> Record h right -> Record h ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node ((forall a. f a -> g a -> h a)
-> Record f left -> Record g left -> Record h left
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *)
(h :: * -> *).
Maplike t =>
(forall a. f a -> g a -> h a)
-> Record f t -> Record g t -> Record h t
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(forall a. f a -> g a -> h a)
-> Record f left -> Record g left -> Record h left
liftA2_Record f a -> g a -> h a
forall a. f a -> g a -> h a
trans Record f left
Record f left
left1 Record g left
Record g left
left2) (f v -> g v -> h v
forall a. f a -> g a -> h a
trans f v
f v
v1 g v
g v
v2) ((forall a. f a -> g a -> h a)
-> Record f right -> Record g right -> Record h right
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *)
(h :: * -> *).
Maplike t =>
(forall a. f a -> g a -> h a)
-> Record f t -> Record g t -> Record h t
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(forall a. f a -> g a -> h a)
-> Record f right -> Record g right -> Record h right
liftA2_Record f a -> g a -> h a
forall a. f a -> g a -> h a
trans Record f right
Record f right
right1 Record g right
Record g right
right2)
liftA_Variant :: forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a)
-> Variant f ('N color left k v right)
-> Variant g ('N color left k v right)
liftA_Variant forall a. f a -> g a
trans Variant f ('N color left k v right)
vv = case Variant f ('N color left k v right)
vv of
Here f v
fv -> g v -> Variant g ('N color left k v right)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here (f v -> g v
forall a. f a -> g a
trans f v
f v
fv)
LookLeft Variant f t
leftV -> Variant g left -> Variant g ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft ((forall a. f a -> g a) -> Variant f left -> Variant g left
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *).
Maplike t =>
(forall a. f a -> g a) -> Variant f t -> Variant g t
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> Variant f left -> Variant g left
liftA_Variant f a -> g a
forall a. f a -> g a
trans Variant f left
Variant f t
leftV)
LookRight Variant f t
rightV -> Variant g right -> Variant g ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight ((forall a. f a -> g a) -> Variant f right -> Variant g right
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *).
Maplike t =>
(forall a. f a -> g a) -> Variant f t -> Variant g t
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> Variant f right -> Variant g right
liftA_Variant f a -> g a
forall a. f a -> g a
trans Variant f right
Variant f t
rightV)
liftA2_Variant :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(forall a. f a -> g a -> h a)
-> Record f ('N color left k v right)
-> Variant g ('N color left k v right)
-> Variant h ('N color left k v right)
liftA2_Variant forall a. f a -> g a -> h a
trans (Node Record f left
left f v
rv Record f right
right) Variant g ('N color left k v right)
vv = case Variant g ('N color left k v right)
vv of
Here g v
fv -> h v -> Variant h ('N color left k v right)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here (f v -> g v -> h v
forall a. f a -> g a -> h a
trans f v
f v
rv g v
g v
fv)
LookLeft Variant g t
leftV -> Variant h left -> Variant h ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft ((forall a. f a -> g a -> h a)
-> Record f left -> Variant g left -> Variant h left
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *)
(h :: * -> *).
Maplike t =>
(forall a. f a -> g a -> h a)
-> Record f t -> Variant g t -> Variant h t
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(forall a. f a -> g a -> h a)
-> Record f left -> Variant g left -> Variant h left
liftA2_Variant f a -> g a -> h a
forall a. f a -> g a -> h a
trans Record f left
Record f left
left Variant g left
Variant g t
leftV)
LookRight Variant g t
rightV -> Variant h right -> Variant h ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight ((forall a. f a -> g a -> h a)
-> Record f right -> Variant g right -> Variant h right
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *)
(h :: * -> *).
Maplike t =>
(forall a. f a -> g a -> h a)
-> Record f t -> Variant g t -> Variant h t
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(forall a. f a -> g a -> h a)
-> Record f right -> Variant g right -> Variant h right
liftA2_Variant f a -> g a -> h a
forall a. f a -> g a -> h a
trans Record f right
Record f right
right Variant g right
Variant g t
rightV)
injections'_Variant :: forall (f :: * -> *).
Record
(Case f (Variant f ('N color left k v right)))
('N color left k v right)
injections'_Variant =
let injections_Left :: Record (Case f (Variant f ('N color left k v right))) left
injections_Left = (forall a.
Case f (Variant f left) a
-> Case f (Variant f ('N color left k v right)) a)
-> Record (Case f (Variant f left)) left
-> Record (Case f (Variant f ('N color left k v right))) left
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *).
Maplike t =>
(forall a. f a -> g a) -> Record f t -> Record g t
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> Record f left -> Record g left
liftA_Record (\(Case f a -> Variant f left
j) -> (f a -> Variant f ('N color left k v right))
-> Case f (Variant f ('N color left k v right)) a
forall q (f :: q -> *) a (b :: q). (f b -> a) -> Case f a b
Case ((f a -> Variant f ('N color left k v right))
-> Case f (Variant f ('N color left k v right)) a)
-> (f a -> Variant f ('N color left k v right))
-> Case f (Variant f ('N color left k v right)) a
forall a b. (a -> b) -> a -> b
$ Variant f left -> Variant f ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f left -> Variant f ('N color left k v right))
-> (f a -> Variant f left)
-> f a
-> Variant f ('N color left k v right)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Variant f left
j) (forall (t :: Map Symbol (*)) (f :: * -> *).
Maplike t =>
Record (Case f (Variant f t)) t
injections'_Variant @left)
injections_Right :: Record (Case f (Variant f ('N color left k v right))) right
injections_Right = (forall a.
Case f (Variant f right) a
-> Case f (Variant f ('N color left k v right)) a)
-> Record (Case f (Variant f right)) right
-> Record (Case f (Variant f ('N color left k v right))) right
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *).
Maplike t =>
(forall a. f a -> g a) -> Record f t -> Record g t
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> Record f right -> Record g right
liftA_Record (\(Case f a -> Variant f right
j) -> (f a -> Variant f ('N color left k v right))
-> Case f (Variant f ('N color left k v right)) a
forall q (f :: q -> *) a (b :: q). (f b -> a) -> Case f a b
Case ((f a -> Variant f ('N color left k v right))
-> Case f (Variant f ('N color left k v right)) a)
-> (f a -> Variant f ('N color left k v right))
-> Case f (Variant f ('N color left k v right)) a
forall a b. (a -> b) -> a -> b
$ Variant f right -> Variant f ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f right -> Variant f ('N color left k v right))
-> (f a -> Variant f right)
-> f a
-> Variant f ('N color left k v right)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Variant f right
j) (forall (t :: Map Symbol (*)) (f :: * -> *).
Maplike t =>
Record (Case f (Variant f t)) t
injections'_Variant @right)
in Record (Case f (Variant f ('N color left k v right))) left
-> Case f (Variant f ('N color left k v right)) v
-> Record (Case f (Variant f ('N color left k v right))) right
-> Record
(Case f (Variant f ('N color left k v right)))
('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record (Case f (Variant f ('N color left k v right))) left
injections_Left ((f v -> Variant f ('N color left k v right))
-> Case f (Variant f ('N color left k v right)) v
forall q (f :: q -> *) a (b :: q). (f b -> a) -> Case f a b
Case ((f v -> Variant f ('N color left k v right))
-> Case f (Variant f ('N color left k v right)) v)
-> (f v -> Variant f ('N color left k v right))
-> Case f (Variant f ('N color left k v right)) v
forall a b. (a -> b) -> a -> b
$ f v -> Variant f ('N color left k v right)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here) Record (Case f (Variant f ('N color left k v right))) right
injections_Right
injections_Record :: forall (f :: * -> *).
Record
(Case f (Endo (Record f ('N color left k v right))))
('N color left k v right)
injections_Record =
Record (Case f (Endo (Record f ('N color left k v right)))) left
-> Case f (Endo (Record f ('N color left k v right))) v
-> Record
(Case f (Endo (Record f ('N color left k v right)))) right
-> Record
(Case f (Endo (Record f ('N color left k v right))))
('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node
((forall a.
Case f (Endo (Record f left)) a
-> Case f (Endo (Record f ('N color left k v right))) a)
-> Record (Case f (Endo (Record f left))) left
-> Record (Case f (Endo (Record f ('N color left k v right)))) left
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *).
Maplike t =>
(forall a. f a -> g a) -> Record f t -> Record g t
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> Record f left -> Record g left
liftA_Record (\(Case f a -> Endo (Record f left)
cleft) ->
((f a -> Endo (Record f ('N color left k v right)))
-> Case f (Endo (Record f ('N color left k v right))) a
forall q (f :: q -> *) a (b :: q). (f b -> a) -> Case f a b
Case ((f a -> Endo (Record f ('N color left k v right)))
-> Case f (Endo (Record f ('N color left k v right))) a)
-> (f a -> Endo (Record f ('N color left k v right)))
-> Case f (Endo (Record f ('N color left k v right))) a
forall a b. (a -> b) -> a -> b
$ \f a
x ->
(Record f ('N color left k v right)
-> Record f ('N color left k v right))
-> Endo (Record f ('N color left k v right))
forall a. (a -> a) -> Endo a
Endo ((Record f ('N color left k v right)
-> Record f ('N color left k v right))
-> Endo (Record f ('N color left k v right)))
-> (Record f ('N color left k v right)
-> Record f ('N color left k v right))
-> Endo (Record f ('N color left k v right))
forall a b. (a -> b) -> a -> b
$ (\(Node Record f left
left' f v
x' Record f right
right') -> Record f left
-> f v -> Record f right -> Record f ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Endo (Record f left) -> Record f left -> Record f left
forall a. Endo a -> a -> a
appEndo (f a -> Endo (Record f left)
cleft f a
x) Record f left
Record f left
left') f v
f v
x' Record f right
Record f right
right')))
(forall (t :: Map Symbol (*)) (f :: * -> *).
Maplike t =>
Record (Case f (Endo (Record f t))) t
injections_Record @left))
((f v -> Endo (Record f ('N color left k v right)))
-> Case f (Endo (Record f ('N color left k v right))) v
forall q (f :: q -> *) a (b :: q). (f b -> a) -> Case f a b
Case ((f v -> Endo (Record f ('N color left k v right)))
-> Case f (Endo (Record f ('N color left k v right))) v)
-> (f v -> Endo (Record f ('N color left k v right)))
-> Case f (Endo (Record f ('N color left k v right))) v
forall a b. (a -> b) -> a -> b
$ \f v
x -> (Record f ('N color left k v right)
-> Record f ('N color left k v right))
-> Endo (Record f ('N color left k v right))
forall a. (a -> a) -> Endo a
Endo ((Record f ('N color left k v right)
-> Record f ('N color left k v right))
-> Endo (Record f ('N color left k v right)))
-> (Record f ('N color left k v right)
-> Record f ('N color left k v right))
-> Endo (Record f ('N color left k v right))
forall a b. (a -> b) -> a -> b
$ \(Node Record f left
left f v
v Record f right
right) -> Record f left
-> f v -> Record f right -> Record f ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
Record f left
left f v
x Record f right
Record f right
right)
((forall a.
Case f (Endo (Record f right)) a
-> Case f (Endo (Record f ('N color left k v right))) a)
-> Record (Case f (Endo (Record f right))) right
-> Record
(Case f (Endo (Record f ('N color left k v right)))) right
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *).
Maplike t =>
(forall a. f a -> g a) -> Record f t -> Record g t
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> Record f right -> Record g right
liftA_Record (\(Case f a -> Endo (Record f right)
cright) ->
((f a -> Endo (Record f ('N color left k v right)))
-> Case f (Endo (Record f ('N color left k v right))) a
forall q (f :: q -> *) a (b :: q). (f b -> a) -> Case f a b
Case ((f a -> Endo (Record f ('N color left k v right)))
-> Case f (Endo (Record f ('N color left k v right))) a)
-> (f a -> Endo (Record f ('N color left k v right)))
-> Case f (Endo (Record f ('N color left k v right))) a
forall a b. (a -> b) -> a -> b
$ \f a
x ->
(Record f ('N color left k v right)
-> Record f ('N color left k v right))
-> Endo (Record f ('N color left k v right))
forall a. (a -> a) -> Endo a
Endo ((Record f ('N color left k v right)
-> Record f ('N color left k v right))
-> Endo (Record f ('N color left k v right)))
-> (Record f ('N color left k v right)
-> Record f ('N color left k v right))
-> Endo (Record f ('N color left k v right))
forall a b. (a -> b) -> a -> b
$ (\(Node Record f left
left' f v
x' Record f right
right') -> Record f left
-> f v -> Record f right -> Record f ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
Record f left
left' f v
f v
x' (Endo (Record f right) -> Record f right -> Record f right
forall a. Endo a -> a -> a
appEndo (f a -> Endo (Record f right)
cright f a
x) Record f right
Record f right
right'))))
(forall (t :: Map Symbol (*)) (f :: * -> *).
Maplike t =>
Record (Case f (Endo (Record f t))) t
injections_Record @right))
collapse'_Record :: forall a. Monoid a => Record (K a) ('N color left k v right) -> a
collapse'_Record (Node Record (K a) left
left (K a
v) Record (K a) right
right) = Record (K a) left -> a
forall a. Monoid a => Record (K a) left -> a
forall (t :: Map Symbol (*)) a.
(Maplike t, Monoid a) =>
Record (K a) t -> a
collapse'_Record Record (K a) left
left a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (a
v a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Record (K a) right -> a
forall a. Monoid a => Record (K a) right -> a
forall (t :: Map Symbol (*)) a.
(Maplike t, Monoid a) =>
Record (K a) t -> a
collapse'_Record Record (K a) right
right)
collapse_Variant :: forall a. Variant (K a) ('N color left k v right) -> a
collapse_Variant Variant (K a) ('N color left k v right)
vv = case Variant (K a) ('N color left k v right)
vv of
Here (K a
a) -> a
a
LookLeft Variant (K a) t
leftV -> Variant (K a) t -> a
forall a. Variant (K a) t -> a
forall (t :: Map Symbol (*)) a. Maplike t => Variant (K a) t -> a
collapse_Variant Variant (K a) t
leftV
LookRight Variant (K a) t
rightV -> Variant (K a) t -> a
forall a. Variant (K a) t -> a
forall (t :: Map Symbol (*)) a. Maplike t => Variant (K a) t -> a
collapse_Variant Variant (K a) t
rightV
{-# DEPRECATED injections_Variant "Use injections'_Variant instead" #-}
injections_Variant :: Maplike t => Record (VariantInjection f t) t
injections_Variant :: forall (t :: Map Symbol (*)) (f :: * -> *).
Maplike t =>
Record (VariantInjection f t) t
injections_Variant = (forall a. Case f (Variant f t) a -> VariantInjection f t a)
-> Record (Case f (Variant f t)) t
-> Record (VariantInjection f t) t
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *).
Maplike t =>
(forall a. f a -> g a) -> Record f t -> Record g t
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> Record f t -> Record g t
liftA_Record (\(Case f a -> Variant f t
f) -> (f a -> Variant f t) -> VariantInjection f t a
forall q (f :: q -> *) (t :: Map Symbol q) (v :: q).
(f v -> Variant f t) -> VariantInjection f t v
VariantInjection f a -> Variant f t
f) Record (Case f (Variant f t)) t
forall (t :: Map Symbol (*)) (f :: * -> *).
Maplike t =>
Record (Case f (Variant f t)) t
forall (f :: * -> *). Record (Case f (Variant f t)) t
injections'_Variant
{-# DEPRECATED VariantInjection "Use Case instead" #-}
newtype VariantInjection (f :: q -> Type) (t :: Map Symbol q) (v :: q) = VariantInjection { forall q (f :: q -> *) (t :: Map Symbol q) (v :: q).
VariantInjection f t v -> f v -> Variant f t
runVariantInjection :: f v -> Variant f t }
instance KeysValuesAll c E where
cpara_Map :: forall (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r 'E
cpara_Map proxy c
_p r 'E
nil forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right)
_step = r 'E
nil
instance (c k v, KeysValuesAll c left, KeysValuesAll c right) => KeysValuesAll c (N color left k v right) where
cpara_Map :: forall (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r ('N color left k v right)
cpara_Map proxy c
p r 'E
nil forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right)
cons =
r left -> r right -> r ('N color left k v right)
forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right)
cons (proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r left
forall symbol q (c :: symbol -> q -> Constraint)
(t :: Map symbol q) (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
KeysValuesAll c t =>
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r t
forall (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r left
cpara_Map proxy c
p r 'E
nil r left -> r right -> r ('N color left k v right)
forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right)
cons) (proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r right
forall symbol q (c :: symbol -> q -> Constraint)
(t :: Map symbol q) (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
KeysValuesAll c t =>
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r t
forall (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r right
cpara_Map proxy c
p r 'E
nil r left -> r right -> r ('N color left k v right)
forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right)
cons)
cpure_Record :: forall c t f. KeysValuesAll c t => Proxy c -> (forall k v. c k v => f v) -> Record f t
cpure_Record :: forall {q} (c :: Symbol -> q -> Constraint) (t :: Map Symbol q)
(f :: q -> *).
KeysValuesAll c t =>
Proxy c
-> (forall (k :: Symbol) (v :: q). c k v => f v) -> Record f t
cpure_Record Proxy c
_ forall (k :: Symbol) (v :: q). c k v => f v
fpure = Proxy c
-> Record f 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
Record f left
-> Record f right -> Record f ('N color left k v right))
-> Record f t
forall symbol q (c :: symbol -> q -> Constraint)
(t :: Map symbol q) (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
KeysValuesAll c t =>
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r t
forall (proxy :: (Symbol -> q -> Constraint) -> *)
(r :: Map Symbol q -> *).
proxy c
-> r 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r t
cpara_Map (forall {k} (t :: k). Proxy t
forall (t :: Symbol -> q -> Constraint). Proxy t
Proxy @c) Record f 'E
forall {q} (f :: q -> *). Record f 'E
unit Record f left
-> Record f right -> Record f ('N color left k v right)
forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
Record f left
-> Record f right -> Record f ('N color left k v right)
go
where
go :: forall left k' v' right color. (c k' v', KeysValuesAll c left, KeysValuesAll c right)
=> Record f left
-> Record f right
-> Record f (N color left k' v' right)
go :: forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
Record f left
-> Record f right -> Record f ('N color left k v right)
go Record f left
left Record f right
right = Record f left
-> f v' -> Record f right -> Record f ('N color left k' v' right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left (forall (k :: Symbol) (v :: q). c k v => f v
fpure @k' @v') Record f right
right
cpure'_Record :: forall c t f. KeysValuesAll (KeyValueConstraints KnownSymbol c) t => Proxy c -> (forall v. c v => String -> f v) -> Record f t
cpure'_Record :: forall {q} (c :: q -> Constraint) (t :: Map Symbol q)
(f :: q -> *).
KeysValuesAll (KeyValueConstraints KnownSymbol c) t =>
Proxy c -> (forall (v :: q). c v => String -> f v) -> Record f t
cpure'_Record Proxy c
_ forall (v :: q). c v => String -> f v
fpure = Proxy (KeyValueConstraints KnownSymbol c)
-> Record f 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KeyValueConstraints KnownSymbol c k v,
KeysValuesAll (KeyValueConstraints KnownSymbol c) left,
KeysValuesAll (KeyValueConstraints KnownSymbol c) right) =>
Record f left
-> Record f right -> Record f ('N color left k v right))
-> Record f t
forall symbol q (c :: symbol -> q -> Constraint)
(t :: Map symbol q) (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
KeysValuesAll c t =>
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r t
forall (proxy :: (Symbol -> q -> Constraint) -> *)
(r :: Map Symbol q -> *).
proxy (KeyValueConstraints KnownSymbol c)
-> r 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KeyValueConstraints KnownSymbol c k v,
KeysValuesAll (KeyValueConstraints KnownSymbol c) left,
KeysValuesAll (KeyValueConstraints KnownSymbol c) right) =>
r left -> r right -> r ('N color left k v right))
-> r t
cpara_Map (forall {k} (t :: k). Proxy t
forall (t :: Symbol -> q -> Constraint). Proxy t
Proxy @(KeyValueConstraints KnownSymbol c)) Record f 'E
forall {q} (f :: q -> *). Record f 'E
unit Record f left
-> Record f right -> Record f ('N color left k v right)
forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KeyValueConstraints KnownSymbol c k v,
KeysValuesAll (KeyValueConstraints KnownSymbol c) left,
KeysValuesAll (KeyValueConstraints KnownSymbol c) right) =>
Record f left
-> Record f right -> Record f ('N color left k v right)
go
where
go :: forall left k' v' right color. (KeyValueConstraints KnownSymbol c k' v', KeysValuesAll (KeyValueConstraints KnownSymbol c) left, KeysValuesAll (KeyValueConstraints KnownSymbol c) right)
=> Record f left
-> Record f right
-> Record f (N color left k' v' right)
go :: forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KeyValueConstraints KnownSymbol c k v,
KeysValuesAll (KeyValueConstraints KnownSymbol c) left,
KeysValuesAll (KeyValueConstraints KnownSymbol c) right) =>
Record f left
-> Record f right -> Record f ('N color left k v right)
go Record f left
left Record f right
right = Record f left
-> f v' -> Record f right -> Record f ('N color left k' v' right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left (forall (v :: q). c v => String -> f v
fpure @v' (Proxy k' -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @k'))) Record f right
right
type F1 :: (q -> Type) -> (q -> Type) -> Map Symbol q -> Type
newtype F1 f g t = F1 { forall q (f :: q -> *) (g :: q -> *) (t :: Map Symbol q).
F1 f g t -> Record f t -> Record g t
unF1 :: Record f t -> Record g t }
cliftA_Record :: forall c t f g. KeysValuesAll c t => Proxy c -> (forall k v. c k v => f v -> g v) -> Record f t -> Record g t
cliftA_Record :: forall {q} (c :: Symbol -> q -> Constraint) (t :: Map Symbol q)
(f :: q -> *) (g :: q -> *).
KeysValuesAll c t =>
Proxy c
-> (forall (k :: Symbol) (v :: q). c k v => f v -> g v)
-> Record f t
-> Record g t
cliftA_Record Proxy c
_ forall (k :: Symbol) (v :: q). c k v => f v -> g v
func = F1 f g t -> Record f t -> Record g t
forall q (f :: q -> *) (g :: q -> *) (t :: Map Symbol q).
F1 f g t -> Record f t -> Record g t
unF1 (F1 f g t -> Record f t -> Record g t)
-> F1 f g t -> Record f t -> Record g t
forall a b. (a -> b) -> a -> b
$ Proxy c
-> F1 f g 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
F1 f g left -> F1 f g right -> F1 f g ('N color left k v right))
-> F1 f g t
forall symbol q (c :: symbol -> q -> Constraint)
(t :: Map symbol q) (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
KeysValuesAll c t =>
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r t
forall (proxy :: (Symbol -> q -> Constraint) -> *)
(r :: Map Symbol q -> *).
proxy c
-> r 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r t
cpara_Map (forall {k} (t :: k). Proxy t
forall (t :: Symbol -> q -> Constraint). Proxy t
Proxy @c) ((Record f 'E -> Record g 'E) -> F1 f g 'E
forall q (f :: q -> *) (g :: q -> *) (t :: Map Symbol q).
(Record f t -> Record g t) -> F1 f g t
F1 ((Record f 'E -> Record g 'E) -> F1 f g 'E)
-> (Record f 'E -> Record g 'E) -> F1 f g 'E
forall a b. (a -> b) -> a -> b
$ \Record f 'E
_ -> Record g 'E
forall {q} (f :: q -> *). Record f 'E
unit) F1 f g left -> F1 f g right -> F1 f g ('N color left k v right)
forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
F1 f g left -> F1 f g right -> F1 f g ('N color left k v right)
go
where
go :: forall left k' v' right color. (c k' v', KeysValuesAll c left, KeysValuesAll c right)
=> F1 f g left
-> F1 f g right
-> F1 f g (N color left k' v' right)
go :: forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
F1 f g left -> F1 f g right -> F1 f g ('N color left k v right)
go (F1 Record f left -> Record g left
leftf) (F1 Record f right -> Record g right
rightf) = (Record f ('N color left k' v' right)
-> Record g ('N color left k' v' right))
-> F1 f g ('N color left k' v' right)
forall q (f :: q -> *) (g :: q -> *) (t :: Map Symbol q).
(Record f t -> Record g t) -> F1 f g t
F1 (\(Node Record f left
left f v
v Record f right
right) -> Record g left
-> g v' -> Record g right -> Record g ('N color left k' v' right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f left -> Record g left
leftf Record f left
Record f left
left) (forall (k :: Symbol) (v :: q). c k v => f v -> g v
func @k' @v' f v'
f v
v) (Record f right -> Record g right
rightf Record f right
Record f right
right))
type F2 :: (q -> Type) -> (q -> Type) -> (q -> Type) -> Map Symbol q -> Type
newtype F2 f g h t = F2 { forall q (f :: q -> *) (g :: q -> *) (h :: q -> *)
(t :: Map Symbol q).
F2 f g h t -> Record f t -> Record g t -> Record h t
unF2 :: Record f t -> Record g t -> Record h t }
cliftA2_Record :: forall c t f g h. KeysValuesAll c t => Proxy c -> (forall k v. c k v => f v -> g v -> h v) -> Record f t -> Record g t -> Record h t
cliftA2_Record :: forall {q} (c :: Symbol -> q -> Constraint) (t :: Map Symbol q)
(f :: q -> *) (g :: q -> *) (h :: q -> *).
KeysValuesAll c t =>
Proxy c
-> (forall (k :: Symbol) (v :: q). c k v => f v -> g v -> h v)
-> Record f t
-> Record g t
-> Record h t
cliftA2_Record Proxy c
_ forall (k :: Symbol) (v :: q). c k v => f v -> g v -> h v
func = F2 f g h t -> Record f t -> Record g t -> Record h t
forall q (f :: q -> *) (g :: q -> *) (h :: q -> *)
(t :: Map Symbol q).
F2 f g h t -> Record f t -> Record g t -> Record h t
unF2 (F2 f g h t -> Record f t -> Record g t -> Record h t)
-> F2 f g h t -> Record f t -> Record g t -> Record h t
forall a b. (a -> b) -> a -> b
$ Proxy c
-> F2 f g h 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
F2 f g h left
-> F2 f g h right -> F2 f g h ('N color left k v right))
-> F2 f g h t
forall symbol q (c :: symbol -> q -> Constraint)
(t :: Map symbol q) (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
KeysValuesAll c t =>
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r t
forall (proxy :: (Symbol -> q -> Constraint) -> *)
(r :: Map Symbol q -> *).
proxy c
-> r 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r t
cpara_Map (forall {k} (t :: k). Proxy t
forall (t :: Symbol -> q -> Constraint). Proxy t
Proxy @c) ((Record f 'E -> Record g 'E -> Record h 'E) -> F2 f g h 'E
forall q (f :: q -> *) (g :: q -> *) (h :: q -> *)
(t :: Map Symbol q).
(Record f t -> Record g t -> Record h t) -> F2 f g h t
F2 ((Record f 'E -> Record g 'E -> Record h 'E) -> F2 f g h 'E)
-> (Record f 'E -> Record g 'E -> Record h 'E) -> F2 f g h 'E
forall a b. (a -> b) -> a -> b
$ \Record f 'E
_ Record g 'E
_ -> Record h 'E
forall {q} (f :: q -> *). Record f 'E
unit) F2 f g h left
-> F2 f g h right -> F2 f g h ('N color left k v right)
forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
F2 f g h left
-> F2 f g h right -> F2 f g h ('N color left k v right)
go
where
go :: forall left k' v' right color. (c k' v', KeysValuesAll c left, KeysValuesAll c right)
=> F2 f g h left
-> F2 f g h right
-> F2 f g h (N color left k' v' right)
go :: forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
F2 f g h left
-> F2 f g h right -> F2 f g h ('N color left k v right)
go (F2 Record f left -> Record g left -> Record h left
leftf) (F2 Record f right -> Record g right -> Record h right
rightf) = (Record f ('N color left k' v' right)
-> Record g ('N color left k' v' right)
-> Record h ('N color left k' v' right))
-> F2 f g h ('N color left k' v' right)
forall q (f :: q -> *) (g :: q -> *) (h :: q -> *)
(t :: Map Symbol q).
(Record f t -> Record g t -> Record h t) -> F2 f g h t
F2 (\(Node Record f left
left1 f v
v1 Record f right
right1) (Node Record g left
left2 g v
v2 Record g right
right2) -> Record h left
-> h v' -> Record h right -> Record h ('N color left k' v' right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f left -> Record g left -> Record h left
leftf Record f left
Record f left
left1 Record g left
Record g left
left2) (forall (k :: Symbol) (v :: q). c k v => f v -> g v -> h v
func @k' @v' f v'
f v
v1 g v'
g v
v2) (Record f right -> Record g right -> Record h right
rightf Record f right
Record f right
right1 Record g right
Record g right
right2))
demoteKeys :: forall t. KeysValuesAll KnownKey t => Record (K String) t
demoteKeys :: forall {q} (t :: Map Symbol q).
KeysValuesAll KnownKey t =>
Record (K String) t
demoteKeys = Proxy KnownKey
-> Record (K String) 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KnownKey k v, KeysValuesAll KnownKey left,
KeysValuesAll KnownKey right) =>
Record (K String) left
-> Record (K String) right
-> Record (K String) ('N color left k v right))
-> Record (K String) t
forall symbol q (c :: symbol -> q -> Constraint)
(t :: Map symbol q) (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
KeysValuesAll c t =>
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r t
forall (proxy :: (Symbol -> q -> Constraint) -> *)
(r :: Map Symbol q -> *).
proxy KnownKey
-> r 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KnownKey k v, KeysValuesAll KnownKey left,
KeysValuesAll KnownKey right) =>
r left -> r right -> r ('N color left k v right))
-> r t
cpara_Map (forall {k} (t :: k). Proxy t
forall (t :: Symbol -> q -> Constraint). Proxy t
Proxy @KnownKey) Record (K String) 'E
forall {q} (f :: q -> *). Record f 'E
unit Record (K String) left
-> Record (K String) right
-> Record (K String) ('N color left k v right)
forall {q} (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KnownKey k v, KeysValuesAll KnownKey left,
KeysValuesAll KnownKey right) =>
Record (K String) left
-> Record (K String) right
-> Record (K String) ('N color left k v right)
forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KnownKey k v, KeysValuesAll KnownKey left,
KeysValuesAll KnownKey right) =>
Record (K String) left
-> Record (K String) right
-> Record (K String) ('N color left k v right)
go
where
go :: forall left k v right color. (KnownKey k v, KeysValuesAll KnownKey left, KeysValuesAll KnownKey right)
=> Record (K String) left
-> Record (K String) right
-> Record (K String) (N color left k v right)
go :: forall {q} (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KnownKey k v, KeysValuesAll KnownKey left,
KeysValuesAll KnownKey right) =>
Record (K String) left
-> Record (K String) right
-> Record (K String) ('N color left k v right)
go Record (K String) left
left Record (K String) right
right = Record (K String) left
-> K String v
-> Record (K String) right
-> Record (K String) ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record (K String) left
left (String -> K String v
forall k a (b :: k). a -> K a b
K (Proxy k -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @k))) Record (K String) right
right
type KnownKey :: Symbol -> q -> Constraint
class KnownSymbol k => KnownKey (k :: Symbol) (v :: q)
instance KnownSymbol k => KnownKey k v
demoteEntries :: forall t. KeysValuesAll KnownKeyTypeableValue t => Record (K (String,TypeRep)) t
demoteEntries :: forall {q} (t :: Map Symbol q).
KeysValuesAll KnownKeyTypeableValue t =>
Record (K (String, TypeRep)) t
demoteEntries = Proxy KnownKeyTypeableValue
-> Record (K (String, TypeRep)) 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KnownKeyTypeableValue k v,
KeysValuesAll KnownKeyTypeableValue left,
KeysValuesAll KnownKeyTypeableValue right) =>
Record (K (String, TypeRep)) left
-> Record (K (String, TypeRep)) right
-> Record (K (String, TypeRep)) ('N color left k v right))
-> Record (K (String, TypeRep)) t
forall symbol q (c :: symbol -> q -> Constraint)
(t :: Map symbol q) (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
KeysValuesAll c t =>
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r t
forall (proxy :: (Symbol -> q -> Constraint) -> *)
(r :: Map Symbol q -> *).
proxy KnownKeyTypeableValue
-> r 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KnownKeyTypeableValue k v,
KeysValuesAll KnownKeyTypeableValue left,
KeysValuesAll KnownKeyTypeableValue right) =>
r left -> r right -> r ('N color left k v right))
-> r t
cpara_Map (forall {k} (t :: k). Proxy t
forall (t :: Symbol -> q -> Constraint). Proxy t
Proxy @KnownKeyTypeableValue) Record (K (String, TypeRep)) 'E
forall {q} (f :: q -> *). Record f 'E
unit Record (K (String, TypeRep)) left
-> Record (K (String, TypeRep)) right
-> Record (K (String, TypeRep)) ('N color left k v right)
forall {q} (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KnownKeyTypeableValue k v,
KeysValuesAll KnownKeyTypeableValue left,
KeysValuesAll KnownKeyTypeableValue right) =>
Record (K (String, TypeRep)) left
-> Record (K (String, TypeRep)) right
-> Record (K (String, TypeRep)) ('N color left k v right)
forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KnownKeyTypeableValue k v,
KeysValuesAll KnownKeyTypeableValue left,
KeysValuesAll KnownKeyTypeableValue right) =>
Record (K (String, TypeRep)) left
-> Record (K (String, TypeRep)) right
-> Record (K (String, TypeRep)) ('N color left k v right)
go
where
go :: forall left k v right color. (KnownKeyTypeableValue k v, KeysValuesAll KnownKeyTypeableValue left, KeysValuesAll KnownKeyTypeableValue right)
=> Record (K (String,TypeRep)) left
-> Record (K (String,TypeRep)) right
-> Record (K (String,TypeRep)) (N color left k v right)
go :: forall {q} (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(KnownKeyTypeableValue k v,
KeysValuesAll KnownKeyTypeableValue left,
KeysValuesAll KnownKeyTypeableValue right) =>
Record (K (String, TypeRep)) left
-> Record (K (String, TypeRep)) right
-> Record (K (String, TypeRep)) ('N color left k v right)
go Record (K (String, TypeRep)) left
left Record (K (String, TypeRep)) right
right = Record (K (String, TypeRep)) left
-> K (String, TypeRep) v
-> Record (K (String, TypeRep)) right
-> Record (K (String, TypeRep)) ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record (K (String, TypeRep)) left
left ((String, TypeRep) -> K (String, TypeRep) v
forall k a (b :: k). a -> K a b
K (Proxy k -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @k),Proxy v -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall (t :: q). Proxy t
forall {k} (t :: k). Proxy t
Proxy @v))) Record (K (String, TypeRep)) right
right
type KnownKeyTypeableValue :: Symbol -> q -> Constraint
class (KnownSymbol k, Typeable v) => KnownKeyTypeableValue (k :: Symbol) (v :: q)
instance (KnownSymbol k, Typeable v) => KnownKeyTypeableValue k v
type KeyValueConstraints :: (Symbol -> Constraint) -> (q -> Constraint) -> Symbol -> q -> Constraint
class (kc k, vc v) => KeyValueConstraints (kc :: Symbol -> Constraint) (vc :: q -> Constraint) (k :: Symbol) (v :: q)
instance (kc k, vc v) => KeyValueConstraints kc vc k v
type ValueConstraint :: (q -> Constraint) -> Symbol -> q -> Constraint
class (vc v) => ValueConstraint (vc :: q -> Constraint) (k :: Symbol) (v :: q)
instance (vc v) => ValueConstraint vc k v
type Record :: (q -> Type) -> Map Symbol q -> Type
data Record (f :: q -> Type) (t :: Map Symbol q) where
Empty :: Record f E
Node :: Record f left -> f v -> Record f right -> Record f (N color left k v right)
instance (Productlike '[] t result, Show (NP f result)) => Show (Record f t) where
show :: Record f t -> String
show Record f t
x = String
"fromNP (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ NP f result -> String
forall a. Show a => a -> String
show (Record f t -> NP f result
forall {k} (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Productlike '[] t result =>
Record f t -> NP f result
toNP Record f t
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
instance ToRecord (Record I (t :: Map Symbol Type)) where
type RecordCode (Record I t) = t
toRecord :: Record I t -> Record I (RecordCode (Record I t))
toRecord = Record I t -> Record I t
Record I t -> Record I (RecordCode (Record I t))
forall a. a -> a
id
instance FromRecord (Record I (t :: Map Symbol Type)) where
fromRecord :: Record I (RecordCode (Record I t)) -> Record I t
fromRecord = Record I t -> Record I t
Record I (RecordCode (Record I t)) -> Record I t
forall a. a -> a
id
{-# DEPRECATED collapse_Record "Use collapse'_Record" #-}
collapse_Record :: forall t result a. (Productlike '[] t result) => Record (K a) t -> [a]
collapse_Record :: forall {q} (t :: Map Symbol q) (result :: [q]) a.
Productlike '[] t result =>
Record (K a) t -> [a]
collapse_Record = NP (K a) result -> [a]
forall {k} a (xs :: [k]). NP (K a) xs -> [a]
collapse_NP (NP (K a) result -> [a])
-> (Record (K a) t -> NP (K a) result) -> Record (K a) t -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record (K a) t -> NP (K a) result
forall {k} (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Productlike '[] t result =>
Record f t -> NP f result
toNP
prettyShow_Record :: forall t f. (Maplike t, KeysValuesAll (KeyValueConstraints KnownSymbol Show) t)
=> (forall x. Show x => f x -> String)
-> Record f t
-> String
prettyShow_Record :: forall (t :: Map Symbol (*)) (f :: * -> *).
(Maplike t,
KeysValuesAll (KeyValueConstraints KnownSymbol Show) t) =>
(forall x. Show x => f x -> String) -> Record f t -> String
prettyShow_Record forall x. Show x => f x -> String
showf Record f t
r =
let showfs :: Record ((,) String :.: Case f String) t
showfs = Proxy Show
-> (forall v.
Show v =>
String -> (:.:) ((,) String) (Case f String) v)
-> Record ((,) String :.: Case f String) t
forall {q} (c :: q -> Constraint) (t :: Map Symbol q)
(f :: q -> *).
KeysValuesAll (KeyValueConstraints KnownSymbol c) t =>
Proxy c -> (forall (v :: q). c v => String -> f v) -> Record f t
cpure'_Record (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @Show) ((forall v.
Show v =>
String -> (:.:) ((,) String) (Case f String) v)
-> Record ((,) String :.: Case f String) t)
-> (forall v.
Show v =>
String -> (:.:) ((,) String) (Case f String) v)
-> Record ((,) String :.: Case f String) t
forall a b. (a -> b) -> a -> b
$ \String
fieldName -> (String, Case f String v) -> (:.:) ((,) String) (Case f String) v
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (String
fieldName, (f v -> String) -> Case f String v
forall q (f :: q -> *) a (b :: q). (f b -> a) -> Case f a b
Case f v -> String
forall x. Show x => f x -> String
showf)
entries :: Record (K [String]) t
entries = (forall a.
(:.:) ((,) String) (Case f String) a -> f a -> K [String] a)
-> Record ((,) String :.: Case f String) t
-> Record f t
-> Record (K [String]) t
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *)
(h :: * -> *).
Maplike t =>
(forall a. f a -> g a -> h a)
-> Record f t -> Record g t -> Record h t
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(forall a. f a -> g a -> h a)
-> Record f t -> Record g t -> Record h t
liftA2_Record (\(Comp (String
fieldName,Case f a -> String
f)) f a
fv -> [String] -> K [String] a
forall k a (b :: k). a -> K a b
K [ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ f a -> String
f f a
fv ]) Record ((,) String :.: Case f String) t
showfs Record f t
r
in String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Monoid a => [a] -> a
mconcat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
", " (Record (K [String]) t -> [String]
forall a. Monoid a => Record (K a) t -> a
forall (t :: Map Symbol (*)) a.
(Maplike t, Monoid a) =>
Record (K a) t -> a
collapse'_Record Record (K [String]) t
entries)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
prettyShow_RecordI :: forall t. (Maplike t, KeysValuesAll (KeyValueConstraints KnownSymbol Show) t) => Record I t -> String
prettyShow_RecordI :: forall (t :: Map Symbol (*)).
(Maplike t,
KeysValuesAll (KeyValueConstraints KnownSymbol Show) t) =>
Record I t -> String
prettyShow_RecordI Record I t
r = (forall x. Show x => I x -> String) -> Record I t -> String
forall (t :: Map Symbol (*)) (f :: * -> *).
(Maplike t,
KeysValuesAll (KeyValueConstraints KnownSymbol Show) t) =>
(forall x. Show x => f x -> String) -> Record f t -> String
prettyShow_Record (x -> String
forall a. Show a => a -> String
show (x -> String) -> (I x -> x) -> I x -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I x -> x
forall a. I a -> a
unI) Record I t
r
{-# DEPRECATED prettyShowRecord "Use prettyShow_Record" #-}
prettyShowRecord :: forall t flat f. (KeysValuesAll KnownKey t,Productlike '[] t flat, All Show flat, SListI flat)
=> (forall x. Show x => f x -> String)
-> Record f t
-> String
prettyShowRecord :: forall (t :: Map Symbol (*)) (flat :: [*]) (f :: * -> *).
(KeysValuesAll KnownKey t, Productlike '[] t flat, All Show flat,
SListI flat) =>
(forall x. Show x => f x -> String) -> Record f t -> String
prettyShowRecord forall x. Show x => f x -> String
showf Record f t
r =
let keysflat :: NP (K String) flat
keysflat = forall {k} (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Productlike '[] t result =>
Record f t -> NP f result
forall (t :: Map Symbol (*)) (result :: [*]) (f :: * -> *).
Productlike '[] t result =>
Record f t -> NP f result
toNP @t (forall {q} (t :: Map Symbol q).
KeysValuesAll KnownKey t =>
Record (K String) t
forall (t :: Map Symbol (*)).
KeysValuesAll KnownKey t =>
Record (K String) t
demoteKeys @t)
valuesflat :: NP f flat
valuesflat = forall {k} (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Productlike '[] t result =>
Record f t -> NP f result
forall (t :: Map Symbol (*)) (result :: [*]) (f :: * -> *).
Productlike '[] t result =>
Record f t -> NP f result
toNP @t Record f t
r
entries :: NP (K String) flat
entries = Proxy Show
-> (forall a. Show a => K String a -> f a -> K String a)
-> NP (K String) flat
-> NP f flat
-> NP (K String) flat
forall {k} (c :: k -> Constraint) (xs :: [k])
(proxy :: (k -> Constraint) -> *) (f :: k -> *) (g :: k -> *)
(h :: k -> *).
All c xs =>
proxy c
-> (forall (a :: k). c a => f a -> g a -> h a)
-> NP f xs
-> NP g xs
-> NP h xs
cliftA2_NP (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @Show) (\(K String
key) f a
fv -> String -> K String a
forall k a (b :: k). a -> K a b
K (String
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ f a -> String
forall x. Show x => f x -> String
showf f a
fv))
NP (K String) flat
keysflat
NP f flat
valuesflat
in String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Monoid a => [a] -> a
mconcat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
", " (NP (K String) flat -> [String]
forall {k} a (xs :: [k]). NP (K a) xs -> [a]
collapse_NP NP (K String) flat
entries)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
{-# DEPRECATED prettyShowRecordI "Use prettyShow_RecordI" #-}
prettyShowRecordI :: forall t flat. (KeysValuesAll KnownKey t,Productlike '[] t flat, All Show flat, SListI flat) => Record I t -> String
prettyShowRecordI :: forall (t :: Map Symbol (*)) (flat :: [*]).
(KeysValuesAll KnownKey t, Productlike '[] t flat, All Show flat,
SListI flat) =>
Record I t -> String
prettyShowRecordI Record I t
r = (forall x. Show x => I x -> String) -> Record I t -> String
forall (t :: Map Symbol (*)) (flat :: [*]) (f :: * -> *).
(KeysValuesAll KnownKey t, Productlike '[] t flat, All Show flat,
SListI flat) =>
(forall x. Show x => f x -> String) -> Record f t -> String
prettyShowRecord (x -> String
forall a. Show a => a -> String
show (x -> String) -> (I x -> x) -> I x -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I x -> x
forall a. I a -> a
unI) Record I t
r
unit :: Record f Empty
unit :: forall {q} (f :: q -> *). Record f 'E
unit = Record f 'E
forall {q} (f :: q -> *). Record f 'E
Empty
type Variant :: (q -> Type) -> Map Symbol q -> Type
data Variant (f :: q -> Type) (t :: Map Symbol q) where
Here :: f v -> Variant f (N color left k v right)
LookRight :: Variant f t -> Variant f (N color' left' k' v' t)
LookLeft :: Variant f t -> Variant f (N color' t k' v' right')
instance (Sumlike '[] t result, Show (NS f result)) => Show (Variant f t) where
show :: Variant f t -> String
show Variant f t
x = String
"fromNS (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ NS f result -> String
forall a. Show a => a -> String
show (Variant f t -> NS f result
forall {k} (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Sumlike '[] t result =>
Variant f t -> NS f result
toNS Variant f t
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
impossible :: Variant f Empty -> b
impossible :: forall {q} (f :: q -> *) b. Variant f Empty -> b
impossible Variant f Empty
v = case Variant f Empty
v of
prettyShow_Variant :: forall t flat f. (Maplike t, KeysValuesAll (KeyValueConstraints KnownSymbol Show) t)
=> (forall x. Show x => f x -> String)
-> Variant f t
-> String
prettyShow_Variant :: forall {k} (t :: Map Symbol (*)) (flat :: k) (f :: * -> *).
(Maplike t,
KeysValuesAll (KeyValueConstraints KnownSymbol Show) t) =>
(forall x. Show x => f x -> String) -> Variant f t -> String
prettyShow_Variant forall x. Show x => f x -> String
showf Variant f t
v =
let showfs :: Record ((,) String :.: Case f String) t
showfs = Proxy Show
-> (forall v.
Show v =>
String -> (:.:) ((,) String) (Case f String) v)
-> Record ((,) String :.: Case f String) t
forall {q} (c :: q -> Constraint) (t :: Map Symbol q)
(f :: q -> *).
KeysValuesAll (KeyValueConstraints KnownSymbol c) t =>
Proxy c -> (forall (v :: q). c v => String -> f v) -> Record f t
cpure'_Record (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @Show) ((forall v.
Show v =>
String -> (:.:) ((,) String) (Case f String) v)
-> Record ((,) String :.: Case f String) t)
-> (forall v.
Show v =>
String -> (:.:) ((,) String) (Case f String) v)
-> Record ((,) String :.: Case f String) t
forall a b. (a -> b) -> a -> b
$ \String
fieldName -> (String, Case f String v) -> (:.:) ((,) String) (Case f String) v
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (String
fieldName, (f v -> String) -> Case f String v
forall q (f :: q -> *) a (b :: q). (f b -> a) -> Case f a b
Case f v -> String
forall x. Show x => f x -> String
showf)
entries :: Variant (K String) t
entries = (forall a.
(:.:) ((,) String) (Case f String) a -> f a -> K String a)
-> Record ((,) String :.: Case f String) t
-> Variant f t
-> Variant (K String) t
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *)
(h :: * -> *).
Maplike t =>
(forall a. f a -> g a -> h a)
-> Record f t -> Variant g t -> Variant h t
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(forall a. f a -> g a -> h a)
-> Record f t -> Variant g t -> Variant h t
liftA2_Variant (\(Comp (String
fieldName,Case f a -> String
f)) f a
fv -> String -> K String a
forall k a (b :: k). a -> K a b
K (String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ f a -> String
f f a
fv String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")) Record ((,) String :.: Case f String) t
showfs Variant f t
v
in Variant (K String) t -> String
forall a. Variant (K a) t -> a
forall (t :: Map Symbol (*)) a. Maplike t => Variant (K a) t -> a
collapse_Variant Variant (K String) t
entries
prettyShow_VariantI :: forall t flat. (Maplike t, KeysValuesAll (KeyValueConstraints KnownSymbol Show) t)
=> Variant I t -> String
prettyShow_VariantI :: forall {k} (t :: Map Symbol (*)) (flat :: k).
(Maplike t,
KeysValuesAll (KeyValueConstraints KnownSymbol Show) t) =>
Variant I t -> String
prettyShow_VariantI Variant I t
v = (forall x. Show x => I x -> String) -> Variant I t -> String
forall {k} (t :: Map Symbol (*)) (flat :: k) (f :: * -> *).
(Maplike t,
KeysValuesAll (KeyValueConstraints KnownSymbol Show) t) =>
(forall x. Show x => f x -> String) -> Variant f t -> String
prettyShow_Variant (x -> String
forall a. Show a => a -> String
show (x -> String) -> (I x -> x) -> I x -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I x -> x
forall a. I a -> a
unI) Variant I t
v
{-# DEPRECATED prettyShowVariant "Use prettyShow_Variant" #-}
prettyShowVariant :: forall t flat f. (KeysValuesAll KnownKey t,Productlike '[] t flat, Sumlike '[] t flat, All Show flat, SListI flat)
=> (forall x. Show x => f x -> String)
-> Variant f t
-> String
prettyShowVariant :: forall (t :: Map Symbol (*)) (flat :: [*]) (f :: * -> *).
(KeysValuesAll KnownKey t, Productlike '[] t flat,
Sumlike '[] t flat, All Show flat, SListI flat) =>
(forall x. Show x => f x -> String) -> Variant f t -> String
prettyShowVariant forall x. Show x => f x -> String
showf Variant f t
v =
let keysflat :: NP (K String) flat
keysflat = forall {k} (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Productlike '[] t result =>
Record f t -> NP f result
forall (t :: Map Symbol (*)) (result :: [*]) (f :: * -> *).
Productlike '[] t result =>
Record f t -> NP f result
toNP @t (forall {q} (t :: Map Symbol q).
KeysValuesAll KnownKey t =>
Record (K String) t
forall (t :: Map Symbol (*)).
KeysValuesAll KnownKey t =>
Record (K String) t
demoteKeys @t)
eliminators :: NP (f -.-> K String) flat
eliminators = Proxy Show
-> (forall a. Show a => K String a -> (-.->) f (K String) a)
-> NP (K String) flat
-> NP (f -.-> K String) flat
forall {k} (c :: k -> Constraint) (xs :: [k])
(proxy :: (k -> Constraint) -> *) (f :: k -> *) (g :: k -> *).
All c xs =>
proxy c
-> (forall (a :: k). c a => f a -> g a) -> NP f xs -> NP g xs
cliftA_NP (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @Show) (\(K String
k) -> (f a -> K String a) -> (-.->) f (K String) a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn (\f a
fv -> (String -> K String a
forall k a (b :: k). a -> K a b
K (String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ f a -> String
forall x. Show x => f x -> String
showf f a
fv String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")))) NP (K String) flat
keysflat
valuesflat :: NS f flat
valuesflat = forall {k} (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Sumlike '[] t result =>
Variant f t -> NS f result
forall (t :: Map Symbol (*)) (result :: [*]) (f :: * -> *).
Sumlike '[] t result =>
Variant f t -> NS f result
toNS @t Variant f t
v
in NS (K String) flat -> String
forall {k} a (xs :: [k]). NS (K a) xs -> a
collapse_NS (NP (f -.-> K String) flat -> NS f flat -> NS (K String) flat
forall {k} (f :: k -> *) (g :: k -> *) (xs :: [k]).
NP (f -.-> g) xs -> NS f xs -> NS g xs
ap_NS NP (f -.-> K String) flat
eliminators NS f flat
valuesflat)
{-# DEPRECATED prettyShowVariantI "Use prettyShow_VariantI" #-}
prettyShowVariantI :: forall t flat. (KeysValuesAll KnownKey t,Productlike '[] t flat, Sumlike '[] t flat, All Show flat, SListI flat)
=> Variant I t -> String
prettyShowVariantI :: forall (t :: Map Symbol (*)) (flat :: [*]).
(KeysValuesAll KnownKey t, Productlike '[] t flat,
Sumlike '[] t flat, All Show flat, SListI flat) =>
Variant I t -> String
prettyShowVariantI Variant I t
v = (forall x. Show x => I x -> String) -> Variant I t -> String
forall (t :: Map Symbol (*)) (flat :: [*]) (f :: * -> *).
(KeysValuesAll KnownKey t, Productlike '[] t flat,
Sumlike '[] t flat, All Show flat, SListI flat) =>
(forall x. Show x => f x -> String) -> Variant f t -> String
prettyShowVariant (x -> String
forall a. Show a => a -> String
show (x -> String) -> (I x -> x) -> I x -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I x -> x
forall a. I a -> a
unI) Variant I t
v
type InsertAll :: [(Symbol,q)] -> Map Symbol q -> Map Symbol q
type family InsertAll (es :: [(Symbol,q)]) (t :: Map Symbol q) :: Map Symbol q where
InsertAll '[] t = t
InsertAll ( '(name,fieldType) ': es ) t = Insert name fieldType (InsertAll es t)
type FromList (es :: [(Symbol,q)]) = InsertAll es Empty
insert :: forall k v t f. Insertable k v t => f v -> Record f t -> Record f (Insert k v t)
insert :: forall {q} (k :: Symbol) (v :: q) (t :: Map Symbol q)
(f :: q -> *).
Insertable k v t =>
f v -> Record f t -> Record f (Insert k v t)
insert = forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Insertable k v t =>
f v -> Record f t -> Record f (Insert k v t)
_insert @_ @k @v @t @f
widen :: forall k v t f. Insertable k v t => Variant f t -> Variant f (Insert k v t)
widen :: forall {q} (k :: Symbol) (v :: q) (t :: Map Symbol q)
(f :: q -> *).
Insertable k v t =>
Variant f t -> Variant f (Insert k v t)
widen = forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Insertable k v t =>
Variant f t -> Variant f (Insert k v t)
_widen @_ @k @v @t @f
addField :: forall k v t f. Insertable k v t => f v -> Record f t -> Record f (Insert k v t)
addField :: forall {q} (k :: Symbol) (v :: q) (t :: Map Symbol q)
(f :: q -> *).
Insertable k v t =>
f v -> Record f t -> Record f (Insert k v t)
addField = forall {q} (k :: Symbol) (v :: q) (t :: Map Symbol q)
(f :: q -> *).
Insertable k v t =>
f v -> Record f t -> Record f (Insert k v t)
forall (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Insertable k v t =>
f v -> Record f t -> Record f (Insert k v t)
insert @k @v @t @f
insertI :: forall k v t . Insertable k v t => v -> Record I t -> Record I (Insert k v t)
insertI :: forall (k :: Symbol) v (t :: Map Symbol (*)).
Insertable k v t =>
v -> Record I t -> Record I (Insert k v t)
insertI = forall {q} (k :: Symbol) (v :: q) (t :: Map Symbol q)
(f :: q -> *).
Insertable k v t =>
f v -> Record f t -> Record f (Insert k v t)
forall (k :: Symbol) v (t :: Map Symbol (*)) (f :: * -> *).
Insertable k v t =>
f v -> Record f t -> Record f (Insert k v t)
insert @k @v @t (I v -> Record I t -> Record I (MakeBlack (Insert1 k v t)))
-> (v -> I v)
-> v
-> Record I t
-> Record I (MakeBlack (Insert1 k v t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> I v
forall a. a -> I a
I
addFieldI :: forall k v t . Insertable k v t => v -> Record I t -> Record I (Insert k v t)
addFieldI :: forall (k :: Symbol) v (t :: Map Symbol (*)).
Insertable k v t =>
v -> Record I t -> Record I (Insert k v t)
addFieldI = forall (k :: Symbol) v (t :: Map Symbol (*)).
Insertable k v t =>
v -> Record I t -> Record I (Insert k v t)
insertI @k @v @t
type Insertable :: Symbol -> q -> Map Symbol q -> Constraint
class Insertable (k :: Symbol) (v :: q) (t :: Map Symbol q) where
type Insert k v t :: Map Symbol q
_insert :: f v -> Record f t -> Record f (Insert k v t)
_widen :: Variant f t -> Variant f (Insert k v t)
instance (InsertableHelper1 k v t, Insert1 k v t ~ inserted, CanMakeBlack inserted) => Insertable k v t where
type Insert k v t = MakeBlack (Insert1 k v t)
_insert :: forall (f :: q -> *). f v -> Record f t -> Record f (Insert k v t)
_insert f v
fv Record f t
r = forall q (t :: Map Symbol q) (f :: q -> *).
CanMakeBlack t =>
Record f t -> Record f (MakeBlack t)
makeBlackR @_ (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
InsertableHelper1 k v t =>
f v -> Record f t -> Record f (Insert1 k v t)
insert1 @_ @k @v f v
fv Record f t
r)
_widen :: forall (f :: q -> *). Variant f t -> Variant f (Insert k v t)
_widen Variant f t
v = forall q (t :: Map Symbol q) (f :: q -> *).
CanMakeBlack t =>
Variant f t -> Variant f (MakeBlack t)
makeBlackV @_ (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
InsertableHelper1 k v t =>
Variant f t -> Variant f (Insert1 k v t)
widen1 @_ @k @v Variant f t
v)
class CanMakeBlack (t :: Map Symbol q) where
type MakeBlack t :: Map Symbol q
makeBlackR :: Record f t -> Record f (MakeBlack t)
makeBlackV :: Variant f t -> Variant f (MakeBlack t)
instance CanMakeBlack (N color left k v right) where
type MakeBlack (N color left k v right) = N B left k v right
makeBlackR :: forall (f :: q -> *).
Record f ('N color left k v right)
-> Record f (MakeBlack ('N color left k v right))
makeBlackR (Node Record f left
left f v
fv Record f right
right) = Record f left
-> f v -> Record f right -> Record f ('N 'B left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left f v
fv Record f right
right
makeBlackV :: forall (f :: q -> *).
Variant f ('N color left k v right)
-> Variant f (MakeBlack ('N color left k v right))
makeBlackV Variant f ('N color left k v right)
v = case Variant f ('N color left k v right)
v of
LookLeft Variant f t
l -> Variant f t -> Variant f ('N 'B t k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
l
Here f v
v -> f v -> Variant f ('N 'B left k v right)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v
LookRight Variant f t
r -> Variant f t -> Variant f ('N 'B left k v t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
r
instance CanMakeBlack E where
type MakeBlack E = E
makeBlackR :: forall (f :: q -> *). Record f 'E -> Record f (MakeBlack 'E)
makeBlackR Record f 'E
Empty = Record f (MakeBlack 'E)
Record f 'E
forall {q} (f :: q -> *). Record f 'E
Empty
makeBlackV :: forall (f :: q -> *). Variant f 'E -> Variant f (MakeBlack 'E)
makeBlackV = Variant f 'E -> Variant f (MakeBlack 'E)
Variant f 'E -> Variant f 'E
forall {q} (f :: q -> *) b. Variant f Empty -> b
impossible
type InsertableHelper1 :: Symbol -> q -> Map Symbol q -> Constraint
class InsertableHelper1 (k :: Symbol)
(v :: q)
(t :: Map Symbol q) where
type Insert1 k v t :: Map Symbol q
insert1 :: f v -> Record f t -> Record f (Insert1 k v t)
widen1 :: Variant f t -> Variant f (Insert1 k v t)
instance InsertableHelper1 k v E where
type Insert1 k v E = N R E k v E
insert1 :: forall (f :: q -> *).
f v -> Record f 'E -> Record f (Insert1 k v 'E)
insert1 f v
fv Record f 'E
Empty = Record f 'E -> f v -> Record f 'E -> Record f ('N 'R 'E k v 'E)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f 'E
forall {q} (f :: q -> *). Record f 'E
Empty f v
fv Record f 'E
forall {q} (f :: q -> *). Record f 'E
Empty
widen1 :: forall (f :: q -> *). Variant f 'E -> Variant f (Insert1 k v 'E)
widen1 = Variant f 'E -> Variant f (Insert1 k v 'E)
Variant f 'E -> Variant f ('N 'R 'E k v 'E)
forall {q} (f :: q -> *) b. Variant f Empty -> b
impossible
instance (CmpSymbol k k' ~ ordering,
InsertableHelper2 ordering k v color left k' v' right
)
=> InsertableHelper1 k v (N color left k' v' right) where
type Insert1 k v (N color left k' v' right) = Insert2 (CmpSymbol k k') k v color left k' v' right
insert1 :: forall (f :: q -> *).
f v
-> Record f ('N color left k' v' right)
-> Record f (Insert1 k v ('N color left k' v' right))
insert1 = forall q (ordering :: Ordering) (k :: Symbol) (v :: q)
(color :: Color) (left :: Map Symbol q) (k' :: Symbol) (v' :: q)
(right :: Map Symbol q) (f :: q -> *).
InsertableHelper2 ordering k v color left k' v' right =>
f v
-> Record f ('N color left k' v' right)
-> Record f (Insert2 ordering k v color left k' v' right)
insert2 @_ @ordering @k @v @color @left @k' @v' @right
widen1 :: forall (f :: q -> *).
Variant f ('N color left k' v' right)
-> Variant f (Insert1 k v ('N color left k' v' right))
widen1 = forall q (ordering :: Ordering) (k :: Symbol) (v :: q)
(color :: Color) (left :: Map Symbol q) (k' :: Symbol) (v' :: q)
(right :: Map Symbol q) (f :: q -> *).
InsertableHelper2 ordering k v color left k' v' right =>
Variant f ('N color left k' v' right)
-> Variant f (Insert2 ordering k v color left k' v' right)
widen2 @_ @ordering @k @v @color @left @k' @v' @right
class InsertableHelper2 (ordering :: Ordering)
(k :: Symbol)
(v :: q)
(color :: Color)
(left :: Map Symbol q)
(k' :: Symbol)
(v' :: q)
(right :: Map Symbol q) where
type Insert2 ordering k v color left k' v' right :: Map Symbol q
insert2 :: f v -> Record f (N color left k' v' right) -> Record f (Insert2 ordering k v color left k' v' right)
widen2 :: Variant f (N color left k' v' right) -> Variant f (Insert2 ordering k v color left k' v' right)
instance (InsertableHelper1 k v left, Insert1 k v left ~ inserted,
Balanceable inserted k' v' right
)
=> InsertableHelper2 LT k v B left k' v' right where
type Insert2 LT k v B left k' v' right = Balance (Insert1 k v left) k' v' right
insert2 :: forall (f :: q -> *).
f v
-> Record f ('N 'B left k' v' right)
-> Record f (Insert2 'LT k v 'B left k' v' right)
insert2 f v
fv (Node Record f left
left f v
fv' Record f right
right) = forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Record f ('N color left k v right)
-> Record f (Balance left k v right)
balanceR @_ @_ @k' @v' @right (Record f inserted
-> f v' -> Record f right -> Record f ('N Any inserted k' v' right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
InsertableHelper1 k v t =>
f v -> Record f t -> Record f (Insert1 k v t)
insert1 @_ @k @v f v
fv Record f left
left) f v'
f v
fv' Record f right
Record f right
right)
widen2 :: forall (f :: q -> *).
Variant f ('N 'B left k' v' right)
-> Variant f (Insert2 'LT k v 'B left k' v' right)
widen2 Variant f ('N 'B left k' v' right)
v = forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Variant f ('N color left k v right)
-> Variant f (Balance left k v right)
balanceV @_ @(Insert1 k v left) @k' @v' @right (Variant f ('N Any (Insert1 k v left) k' v' right)
-> Variant f (Balance (Insert1 k v left) k' v' right))
-> Variant f ('N Any (Insert1 k v left) k' v' right)
-> Variant f (Balance (Insert1 k v left) k' v' right)
forall a b. (a -> b) -> a -> b
$ case Variant f ('N 'B left k' v' right)
v of
Here f v
x -> f v' -> Variant f ('N Any inserted k' v' right)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v'
f v
x
LookLeft Variant f t
x -> Variant f inserted -> Variant f ('N Any inserted k' v' right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
InsertableHelper1 k v t =>
Variant f t -> Variant f (Insert1 k v t)
widen1 @_ @k @v Variant f t
x)
LookRight Variant f t
x -> Variant f right -> Variant f ('N Any inserted k' v' right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f right
Variant f t
x
instance (InsertableHelper1 k v left, Insert1 k v left ~ inserted,
Balanceable inserted k' v' right
)
=> InsertableHelper2 LT k v R left k' v' right where
type Insert2 LT k v R left k' v' right = N R (Insert1 k v left) k' v' right
insert2 :: forall (f :: q -> *).
f v
-> Record f ('N 'R left k' v' right)
-> Record f (Insert2 'LT k v 'R left k' v' right)
insert2 f v
fv (Node Record f left
left f v
fv' Record f right
right) = Record f inserted
-> f v -> Record f right -> Record f ('N 'R inserted k' v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
InsertableHelper1 k v t =>
f v -> Record f t -> Record f (Insert1 k v t)
insert1 @_ @k @v f v
fv Record f left
left) f v
fv' Record f right
right
widen2 :: forall (f :: q -> *).
Variant f ('N 'R left k' v' right)
-> Variant f (Insert2 'LT k v 'R left k' v' right)
widen2 Variant f ('N 'R left k' v' right)
v = case Variant f ('N 'R left k' v' right)
v of
Here f v
x -> f v -> Variant f ('N 'R inserted k' v right)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x
LookLeft Variant f t
x -> Variant f inserted -> Variant f ('N 'R inserted k' v' right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
InsertableHelper1 k v t =>
Variant f t -> Variant f (Insert1 k v t)
widen1 @_ @k @v Variant f t
x)
LookRight Variant f t
x -> Variant f t -> Variant f ('N 'R inserted k' v' t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
x
instance InsertableHelper2 EQ k v color left k v right where
type Insert2 EQ k v color left k v right = N color left k v right
insert2 :: forall (f :: q -> *).
f v
-> Record f ('N color left k v right)
-> Record f (Insert2 'EQ k v color left k v right)
insert2 f v
fv (Node Record f left
left f v
_ Record f right
right) = Record f left
-> f v -> Record f right -> Record f ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left f v
fv Record f right
right
widen2 :: forall (f :: q -> *).
Variant f ('N color left k v right)
-> Variant f (Insert2 'EQ k v color left k v right)
widen2 = Variant f ('N color left k v right)
-> Variant f (Insert2 'EQ k v color left k v right)
Variant f ('N color left k v right)
-> Variant f ('N color left k v right)
forall a. a -> a
id
instance (InsertableHelper1 k v right, Insert1 k v right ~ inserted,
Balanceable left k' v' inserted
)
=> InsertableHelper2 GT k v B left k' v' right where
type Insert2 GT k v B left k' v' right = Balance left k' v' (Insert1 k v right)
insert2 :: forall (f :: q -> *).
f v
-> Record f ('N 'B left k' v' right)
-> Record f (Insert2 'GT k v 'B left k' v' right)
insert2 f v
fv (Node Record f left
left f v
fv' Record f right
right) = forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Record f ('N color left k v right)
-> Record f (Balance left k v right)
balanceR @_ @left @k' @v' @_ (Record f left
-> f v'
-> Record f inserted
-> Record f ('N Any left k' v' inserted)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
Record f left
left f v'
f v
fv' (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
InsertableHelper1 k v t =>
f v -> Record f t -> Record f (Insert1 k v t)
insert1 @_ @k @v f v
fv Record f right
right))
widen2 :: forall (f :: q -> *).
Variant f ('N 'B left k' v' right)
-> Variant f (Insert2 'GT k v 'B left k' v' right)
widen2 Variant f ('N 'B left k' v' right)
v = forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Variant f ('N color left k v right)
-> Variant f (Balance left k v right)
balanceV @_ @left @k' @v' @(Insert1 k v right) (Variant f ('N Any left k' v' (Insert1 k v right))
-> Variant f (Balance left k' v' (Insert1 k v right)))
-> Variant f ('N Any left k' v' (Insert1 k v right))
-> Variant f (Balance left k' v' (Insert1 k v right))
forall a b. (a -> b) -> a -> b
$ case Variant f ('N 'B left k' v' right)
v of
Here f v
x -> f v' -> Variant f ('N Any left k' v' inserted)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v'
f v
x
LookLeft Variant f t
x -> Variant f left -> Variant f ('N Any left k' v' inserted)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f left
Variant f t
x
LookRight Variant f t
x -> Variant f inserted -> Variant f ('N Any left k' v' inserted)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
InsertableHelper1 k v t =>
Variant f t -> Variant f (Insert1 k v t)
widen1 @_ @k @v Variant f t
x)
instance (InsertableHelper1 k v right, Insert1 k v right ~ inserted,
Balanceable left k' v' inserted
)
=> InsertableHelper2 GT k v R left k' v' right where
type Insert2 GT k v R left k' v' right = N R left k' v' (Insert1 k v right)
insert2 :: forall (f :: q -> *).
f v
-> Record f ('N 'R left k' v' right)
-> Record f (Insert2 'GT k v 'R left k' v' right)
insert2 f v
fv (Node Record f left
left f v
fv' Record f right
right) = Record f left
-> f v -> Record f inserted -> Record f ('N 'R left k' v inserted)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left f v
fv' (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
InsertableHelper1 k v t =>
f v -> Record f t -> Record f (Insert1 k v t)
insert1 @_ @k @v f v
fv Record f right
right)
widen2 :: forall (f :: q -> *).
Variant f ('N 'R left k' v' right)
-> Variant f (Insert2 'GT k v 'R left k' v' right)
widen2 Variant f ('N 'R left k' v' right)
v = case Variant f ('N 'R left k' v' right)
v of
Here f v
x -> f v -> Variant f ('N 'R left k' v inserted)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x
LookLeft Variant f t
x -> Variant f t -> Variant f ('N 'R t k' v' inserted)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
x
LookRight Variant f t
x -> Variant f inserted -> Variant f ('N 'R left k' v' inserted)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
InsertableHelper1 k v t =>
Variant f t -> Variant f (Insert1 k v t)
widen1 @_ @k @v Variant f t
x)
data BalanceAction = BalanceSpecial
| BalanceLL
| BalanceLR
| BalanceRL
| BalanceRR
| DoNotBalance
deriving Int -> BalanceAction -> ShowS
[BalanceAction] -> ShowS
BalanceAction -> String
(Int -> BalanceAction -> ShowS)
-> (BalanceAction -> String)
-> ([BalanceAction] -> ShowS)
-> Show BalanceAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BalanceAction -> ShowS
showsPrec :: Int -> BalanceAction -> ShowS
$cshow :: BalanceAction -> String
show :: BalanceAction -> String
$cshowList :: [BalanceAction] -> ShowS
showList :: [BalanceAction] -> ShowS
Show
type ShouldBalance :: Map k' v' -> Map k' v' -> BalanceAction
type family ShouldBalance (left :: Map k' v') (right :: Map k' v') :: BalanceAction where
ShouldBalance (N R _ _ _ _) (N R _ _ _ _) = BalanceSpecial
ShouldBalance (N R (N R _ _ _ _) _ _ _) _ = BalanceLL
ShouldBalance (N R _ _ _ (N R _ _ _ _)) _ = BalanceLR
ShouldBalance _ (N R (N R _ _ _ _) _ _ _) = BalanceRL
ShouldBalance _ (N R _ _ _ (N R _ _ _ _)) = BalanceRR
ShouldBalance _ _ = DoNotBalance
class Balanceable (left :: Map Symbol q) (k :: Symbol) (v :: q) (right :: Map Symbol q) where
type Balance left k v right :: Map Symbol q
balanceR :: Record f (N color left k v right) -> Record f (Balance left k v right)
balanceV :: Variant f (N color left k v right) -> Variant f (Balance left k v right)
instance (ShouldBalance left right ~ action,
BalanceableHelper action left k v right
)
=> Balanceable left k v right where
type Balance left k v right = Balance' (ShouldBalance left right) left k v right
balanceR :: forall (f :: q -> *) (color :: Color).
Record f ('N color left k v right)
-> Record f (Balance left k v right)
balanceR = forall q (action :: BalanceAction) (left :: Map Symbol q)
(k :: Symbol) (v :: q) (right :: Map Symbol q) (f :: q -> *)
(color :: Color).
BalanceableHelper action left k v right =>
Record f ('N color left k v right)
-> Record f (Balance' action left k v right)
balanceR' @_ @action @left @k @v @right
balanceV :: forall (f :: q -> *) (color :: Color).
Variant f ('N color left k v right)
-> Variant f (Balance left k v right)
balanceV = forall q (action :: BalanceAction) (left :: Map Symbol q)
(k :: Symbol) (v :: q) (right :: Map Symbol q) (f :: q -> *)
(color :: Color).
BalanceableHelper action left k v right =>
Variant f ('N color left k v right)
-> Variant f (Balance' action left k v right)
balanceV' @_ @action @left @k @v @right
class BalanceableHelper (action :: BalanceAction)
(left :: Map Symbol q)
(k :: Symbol)
(v :: q)
(right :: Map Symbol q) where
type Balance' action left k v right :: Map Symbol q
balanceR' :: Record f (N color left k v right) -> Record f (Balance' action left k v right)
balanceV' :: Variant f (N color left k v right) -> Variant f (Balance' action left k v right)
instance BalanceableHelper BalanceSpecial (N R left1 k1 v1 right1) kx vx (N R left2 k2 v2 right2) where
type Balance' BalanceSpecial (N R left1 k1 v1 right1) kx vx (N R left2 k2 v2 right2) =
N R (N B left1 k1 v1 right1) kx vx (N B left2 k2 v2 right2)
balanceR' :: forall (f :: q -> *) (color :: Color).
Record
f
('N
color ('N 'R left1 k1 v1 right1) kx vx ('N 'R left2 k2 v2 right2))
-> Record
f
(Balance'
'BalanceSpecial
('N 'R left1 k1 v1 right1)
kx
vx
('N 'R left2 k2 v2 right2))
balanceR' (Node (Node Record f left
left1 f v
v1 Record f right
right1) f v
vx (Node Record f left
left2 f v
v2 Record f right
right2)) =
(Record f ('N 'B left k1 v right)
-> f v
-> Record f ('N 'B left k2 v right)
-> Record
f ('N 'R ('N 'B left k1 v right) kx v ('N 'B left k2 v right))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f left
-> f v -> Record f right -> Record f ('N 'B left k1 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left1 f v
v1 Record f right
right1) f v
vx (Record f left
-> f v -> Record f right -> Record f ('N 'B left k2 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left2 f v
v2 Record f right
right2))
balanceV' :: forall (f :: q -> *) (color :: Color).
Variant
f
('N
color ('N 'R left1 k1 v1 right1) kx vx ('N 'R left2 k2 v2 right2))
-> Variant
f
(Balance'
'BalanceSpecial
('N 'R left1 k1 v1 right1)
kx
vx
('N 'R left2 k2 v2 right2))
balanceV' Variant
f
('N
color ('N 'R left1 k1 v1 right1) kx vx ('N 'R left2 k2 v2 right2))
v = case Variant
f
('N
color ('N 'R left1 k1 v1 right1) kx vx ('N 'R left2 k2 v2 right2))
v of
LookLeft (LookLeft Variant f t
x) -> Variant f ('N 'B t k1 v1 right1)
-> Variant
f ('N 'R ('N 'B t k1 v1 right1) kx vx ('N 'B left2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B t k1 v1 right1)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
x)
LookLeft (Here f v
x) -> Variant f ('N 'B left1 k1 v right1)
-> Variant
f
('N 'R ('N 'B left1 k1 v right1) kx vx ('N 'B left2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (f v -> Variant f ('N 'B left1 k1 v right1)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x)
LookLeft (LookRight Variant f t
x) -> Variant f ('N 'B left1 k1 v1 t)
-> Variant
f ('N 'R ('N 'B left1 k1 v1 t) kx vx ('N 'B left2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B left1 k1 v1 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
x)
Here f v
x -> f v
-> Variant
f
('N 'R ('N 'B left1 k1 v1 right1) kx v ('N 'B left2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x
LookRight (LookLeft Variant f t
x) -> Variant f ('N 'B t k2 v2 right2)
-> Variant
f ('N 'R ('N 'B left1 k1 v1 right1) kx vx ('N 'B t k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'B t k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
x)
LookRight (Here f v
x) -> Variant f ('N 'B left2 k2 v right2)
-> Variant
f
('N 'R ('N 'B left1 k1 v1 right1) kx vx ('N 'B left2 k2 v right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (f v -> Variant f ('N 'B left2 k2 v right2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x)
LookRight (LookRight Variant f t
x) -> Variant f ('N 'B left2 k2 v2 t)
-> Variant
f ('N 'R ('N 'B left1 k1 v1 right1) kx vx ('N 'B left2 k2 v2 t))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'B left2 k2 v2 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
x)
instance BalanceableHelper BalanceLL (N R (N R a k1 v1 b) k2 v2 c) k3 v3 d where
type Balance' BalanceLL (N R (N R a k1 v1 b) k2 v2 c) k3 v3 d =
N R (N B a k1 v1 b) k2 v2 (N B c k3 v3 d)
balanceR' :: forall (f :: q -> *) (color :: Color).
Record f ('N color ('N 'R ('N 'R a k1 v1 b) k2 v2 c) k3 v3 d)
-> Record
f (Balance' 'BalanceLL ('N 'R ('N 'R a k1 v1 b) k2 v2 c) k3 v3 d)
balanceR' (Node (Node (Node Record f left
a f v
fv1 Record f right
b) f v
fv2 Record f right
c) f v
fv3 Record f right
d) =
Record f ('N 'B left k1 v right)
-> f v
-> Record f ('N 'B right k3 v right)
-> Record
f ('N 'R ('N 'B left k1 v right) k2 v ('N 'B right k3 v right))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f left
-> f v -> Record f right -> Record f ('N 'B left k1 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
a f v
fv1 Record f right
b) f v
fv2 (Record f right
-> f v -> Record f right -> Record f ('N 'B right k3 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f right
c f v
fv3 Record f right
d)
balanceV' :: forall (f :: q -> *) (color :: Color).
Variant f ('N color ('N 'R ('N 'R a k1 v1 b) k2 v2 c) k3 v3 d)
-> Variant
f (Balance' 'BalanceLL ('N 'R ('N 'R a k1 v1 b) k2 v2 c) k3 v3 d)
balanceV' Variant f ('N color ('N 'R ('N 'R a k1 v1 b) k2 v2 c) k3 v3 d)
v = case Variant f ('N color ('N 'R ('N 'R a k1 v1 b) k2 v2 c) k3 v3 d)
v of
LookLeft (LookLeft Variant f t
x) -> Variant f ('N 'B a k1 v1 b)
-> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v2 ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (case Variant f t
x of LookLeft Variant f t
y -> Variant f t -> Variant f ('N 'B t k1 v1 b)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
y
Here f v
y -> f v -> Variant f ('N 'B a k1 v b)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
y
LookRight Variant f t
y -> Variant f t -> Variant f ('N 'B a k1 v1 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
y)
LookLeft (Here f v
x) -> f v -> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x
LookLeft (LookRight Variant f t
x) -> Variant f ('N 'B t k3 v3 d)
-> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v2 ('N 'B t k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'B t k3 v3 d)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
x)
Here f v
x -> Variant f ('N 'B c k3 v d)
-> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v2 ('N 'B c k3 v d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (f v -> Variant f ('N 'B c k3 v d)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x)
LookRight Variant f t
x -> Variant f ('N 'B c k3 v3 t)
-> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v2 ('N 'B c k3 v3 t))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'B c k3 v3 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
x)
instance BalanceableHelper BalanceLR (N R a k1 v1 (N R b k2 v2 c)) k3 v3 d where
type Balance' BalanceLR (N R a k1 v1 (N R b k2 v2 c)) k3 v3 d =
N R (N B a k1 v1 b) k2 v2 (N B c k3 v3 d)
balanceR' :: forall (f :: q -> *) (color :: Color).
Record f ('N color ('N 'R a k1 v1 ('N 'R b k2 v2 c)) k3 v3 d)
-> Record
f (Balance' 'BalanceLR ('N 'R a k1 v1 ('N 'R b k2 v2 c)) k3 v3 d)
balanceR' (Node (Node Record f left
a f v
fv1 (Node Record f left
b f v
fv2 Record f right
c)) f v
fv3 Record f right
d) =
Record f ('N 'B left k1 v left)
-> f v
-> Record f ('N 'B right k3 v right)
-> Record
f ('N 'R ('N 'B left k1 v left) k2 v ('N 'B right k3 v right))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f left
-> f v -> Record f left -> Record f ('N 'B left k1 v left)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
a f v
fv1 Record f left
b) f v
fv2 (Record f right
-> f v -> Record f right -> Record f ('N 'B right k3 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f right
c f v
fv3 Record f right
d)
balanceV' :: forall (f :: q -> *) (color :: Color).
Variant f ('N color ('N 'R a k1 v1 ('N 'R b k2 v2 c)) k3 v3 d)
-> Variant
f (Balance' 'BalanceLR ('N 'R a k1 v1 ('N 'R b k2 v2 c)) k3 v3 d)
balanceV' Variant f ('N color ('N 'R a k1 v1 ('N 'R b k2 v2 c)) k3 v3 d)
v = case Variant f ('N color ('N 'R a k1 v1 ('N 'R b k2 v2 c)) k3 v3 d)
v of
LookLeft (LookLeft Variant f t
x) -> Variant f ('N 'B t k1 v1 b)
-> Variant f ('N 'R ('N 'B t k1 v1 b) k2 v2 ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B t k1 v1 b)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
x)
LookLeft (Here f v
x) -> Variant f ('N 'B a k1 v b)
-> Variant f ('N 'R ('N 'B a k1 v b) k2 v2 ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (f v -> Variant f ('N 'B a k1 v b)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x)
LookLeft (LookRight Variant f t
x) -> case Variant f t
x of LookLeft Variant f t
y -> Variant f ('N 'B a k1 v1 t)
-> Variant f ('N 'R ('N 'B a k1 v1 t) k2 v2 ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B a k1 v1 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
y)
Here f v
y -> f v -> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
y
LookRight Variant f t
y -> Variant f ('N 'B t k3 v3 d)
-> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v2 ('N 'B t k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'B t k3 v3 d)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
y)
Here f v
x -> Variant f ('N 'B c k3 v d)
-> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v2 ('N 'B c k3 v d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (f v -> Variant f ('N 'B c k3 v d)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x)
LookRight Variant f t
x -> Variant f ('N 'B c k3 v3 t)
-> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v2 ('N 'B c k3 v3 t))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'B c k3 v3 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
x)
instance BalanceableHelper BalanceRL a k1 v1 (N R (N R b k2 v2 c) k3 v3 d) where
type Balance' BalanceRL a k1 v1 (N R (N R b k2 v2 c) k3 v3 d) =
N R (N B a k1 v1 b) k2 v2 (N B c k3 v3 d)
balanceR' :: forall (f :: q -> *) (color :: Color).
Record f ('N color a k1 v1 ('N 'R ('N 'R b k2 v2 c) k3 v3 d))
-> Record
f (Balance' 'BalanceRL a k1 v1 ('N 'R ('N 'R b k2 v2 c) k3 v3 d))
balanceR' (Node Record f left
a f v
fv1 (Node (Node Record f left
b f v
fv2 Record f right
c) f v
fv3 Record f right
d)) =
Record f ('N 'B left k1 v left)
-> f v
-> Record f ('N 'B right k3 v right)
-> Record
f ('N 'R ('N 'B left k1 v left) k2 v ('N 'B right k3 v right))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f left
-> f v -> Record f left -> Record f ('N 'B left k1 v left)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
a f v
fv1 Record f left
b) f v
fv2 (Record f right
-> f v -> Record f right -> Record f ('N 'B right k3 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f right
c f v
fv3 Record f right
d)
balanceV' :: forall (f :: q -> *) (color :: Color).
Variant f ('N color a k1 v1 ('N 'R ('N 'R b k2 v2 c) k3 v3 d))
-> Variant
f (Balance' 'BalanceRL a k1 v1 ('N 'R ('N 'R b k2 v2 c) k3 v3 d))
balanceV' Variant f ('N color a k1 v1 ('N 'R ('N 'R b k2 v2 c) k3 v3 d))
v = case Variant f ('N color a k1 v1 ('N 'R ('N 'R b k2 v2 c) k3 v3 d))
v of
LookLeft Variant f t
x -> Variant f ('N 'B t k1 v1 b)
-> Variant f ('N 'R ('N 'B t k1 v1 b) k2 v2 ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B t k1 v1 b)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
x)
Here f v
x -> Variant f ('N 'B a k1 v b)
-> Variant f ('N 'R ('N 'B a k1 v b) k2 v2 ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (f v -> Variant f ('N 'B a k1 v b)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x)
LookRight (LookLeft Variant f t
x) -> case Variant f t
x of LookLeft Variant f t
y -> Variant f ('N 'B a k1 v1 t)
-> Variant f ('N 'R ('N 'B a k1 v1 t) k2 v2 ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B a k1 v1 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
y)
Here f v
y -> f v -> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
y
LookRight Variant f t
y -> Variant f ('N 'B t k3 v3 d)
-> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v2 ('N 'B t k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'B t k3 v3 d)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
y)
LookRight (Here f v
x) -> Variant f ('N 'B c k3 v d)
-> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v2 ('N 'B c k3 v d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (f v -> Variant f ('N 'B c k3 v d)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x)
LookRight (LookRight Variant f t
x) -> Variant f ('N 'B c k3 v3 t)
-> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v2 ('N 'B c k3 v3 t))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'B c k3 v3 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
x)
instance BalanceableHelper BalanceRR a k1 v1 (N R b k2 v2 (N R c k3 v3 d)) where
type Balance' BalanceRR a k1 v1 (N R b k2 v2 (N R c k3 v3 d)) =
N R (N B a k1 v1 b) k2 v2 (N B c k3 v3 d)
balanceR' :: forall (f :: q -> *) (color :: Color).
Record f ('N color a k1 v1 ('N 'R b k2 v2 ('N 'R c k3 v3 d)))
-> Record
f (Balance' 'BalanceRR a k1 v1 ('N 'R b k2 v2 ('N 'R c k3 v3 d)))
balanceR' (Node Record f left
a f v
fv1 (Node Record f left
b f v
fv2 (Node Record f left
c f v
fv3 Record f right
d))) =
Record f ('N 'B left k1 v left)
-> f v
-> Record f ('N 'B left k3 v right)
-> Record
f ('N 'R ('N 'B left k1 v left) k2 v ('N 'B left k3 v right))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f left
-> f v -> Record f left -> Record f ('N 'B left k1 v left)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
a f v
fv1 Record f left
b) f v
fv2 (Record f left
-> f v -> Record f right -> Record f ('N 'B left k3 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
c f v
fv3 Record f right
d)
balanceV' :: forall (f :: q -> *) (color :: Color).
Variant f ('N color a k1 v1 ('N 'R b k2 v2 ('N 'R c k3 v3 d)))
-> Variant
f (Balance' 'BalanceRR a k1 v1 ('N 'R b k2 v2 ('N 'R c k3 v3 d)))
balanceV' Variant f ('N color a k1 v1 ('N 'R b k2 v2 ('N 'R c k3 v3 d)))
v = case Variant f ('N color a k1 v1 ('N 'R b k2 v2 ('N 'R c k3 v3 d)))
v of
LookLeft Variant f t
x -> Variant f ('N 'B t k1 v1 b)
-> Variant f ('N 'R ('N 'B t k1 v1 b) k2 v2 ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B t k1 v1 b)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
x)
Here f v
x -> Variant f ('N 'B a k1 v b)
-> Variant f ('N 'R ('N 'B a k1 v b) k2 v2 ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (f v -> Variant f ('N 'B a k1 v b)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x)
LookRight (LookLeft Variant f t
x) -> Variant f ('N 'B a k1 v1 t)
-> Variant f ('N 'R ('N 'B a k1 v1 t) k2 v2 ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B a k1 v1 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
x)
LookRight (Here f v
x) -> f v -> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x
LookRight (LookRight Variant f t
x) -> Variant f ('N 'B c k3 v3 d)
-> Variant f ('N 'R ('N 'B a k1 v1 b) k2 v2 ('N 'B c k3 v3 d))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (case Variant f t
x of LookLeft Variant f t
y -> Variant f t -> Variant f ('N 'B t k3 v3 d)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
y
Here f v
y -> f v -> Variant f ('N 'B c k3 v d)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
y
LookRight Variant f t
y -> Variant f t -> Variant f ('N 'B c k3 v3 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
y)
instance BalanceableHelper DoNotBalance a k v b where
type Balance' DoNotBalance a k v b = N B a k v b
balanceR' :: forall (f :: q -> *) (color :: Color).
Record f ('N color a k v b)
-> Record f (Balance' 'DoNotBalance a k v b)
balanceR' (Node Record f left
left f v
v Record f right
right) = (Record f left
-> f v -> Record f right -> Record f ('N 'B left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left f v
v Record f right
right)
balanceV' :: forall (f :: q -> *) (color :: Color).
Variant f ('N color a k v b)
-> Variant f (Balance' 'DoNotBalance a k v b)
balanceV' Variant f ('N color a k v b)
v = case Variant f ('N color a k v b)
v of
LookLeft Variant f t
l -> Variant f t -> Variant f ('N 'B t k v b)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
l
Here f v
v -> f v -> Variant f ('N 'B a k v b)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v
LookRight Variant f t
r -> Variant f t -> Variant f ('N 'B a k v t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
r
type family Field (f :: q -> Type) (t :: Map Symbol q) (v :: q) where
Field f t v = Record f t -> (f v -> Record f t, f v)
type family Branch (f :: q -> Type) (t :: Map Symbol q) (v :: q) where
Branch f t v = (Variant f t -> Maybe (f v), f v -> Variant f t)
class Key (k :: Symbol) (t :: Map Symbol q) where
type Value k t :: q
_field :: Field f t (Value k t)
_branch :: Branch f t (Value k t)
field :: forall k t f. Key k t => Field f t (Value k t)
field :: forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Field f t (Value k t)
field = forall q (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Field f t (Value k t)
_field @_ @k @t
branch :: forall k t f. Key k t => Branch f t (Value k t)
branch :: forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Branch f t (Value k t)
branch = forall q (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Branch f t (Value k t)
_branch @_ @k @t
class KeyHelper (ordering :: Ordering) (k :: Symbol) (left :: Map Symbol q) (v :: q) (right :: Map Symbol q) where
type Value' ordering k left v right :: q
field' :: Field f (N colorx left kx v right) (Value' ordering k left v right)
branch' :: Branch f (N colorx left kx v right) (Value' ordering k left v right)
instance (CmpSymbol k' k ~ ordering, KeyHelper ordering k left v' right) => Key k (N color left k' v' right) where
type Value k (N color left k' v' right) = Value' (CmpSymbol k' k) k left v' right
_field :: forall (f :: q -> *).
Field
f ('N color left k' v' right) (Value k ('N color left k' v' right))
_field = forall q (ordering :: Ordering) (k :: Symbol)
(left :: Map Symbol q) (v :: q) (right :: Map Symbol q)
(f :: q -> *) (colorx :: Color) (kx :: Symbol).
KeyHelper ordering k left v right =>
Field
f ('N colorx left kx v right) (Value' ordering k left v right)
field' @_ @ordering @k @left @v' @right
_branch :: forall (f :: q -> *).
Branch
f ('N color left k' v' right) (Value k ('N color left k' v' right))
_branch = forall q (ordering :: Ordering) (k :: Symbol)
(left :: Map Symbol q) (v :: q) (right :: Map Symbol q)
(f :: q -> *) (colorx :: Color) (kx :: Symbol).
KeyHelper ordering k left v right =>
Branch
f ('N colorx left kx v right) (Value' ordering k left v right)
branch' @_ @ordering @k @left @v' @right
instance (CmpSymbol k2 k ~ ordering, KeyHelper ordering k left2 v2 right2)
=> KeyHelper LT k left v (N color2 left2 k2 v2 right2) where
type Value' LT k left v (N color2 left2 k2 v2 right2) = Value' (CmpSymbol k2 k) k left2 v2 right2
field' :: forall (f :: q -> *) (colorx :: Color) (kx :: Symbol).
Field
f
('N colorx left kx v ('N color2 left2 k2 v2 right2))
(Value' 'LT k left v ('N color2 left2 k2 v2 right2))
field' (Node Record f left
left f v
fv Record f right
right) =
let (f (Value' ordering k left2 v2 right2)
-> Record f ('N color2 left2 k2 v2 right2)
setter,f (Value' ordering k left2 v2 right2)
x) = forall q (ordering :: Ordering) (k :: Symbol)
(left :: Map Symbol q) (v :: q) (right :: Map Symbol q)
(f :: q -> *) (colorx :: Color) (kx :: Symbol).
KeyHelper ordering k left v right =>
Field
f ('N colorx left kx v right) (Value' ordering k left v right)
field' @_ @ordering @k @left2 @v2 @right2 Record f right
right
in (\f (Value' ordering k left2 v2 right2)
z -> Record f left
-> f v
-> Record f ('N color2 left2 k2 v2 right2)
-> Record f ('N colorx left kx v ('N color2 left2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left f v
fv (f (Value' ordering k left2 v2 right2)
-> Record f ('N color2 left2 k2 v2 right2)
setter f (Value' ordering k left2 v2 right2)
z),f (Value' ordering k left2 v2 right2)
x)
branch' :: forall (f :: q -> *) (colorx :: Color) (kx :: Symbol).
Branch
f
('N colorx left kx v ('N color2 left2 k2 v2 right2))
(Value' 'LT k left v ('N color2 left2 k2 v2 right2))
branch' =
let (Variant f ('N color2 left2 k2 v2 right2)
-> Maybe (f (Value' ordering k left2 v2 right2))
match,f (Value' ordering k left2 v2 right2)
-> Variant f ('N color2 left2 k2 v2 right2)
inj) = forall q (ordering :: Ordering) (k :: Symbol)
(left :: Map Symbol q) (v :: q) (right :: Map Symbol q)
(f :: q -> *) (colorx :: Color) (kx :: Symbol).
KeyHelper ordering k left v right =>
Branch
f ('N colorx left kx v right) (Value' ordering k left v right)
branch' @_ @ordering @k @left2 @v2 @right2
in (\case LookRight Variant f t
x -> Variant f t -> Maybe (f (Value' ordering k left2 v2 right2))
Variant f ('N color2 left2 k2 v2 right2)
-> Maybe (f (Value' ordering k left2 v2 right2))
match Variant f t
x
Variant f ('N colorx left kx v ('N color2 left2 k2 v2 right2))
_ -> Maybe (f (Value' ordering k left2 v2 right2))
forall a. Maybe a
Nothing,
\f (Value' ordering k left2 v2 right2)
fv -> Variant f ('N color2 left2 k2 v2 right2)
-> Variant f ('N colorx left kx v ('N color2 left2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (f (Value' ordering k left2 v2 right2)
-> Variant f ('N color2 left2 k2 v2 right2)
inj f (Value' ordering k left2 v2 right2)
fv))
instance (CmpSymbol k2 k ~ ordering, KeyHelper ordering k left2 v2 right2)
=> KeyHelper GT k (N color2 left2 k2 v2 right2) v' right where
type Value' GT k (N color2 left2 k2 v2 right2) v' right = Value' (CmpSymbol k2 k) k left2 v2 right2
field' :: forall (f :: q -> *) (colorx :: Color) (kx :: Symbol).
Field
f
('N colorx ('N color2 left2 k2 v2 right2) kx v' right)
(Value' 'GT k ('N color2 left2 k2 v2 right2) v' right)
field' (Node Record f left
left f v
fv Record f right
right) =
let (f (Value' ordering k left2 v2 right2)
-> Record f ('N color2 left2 k2 v2 right2)
setter,f (Value' ordering k left2 v2 right2)
x) = forall q (ordering :: Ordering) (k :: Symbol)
(left :: Map Symbol q) (v :: q) (right :: Map Symbol q)
(f :: q -> *) (colorx :: Color) (kx :: Symbol).
KeyHelper ordering k left v right =>
Field
f ('N colorx left kx v right) (Value' ordering k left v right)
field' @_ @ordering @k @left2 @v2 @right2 Record f left
left
in (\f (Value' ordering k left2 v2 right2)
z -> Record f ('N color2 left2 k2 v2 right2)
-> f v
-> Record f right
-> Record f ('N colorx ('N color2 left2 k2 v2 right2) kx v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (f (Value' ordering k left2 v2 right2)
-> Record f ('N color2 left2 k2 v2 right2)
setter f (Value' ordering k left2 v2 right2)
z) f v
fv Record f right
right,f (Value' ordering k left2 v2 right2)
x)
branch' :: forall (f :: q -> *) (colorx :: Color) (kx :: Symbol).
Branch
f
('N colorx ('N color2 left2 k2 v2 right2) kx v' right)
(Value' 'GT k ('N color2 left2 k2 v2 right2) v' right)
branch' =
let (Variant f ('N color2 left2 k2 v2 right2)
-> Maybe (f (Value' ordering k left2 v2 right2))
match,f (Value' ordering k left2 v2 right2)
-> Variant f ('N color2 left2 k2 v2 right2)
inj) = forall q (ordering :: Ordering) (k :: Symbol)
(left :: Map Symbol q) (v :: q) (right :: Map Symbol q)
(f :: q -> *) (colorx :: Color) (kx :: Symbol).
KeyHelper ordering k left v right =>
Branch
f ('N colorx left kx v right) (Value' ordering k left v right)
branch' @_ @ordering @k @left2 @v2 @right2
in (\case LookLeft Variant f t
x -> Variant f t -> Maybe (f (Value' ordering k left2 v2 right2))
Variant f ('N color2 left2 k2 v2 right2)
-> Maybe (f (Value' ordering k left2 v2 right2))
match Variant f t
x
Variant f ('N colorx ('N color2 left2 k2 v2 right2) kx v' right)
_ -> Maybe (f (Value' ordering k left2 v2 right2))
forall a. Maybe a
Nothing,
\f (Value' ordering k left2 v2 right2)
fv -> Variant f ('N color2 left2 k2 v2 right2)
-> Variant f ('N colorx ('N color2 left2 k2 v2 right2) kx v' right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (f (Value' ordering k left2 v2 right2)
-> Variant f ('N color2 left2 k2 v2 right2)
inj f (Value' ordering k left2 v2 right2)
fv))
instance KeyHelper EQ k left v right where
type Value' EQ k left v right = v
field' :: forall (f :: q -> *) (colorx :: Color) (kx :: Symbol).
Field f ('N colorx left kx v right) (Value' 'EQ k left v right)
field' (Node Record f left
left f v
fv Record f right
right) = (\f v
x -> Record f left
-> f v -> Record f right -> Record f ('N colorx left kx v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left f v
x Record f right
right, f v
fv)
branch' :: forall (f :: q -> *) (colorx :: Color) (kx :: Symbol).
Branch f ('N colorx left kx v right) (Value' 'EQ k left v right)
branch' = (\case Here f v
x -> f v -> Maybe (f v)
forall a. a -> Maybe a
Just f v
x
Variant f ('N colorx left kx v right)
_ -> Maybe (f v)
forall a. Maybe a
Nothing,
f v -> Variant f ('N colorx left kx v right)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here)
project :: forall k t f . Key k t => Record f t -> f (Value k t)
project :: forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Record f t -> f (Value k t)
project = (f (Value k t) -> Record f t, f (Value k t)) -> f (Value k t)
forall a b. (a, b) -> b
snd ((f (Value k t) -> Record f t, f (Value k t)) -> f (Value k t))
-> (Record f t -> (f (Value k t) -> Record f t, f (Value k t)))
-> Record f t
-> f (Value k t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Field f t (Value k t)
forall (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Field f t (Value k t)
field @k @t
getField :: forall k t f . Key k t => Record f t -> f (Value k t)
getField :: forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Record f t -> f (Value k t)
getField = forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Record f t -> f (Value k t)
forall (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Record f t -> f (Value k t)
project @k @t @f
setField :: forall k t f . Key k t => f (Value k t) -> Record f t -> Record f t
setField :: forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
f (Value k t) -> Record f t -> Record f t
setField f (Value k t)
fv Record f t
r = (f (Value k t) -> Record f t, f (Value k t))
-> f (Value k t) -> Record f t
forall a b. (a, b) -> a
fst (forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Field f t (Value k t)
forall (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Field f t (Value k t)
field @k @t @f Record f t
r) f (Value k t)
fv
modifyField :: forall k t f . Key k t => (f (Value k t) -> f (Value k t)) -> Record f t -> Record f t
modifyField :: forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
(f (Value k t) -> f (Value k t)) -> Record f t -> Record f t
modifyField f (Value k t) -> f (Value k t)
f Record f t
r = ((f (Value k t) -> Record f t) -> f (Value k t) -> Record f t)
-> (f (Value k t) -> Record f t, f (Value k t)) -> Record f t
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (f (Value k t) -> Record f t) -> f (Value k t) -> Record f t
forall a b. (a -> b) -> a -> b
($) ((f (Value k t) -> f (Value k t))
-> (f (Value k t) -> Record f t, f (Value k t))
-> (f (Value k t) -> Record f t, f (Value k t))
forall a b.
(a -> b)
-> (f (Value k t) -> Record f t, a)
-> (f (Value k t) -> Record f t, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (Value k t) -> f (Value k t)
f (forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Field f t (Value k t)
forall (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Field f t (Value k t)
field @k @t @f Record f t
r))
inject :: forall k t f. Key k t => f (Value k t) -> Variant f t
inject :: forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
f (Value k t) -> Variant f t
inject = (Variant f t -> Maybe (f (Value k t)),
f (Value k t) -> Variant f t)
-> f (Value k t) -> Variant f t
forall a b. (a, b) -> b
snd (forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Branch f t (Value k t)
forall (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Branch f t (Value k t)
branch @k @t)
match :: forall k t f. Key k t => Variant f t -> Maybe (f (Value k t))
match :: forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Variant f t -> Maybe (f (Value k t))
match = (Variant f t -> Maybe (f (Value k t)),
f (Value k t) -> Variant f t)
-> Variant f t -> Maybe (f (Value k t))
forall a b. (a, b) -> a
fst (forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Branch f t (Value k t)
forall (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Branch f t (Value k t)
branch @k @t)
projectI :: forall k t . Key k t => Record I t -> Value k t
projectI :: forall (k :: Symbol) (t :: Map Symbol (*)).
Key k t =>
Record I t -> Value k t
projectI = I (Value k t) -> Value k t
forall a. I a -> a
unI (I (Value k t) -> Value k t)
-> (Record I t -> I (Value k t)) -> Record I t -> Value k t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (I (Value k t) -> Record I t, I (Value k t)) -> I (Value k t)
forall a b. (a, b) -> b
snd ((I (Value k t) -> Record I t, I (Value k t)) -> I (Value k t))
-> (Record I t -> (I (Value k t) -> Record I t, I (Value k t)))
-> Record I t
-> I (Value k t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Field f t (Value k t)
forall (k :: Symbol) (t :: Map Symbol (*)) (f :: * -> *).
Key k t =>
Field f t (Value k t)
field @k @t
getFieldI :: forall k t . Key k t => Record I t -> Value k t
getFieldI :: forall (k :: Symbol) (t :: Map Symbol (*)).
Key k t =>
Record I t -> Value k t
getFieldI = forall (k :: Symbol) (t :: Map Symbol (*)).
Key k t =>
Record I t -> Value k t
projectI @k @t
setFieldI :: forall k t . Key k t => Value k t -> Record I t -> Record I t
setFieldI :: forall (k :: Symbol) (t :: Map Symbol (*)).
Key k t =>
Value k t -> Record I t -> Record I t
setFieldI Value k t
v Record I t
r = (I (Value k t) -> Record I t, I (Value k t))
-> I (Value k t) -> Record I t
forall a b. (a, b) -> a
fst (forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Field f t (Value k t)
forall (k :: Symbol) (t :: Map Symbol (*)) (f :: * -> *).
Key k t =>
Field f t (Value k t)
field @k @t Record I t
r) (Value k t -> I (Value k t)
forall a. a -> I a
I Value k t
v)
modifyFieldI :: forall k t . Key k t => (Value k t -> Value k t) -> Record I t -> Record I t
modifyFieldI :: forall (k :: Symbol) (t :: Map Symbol (*)).
Key k t =>
(Value k t -> Value k t) -> Record I t -> Record I t
modifyFieldI Value k t -> Value k t
f = forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
(f (Value k t) -> f (Value k t)) -> Record f t -> Record f t
forall (k :: Symbol) (t :: Map Symbol (*)) (f :: * -> *).
Key k t =>
(f (Value k t) -> f (Value k t)) -> Record f t -> Record f t
modifyField @k @t (Value k t -> I (Value k t)
forall a. a -> I a
I (Value k t -> I (Value k t))
-> (I (Value k t) -> Value k t) -> I (Value k t) -> I (Value k t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value k t -> Value k t
f (Value k t -> Value k t)
-> (I (Value k t) -> Value k t) -> I (Value k t) -> Value k t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I (Value k t) -> Value k t
forall a. I a -> a
unI)
injectI :: forall k t. Key k t => Value k t -> Variant I t
injectI :: forall (k :: Symbol) (t :: Map Symbol (*)).
Key k t =>
Value k t -> Variant I t
injectI = (Variant I t -> Maybe (I (Value k t)),
I (Value k t) -> Variant I t)
-> I (Value k t) -> Variant I t
forall a b. (a, b) -> b
snd (forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Branch f t (Value k t)
forall (k :: Symbol) (t :: Map Symbol (*)) (f :: * -> *).
Key k t =>
Branch f t (Value k t)
branch @k @t) (I (Value k t) -> Variant I t)
-> (Value k t -> I (Value k t)) -> Value k t -> Variant I t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value k t -> I (Value k t)
forall a. a -> I a
I
matchI :: forall k t . Key k t => Variant I t -> Maybe (Value k t)
matchI :: forall (k :: Symbol) (t :: Map Symbol (*)).
Key k t =>
Variant I t -> Maybe (Value k t)
matchI Variant I t
v = I (Value k t) -> Value k t
forall a. I a -> a
unI (I (Value k t) -> Value k t)
-> Maybe (I (Value k t)) -> Maybe (Value k t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant I t -> Maybe (I (Value k t)),
I (Value k t) -> Variant I t)
-> Variant I t -> Maybe (I (Value k t))
forall a b. (a, b) -> a
fst (forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Branch f t (Value k t)
forall (k :: Symbol) (t :: Map Symbol (*)) (f :: * -> *).
Key k t =>
Branch f t (Value k t)
branch @k @t) Variant I t
v
{-# DEPRECATED eliminate "Use eliminate_Variant instead." #-}
eliminate :: (Productlike '[] t result, Sumlike '[] t result, SListI result) => Record (Case f r) t -> Variant f t -> r
eliminate :: forall {q} (t :: Map Symbol q) (result :: [q]) (f :: q -> *) r.
(Productlike '[] t result, Sumlike '[] t result, SListI result) =>
Record (Case f r) t -> Variant f t -> r
eliminate Record (Case f r) t
cases Variant f t
variant =
let adapt :: Case f a b -> (-.->) f (K a) b
adapt (Case f b -> a
e) = (f b -> K a b) -> (-.->) f (K a) b
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn (\f b
fv -> a -> K a b
forall k a (b :: k). a -> K a b
K (f b -> a
e f b
fv))
in NS (K r) result -> r
forall {k} a (xs :: [k]). NS (K a) xs -> a
collapse_NS (NP (f -.-> K r) result -> NS f result -> NS (K r) result
forall {k} (f :: k -> *) (g :: k -> *) (xs :: [k]).
NP (f -.-> g) xs -> NS f xs -> NS g xs
ap_NS ((forall (a :: q). Case f r a -> (-.->) f (K r) a)
-> NP (Case f r) result -> NP (f -.-> K r) result
forall {k} (xs :: [k]) (f :: k -> *) (g :: k -> *).
SListI xs =>
(forall (a :: k). f a -> g a) -> NP f xs -> NP g xs
liftA_NP Case f r a -> (-.->) f (K r) a
forall (a :: q). Case f r a -> (-.->) f (K r) a
forall {k} {f :: k -> *} {a} {b :: k}.
Case f a b -> (-.->) f (K a) b
adapt (Record (Case f r) t -> NP (Case f r) result
forall {k} (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Productlike '[] t result =>
Record f t -> NP f result
toNP Record (Case f r) t
cases)) (Variant f t -> NS f result
forall {k} (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Sumlike '[] t result =>
Variant f t -> NS f result
toNS Variant f t
variant))
eliminate_Variant :: Maplike t => Record (Case f r) t -> Variant f t -> r
eliminate_Variant :: forall (t :: Map Symbol (*)) (f :: * -> *) r.
Maplike t =>
Record (Case f r) t -> Variant f t -> r
eliminate_Variant Record (Case f r) t
cases Variant f t
variant =
let adapt :: Case f a b -> f b -> K a b
adapt (Case f b -> a
f) f b
x = a -> K a b
forall k a (b :: k). a -> K a b
K (f b -> a
f f b
x)
in Variant (K r) t -> r
forall a. Variant (K a) t -> a
forall (t :: Map Symbol (*)) a. Maplike t => Variant (K a) t -> a
collapse_Variant (Variant (K r) t -> r) -> Variant (K r) t -> r
forall a b. (a -> b) -> a -> b
$ (forall a. Case f r a -> f a -> K r a)
-> Record (Case f r) t -> Variant f t -> Variant (K r) t
forall (t :: Map Symbol (*)) (f :: * -> *) (g :: * -> *)
(h :: * -> *).
Maplike t =>
(forall a. f a -> g a -> h a)
-> Record f t -> Variant g t -> Variant h t
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(forall a. f a -> g a -> h a)
-> Record f t -> Variant g t -> Variant h t
liftA2_Variant Case f r a -> f a -> K r a
forall a. Case f r a -> f a -> K r a
forall {q} {k} {f :: q -> *} {a} {b :: q} {b :: k}.
Case f a b -> f b -> K a b
adapt Record (Case f r) t
cases Variant f t
variant
type Case :: (q -> Type) -> Type -> q -> Type
newtype Case f a b = Case { forall q (f :: q -> *) a (b :: q). Case f a b -> f b -> a
runCase :: f b -> a }
instance Functor f => Contravariant (Case f a) where
contramap :: forall a' a. (a' -> a) -> Case f a a -> Case f a a'
contramap a' -> a
g (Case f a -> a
c) = (f a' -> a) -> Case f a a'
forall q (f :: q -> *) a (b :: q). (f b -> a) -> Case f a b
Case (f a -> a
c (f a -> a) -> (f a' -> f a) -> f a' -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a' -> a) -> f a' -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a' -> a
g)
addCase :: forall k v t f a. Insertable k v t => (f v -> a) -> Record (Case f a) t -> Record (Case f a) (Insert k v t)
addCase :: forall {q} (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *)
a.
Insertable k v t =>
(f v -> a)
-> Record (Case f a) t -> Record (Case f a) (Insert k v t)
addCase f v -> a
f = forall {q} (k :: Symbol) (v :: q) (t :: Map Symbol q)
(f :: q -> *).
Insertable k v t =>
f v -> Record f t -> Record f (Insert k v t)
forall (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Insertable k v t =>
f v -> Record f t -> Record f (Insert k v t)
addField @k @v @t ((f v -> a) -> Case f a v
forall q (f :: q -> *) a (b :: q). (f b -> a) -> Case f a b
Case f v -> a
f)
addCaseI :: forall k v t a. Insertable k v t => (v -> a) -> Record (Case I a) t -> Record (Case I a) (Insert k v t)
addCaseI :: forall (k :: Symbol) v (t :: Map Symbol (*)) a.
Insertable k v t =>
(v -> a) -> Record (Case I a) t -> Record (Case I a) (Insert k v t)
addCaseI v -> a
f = forall {q} (k :: Symbol) (v :: q) (t :: Map Symbol q)
(f :: q -> *).
Insertable k v t =>
f v -> Record f t -> Record f (Insert k v t)
forall (k :: Symbol) v (t :: Map Symbol (*)) (f :: * -> *).
Insertable k v t =>
f v -> Record f t -> Record f (Insert k v t)
addField @k @v @t ((I v -> a) -> Case I a v
forall q (f :: q -> *) a (b :: q). (f b -> a) -> Case f a b
Case (v -> a
f (v -> a) -> (I v -> v) -> I v -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I v -> v
forall a. I a -> a
unI))
type SetField :: (q -> Type) -> Type -> q -> Type
newtype SetField f a b = SetField { forall q (f :: q -> *) a (b :: q). SetField f a b -> f b -> a -> a
getSetField :: f b -> a -> a }
type PresentIn :: Map Symbol q -> Symbol -> q -> Constraint
class (Key k t, Value k t ~ v) => PresentIn (t :: Map Symbol q) (k :: Symbol) (v :: q)
instance (Key k t, Value k t ~ v) => PresentIn (t :: Map Symbol q) (k :: Symbol) (v :: q)
{-# DEPRECATED ProductlikeSubset "This constraint is obsolete" #-}
type ProductlikeSubset (subset :: Map Symbol q) (whole :: Map Symbol q) (flat :: [q]) =
(KeysValuesAll (PresentIn whole) subset,
Productlike '[] subset flat,
SListI flat)
{-# DEPRECATED fieldSubset "Use Data.RBR.Subset.fieldSubset" #-}
fieldSubset :: forall subset whole flat f. (ProductlikeSubset subset whole flat)
=> Record f whole -> (Record f subset -> Record f whole, Record f subset)
fieldSubset :: forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
Record f whole
-> (Record f subset -> Record f whole, Record f subset)
fieldSubset Record f whole
r =
(,)
(let goset :: forall left k v right color. (PresentIn whole k v, KeysValuesAll (PresentIn whole) left,
KeysValuesAll (PresentIn whole) right)
=> Record (SetField f (Record f whole)) left
-> Record (SetField f (Record f whole)) right
-> Record (SetField f (Record f whole)) (N color left k v right)
goset :: forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(PresentIn whole k v, KeysValuesAll (PresentIn whole) left,
KeysValuesAll (PresentIn whole) right) =>
Record (SetField f (Record f whole)) left
-> Record (SetField f (Record f whole)) right
-> Record (SetField f (Record f whole)) ('N color left k v right)
goset Record (SetField f (Record f whole)) left
left Record (SetField f (Record f whole)) right
right = Record (SetField f (Record f whole)) left
-> SetField f (Record f whole) v
-> Record (SetField f (Record f whole)) right
-> Record (SetField f (Record f whole)) ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record (SetField f (Record f whole)) left
left ((f v -> Record f whole -> Record f whole)
-> SetField f (Record f whole) v
forall q (f :: q -> *) a (b :: q).
(f b -> a -> a) -> SetField f a b
SetField (\f v
v Record f whole
w -> (f v -> Record f whole, f v) -> f v -> Record f whole
forall a b. (a, b) -> a
fst (forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Field f t (Value k t)
forall (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Field f t (Value k t)
field @k @whole Record f whole
w) f v
v)) Record (SetField f (Record f whole)) right
right
setters :: NP (SetField f (Record f whole)) flat
setters = forall {k} (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Productlike '[] t result =>
Record f t -> NP f result
forall (t :: Map Symbol q) (result :: [q]) (f :: q -> *).
Productlike '[] t result =>
Record f t -> NP f result
toNP @subset @_ @(SetField f (Record f whole)) (Proxy (PresentIn whole)
-> Record (SetField f (Record f whole)) 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(PresentIn whole k v, KeysValuesAll (PresentIn whole) left,
KeysValuesAll (PresentIn whole) right) =>
Record (SetField f (Record f whole)) left
-> Record (SetField f (Record f whole)) right
-> Record (SetField f (Record f whole)) ('N color left k v right))
-> Record (SetField f (Record f whole)) subset
forall symbol q (c :: symbol -> q -> Constraint)
(t :: Map symbol q) (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
KeysValuesAll c t =>
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r t
forall (proxy :: (Symbol -> q -> Constraint) -> *)
(r :: Map Symbol q -> *).
proxy (PresentIn whole)
-> r 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(PresentIn whole k v, KeysValuesAll (PresentIn whole) left,
KeysValuesAll (PresentIn whole) right) =>
r left -> r right -> r ('N color left k v right))
-> r subset
cpara_Map (forall {k} (t :: k). Proxy t
forall (t :: Symbol -> q -> Constraint). Proxy t
Proxy @(PresentIn whole)) Record (SetField f (Record f whole)) 'E
forall {q} (f :: q -> *). Record f 'E
unit Record (SetField f (Record f whole)) left
-> Record (SetField f (Record f whole)) right
-> Record (SetField f (Record f whole)) ('N color left k v right)
forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(PresentIn whole k v, KeysValuesAll (PresentIn whole) left,
KeysValuesAll (PresentIn whole) right) =>
Record (SetField f (Record f whole)) left
-> Record (SetField f (Record f whole)) right
-> Record (SetField f (Record f whole)) ('N color left k v right)
goset)
appz :: SetField f a b -> f b -> K (Endo a) b
appz (SetField f b -> a -> a
func) f b
fv = Endo a -> K (Endo a) b
forall k a (b :: k). a -> K a b
K ((a -> a) -> Endo a
forall a. (a -> a) -> Endo a
Endo (f b -> a -> a
func f b
fv))
in \Record f subset
toset -> Endo (Record f whole) -> Record f whole -> Record f whole
forall a. Endo a -> a -> a
appEndo ([Endo (Record f whole)] -> Endo (Record f whole)
forall a. Monoid a => [a] -> a
mconcat (NP (K (Endo (Record f whole))) flat -> [Endo (Record f whole)]
forall {k} a (xs :: [k]). NP (K a) xs -> [a]
collapse_NP ((forall (a :: q).
SetField f (Record f whole) a
-> f a -> K (Endo (Record f whole)) a)
-> NP (SetField f (Record f whole)) flat
-> NP f flat
-> NP (K (Endo (Record f whole))) flat
forall {k} (xs :: [k]) (f :: k -> *) (g :: k -> *) (h :: k -> *).
SListI xs =>
(forall (a :: k). f a -> g a -> h a)
-> NP f xs -> NP g xs -> NP h xs
liftA2_NP SetField f (Record f whole) a -> f a -> K (Endo (Record f whole)) a
forall (a :: q).
SetField f (Record f whole) a -> f a -> K (Endo (Record f whole)) a
forall {q} {k} {f :: q -> *} {a} {b :: q} {b :: k}.
SetField f a b -> f b -> K (Endo a) b
appz NP (SetField f (Record f whole)) flat
setters (Record f subset -> NP f flat
forall {k} (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Productlike '[] t result =>
Record f t -> NP f result
toNP Record f subset
toset)))) Record f whole
r)
(let goget :: forall left k v right color. (PresentIn whole k v, KeysValuesAll (PresentIn whole) left,
KeysValuesAll (PresentIn whole) right)
=> Record f left
-> Record f right
-> Record f (N color left k v right)
goget :: forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(PresentIn whole k v, KeysValuesAll (PresentIn whole) left,
KeysValuesAll (PresentIn whole) right) =>
Record f left
-> Record f right -> Record f ('N color left k v right)
goget Record f left
left Record f right
right = Record f left
-> f v -> Record f right -> Record f ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left (forall {q} (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Record f t -> f (Value k t)
forall (k :: Symbol) (t :: Map Symbol q) (f :: q -> *).
Key k t =>
Record f t -> f (Value k t)
project @k @whole Record f whole
r) Record f right
right
in Proxy (PresentIn whole)
-> Record f 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(PresentIn whole k v, KeysValuesAll (PresentIn whole) left,
KeysValuesAll (PresentIn whole) right) =>
Record f left
-> Record f right -> Record f ('N color left k v right))
-> Record f subset
forall symbol q (c :: symbol -> q -> Constraint)
(t :: Map symbol q) (proxy :: (symbol -> q -> Constraint) -> *)
(r :: Map symbol q -> *).
KeysValuesAll c t =>
proxy c
-> r 'E
-> (forall (left :: Map symbol q) (k :: symbol) (v :: q)
(right :: Map symbol q) (color :: Color).
(c k v, KeysValuesAll c left, KeysValuesAll c right) =>
r left -> r right -> r ('N color left k v right))
-> r t
forall (proxy :: (Symbol -> q -> Constraint) -> *)
(r :: Map Symbol q -> *).
proxy (PresentIn whole)
-> r 'E
-> (forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(PresentIn whole k v, KeysValuesAll (PresentIn whole) left,
KeysValuesAll (PresentIn whole) right) =>
r left -> r right -> r ('N color left k v right))
-> r subset
cpara_Map (forall {k} (t :: k). Proxy t
forall (t :: Symbol -> q -> Constraint). Proxy t
Proxy @(PresentIn whole)) Record f 'E
forall {q} (f :: q -> *). Record f 'E
unit Record f left
-> Record f right -> Record f ('N color left k v right)
forall (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (color :: Color).
(PresentIn whole k v, KeysValuesAll (PresentIn whole) left,
KeysValuesAll (PresentIn whole) right) =>
Record f left
-> Record f right -> Record f ('N color left k v right)
goget)
{-# DEPRECATED projectSubset "Use Data.RBR.Subset.projectSubset" #-}
projectSubset :: forall subset whole flat f. (ProductlikeSubset subset whole flat)
=> Record f whole
-> Record f subset
projectSubset :: forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
Record f whole -> Record f subset
projectSubset = (Record f subset -> Record f whole, Record f subset)
-> Record f subset
forall a b. (a, b) -> b
snd ((Record f subset -> Record f whole, Record f subset)
-> Record f subset)
-> (Record f whole
-> (Record f subset -> Record f whole, Record f subset))
-> Record f whole
-> Record f subset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record f whole
-> (Record f subset -> Record f whole, Record f subset)
forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
Record f whole
-> (Record f subset -> Record f whole, Record f subset)
fieldSubset
{-# DEPRECATED getFieldSubset "Use Data.RBR.Subset.getFieldSubset" #-}
getFieldSubset :: forall subset whole flat f. (ProductlikeSubset subset whole flat)
=> Record f whole
-> Record f subset
getFieldSubset :: forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
Record f whole -> Record f subset
getFieldSubset = Record f whole -> Record f subset
forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
Record f whole -> Record f subset
projectSubset
{-# DEPRECATED setFieldSubset "Use Data.RBR.Subset.setFieldSubset" #-}
setFieldSubset :: forall subset whole flat f. (ProductlikeSubset subset whole flat)
=> Record f subset
-> Record f whole
-> Record f whole
setFieldSubset :: forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
Record f subset -> Record f whole -> Record f whole
setFieldSubset Record f subset
subset Record f whole
whole = (Record f subset -> Record f whole, Record f subset)
-> Record f subset -> Record f whole
forall a b. (a, b) -> a
fst (Record f whole
-> (Record f subset -> Record f whole, Record f subset)
forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
Record f whole
-> (Record f subset -> Record f whole, Record f subset)
fieldSubset Record f whole
whole) Record f subset
subset
{-# DEPRECATED modifyFieldSubset "Use Data.RBR.Subset.modifyFieldSubset" #-}
modifyFieldSubset :: forall subset whole flat f. (ProductlikeSubset subset whole flat)
=> (Record f subset -> Record f subset)
-> Record f whole
-> Record f whole
modifyFieldSubset :: forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
(Record f subset -> Record f subset)
-> Record f whole -> Record f whole
modifyFieldSubset Record f subset -> Record f subset
f Record f whole
r = ((Record f subset -> Record f whole)
-> Record f subset -> Record f whole)
-> (Record f subset -> Record f whole, Record f subset)
-> Record f whole
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Record f subset -> Record f whole)
-> Record f subset -> Record f whole
forall a b. (a -> b) -> a -> b
($) ((Record f subset -> Record f subset)
-> (Record f subset -> Record f whole, Record f subset)
-> (Record f subset -> Record f whole, Record f subset)
forall a b.
(a -> b)
-> (Record f subset -> Record f whole, a)
-> (Record f subset -> Record f whole, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Record f subset -> Record f subset
f (forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
Record f whole
-> (Record f subset -> Record f whole, Record f subset)
forall (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
Record f whole
-> (Record f subset -> Record f whole, Record f subset)
fieldSubset @subset @whole Record f whole
r))
{-# DEPRECATED SumlikeSubset "This constraint is obsolete" #-}
type SumlikeSubset (subset :: Map Symbol q) (whole :: Map Symbol q) (subflat :: [q]) (wholeflat :: [q]) =
(KeysValuesAll (PresentIn whole) subset,
Productlike '[] whole wholeflat,
Sumlike '[] whole wholeflat,
SListI wholeflat,
Productlike '[] subset subflat,
Sumlike '[] subset subflat,
SListI subflat)
{-# DEPRECATED branchSubset "Use Data.RBR.Subset.branchSubset" #-}
branchSubset :: forall subset whole subflat wholeflat f. (SumlikeSubset subset whole subflat wholeflat)
=> (Variant f whole -> Maybe (Variant f subset), Variant f subset -> Variant f whole)
branchSubset :: forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(subflat :: [q]) (wholeflat :: [q]) (f :: q -> *).
SumlikeSubset subset whole subflat wholeflat =>
(Variant f whole -> Maybe (Variant f subset),
Variant f subset -> Variant f whole)
branchSubset =
let inj2case :: forall t flat f v. Sumlike '[] t flat => (_ -> _) -> Injection _ flat v -> Case _ _ v
inj2case :: (Variant f t -> w) -> Injection f flat v -> Case f w v
inj2case = \Variant f t -> w
adapt -> \Injection f flat v
fn -> (f v -> w) -> Case f w v
forall q (f :: q -> *) a (b :: q). (f b -> a) -> Case f a b
Case (\f v
fv -> Variant f t -> w
adapt (forall {q} (t :: Map Symbol q) (result :: [q]) (f :: q -> *).
Sumlike '[] t result =>
NS f result -> Variant f t
forall (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Sumlike '[] t result =>
NS f result -> Variant f t
fromNS @t (K (NS f flat) v -> NS f flat
forall {k} a (b :: k). K a b -> a
unK (Injection f flat v -> f v -> K (NS f flat) v
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(-.->) f g a -> f a -> g a
apFn Injection f flat v
fn f v
fv))))
subs :: forall f. Record f whole -> (Record f subset -> Record f whole, Record f subset)
subs :: forall (f :: q -> *).
Record f whole
-> (Record f subset -> Record f whole, Record f subset)
subs = forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
Record f whole
-> (Record f subset -> Record f whole, Record f subset)
forall (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
Record f whole
-> (Record f subset -> Record f whole, Record f subset)
fieldSubset @subset @whole
in
(,)
(let injs :: Record (Case f (Maybe (Variant f subset))) subset
injs :: Record (Case f (Maybe (Variant f subset))) subset
injs = forall {q} (t :: Map Symbol q) (result :: [q]) (f :: q -> *).
Productlike '[] t result =>
NP f result -> Record f t
forall (t :: Map Symbol q) (result :: [q]) (f :: q -> *).
Productlike '[] t result =>
NP f result -> Record f t
fromNP @subset ((forall (a :: q).
Injection f subflat a -> Case f (Maybe (Variant f subset)) a)
-> NP (Injection f subflat) subflat
-> NP (Case f (Maybe (Variant f subset))) subflat
forall {k} (xs :: [k]) (f :: k -> *) (g :: k -> *).
SListI xs =>
(forall (a :: k). f a -> g a) -> NP f xs -> NP g xs
liftA_NP ((Variant f subset -> Maybe (Variant f subset))
-> (-.->) f (K (NS f subflat)) a
-> Case f (Maybe (Variant f subset)) a
forall {k} {k} (t :: Map Symbol k) (flat :: [k]) (f :: k) (v :: k)
{f :: k -> *} {w}.
Sumlike '[] t flat =>
(Variant f t -> w) -> Injection f flat v -> Case f w v
inj2case Variant f subset -> Maybe (Variant f subset)
forall a. a -> Maybe a
Just) (forall (xs :: [q]) (f :: q -> *).
SListI xs =>
NP (Injection f xs) xs
forall {k} (xs :: [k]) (f :: k -> *).
SListI xs =>
NP (Injection f xs) xs
injections @subflat))
wholeinjs :: Record (Case f (Maybe (Variant f subset))) whole
wholeinjs :: Record (Case f (Maybe (Variant f subset))) whole
wholeinjs = forall {q} (t :: Map Symbol q) (result :: [q]) (f :: q -> *).
Productlike '[] t result =>
NP f result -> Record f t
forall (t :: Map Symbol q) (result :: [q]) (f :: q -> *).
Productlike '[] t result =>
NP f result -> Record f t
fromNP @whole ((forall (a :: q). Case f (Maybe (Variant f subset)) a)
-> NP (Case f (Maybe (Variant f subset))) wholeflat
forall {k} (f :: k -> *) (xs :: [k]).
SListI xs =>
(forall (a :: k). f a) -> NP f xs
pure_NP ((f a -> Maybe (Variant f subset))
-> Case f (Maybe (Variant f subset)) a
forall q (f :: q -> *) a (b :: q). (f b -> a) -> Case f a b
Case (\f a
_ -> Maybe (Variant f subset)
forall a. Maybe a
Nothing)))
mixedinjs :: Record (Case f (Maybe (Variant f subset))) whole
mixedinjs = (Record (Case f (Maybe (Variant f subset))) subset
-> Record (Case f (Maybe (Variant f subset))) whole,
Record (Case f (Maybe (Variant f subset))) subset)
-> Record (Case f (Maybe (Variant f subset))) subset
-> Record (Case f (Maybe (Variant f subset))) whole
forall a b. (a, b) -> a
fst (Record (Case f (Maybe (Variant f subset))) whole
-> (Record (Case f (Maybe (Variant f subset))) subset
-> Record (Case f (Maybe (Variant f subset))) whole,
Record (Case f (Maybe (Variant f subset))) subset)
forall (f :: q -> *).
Record f whole
-> (Record f subset -> Record f whole, Record f subset)
subs Record (Case f (Maybe (Variant f subset))) whole
wholeinjs) Record (Case f (Maybe (Variant f subset))) subset
injs
in Record (Case f (Maybe (Variant f subset))) whole
-> Variant f whole -> Maybe (Variant f subset)
forall {q} (t :: Map Symbol q) (result :: [q]) (f :: q -> *) r.
(Productlike '[] t result, Sumlike '[] t result, SListI result) =>
Record (Case f r) t -> Variant f t -> r
eliminate Record (Case f (Maybe (Variant f subset))) whole
mixedinjs)
(let wholeinjs :: Record (Case f (Variant f whole)) whole
wholeinjs :: Record (Case f (Variant f whole)) whole
wholeinjs = forall {q} (t :: Map Symbol q) (result :: [q]) (f :: q -> *).
Productlike '[] t result =>
NP f result -> Record f t
forall (t :: Map Symbol q) (result :: [q]) (f :: q -> *).
Productlike '[] t result =>
NP f result -> Record f t
fromNP @whole ((forall (a :: q).
Injection f wholeflat a -> Case f (Variant f whole) a)
-> NP (Injection f wholeflat) wholeflat
-> NP (Case f (Variant f whole)) wholeflat
forall {k} (xs :: [k]) (f :: k -> *) (g :: k -> *).
SListI xs =>
(forall (a :: k). f a -> g a) -> NP f xs -> NP g xs
liftA_NP ((Variant f whole -> Variant f whole)
-> (-.->) f (K (NS f wholeflat)) a -> Case f (Variant f whole) a
forall {k} {k} (t :: Map Symbol k) (flat :: [k]) (f :: k) (v :: k)
{f :: k -> *} {w}.
Sumlike '[] t flat =>
(Variant f t -> w) -> Injection f flat v -> Case f w v
inj2case Variant f whole -> Variant f whole
forall a. a -> a
id) (forall (xs :: [q]) (f :: q -> *).
SListI xs =>
NP (Injection f xs) xs
forall {k} (xs :: [k]) (f :: k -> *).
SListI xs =>
NP (Injection f xs) xs
injections @wholeflat))
injs :: Record (Case f (Variant f whole)) subset
injs = (Record (Case f (Variant f whole)) subset
-> Record (Case f (Variant f whole)) whole,
Record (Case f (Variant f whole)) subset)
-> Record (Case f (Variant f whole)) subset
forall a b. (a, b) -> b
snd (Record (Case f (Variant f whole)) whole
-> (Record (Case f (Variant f whole)) subset
-> Record (Case f (Variant f whole)) whole,
Record (Case f (Variant f whole)) subset)
forall (f :: q -> *).
Record f whole
-> (Record f subset -> Record f whole, Record f subset)
subs Record (Case f (Variant f whole)) whole
wholeinjs)
in Record (Case f (Variant f whole)) subset
-> Variant f subset -> Variant f whole
forall {q} (t :: Map Symbol q) (result :: [q]) (f :: q -> *) r.
(Productlike '[] t result, Sumlike '[] t result, SListI result) =>
Record (Case f r) t -> Variant f t -> r
eliminate Record (Case f (Variant f whole)) subset
injs)
{-# DEPRECATED injectSubset "Use Data.RBR.Subset.injectSubset" #-}
injectSubset :: forall subset whole subflat wholeflat f. (SumlikeSubset subset whole subflat wholeflat)
=> Variant f subset -> Variant f whole
injectSubset :: forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(subflat :: [q]) (wholeflat :: [q]) (f :: q -> *).
SumlikeSubset subset whole subflat wholeflat =>
Variant f subset -> Variant f whole
injectSubset = (Variant f whole -> Maybe (Variant f subset),
Variant f subset -> Variant f whole)
-> Variant f subset -> Variant f whole
forall a b. (a, b) -> b
snd (forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(subflat :: [q]) (wholeflat :: [q]) (f :: q -> *).
SumlikeSubset subset whole subflat wholeflat =>
(Variant f whole -> Maybe (Variant f subset),
Variant f subset -> Variant f whole)
forall (subset :: Map Symbol q) (whole :: Map Symbol q)
(subflat :: [q]) (wholeflat :: [q]) (f :: q -> *).
SumlikeSubset subset whole subflat wholeflat =>
(Variant f whole -> Maybe (Variant f subset),
Variant f subset -> Variant f whole)
branchSubset @subset @whole @subflat @wholeflat)
{-# DEPRECATED matchSubset "Use Data.RBR.Subset.matchSubset" #-}
matchSubset :: forall subset whole subflat wholeflat f. (SumlikeSubset subset whole subflat wholeflat)
=> Variant f whole -> Maybe (Variant f subset)
matchSubset :: forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(subflat :: [q]) (wholeflat :: [q]) (f :: q -> *).
SumlikeSubset subset whole subflat wholeflat =>
Variant f whole -> Maybe (Variant f subset)
matchSubset = (Variant f whole -> Maybe (Variant f subset),
Variant f subset -> Variant f whole)
-> Variant f whole -> Maybe (Variant f subset)
forall a b. (a, b) -> a
fst (forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(subflat :: [q]) (wholeflat :: [q]) (f :: q -> *).
SumlikeSubset subset whole subflat wholeflat =>
(Variant f whole -> Maybe (Variant f subset),
Variant f subset -> Variant f whole)
forall (subset :: Map Symbol q) (whole :: Map Symbol q)
(subflat :: [q]) (wholeflat :: [q]) (f :: q -> *).
SumlikeSubset subset whole subflat wholeflat =>
(Variant f whole -> Maybe (Variant f subset),
Variant f subset -> Variant f whole)
branchSubset @subset @whole @subflat @wholeflat)
{-# DEPRECATED eliminateSubset "Use Data.RBR.Subset.eliminateSubset" #-}
eliminateSubset :: forall subset whole subflat wholeflat f r. (SumlikeSubset subset whole subflat wholeflat)
=> Record (Case f r) whole -> Variant f subset -> r
eliminateSubset :: forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(subflat :: [q]) (wholeflat :: [q]) (f :: q -> *) r.
SumlikeSubset subset whole subflat wholeflat =>
Record (Case f r) whole -> Variant f subset -> r
eliminateSubset Record (Case f r) whole
cases =
let reducedCases :: Record (Case f r) subset
reducedCases = forall {q} (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
Record f whole -> Record f subset
forall (subset :: Map Symbol q) (whole :: Map Symbol q)
(flat :: [q]) (f :: q -> *).
ProductlikeSubset subset whole flat =>
Record f whole -> Record f subset
getFieldSubset @subset @whole Record (Case f r) whole
cases
in Record (Case f r) subset -> Variant f subset -> r
forall {q} (t :: Map Symbol q) (result :: [q]) (f :: q -> *) r.
(Productlike '[] t result, Sumlike '[] t result, SListI result) =>
Record (Case f r) t -> Variant f t -> r
eliminate Record (Case f r) subset
reducedCases
type Productlike :: [k] -> Map Symbol k -> [k] -> Constraint
class Productlike (start :: [k])
(t :: Map Symbol k)
(result :: [k]) | start t -> result, result t -> start where
_prefixNP:: Record f t -> NP f start -> NP f result
_breakNP :: NP f result -> (Record f t, NP f start)
instance Productlike start E start where
_prefixNP :: forall (f :: k -> *). Record f 'E -> NP f start -> NP f start
_prefixNP Record f 'E
_ NP f start
start = NP f start
start
_breakNP :: forall (f :: k -> *). NP f start -> (Record f 'E, NP f start)
_breakNP NP f start
start = (Record f 'E
forall {q} (f :: q -> *). Record f 'E
Empty, NP f start
start)
instance (Productlike start right middle,
Productlike (v ': middle) left result)
=> Productlike start (N color left k v right) result where
_prefixNP :: forall (f :: q -> *).
Record f ('N color left k v right) -> NP f start -> NP f result
_prefixNP (Node Record f left
left f v
fv Record f right
right) NP f start
start =
forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Productlike start t result =>
Record f t -> NP f start -> NP f result
_prefixNP @_ @_ @left @result Record f left
Record f left
left (f v
fv f v -> NP f middle -> NP f (v : middle)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall (start :: [q]) (t :: Map Symbol q) (result :: [q])
(f :: q -> *).
Productlike start t result =>
Record f t -> NP f start -> NP f result
forall {k} (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Productlike start t result =>
Record f t -> NP f start -> NP f result
prefixNP @start @right @middle Record f right
Record f right
right NP f start
start)
_breakNP :: forall (f :: q -> *).
NP f result -> (Record f ('N color left k v right), NP f start)
_breakNP NP f result
result =
let (Record f left
left, f v
f x
fv :* NP f middle
NP f xs
middle) = forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Productlike start t result =>
NP f result -> (Record f t, NP f start)
_breakNP @_ @_ @left @result NP f result
result
(Record f right
right, NP f start
start) = forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Productlike start t result =>
NP f result -> (Record f t, NP f start)
_breakNP @_ @start @right NP f middle
middle
in (Record f left
-> f v -> Record f right -> Record f ('N color left k v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left f v
fv Record f right
right, NP f start
start)
prefixNP:: forall start t result f. Productlike start t result => Record f t -> NP f start -> NP f result
prefixNP :: forall {k} (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Productlike start t result =>
Record f t -> NP f start -> NP f result
prefixNP = forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Productlike start t result =>
Record f t -> NP f start -> NP f result
_prefixNP @_ @start @t @result
breakNP :: forall start t result f. Productlike start t result => NP f result -> (Record f t, NP f start)
breakNP :: forall {k} (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Productlike start t result =>
NP f result -> (Record f t, NP f start)
breakNP = forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Productlike start t result =>
NP f result -> (Record f t, NP f start)
_breakNP @_ @start @t @result
toNP :: forall t result f. Productlike '[] t result => Record f t -> NP f result
toNP :: forall {k} (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Productlike '[] t result =>
Record f t -> NP f result
toNP Record f t
r = Record f t -> NP f '[] -> NP f result
forall {k} (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Productlike start t result =>
Record f t -> NP f start -> NP f result
prefixNP Record f t
r NP f '[]
forall {k} (a :: k -> *). NP a '[]
Nil
fromNP :: forall t result f. Productlike '[] t result => NP f result -> Record f t
fromNP :: forall {q} (t :: Map Symbol q) (result :: [q]) (f :: q -> *).
Productlike '[] t result =>
NP f result -> Record f t
fromNP NP f result
np = let (Record f t
r,NP f '[]
Nil) = NP f result -> (Record f t, NP f '[])
forall {k} (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Productlike start t result =>
NP f result -> (Record f t, NP f start)
breakNP NP f result
np in Record f t
r
type Sumlike :: [k] -> Map Symbol k -> [k] -> Constraint
class Sumlike (start :: [k])
(t :: Map Symbol k)
(result :: [k]) | start t -> result, result t -> start where
_prefixNS :: Either (NS f start) (Variant f t) -> NS f result
_breakNS :: NS f result -> Either (NS f start) (Variant f t)
instance Sumlike start
(N color E k v E)
(v ': start) where
_prefixNS :: forall (f :: a -> *).
Either (NS f start) (Variant f ('N color 'E k v 'E))
-> NS f (v : start)
_prefixNS = \case
Left NS f start
l -> NS f start -> NS f (v : start)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S NS f start
l
Right Variant f ('N color 'E k v 'E)
x -> case Variant f ('N color 'E k v 'E)
x of Here f v
fv -> forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
forall (a :: a -> *) (x :: a) (xs :: [a]). a x -> NS a (x : xs)
Z @_ @v @start f v
f v
fv
_breakNS :: forall (f :: a -> *).
NS f (v : start)
-> Either (NS f start) (Variant f ('N color 'E k v 'E))
_breakNS = \case
Z f x
x -> Variant f ('N color 'E k v 'E)
-> Either (NS f start) (Variant f ('N color 'E k v 'E))
forall a b. b -> Either a b
Right (f v -> Variant f ('N color 'E k v 'E)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
f x
x)
S NS f xs
x -> NS f start -> Either (NS f start) (Variant f ('N color 'E k v 'E))
forall a b. a -> Either a b
Left NS f start
NS f xs
x
instance (Sumlike start (N colorR leftR kR vR rightR) middle,
Sumlike (v ': middle) (N colorL leftL kL vL rightL) result)
=> Sumlike start
(N color (N colorL leftL kL vL rightL) k v (N colorR leftR kR vR rightR))
result where
_prefixNS :: forall (f :: q -> *).
Either
(NS f start)
(Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR)))
-> NS f result
_prefixNS = \case
Left NS f start
x ->
forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
_prefixNS @_ @_ @(N colorL leftL kL vL rightL) (NS f (v : middle)
-> Either
(NS f (v : middle)) (Variant f ('N colorL leftL kL vL rightL))
forall a b. a -> Either a b
Left (NS f middle -> NS f (v : middle)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
_prefixNS @_ @_ @(N colorR leftR kR vR rightR) (NS f start
-> Either (NS f start) (Variant f ('N colorR leftR kR vR rightR))
forall a b. a -> Either a b
Left NS f start
x))))
Right Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR))
x ->
case Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR))
x of LookLeft Variant f t
x -> forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
_prefixNS @_ @(v ': middle) @(N colorL leftL kL vL rightL) @result (Variant f ('N colorL leftL kL vL rightL)
-> Either
(NS f (v : middle)) (Variant f ('N colorL leftL kL vL rightL))
forall a b. b -> Either a b
Right Variant f t
Variant f ('N colorL leftL kL vL rightL)
x)
Here f v
x -> forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
_prefixNS @_ @_ @(N colorL leftL kL vL rightL) (NS f (v : middle)
-> Either
(NS f (v : middle)) (Variant f ('N colorL leftL kL vL rightL))
forall a b. a -> Either a b
Left (f v -> NS f (v : middle)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z f v
x))
LookRight Variant f t
x -> forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
_prefixNS @_ @_ @(N colorL leftL kL vL rightL) (NS f (v : middle)
-> Either
(NS f (v : middle)) (Variant f ('N colorL leftL kL vL rightL))
forall a b. a -> Either a b
Left (NS f middle -> NS f (v : middle)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
_prefixNS @_ (Variant f t -> Either (NS f start) (Variant f t)
forall a b. b -> Either a b
Right Variant f t
x))))
_breakNS :: forall (f :: q -> *).
NS f result
-> Either
(NS f start)
(Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR)))
_breakNS NS f result
ns = case forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
NS f result -> Either (NS f start) (Variant f t)
_breakNS @_ @(v ': middle) @(N colorL leftL kL vL rightL) NS f result
ns of
Left NS f (v : middle)
x -> case NS f (v : middle)
x of
Z f x
x -> Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR))
-> Either
(NS f start)
(Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR)))
forall a b. b -> Either a b
Right (f v
-> Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
f x
x)
S NS f xs
x -> case forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
NS f result -> Either (NS f start) (Variant f t)
_breakNS @_ @start @(N colorR leftR kR vR rightR) NS f xs
x of
Left NS f start
ns -> NS f start
-> Either
(NS f start)
(Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR)))
forall a b. a -> Either a b
Left NS f start
ns
Right Variant f ('N colorR leftR kR vR rightR)
v -> Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR))
-> Either
(NS f start)
(Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR)))
forall a b. b -> Either a b
Right (Variant f ('N colorR leftR kR vR rightR)
-> Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f ('N colorR leftR kR vR rightR)
v)
Right Variant f ('N colorL leftL kL vL rightL)
v -> Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR))
-> Either
(NS f start)
(Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR)))
forall a b. b -> Either a b
Right (Variant f ('N colorL leftL kL vL rightL)
-> Variant
f
('N
color
('N colorL leftL kL vL rightL)
k
v
('N colorR leftR kR vR rightR))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f ('N colorL leftL kL vL rightL)
v)
instance Sumlike (v ': start) (N colorL leftL kL vL rightL) result
=> Sumlike start (N color (N colorL leftL kL vL rightL) k v E) result where
_prefixNS :: forall (f :: q -> *).
Either
(NS f start)
(Variant f ('N color ('N colorL leftL kL vL rightL) k v 'E))
-> NS f result
_prefixNS = \case
Left NS f start
x ->
forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
_prefixNS @_ @_ @(N colorL leftL kL vL rightL) (NS f (v : start)
-> Either
(NS f (v : start)) (Variant f ('N colorL leftL kL vL rightL))
forall a b. a -> Either a b
Left (NS f start -> NS f (v : start)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S NS f start
x))
Right Variant f ('N color ('N colorL leftL kL vL rightL) k v 'E)
x ->
case Variant f ('N color ('N colorL leftL kL vL rightL) k v 'E)
x of LookLeft Variant f t
x -> forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
_prefixNS @_ @(v ': start) @(N colorL leftL kL vL rightL) @result (Variant f ('N colorL leftL kL vL rightL)
-> Either
(NS f (v : start)) (Variant f ('N colorL leftL kL vL rightL))
forall a b. b -> Either a b
Right Variant f t
Variant f ('N colorL leftL kL vL rightL)
x)
Here f v
x -> forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
_prefixNS @_ @_ @(N colorL leftL kL vL rightL) (NS f (v : start)
-> Either
(NS f (v : start)) (Variant f ('N colorL leftL kL vL rightL))
forall a b. a -> Either a b
Left (f v -> NS f (v : start)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z f v
x))
_breakNS :: forall (f :: q -> *).
NS f result
-> Either
(NS f start)
(Variant f ('N color ('N colorL leftL kL vL rightL) k v 'E))
_breakNS NS f result
ns = case forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
NS f result -> Either (NS f start) (Variant f t)
_breakNS @_ @(v ': start) @(N colorL leftL kL vL rightL) NS f result
ns of
Left NS f (v : start)
x -> case NS f (v : start)
x of
Z f x
x -> Variant f ('N color ('N colorL leftL kL vL rightL) k v 'E)
-> Either
(NS f start)
(Variant f ('N color ('N colorL leftL kL vL rightL) k v 'E))
forall a b. b -> Either a b
Right (f v -> Variant f ('N color ('N colorL leftL kL vL rightL) k v 'E)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
f x
x)
S NS f xs
x -> NS f start
-> Either
(NS f start)
(Variant f ('N color ('N colorL leftL kL vL rightL) k v 'E))
forall a b. a -> Either a b
Left NS f start
NS f xs
x
Right Variant f ('N colorL leftL kL vL rightL)
v -> Variant f ('N color ('N colorL leftL kL vL rightL) k v 'E)
-> Either
(NS f start)
(Variant f ('N color ('N colorL leftL kL vL rightL) k v 'E))
forall a b. b -> Either a b
Right (Variant f ('N colorL leftL kL vL rightL)
-> Variant f ('N color ('N colorL leftL kL vL rightL) k v 'E)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f ('N colorL leftL kL vL rightL)
v)
instance Sumlike start (N colorR leftR kR vR rightR) middle
=> Sumlike start (N color E k v (N colorR leftR kR vR rightR)) (v ': middle) where
_prefixNS :: forall (f :: a -> *).
Either
(NS f start)
(Variant f ('N color 'E k v ('N colorR leftR kR vR rightR)))
-> NS f (v : middle)
_prefixNS = \case
Left NS f start
x -> NS f middle -> NS f (v : middle)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
_prefixNS @_ @_ @(N colorR leftR kR vR rightR) (NS f start
-> Either (NS f start) (Variant f ('N colorR leftR kR vR rightR))
forall a b. a -> Either a b
Left NS f start
x))
Right Variant f ('N color 'E k v ('N colorR leftR kR vR rightR))
x ->
case Variant f ('N color 'E k v ('N colorR leftR kR vR rightR))
x of Here f v
x -> f v -> NS f (v : middle)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z f v
f v
x
LookRight Variant f t
x -> NS f middle -> NS f (v : middle)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
_prefixNS @_ @_ @(N colorR leftR kR vR rightR) (Variant f ('N colorR leftR kR vR rightR)
-> Either (NS f start) (Variant f ('N colorR leftR kR vR rightR))
forall a b. b -> Either a b
Right Variant f t
Variant f ('N colorR leftR kR vR rightR)
x))
_breakNS :: forall (f :: a -> *).
NS f (v : middle)
-> Either
(NS f start)
(Variant f ('N color 'E k v ('N colorR leftR kR vR rightR)))
_breakNS = \case
Z f x
x -> Variant f ('N color 'E k v ('N colorR leftR kR vR rightR))
-> Either
(NS f start)
(Variant f ('N color 'E k v ('N colorR leftR kR vR rightR)))
forall a b. b -> Either a b
Right (f v -> Variant f ('N color 'E k v ('N colorR leftR kR vR rightR))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
f x
x)
S NS f xs
x -> case forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
NS f result -> Either (NS f start) (Variant f t)
_breakNS @_ @_ @(N colorR leftR kR vR rightR) NS f xs
x of
Left NS f start
ns -> NS f start
-> Either
(NS f start)
(Variant f ('N color 'E k v ('N colorR leftR kR vR rightR)))
forall a b. a -> Either a b
Left NS f start
ns
Right Variant f ('N colorR leftR kR vR rightR)
v -> Variant f ('N color 'E k v ('N colorR leftR kR vR rightR))
-> Either
(NS f start)
(Variant f ('N color 'E k v ('N colorR leftR kR vR rightR)))
forall a b. b -> Either a b
Right (Variant f ('N colorR leftR kR vR rightR)
-> Variant f ('N color 'E k v ('N colorR leftR kR vR rightR))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f ('N colorR leftR kR vR rightR)
v)
prefixNS :: forall start t result f. Sumlike start t result => Either (NS f start) (Variant f t) -> NS f result
prefixNS :: forall {k} (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
prefixNS = forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
_prefixNS @_ @start @t @result
breakNS :: forall start t result f. Sumlike start t result => NS f result -> Either (NS f start) (Variant f t)
breakNS :: forall {q} (start :: [q]) (t :: Map Symbol q) (result :: [q])
(f :: q -> *).
Sumlike start t result =>
NS f result -> Either (NS f start) (Variant f t)
breakNS = forall k (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
NS f result -> Either (NS f start) (Variant f t)
_breakNS @_ @start @t @result
toNS :: forall t result f. Sumlike '[] t result => Variant f t -> NS f result
toNS :: forall {k} (t :: Map Symbol k) (result :: [k]) (f :: k -> *).
Sumlike '[] t result =>
Variant f t -> NS f result
toNS = Either (NS f '[]) (Variant f t) -> NS f result
forall {k} (start :: [k]) (t :: Map Symbol k) (result :: [k])
(f :: k -> *).
Sumlike start t result =>
Either (NS f start) (Variant f t) -> NS f result
prefixNS (Either (NS f '[]) (Variant f t) -> NS f result)
-> (Variant f t -> Either (NS f '[]) (Variant f t))
-> Variant f t
-> NS f result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant f t -> Either (NS f '[]) (Variant f t)
forall a b. b -> Either a b
Right
fromNS :: forall t result f. Sumlike '[] t result => NS f result -> Variant f t
fromNS :: forall {q} (t :: Map Symbol q) (result :: [q]) (f :: q -> *).
Sumlike '[] t result =>
NS f result -> Variant f t
fromNS NS f result
ns = case NS f result -> Either (NS f '[]) (Variant f t)
forall {q} (start :: [q]) (t :: Map Symbol q) (result :: [q])
(f :: q -> *).
Sumlike start t result =>
NS f result -> Either (NS f start) (Variant f t)
breakNS NS f result
ns of
Left NS f '[]
_ -> String -> Variant f t
forall a. HasCallStack => String -> a
error String
"this never happens"
Right Variant f t
x -> Variant f t
x
type ToRecord :: Type -> Constraint
class ToRecord (r :: Type) where
type RecordCode r :: Map Symbol Type
type RecordCode r = RecordCode' E (G.Rep r)
toRecord :: r -> Record I (RecordCode r)
default toRecord :: (G.Generic r,ToRecordHelper E (G.Rep r),RecordCode r ~ RecordCode' E (G.Rep r)) => r -> Record I (RecordCode r)
toRecord r
r = Record I 'E -> Rep r Any -> Record I (RecordCode' 'E (Rep r))
forall x.
Record I 'E -> Rep r x -> Record I (RecordCode' 'E (Rep r))
forall (start :: Map Symbol (*)) (g :: * -> *) x.
ToRecordHelper start g =>
Record I start -> g x -> Record I (RecordCode' start g)
toRecord' Record I 'E
forall {q} (f :: q -> *). Record f 'E
unit (r -> Rep r Any
forall x. r -> Rep r x
forall a x. Generic a => a -> Rep a x
G.from r
r)
instance (
G.Generic r,
ToRecordHelper E (G.Rep r)
) =>
ToRecord (Generically (r :: Type)) where
type RecordCode (Generically (r :: Type)) = RecordCode' E (G.Rep r)
toRecord :: Generically r -> Record I (RecordCode (Generically r))
toRecord (Generically r
r) = Record I 'E -> Rep r Any -> Record I (RecordCode' 'E (Rep r))
forall x.
Record I 'E -> Rep r x -> Record I (RecordCode' 'E (Rep r))
forall (start :: Map Symbol (*)) (g :: * -> *) x.
ToRecordHelper start g =>
Record I start -> g x -> Record I (RecordCode' start g)
toRecord' Record I 'E
forall {q} (f :: q -> *). Record f 'E
unit (r -> Rep r Any
forall x. r -> Rep r x
forall a x. Generic a => a -> Rep a x
G.from r
r)
class ToRecordHelper (start :: Map Symbol Type) (g :: Type -> Type) where
type RecordCode' start g :: Map Symbol Type
toRecord' :: Record I start -> g x -> Record I (RecordCode' start g)
instance ToRecordHelper E fields => ToRecordHelper E (D1 meta (C1 metacons fields)) where
type RecordCode' E (D1 meta (C1 metacons fields)) = RecordCode' E fields
toRecord' :: forall x.
Record I 'E
-> D1 meta (C1 metacons fields) x
-> Record I (RecordCode' 'E (D1 meta (C1 metacons fields)))
toRecord' Record I 'E
r (M1 (M1 fields x
g)) = forall (start :: Map Symbol (*)) (g :: * -> *) x.
ToRecordHelper start g =>
Record I start -> g x -> Record I (RecordCode' start g)
toRecord' @E @fields Record I 'E
r fields x
g
instance (Insertable k v start) =>
ToRecordHelper start
(S1 ('G.MetaSel ('Just k)
unpackedness
strictness
laziness)
(Rec0 v))
where
type RecordCode' start
(S1 ('G.MetaSel ('Just k)
unpackedness
strictness
laziness)
(Rec0 v)) = Insert k v start
toRecord' :: forall x.
Record I start
-> S1
('MetaSel ('Just k) unpackedness strictness laziness) (Rec0 v) x
-> Record
I
(RecordCode'
start
(S1
('MetaSel ('Just k) unpackedness strictness laziness) (Rec0 v)))
toRecord' Record I start
start (M1 (K1 v
v)) = forall (k :: Symbol) v (t :: Map Symbol (*)).
Insertable k v t =>
v -> Record I t -> Record I (Insert k v t)
insertI @k v
v Record I start
start
instance ( ToRecordHelper start t2,
RecordCode' start t2 ~ middle,
ToRecordHelper middle t1
) =>
ToRecordHelper start (t1 G.:*: t2)
where
type RecordCode' start (t1 G.:*: t2) = RecordCode' (RecordCode' start t2) t1
toRecord' :: forall x.
Record I start
-> (:*:) t1 t2 x -> Record I (RecordCode' start (t1 :*: t2))
toRecord' Record I start
start (t1 x
t1 G.:*: t2 x
t2) = forall (start :: Map Symbol (*)) (g :: * -> *) x.
ToRecordHelper start g =>
Record I start -> g x -> Record I (RecordCode' start g)
toRecord' @middle (forall (start :: Map Symbol (*)) (g :: * -> *) x.
ToRecordHelper start g =>
Record I start -> g x -> Record I (RecordCode' start g)
toRecord' @start Record I start
start t2 x
t2) t1 x
t1
type FromRecord :: Type -> Constraint
class ToRecord r => FromRecord (r :: Type) where
fromRecord :: Record I (RecordCode r) -> r
default fromRecord :: (G.Generic r, FromRecordHelper (RecordCode r) (G.Rep r)) => Record I (RecordCode r) -> r
fromRecord Record I (RecordCode r)
r = Rep r Any -> r
forall a x. Generic a => Rep a x -> a
forall x. Rep r x -> r
G.to (forall (t :: Map Symbol (*)) (g :: * -> *) x.
FromRecordHelper t g =>
Record I t -> g x
fromRecord' @(RecordCode r) @(G.Rep r) Record I (RecordCode r)
r)
type IsRecordType :: Type -> Map Symbol Type -> Constraint
type IsRecordType (r :: Type) (t :: Map Symbol Type) = (G.Generic r, ToRecord r, RecordCode r ~ t, FromRecord r)
type FromRecordHelper :: Map Symbol Type -> (Type -> Type) -> Constraint
class FromRecordHelper (t :: Map Symbol Type) (g :: Type -> Type) where
fromRecord' :: Record I t -> g x
instance FromRecordHelper t fields => FromRecordHelper t (D1 meta (C1 metacons fields)) where
fromRecord' :: forall x. Record I t -> D1 meta (C1 metacons fields) x
fromRecord' Record I t
r = C1 metacons fields x -> M1 D meta (C1 metacons fields) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (fields x -> C1 metacons fields x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall (t :: Map Symbol (*)) (g :: * -> *) x.
FromRecordHelper t g =>
Record I t -> g x
fromRecord' @t @fields Record I t
r))
instance (Key k t, Value k t ~ v) =>
FromRecordHelper t
(S1 ('G.MetaSel ('Just k)
unpackedness
strictness
laziness)
(Rec0 v))
where
fromRecord' :: forall x.
Record I t
-> S1
('MetaSel ('Just k) unpackedness strictness laziness) (Rec0 v) x
fromRecord' Record I t
r = let v :: Value k t
v = forall (k :: Symbol) (t :: Map Symbol (*)).
Key k t =>
Record I t -> Value k t
projectI @k Record I t
r in Rec0 v x
-> M1
S ('MetaSel ('Just k) unpackedness strictness laziness) (Rec0 v) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (v -> Rec0 v x
forall k i c (p :: k). c -> K1 i c p
K1 v
Value k t
v)
instance ( FromRecordHelper t t1,
FromRecordHelper t t2
) =>
FromRecordHelper t (t1 G.:*: t2)
where
fromRecord' :: forall x. Record I t -> (:*:) t1 t2 x
fromRecord' Record I t
r =
let v1 :: t1 x
v1 = forall (t :: Map Symbol (*)) (g :: * -> *) x.
FromRecordHelper t g =>
Record I t -> g x
fromRecord' @_ @t1 Record I t
r
v2 :: t2 x
v2 = forall (t :: Map Symbol (*)) (g :: * -> *) x.
FromRecordHelper t g =>
Record I t -> g x
fromRecord' @_ @t2 Record I t
r
in t1 x
v1 t1 x -> t2 x -> (:*:) t1 t2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
G.:*: t2 x
v2
type VariantCode :: Type -> Map Symbol Type
type family VariantCode (s :: Type) :: Map Symbol Type where
VariantCode s = VariantCode' E (G.Rep s)
type VariantCode' :: Map Symbol Type -> (Type -> Type) -> Map Symbol Type
type family VariantCode' (acc :: Map Symbol Type) (g :: Type -> Type) :: Map Symbol Type where
VariantCode' acc (D1 meta fields) = VariantCode' acc fields
VariantCode' acc (t1 G.:+: t2) = VariantCode' (VariantCode' acc t2) t1
VariantCode' acc (C1 (G.MetaCons k _ _) (S1 ('G.MetaSel Nothing unpackedness strictness laziness) (Rec0 v))) = Insert k v acc
VariantCode' acc (C1 (G.MetaCons k _ _) G.U1) = Insert k () acc
type FromVariant :: Type -> Constraint
class FromVariant (s :: Type) where
fromVariant :: Variant I (VariantCode s) -> s
default fromVariant :: (G.Generic s, FromVariantHelper (VariantCode s) (G.Rep s)) => Variant I (VariantCode s) -> s
fromVariant Variant I (VariantCode s)
v = case forall (t :: Map Symbol (*)) (g :: * -> *) x.
FromVariantHelper t g =>
Variant I t -> Maybe (g x)
fromVariant' @(VariantCode s) Variant I (VariantCode s)
v of
Just Rep s Any
x -> Rep s Any -> s
forall a x. Generic a => Rep a x -> a
forall x. Rep s x -> s
G.to Rep s Any
x
Maybe (Rep s Any)
Nothing -> String -> s
forall a. HasCallStack => String -> a
error String
"fromVariant match fail. Should not happen."
type IsVariantType :: Type -> Map Symbol Type -> Constraint
type IsVariantType (v :: Type) (t :: Map Symbol Type) = (G.Generic v, ToVariant v, VariantCode v ~ t, FromVariant v)
class FromVariantHelper (t :: Map Symbol Type) (g :: Type -> Type) where
fromVariant' :: Variant I t -> Maybe (g x)
instance FromVariantHelper t fields => FromVariantHelper t (D1 meta fields) where
fromVariant' :: forall x. Variant I t -> Maybe (D1 meta fields x)
fromVariant' Variant I t
v = fields x -> M1 D meta fields x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (fields x -> M1 D meta fields x)
-> Maybe (fields x) -> Maybe (M1 D meta fields x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: Map Symbol (*)) (g :: * -> *) x.
FromVariantHelper t g =>
Variant I t -> Maybe (g x)
fromVariant' @t Variant I t
v
instance (Key k t, Value k t ~ v)
=> FromVariantHelper t (C1 (G.MetaCons k x y) (S1 ('G.MetaSel Nothing unpackedness strictness laziness) (Rec0 v)))
where
fromVariant' :: forall x.
Variant I t
-> Maybe
(C1
('MetaCons k x y)
(S1 ('MetaSel 'Nothing unpackedness strictness laziness) (Rec0 v))
x)
fromVariant' Variant I t
v = case forall (k :: Symbol) (t :: Map Symbol (*)).
Key k t =>
Variant I t -> Maybe (Value k t)
matchI @k @t Variant I t
v of
Just Value k t
x -> C1
('MetaCons k x y)
(S1 ('MetaSel 'Nothing unpackedness strictness laziness) (Rec0 v))
x
-> Maybe
(C1
('MetaCons k x y)
(S1 ('MetaSel 'Nothing unpackedness strictness laziness) (Rec0 v))
x)
forall a. a -> Maybe a
Just (S1 ('MetaSel 'Nothing unpackedness strictness laziness) (Rec0 v) x
-> C1
('MetaCons k x y)
(S1 ('MetaSel 'Nothing unpackedness strictness laziness) (Rec0 v))
x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Rec0 v x
-> S1
('MetaSel 'Nothing unpackedness strictness laziness) (Rec0 v) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (v -> Rec0 v x
forall k i c (p :: k). c -> K1 i c p
K1 v
Value k t
x)) )
Maybe (Value k t)
Nothing -> Maybe
(C1
('MetaCons k x y)
(S1 ('MetaSel 'Nothing unpackedness strictness laziness) (Rec0 v))
x)
forall a. Maybe a
Nothing
instance (Key k t, Value k t ~ ())
=> FromVariantHelper t (C1 (G.MetaCons k x y) G.U1)
where
fromVariant' :: forall x. Variant I t -> Maybe (C1 ('MetaCons k x y) U1 x)
fromVariant' Variant I t
v = case forall (k :: Symbol) (t :: Map Symbol (*)).
Key k t =>
Variant I t -> Maybe (Value k t)
matchI @k @t Variant I t
v of
Just Value k t
x -> C1 ('MetaCons k x y) U1 x -> Maybe (C1 ('MetaCons k x y) U1 x)
forall a. a -> Maybe a
Just (U1 x -> C1 ('MetaCons k x y) U1 x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 U1 x
forall k (p :: k). U1 p
G.U1)
Maybe (Value k t)
Nothing -> Maybe (C1 ('MetaCons k x y) U1 x)
forall a. Maybe a
Nothing
instance ( FromVariantHelper t t1,
FromVariantHelper t t2
) =>
FromVariantHelper t (t1 G.:+: t2)
where
fromVariant' :: forall x. Variant I t -> Maybe ((:+:) t1 t2 x)
fromVariant' Variant I t
v = case forall (t :: Map Symbol (*)) (g :: * -> *) x.
FromVariantHelper t g =>
Variant I t -> Maybe (g x)
fromVariant' @t @t1 Variant I t
v of
Just t1 x
x1 -> (:+:) t1 t2 x -> Maybe ((:+:) t1 t2 x)
forall a. a -> Maybe a
Just (t1 x -> (:+:) t1 t2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
G.L1 t1 x
x1)
Maybe (t1 x)
Nothing -> case forall (t :: Map Symbol (*)) (g :: * -> *) x.
FromVariantHelper t g =>
Variant I t -> Maybe (g x)
fromVariant' @t @t2 Variant I t
v of
Just t2 x
x2 -> (:+:) t1 t2 x -> Maybe ((:+:) t1 t2 x)
forall a. a -> Maybe a
Just (t2 x -> (:+:) t1 t2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
G.R1 t2 x
x2)
Maybe (t2 x)
Nothing -> Maybe ((:+:) t1 t2 x)
forall a. Maybe a
Nothing
type ToVariant :: Type -> Constraint
class ToVariant (s :: Type) where
toVariant :: s -> Variant I (VariantCode s)
default toVariant :: (G.Generic s, ToVariantHelper (VariantCode s) (G.Rep s)) => s -> Variant I (VariantCode s)
toVariant s
s = forall (t :: Map Symbol (*)) (g :: * -> *) x.
ToVariantHelper t g =>
g x -> Variant I t
toVariant' @(VariantCode s) @(G.Rep s) (s -> Rep s Any
forall x. s -> Rep s x
forall a x. Generic a => a -> Rep a x
G.from s
s)
class ToVariantHelper (t :: Map Symbol Type) (g :: Type -> Type) where
toVariant' :: g x -> Variant I t
instance ToVariantHelper t fields => ToVariantHelper t (D1 meta fields) where
toVariant' :: forall x. D1 meta fields x -> Variant I t
toVariant' (M1 fields x
fields) = forall (t :: Map Symbol (*)) (g :: * -> *) x.
ToVariantHelper t g =>
g x -> Variant I t
toVariant' @t fields x
fields
instance (Key k t, Value k t ~ v) =>
ToVariantHelper t (C1 (G.MetaCons k x y) (S1 ('G.MetaSel Nothing unpackedness strictness laziness) (Rec0 v)))
where
toVariant' :: forall x.
C1
('MetaCons k x y)
(S1 ('MetaSel 'Nothing unpackedness strictness laziness) (Rec0 v))
x
-> Variant I t
toVariant' (M1 (M1 (K1 v
v))) = forall (k :: Symbol) (t :: Map Symbol (*)).
Key k t =>
Value k t -> Variant I t
injectI @k v
Value k t
v
instance (Key k t, Value k t ~ ()) =>
ToVariantHelper t (C1 (G.MetaCons k x y) G.U1) where
toVariant' :: forall x. C1 ('MetaCons k x y) U1 x -> Variant I t
toVariant' (M1 U1 x
G.U1) = forall (k :: Symbol) (t :: Map Symbol (*)).
Key k t =>
Value k t -> Variant I t
injectI @k ()
instance ( ToVariantHelper t t1,
ToVariantHelper t t2
) =>
ToVariantHelper t (t1 G.:+: t2)
where
toVariant' :: forall x. (:+:) t1 t2 x -> Variant I t
toVariant' = \case
G.L1 t1 x
l -> forall (t :: Map Symbol (*)) (g :: * -> *) x.
ToVariantHelper t g =>
g x -> Variant I t
toVariant' @t t1 x
l
G.R1 t2 x
r -> forall (t :: Map Symbol (*)) (g :: * -> *) x.
ToVariantHelper t g =>
g x -> Variant I t
toVariant' @t t2 x
r
type DiscriminateBalL :: Map k v -> Map k v -> Bool
type family DiscriminateBalL (l :: Map k v) (r :: Map k v) :: Bool where
DiscriminateBalL (N R _ _ _ _) _ = False
DiscriminateBalL _ _ = True
type BalanceableL :: Map Symbol q -> Symbol -> q -> Map Symbol q -> Constraint
class BalanceableL (l :: Map Symbol q) (k :: Symbol) (v :: q) (r :: Map Symbol q) where
type BalL l k v r :: Map Symbol q
balLR :: Record f (N color l k v r) -> Record f (BalL l k v r)
balLV :: Variant f (N color l k v r) -> Variant f (BalL l k v r)
type BalanceableHelperL :: Bool -> Map Symbol q -> Symbol -> q -> Map Symbol q -> Constraint
class BalanceableHelperL (b :: Bool) (l :: Map Symbol q) (k :: Symbol) (v :: q) (r :: Map Symbol q) where
type BalL' b l k v r :: Map Symbol q
balLR' :: Record f (N color l k v r) -> Record f (BalL' b l k v r)
balLV' :: Variant f (N color l k v r) -> Variant f (BalL' b l k v r)
instance (DiscriminateBalL l r ~ b, BalanceableHelperL b l k v r) => BalanceableL l k v r where
type BalL l k v r = BalL' (DiscriminateBalL l r) l k v r
balLR :: forall (f :: q -> *) (color :: Color).
Record f ('N color l k v r) -> Record f (BalL l k v r)
balLR = forall q (b :: Bool) (l :: Map Symbol q) (k :: Symbol) (v :: q)
(r :: Map Symbol q) (f :: q -> *) (color :: Color).
BalanceableHelperL b l k v r =>
Record f ('N color l k v r) -> Record f (BalL' b l k v r)
balLR' @_ @b @l @k @v @r
balLV :: forall (f :: q -> *) (color :: Color).
Variant f ('N color l k v r) -> Variant f (BalL l k v r)
balLV = forall q (b :: Bool) (l :: Map Symbol q) (k :: Symbol) (v :: q)
(r :: Map Symbol q) (f :: q -> *) (color :: Color).
BalanceableHelperL b l k v r =>
Variant f ('N color l k v r) -> Variant f (BalL' b l k v r)
balLV' @_ @b @l @k @v @r
instance BalanceableHelperL False (N R left1 k1 v1 right1) k2 v2 right2 where
type BalL' False (N R left1 k1 v1 right1) k2 v2 right2 =
(N R (N B left1 k1 v1 right1) k2 v2 right2)
balLR' :: forall (f :: q -> *) (color :: Color).
Record f ('N color ('N 'R left1 k1 v1 right1) k2 v2 right2)
-> Record f (BalL' 'False ('N 'R left1 k1 v1 right1) k2 v2 right2)
balLR' (Node (Node Record f left
left' f v
v' Record f right
right') f v
v Record f right
right) = Record f ('N 'B left k1 v right)
-> f v
-> Record f right
-> Record f ('N 'R ('N 'B left k1 v right) k2 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f left
-> f v -> Record f right -> Record f ('N 'B left k1 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left' f v
v' Record f right
right') f v
v Record f right
right
balLV' :: forall (f :: q -> *) (color :: Color).
Variant f ('N color ('N 'R left1 k1 v1 right1) k2 v2 right2)
-> Variant f (BalL' 'False ('N 'R left1 k1 v1 right1) k2 v2 right2)
balLV' Variant f ('N color ('N 'R left1 k1 v1 right1) k2 v2 right2)
v = case Variant f ('N color ('N 'R left1 k1 v1 right1) k2 v2 right2)
v of LookLeft Variant f t
x -> Variant f ('N 'B left1 k1 v1 right1)
-> Variant f ('N 'R ('N 'B left1 k1 v1 right1) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (case Variant f t
x of LookLeft Variant f t
y -> Variant f t -> Variant f ('N 'B t k1 v1 right1)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
y
Here f v
y -> f v -> Variant f ('N 'B left1 k1 v right1)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
y
LookRight Variant f t
y -> Variant f t -> Variant f ('N 'B left1 k1 v1 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
y)
Here f v
x -> f v -> Variant f ('N 'R ('N 'B left1 k1 v1 right1) k2 v right2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x
LookRight Variant f t
x -> Variant f t -> Variant f ('N 'R ('N 'B left1 k1 v1 right1) k2 v2 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
x
instance (N R t2 z zv t3 ~ g, BalanceableHelper (ShouldBalance t1 g) t1 y yv g) =>
BalanceableHelperL True t1 y yv (N B t2 z zv t3) where
type BalL' True t1 y yv (N B t2 z zv t3)
= Balance t1 y yv (N R t2 z zv t3)
balLR' :: forall (f :: q -> *) (color :: Color).
Record f ('N color t1 y yv ('N 'B t2 z zv t3))
-> Record f (BalL' 'True t1 y yv ('N 'B t2 z zv t3))
balLR' (Node Record f left
left1 f v
v1 (Node Record f left
left2 f v
v2 Record f right
right2)) =
forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Record f ('N color left k v right)
-> Record f (Balance left k v right)
balanceR @_ @t1 @y @yv @(N R t2 z zv t3) (Record f t1
-> f yv
-> Record f ('N 'R t2 z zv t3)
-> Record f ('N Any t1 y yv ('N 'R t2 z zv t3))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f t1
Record f left
left1 f yv
f v
v1 (Record f t2 -> f zv -> Record f t3 -> Record f ('N 'R t2 z zv t3)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f t2
Record f left
left2 f zv
f v
v2 Record f t3
Record f right
right2))
balLV' :: forall (f :: q -> *) (color :: Color).
Variant f ('N color t1 y yv ('N 'B t2 z zv t3))
-> Variant f (BalL' 'True t1 y yv ('N 'B t2 z zv t3))
balLV' Variant f ('N color t1 y yv ('N 'B t2 z zv t3))
v = forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Variant f ('N color left k v right)
-> Variant f (Balance left k v right)
balanceV @_ @t1 @y @yv @(N R t2 z zv t3) (case Variant f ('N color t1 y yv ('N 'B t2 z zv t3))
v of
LookLeft Variant f t
l -> Variant f t1 -> Variant f ('N Any t1 y yv ('N 'R t2 z zv t3))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t1
Variant f t
l
Here f v
x -> f yv -> Variant f ('N Any t1 y yv ('N 'R t2 z zv t3))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f yv
f v
x
LookRight Variant f t
r -> Variant f ('N 'R t2 z zv t3)
-> Variant f ('N Any t1 y yv ('N 'R t2 z zv t3))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (case Variant f t
r of
LookLeft Variant f t
l' -> Variant f t2 -> Variant f ('N 'R t2 z zv t3)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t2
Variant f t
l'
Here f v
x' -> f zv -> Variant f ('N 'R t2 z zv t3)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f zv
f v
x'
LookRight Variant f t
r' -> Variant f t3 -> Variant f ('N 'R t2 z zv t3)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t3
Variant f t
r'))
instance (N R l k kv r ~ g, BalanceableHelper (ShouldBalance t3 g) t3 z zv g) =>
BalanceableHelperL True t1 y yv (N R (N B t2 u uv t3) z zv (N B l k kv r)) where
type BalL' True t1 y yv (N R (N B t2 u uv t3) z zv (N B l k kv r)) =
N R (N B t1 y yv t2) u uv (Balance t3 z zv (N R l k kv r))
balLR' :: forall (f :: q -> *) (color :: Color).
Record
f
('N color t1 y yv ('N 'R ('N 'B t2 u uv t3) z zv ('N 'B l k kv r)))
-> Record
f
(BalL'
'True t1 y yv ('N 'R ('N 'B t2 u uv t3) z zv ('N 'B l k kv r)))
balLR' (Node Record f left
left1 f v
v1 (Node (Node Record f left
left2 f v
v2 Record f right
right2) f v
vx (Node Record f left
left3 f v
v3 Record f right
right3))) =
Record f ('N 'B left y v left)
-> f v
-> Record
f
(Balance'
(ShouldBalance t3 ('N 'R l k kv r)) t3 z zv ('N 'R l k kv r))
-> Record
f
('N
'R
('N 'B left y v left)
u
v
(Balance'
(ShouldBalance t3 ('N 'R l k kv r)) t3 z zv ('N 'R l k kv r)))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f left
-> f v -> Record f left -> Record f ('N 'B left y v left)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left1 f v
v1 Record f left
left2) f v
v2 (forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Record f ('N color left k v right)
-> Record f (Balance left k v right)
balanceR @_ @t3 @z @zv @(N R l k kv r) (Record f t3
-> f zv
-> Record f ('N 'R l k kv r)
-> Record f ('N Any t3 z zv ('N 'R l k kv r))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f t3
Record f right
right2 f zv
f v
vx (Record f l -> f kv -> Record f r -> Record f ('N 'R l k kv r)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f l
Record f left
left3 f kv
f v
v3 Record f r
Record f right
right3)))
balLV' :: forall (f :: q -> *) (color :: Color).
Variant
f
('N color t1 y yv ('N 'R ('N 'B t2 u uv t3) z zv ('N 'B l k kv r)))
-> Variant
f
(BalL'
'True t1 y yv ('N 'R ('N 'B t2 u uv t3) z zv ('N 'B l k kv r)))
balLV' Variant
f
('N color t1 y yv ('N 'R ('N 'B t2 u uv t3) z zv ('N 'B l k kv r)))
v = case Variant
f
('N color t1 y yv ('N 'R ('N 'B t2 u uv t3) z zv ('N 'B l k kv r)))
v of LookLeft Variant f t
left1 -> Variant f ('N 'B t y yv t2)
-> Variant
f
('N
'R
('N 'B t y yv t2)
u
uv
(Balance'
(ShouldBalance t3 ('N 'R l k kv r)) t3 z zv ('N 'R l k kv r)))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B t y yv t2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
left1)
Here f v
v1 -> Variant f ('N 'B t1 y v t2)
-> Variant
f
('N
'R
('N 'B t1 y v t2)
u
uv
(Balance'
(ShouldBalance t3 ('N 'R l k kv r)) t3 z zv ('N 'R l k kv r)))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (f v -> Variant f ('N 'B t1 y v t2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v1)
LookRight (LookLeft (LookLeft Variant f t
left2)) -> Variant f ('N 'B t1 y yv t)
-> Variant
f
('N
'R
('N 'B t1 y yv t)
u
uv
(Balance'
(ShouldBalance t3 ('N 'R l k kv r)) t3 z zv ('N 'R l k kv r)))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B t1 y yv t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
left2)
LookRight (LookLeft (Here f v
v2)) -> f v
-> Variant
f
('N
'R
('N 'B t1 y yv t2)
u
v
(Balance'
(ShouldBalance t3 ('N 'R l k kv r)) t3 z zv ('N 'R l k kv r)))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v2
LookRight (LookLeft (LookRight Variant f t
right2)) -> Variant
f
(Balance'
(ShouldBalance t3 ('N 'R l k kv r)) t3 z zv ('N 'R l k kv r))
-> Variant
f
('N
'R
('N 'B t1 y yv t2)
u
uv
(Balance'
(ShouldBalance t3 ('N 'R l k kv r)) t3 z zv ('N 'R l k kv r)))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Variant f ('N color left k v right)
-> Variant f (Balance left k v right)
balanceV @_ @t3 @z @zv @(N R l k kv r) (Variant f t3 -> Variant f ('N Any t3 z zv ('N 'R l k kv r))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t3
Variant f t
right2))
LookRight (Here f v
vx) -> Variant
f
(Balance'
(ShouldBalance t3 ('N 'R l k kv r)) t3 z zv ('N 'R l k kv r))
-> Variant
f
('N
'R
('N 'B t1 y yv t2)
u
uv
(Balance'
(ShouldBalance t3 ('N 'R l k kv r)) t3 z zv ('N 'R l k kv r)))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Variant f ('N color left k v right)
-> Variant f (Balance left k v right)
balanceV @_ @t3 @z @zv @(N R l k kv r) (f zv -> Variant f ('N Any t3 z zv ('N 'R l k kv r))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f zv
f v
vx))
LookRight (LookRight Variant f t
rr) -> Variant
f
(Balance'
(ShouldBalance t3 ('N 'R l k kv r)) t3 z zv ('N 'R l k kv r))
-> Variant
f
('N
'R
('N 'B t1 y yv t2)
u
uv
(Balance'
(ShouldBalance t3 ('N 'R l k kv r)) t3 z zv ('N 'R l k kv r)))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Variant f ('N color left k v right)
-> Variant f (Balance left k v right)
balanceV @_ @t3 @z @zv @(N R l k kv r) (Variant f ('N 'R l k kv r)
-> Variant f ('N Any t3 z zv ('N 'R l k kv r))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (case Variant f t
rr of
LookLeft Variant f t
left3 -> Variant f l -> Variant f ('N 'R l k kv r)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f l
Variant f t
left3
Here f v
v3 -> f kv -> Variant f ('N 'R l k kv r)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f kv
f v
v3
LookRight Variant f t
right3 -> Variant f r -> Variant f ('N 'R l k kv r)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f r
Variant f t
right3)))
type DiscriminateBalR :: Map k v -> Map k v -> Bool
type family DiscriminateBalR (l :: Map k v) (r :: Map k v) :: Bool where
DiscriminateBalR _ (N R _ _ _ _) = False
DiscriminateBalR _ _ = True
type BalanceableR :: Map Symbol q -> Symbol -> q -> Map Symbol q -> Constraint
class BalanceableR (l :: Map Symbol q) (k :: Symbol) (v :: q) (r :: Map Symbol q) where
type BalR l k v r :: Map Symbol q
balRR :: Record f (N color l k v r) -> Record f (BalR l k v r)
balRV :: Variant f (N color l k v r) -> Variant f (BalR l k v r)
type BalanceableHelperR :: Bool -> Map Symbol q -> Symbol -> q -> Map Symbol q -> Constraint
class BalanceableHelperR (b :: Bool) (l :: Map Symbol q) (k :: Symbol) (v :: q) (r :: Map Symbol q) where
type BalR' b l k v r :: Map Symbol q
balRR' :: Record f (N color l k v r) -> Record f (BalR' b l k v r)
balRV' :: Variant f (N color l k v r) -> Variant f (BalR' b l k v r)
instance (DiscriminateBalR l r ~ b, BalanceableHelperR b l k v r) => BalanceableR l k v r where
type BalR l k v r = BalR' (DiscriminateBalR l r) l k v r
balRR :: forall (f :: q -> *) (color :: Color).
Record f ('N color l k v r) -> Record f (BalR l k v r)
balRR = forall q (b :: Bool) (l :: Map Symbol q) (k :: Symbol) (v :: q)
(r :: Map Symbol q) (f :: q -> *) (color :: Color).
BalanceableHelperR b l k v r =>
Record f ('N color l k v r) -> Record f (BalR' b l k v r)
balRR' @_ @b @l @k @v @r
balRV :: forall (f :: q -> *) (color :: Color).
Variant f ('N color l k v r) -> Variant f (BalR l k v r)
balRV = forall q (b :: Bool) (l :: Map Symbol q) (k :: Symbol) (v :: q)
(r :: Map Symbol q) (f :: q -> *) (color :: Color).
BalanceableHelperR b l k v r =>
Variant f ('N color l k v r) -> Variant f (BalR' b l k v r)
balRV' @_ @b @l @k @v @r
instance BalanceableHelperR False right2 k2 v2 (N R left1 k1 v1 right1) where
type BalR' False right2 k2 v2 (N R left1 k1 v1 right1) =
(N R right2 k2 v2 (N B left1 k1 v1 right1))
balRR' :: forall (f :: q -> *) (color :: Color).
Record f ('N color right2 k2 v2 ('N 'R left1 k1 v1 right1))
-> Record f (BalR' 'False right2 k2 v2 ('N 'R left1 k1 v1 right1))
balRR' (Node Record f left
right f v
v (Node Record f left
left' f v
v' Record f right
right')) = Record f left
-> f v
-> Record f ('N 'B left k1 v right)
-> Record f ('N 'R left k2 v ('N 'B left k1 v right))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
right f v
v (Record f left
-> f v -> Record f right -> Record f ('N 'B left k1 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left' f v
v' Record f right
right')
balRV' :: forall (f :: q -> *) (color :: Color).
Variant f ('N color right2 k2 v2 ('N 'R left1 k1 v1 right1))
-> Variant f (BalR' 'False right2 k2 v2 ('N 'R left1 k1 v1 right1))
balRV' Variant f ('N color right2 k2 v2 ('N 'R left1 k1 v1 right1))
v = case Variant f ('N color right2 k2 v2 ('N 'R left1 k1 v1 right1))
v of LookLeft Variant f t
x -> Variant f t -> Variant f ('N 'R t k2 v2 ('N 'B left1 k1 v1 right1))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
x
Here f v
x -> f v -> Variant f ('N 'R right2 k2 v ('N 'B left1 k1 v1 right1))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
x
LookRight Variant f t
x -> Variant f ('N 'B left1 k1 v1 right1)
-> Variant f ('N 'R right2 k2 v2 ('N 'B left1 k1 v1 right1))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (case Variant f t
x of LookLeft Variant f t
y -> Variant f t -> Variant f ('N 'B t k1 v1 right1)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
y
Here f v
y -> f v -> Variant f ('N 'B left1 k1 v right1)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
y
LookRight Variant f t
y -> Variant f t -> Variant f ('N 'B left1 k1 v1 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
y)
instance (N R t2 z zv t3 ~ g, ShouldBalance g t1 ~ shouldbalance, BalanceableHelper shouldbalance g y yv t1) =>
BalanceableHelperR True (N B t2 z zv t3) y yv t1 where
type BalR' True (N B t2 z zv t3) y yv t1
= Balance (N R t2 z zv t3) y yv t1
balRR' :: forall (f :: q -> *) (color :: Color).
Record f ('N color ('N 'B t2 z zv t3) y yv t1)
-> Record f (BalR' 'True ('N 'B t2 z zv t3) y yv t1)
balRR' (Node (Node Record f left
left1 f v
v1 Record f right
right1) f v
v2 Record f right
right2) = forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Record f ('N color left k v right)
-> Record f (Balance left k v right)
balanceR @_ @(N R t2 z zv t3) @y @yv @t1
(Record f ('N 'R t2 z zv t3)
-> f yv
-> Record f t1
-> Record f ('N Any ('N 'R t2 z zv t3) y yv t1)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f t2 -> f zv -> Record f t3 -> Record f ('N 'R t2 z zv t3)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f t2
Record f left
left1 f zv
f v
v1 Record f t3
Record f right
right1) f yv
f v
v2 Record f t1
Record f right
right2)
balRV' :: forall (f :: q -> *) (color :: Color).
Variant f ('N color ('N 'B t2 z zv t3) y yv t1)
-> Variant f (BalR' 'True ('N 'B t2 z zv t3) y yv t1)
balRV' Variant f ('N color ('N 'B t2 z zv t3) y yv t1)
v = forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Variant f ('N color left k v right)
-> Variant f (Balance left k v right)
balanceV @_ @(N R t2 z zv t3) @y @yv @t1 (case Variant f ('N color ('N 'B t2 z zv t3) y yv t1)
v of
LookLeft Variant f t
l -> Variant f ('N 'R t2 z zv t3)
-> Variant f ('N Any ('N 'R t2 z zv t3) y yv t1)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (case Variant f t
l of
LookLeft Variant f t
l' -> Variant f t2 -> Variant f ('N 'R t2 z zv t3)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t2
Variant f t
l'
Here f v
x' -> f zv -> Variant f ('N 'R t2 z zv t3)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f zv
f v
x'
LookRight Variant f t
r' -> Variant f t3 -> Variant f ('N 'R t2 z zv t3)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t3
Variant f t
r')
Here f v
x -> f yv -> Variant f ('N Any ('N 'R t2 z zv t3) y yv t1)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f yv
f v
x
LookRight Variant f t
r -> Variant f t1 -> Variant f ('N Any ('N 'R t2 z zv t3) y yv t1)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t1
Variant f t
r)
instance (N R t2 u uv t3 ~ g, ShouldBalance g l ~ shouldbalance, BalanceableHelper shouldbalance g z zv l) =>
BalanceableHelperR True (N R (N B t2 u uv t3) z zv (N B l k kv r)) y yv t1 where
type BalR' True (N R (N B t2 u uv t3) z zv (N B l k kv r)) y yv t1 =
N R (Balance (N R t2 u uv t3) z zv l) k kv (N B r y yv t1)
balRR' :: forall (f :: q -> *) (color :: Color).
Record
f
('N color ('N 'R ('N 'B t2 u uv t3) z zv ('N 'B l k kv r)) y yv t1)
-> Record
f
(BalR'
'True ('N 'R ('N 'B t2 u uv t3) z zv ('N 'B l k kv r)) y yv t1)
balRR' (Node (Node (Node Record f left
left2 f v
v2 Record f right
right2) f v
vx (Node Record f left
left3 f v
v3 Record f right
right3)) f v
v1 Record f right
left1) =
Record f (Balance' shouldbalance ('N 'R t2 u uv t3) z zv l)
-> f v
-> Record f ('N 'B right y v right)
-> Record
f
('N
'R
(Balance' shouldbalance ('N 'R t2 u uv t3) z zv l)
k
v
('N 'B right y v right))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Record f ('N color left k v right)
-> Record f (Balance left k v right)
balanceR @_ @(N R t2 u uv t3) @z @zv @l (Record f ('N 'R t2 u uv t3)
-> f zv
-> Record f l
-> Record f ('N Any ('N 'R t2 u uv t3) z zv l)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f t2 -> f uv -> Record f t3 -> Record f ('N 'R t2 u uv t3)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f t2
Record f left
left2 f uv
f v
v2 Record f t3
Record f right
right2) f zv
f v
vx Record f l
Record f left
left3)) f v
v3 (Record f right
-> f v -> Record f right -> Record f ('N 'B right y v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f right
right3 f v
v1 Record f right
left1)
balRV' :: forall (f :: q -> *) (color :: Color).
Variant
f
('N color ('N 'R ('N 'B t2 u uv t3) z zv ('N 'B l k kv r)) y yv t1)
-> Variant
f
(BalR'
'True ('N 'R ('N 'B t2 u uv t3) z zv ('N 'B l k kv r)) y yv t1)
balRV' Variant
f
('N color ('N 'R ('N 'B t2 u uv t3) z zv ('N 'B l k kv r)) y yv t1)
v = case Variant
f
('N color ('N 'R ('N 'B t2 u uv t3) z zv ('N 'B l k kv r)) y yv t1)
v of
LookLeft (LookLeft Variant f t
rr) -> Variant f (Balance' shouldbalance ('N 'R t2 u uv t3) z zv l)
-> Variant
f
('N
'R
(Balance' shouldbalance ('N 'R t2 u uv t3) z zv l)
k
kv
('N 'B r y yv t1))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Variant f ('N color left k v right)
-> Variant f (Balance left k v right)
balanceV @_ @(N R t2 u uv t3) @z @zv @l (Variant f ('N 'R t2 u uv t3)
-> Variant f ('N Any ('N 'R t2 u uv t3) z zv l)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (case Variant f t
rr of
LookLeft Variant f t
t2 -> Variant f t2 -> Variant f ('N 'R t2 u uv t3)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t2
Variant f t
t2
Here f v
uv -> f uv -> Variant f ('N 'R t2 u uv t3)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f uv
f v
uv
LookRight Variant f t
t3 -> Variant f t3 -> Variant f ('N 'R t2 u uv t3)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t3
Variant f t
t3)))
LookLeft (Here f v
zv) -> Variant f (Balance' shouldbalance ('N 'R t2 u uv t3) z zv l)
-> Variant
f
('N
'R
(Balance' shouldbalance ('N 'R t2 u uv t3) z zv l)
k
kv
('N 'B r y yv t1))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Variant f ('N color left k v right)
-> Variant f (Balance left k v right)
balanceV @_ @(N R t2 u uv t3) @z @zv @l (f zv -> Variant f ('N Any ('N 'R t2 u uv t3) z zv l)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f zv
f v
zv))
LookLeft (LookRight (LookLeft Variant f t
l)) -> Variant f (Balance' shouldbalance ('N 'R t2 u uv t3) z zv l)
-> Variant
f
('N
'R
(Balance' shouldbalance ('N 'R t2 u uv t3) z zv l)
k
kv
('N 'B r y yv t1))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (forall q (left :: Map Symbol q) (k :: Symbol) (v :: q)
(right :: Map Symbol q) (f :: q -> *) (color :: Color).
Balanceable left k v right =>
Variant f ('N color left k v right)
-> Variant f (Balance left k v right)
balanceV @_ @(N R t2 u uv t3) @z @zv @l (Variant f l -> Variant f ('N Any ('N 'R t2 u uv t3) z zv l)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f l
Variant f t
l))
LookLeft (LookRight (Here f v
kv)) -> f v
-> Variant
f
('N
'R
(Balance' shouldbalance ('N 'R t2 u uv t3) z zv l)
k
v
('N 'B r y yv t1))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
kv
LookLeft (LookRight (LookRight Variant f t
r)) -> Variant f ('N 'B t y yv t1)
-> Variant
f
('N
'R
(Balance' shouldbalance ('N 'R t2 u uv t3) z zv l)
k
kv
('N 'B t y yv t1))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'B t y yv t1)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
r)
Here f v
yv -> Variant f ('N 'B r y v t1)
-> Variant
f
('N
'R
(Balance' shouldbalance ('N 'R t2 u uv t3) z zv l)
k
kv
('N 'B r y v t1))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (f v -> Variant f ('N 'B r y v t1)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
yv)
LookRight Variant f t
t1 -> Variant f ('N 'B r y yv t)
-> Variant
f
('N
'R
(Balance' shouldbalance ('N 'R t2 u uv t3) z zv l)
k
kv
('N 'B r y yv t))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'B r y yv t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
t1)
type Fuseable :: Map Symbol q -> Map Symbol q -> Constraint
class Fuseable (l :: Map Symbol q) (r :: Map Symbol q) where
type Fuse l r :: Map Symbol q
fuseRecord :: Record f l -> Record f r -> Record f (Fuse l r)
fuseVariant :: Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
instance Fuseable E E where
type Fuse E E = E
fuseRecord :: forall (f :: q -> *).
Record f 'E -> Record f 'E -> Record f (Fuse 'E 'E)
fuseRecord Record f 'E
_ Record f 'E
_ = Record f (Fuse 'E 'E)
Record f 'E
forall {q} (f :: q -> *). Record f 'E
unit
fuseVariant :: forall (f :: q -> *).
Either (Variant f 'E) (Variant f 'E) -> Variant f (Fuse 'E 'E)
fuseVariant Either (Variant f 'E) (Variant f 'E)
v = case Either (Variant f 'E) (Variant f 'E)
v of
instance Fuseable E (N color left k v right) where
type Fuse E (N color left k v right) = N color left k v right
fuseRecord :: forall (f :: q -> *).
Record f 'E
-> Record f ('N color left k v right)
-> Record f (Fuse 'E ('N color left k v right))
fuseRecord Record f 'E
_ Record f ('N color left k v right)
r = Record f (Fuse 'E ('N color left k v right))
Record f ('N color left k v right)
r
fuseVariant :: forall (f :: q -> *).
Either (Variant f 'E) (Variant f ('N color left k v right))
-> Variant f (Fuse 'E ('N color left k v right))
fuseVariant Either (Variant f 'E) (Variant f ('N color left k v right))
e = case Either (Variant f 'E) (Variant f ('N color left k v right))
e of
Right Variant f ('N color left k v right)
v -> Variant f (Fuse 'E ('N color left k v right))
Variant f ('N color left k v right)
v
instance Fuseable (N color left k v right) E where
type Fuse (N color left k v right) E = N color left k v right
fuseRecord :: forall (f :: q -> *).
Record f ('N color left k v right)
-> Record f 'E -> Record f (Fuse ('N color left k v right) 'E)
fuseRecord Record f ('N color left k v right)
r Record f 'E
_ = Record f (Fuse ('N color left k v right) 'E)
Record f ('N color left k v right)
r
fuseVariant :: forall (f :: q -> *).
Either (Variant f ('N color left k v right)) (Variant f 'E)
-> Variant f (Fuse ('N color left k v right) 'E)
fuseVariant Either (Variant f ('N color left k v right)) (Variant f 'E)
e = case Either (Variant f ('N color left k v right)) (Variant f 'E)
e of
Left Variant f ('N color left k v right)
v -> Variant f (Fuse ('N color left k v right) 'E)
Variant f ('N color left k v right)
v
instance Fuseable (N B left1 k1 v1 right1) left2
=> Fuseable (N B left1 k1 v1 right1) (N R left2 k2 v2 right2) where
type Fuse (N B left1 k1 v1 right1) (N R left2 k2 v2 right2) = N R (Fuse (N B left1 k1 v1 right1) left2) k2 v2 right2
fuseRecord :: forall (f :: q -> *).
Record f ('N 'B left1 k1 v1 right1)
-> Record f ('N 'R left2 k2 v2 right2)
-> Record
f (Fuse ('N 'B left1 k1 v1 right1) ('N 'R left2 k2 v2 right2))
fuseRecord (Node Record f left
left1 f v
v1 Record f right
right1) (Node Record f left
left2 f v
v2 Record f right
right2) = Record f (Fuse ('N 'B left1 k1 v1 right1) left2)
-> f v
-> Record f right
-> Record
f ('N 'R (Fuse ('N 'B left1 k1 v1 right1) left2) k2 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Record f l -> Record f r -> Record f (Fuse l r)
fuseRecord @_ @(N B left1 k1 v1 right1) (Record f left1
-> f v1 -> Record f right1 -> Record f ('N 'B left1 k1 v1 right1)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left1
Record f left
left1 f v1
f v
v1 Record f right1
Record f right
right1) Record f left
left2) f v
v2 Record f right
right2
fuseVariant :: forall (f :: q -> *).
Either
(Variant f ('N 'B left1 k1 v1 right1))
(Variant f ('N 'R left2 k2 v2 right2))
-> Variant
f (Fuse ('N 'B left1 k1 v1 right1) ('N 'R left2 k2 v2 right2))
fuseVariant Either
(Variant f ('N 'B left1 k1 v1 right1))
(Variant f ('N 'R left2 k2 v2 right2))
e = case Either
(Variant f ('N 'B left1 k1 v1 right1))
(Variant f ('N 'R left2 k2 v2 right2))
e of
Left Variant f ('N 'B left1 k1 v1 right1)
l -> case Variant f ('N 'B left1 k1 v1 right1)
l of
LookLeft Variant f t
left1 -> Variant f (Fuse ('N 'B left1 k1 v1 right1) left2)
-> Variant
f ('N 'R (Fuse ('N 'B left1 k1 v1 right1) left2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @(N B left1 k1 v1 right1) @left2 (Variant f ('N 'B left1 k1 v1 right1)
-> Either (Variant f ('N 'B left1 k1 v1 right1)) (Variant f left2)
forall a b. a -> Either a b
Left (Variant f left1 -> Variant f ('N 'B left1 k1 v1 right1)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f left1
Variant f t
left1)))
Here f v
v1 -> Variant f (Fuse ('N 'B left1 k1 v1 right1) left2)
-> Variant
f ('N 'R (Fuse ('N 'B left1 k1 v1 right1) left2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @(N B left1 k1 v1 right1) @left2 (Variant f ('N 'B left1 k1 v1 right1)
-> Either (Variant f ('N 'B left1 k1 v1 right1)) (Variant f left2)
forall a b. a -> Either a b
Left (f v1 -> Variant f ('N 'B left1 k1 v1 right1)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v1
f v
v1)))
LookRight Variant f t
right1 -> Variant f (Fuse ('N 'B left1 k1 v1 right1) left2)
-> Variant
f ('N 'R (Fuse ('N 'B left1 k1 v1 right1) left2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @(N B left1 k1 v1 right1) @left2 (Variant f ('N 'B left1 k1 v1 right1)
-> Either (Variant f ('N 'B left1 k1 v1 right1)) (Variant f left2)
forall a b. a -> Either a b
Left (Variant f right1 -> Variant f ('N 'B left1 k1 v1 right1)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f right1
Variant f t
right1)))
Right Variant f ('N 'R left2 k2 v2 right2)
r -> case Variant f ('N 'R left2 k2 v2 right2)
r of
LookLeft Variant f t
left2 -> Variant f (Fuse ('N 'B left1 k1 v1 right1) left2)
-> Variant
f ('N 'R (Fuse ('N 'B left1 k1 v1 right1) left2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @(N B left1 k1 v1 right1) @left2 (Variant f left2
-> Either (Variant f ('N 'B left1 k1 v1 right1)) (Variant f left2)
forall a b. b -> Either a b
Right Variant f left2
Variant f t
left2))
Here f v
v2 -> f v
-> Variant
f ('N 'R (Fuse ('N 'B left1 k1 v1 right1) left2) k2 v right2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v2
LookRight Variant f t
right2 -> Variant f t
-> Variant
f ('N 'R (Fuse ('N 'B left1 k1 v1 right1) left2) k2 v2 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
right2
instance Fuseable right1 (N B left2 k2 v2 right2)
=> Fuseable (N R left1 k1 v1 right1) (N B left2 k2 v2 right2) where
type Fuse (N R left1 k1 v1 right1) (N B left2 k2 v2 right2) = N R left1 k1 v1 (Fuse right1 (N B left2 k2 v2 right2))
fuseRecord :: forall (f :: q -> *).
Record f ('N 'R left1 k1 v1 right1)
-> Record f ('N 'B left2 k2 v2 right2)
-> Record
f (Fuse ('N 'R left1 k1 v1 right1) ('N 'B left2 k2 v2 right2))
fuseRecord (Node Record f left
left1 f v
v1 Record f right
right1) (Node Record f left
left2 f v
v2 Record f right
right2) = Record f left
-> f v
-> Record f (Fuse right1 ('N 'B left2 k2 v2 right2))
-> Record
f ('N 'R left k1 v (Fuse right1 ('N 'B left2 k2 v2 right2)))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left1 f v
v1 (forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Record f l -> Record f r -> Record f (Fuse l r)
fuseRecord @_ @_ @(N B left2 k2 v2 right2) Record f right
right1 (Record f left2
-> f v2 -> Record f right2 -> Record f ('N 'B left2 k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left2
Record f left
left2 f v2
f v
v2 Record f right2
Record f right
right2))
fuseVariant :: forall (f :: q -> *).
Either
(Variant f ('N 'R left1 k1 v1 right1))
(Variant f ('N 'B left2 k2 v2 right2))
-> Variant
f (Fuse ('N 'R left1 k1 v1 right1) ('N 'B left2 k2 v2 right2))
fuseVariant Either
(Variant f ('N 'R left1 k1 v1 right1))
(Variant f ('N 'B left2 k2 v2 right2))
e = case Either
(Variant f ('N 'R left1 k1 v1 right1))
(Variant f ('N 'B left2 k2 v2 right2))
e of
Left Variant f ('N 'R left1 k1 v1 right1)
l -> case Variant f ('N 'R left1 k1 v1 right1)
l of
LookLeft Variant f t
left1 -> Variant f t
-> Variant
f ('N 'R t k1 v1 (Fuse right1 ('N 'B left2 k2 v2 right2)))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
left1
Here f v
v1 -> f v
-> Variant
f ('N 'R left1 k1 v (Fuse right1 ('N 'B left2 k2 v2 right2)))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v1
LookRight Variant f t
right1 -> Variant f (Fuse right1 ('N 'B left2 k2 v2 right2))
-> Variant
f ('N 'R left1 k1 v1 (Fuse right1 ('N 'B left2 k2 v2 right2)))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @right1 @(N B left2 k2 v2 right2) (Variant f right1
-> Either (Variant f right1) (Variant f ('N 'B left2 k2 v2 right2))
forall a b. a -> Either a b
Left Variant f right1
Variant f t
right1))
Right Variant f ('N 'B left2 k2 v2 right2)
r -> case Variant f ('N 'B left2 k2 v2 right2)
r of
LookLeft Variant f t
left2 -> Variant f (Fuse right1 ('N 'B left2 k2 v2 right2))
-> Variant
f ('N 'R left1 k1 v1 (Fuse right1 ('N 'B left2 k2 v2 right2)))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @right1 @(N B left2 k2 v2 right2) (Variant f ('N 'B left2 k2 v2 right2)
-> Either (Variant f right1) (Variant f ('N 'B left2 k2 v2 right2))
forall a b. b -> Either a b
Right (Variant f left2 -> Variant f ('N 'B left2 k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f left2
Variant f t
left2)))
Here f v
v2 -> Variant f (Fuse right1 ('N 'B left2 k2 v2 right2))
-> Variant
f ('N 'R left1 k1 v1 (Fuse right1 ('N 'B left2 k2 v2 right2)))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @right1 @(N B left2 k2 v2 right2) (Variant f ('N 'B left2 k2 v2 right2)
-> Either (Variant f right1) (Variant f ('N 'B left2 k2 v2 right2))
forall a b. b -> Either a b
Right (f v2 -> Variant f ('N 'B left2 k2 v2 right2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v2
f v
v2)))
LookRight Variant f t
right2 -> Variant f (Fuse right1 ('N 'B left2 k2 v2 right2))
-> Variant
f ('N 'R left1 k1 v1 (Fuse right1 ('N 'B left2 k2 v2 right2)))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @right1 @(N B left2 k2 v2 right2) (Variant f ('N 'B left2 k2 v2 right2)
-> Either (Variant f right1) (Variant f ('N 'B left2 k2 v2 right2))
forall a b. b -> Either a b
Right (Variant f right2 -> Variant f ('N 'B left2 k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f right2
Variant f t
right2)))
instance (Fuseable right1 left2, Fuse right1 left2 ~ fused, FuseableHelper1 fused (N R left1 k1 v1 right1) (N R left2 k2 v2 right2))
=> Fuseable (N R left1 k1 v1 right1) (N R left2 k2 v2 right2) where
type Fuse (N R left1 k1 v1 right1) (N R left2 k2 v2 right2) = Fuse1 (Fuse right1 left2) (N R left1 k1 v1 right1) (N R left2 k2 v2 right2)
fuseRecord :: forall (f :: q -> *).
Record f ('N 'R left1 k1 v1 right1)
-> Record f ('N 'R left2 k2 v2 right2)
-> Record
f (Fuse ('N 'R left1 k1 v1 right1) ('N 'R left2 k2 v2 right2))
fuseRecord = forall q (fused :: Map Symbol q) (l :: Map Symbol q)
(r :: Map Symbol q) (f :: q -> *).
FuseableHelper1 fused l r =>
Record f l -> Record f r -> Record f (Fuse l r)
fuseRecord1 @_ @(Fuse right1 left2)
fuseVariant :: forall (f :: q -> *).
Either
(Variant f ('N 'R left1 k1 v1 right1))
(Variant f ('N 'R left2 k2 v2 right2))
-> Variant
f (Fuse ('N 'R left1 k1 v1 right1) ('N 'R left2 k2 v2 right2))
fuseVariant = forall q (fused :: Map Symbol q) (l :: Map Symbol q)
(r :: Map Symbol q) (f :: q -> *).
FuseableHelper1 fused l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant1 @_ @(Fuse right1 left2)
type FuseableHelper1 :: Map Symbol q -> Map Symbol q -> Map Symbol q -> Constraint
class FuseableHelper1 (fused :: Map Symbol q) (l :: Map Symbol q) (r :: Map Symbol q) where
type Fuse1 fused l r :: Map Symbol q
fuseRecord1 :: Record f l -> Record f r -> Record f (Fuse l r)
fuseVariant1 :: Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
instance (Fuseable right1 left2, Fuse right1 left2 ~ N R s1 z zv s2)
=> FuseableHelper1 (N R s1 z zv s2) (N R left1 k1 v1 right1) (N R left2 k2 v2 right2) where
type Fuse1 (N R s1 z zv s2) (N R left1 k1 v1 right1) (N R left2 k2 v2 right2) = N R (N R left1 k1 v1 s1) z zv (N R s2 k2 v2 right2)
fuseRecord1 :: forall (f :: q -> *).
Record f ('N 'R left1 k1 v1 right1)
-> Record f ('N 'R left2 k2 v2 right2)
-> Record
f (Fuse ('N 'R left1 k1 v1 right1) ('N 'R left2 k2 v2 right2))
fuseRecord1 (Node Record f left
left1 f v
v1 Record f right
right1) (Node Record f left
left2 f v
v2 Record f right
right2) =
case Record f right -> Record f left -> Record f (Fuse right left)
forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Record f l -> Record f r -> Record f (Fuse l r)
forall (f :: q -> *).
Record f right -> Record f left -> Record f (Fuse right left)
fuseRecord Record f right
right1 Record f left
left2 of
Node Record f left
s1 f v
zv Record f right
s2 -> Record f ('N 'R left k1 v left)
-> f v
-> Record f ('N 'R right k2 v right)
-> Record
f ('N 'R ('N 'R left k1 v left) z v ('N 'R right k2 v right))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f left
-> f v -> Record f left -> Record f ('N 'R left k1 v left)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left1 f v
v1 Record f left
s1) f v
zv (Record f right
-> f v -> Record f right -> Record f ('N 'R right k2 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f right
s2 f v
v2 Record f right
right2)
fuseVariant1 :: forall (f :: q -> *).
Either
(Variant f ('N 'R left1 k1 v1 right1))
(Variant f ('N 'R left2 k2 v2 right2))
-> Variant
f (Fuse ('N 'R left1 k1 v1 right1) ('N 'R left2 k2 v2 right2))
fuseVariant1 Either
(Variant f ('N 'R left1 k1 v1 right1))
(Variant f ('N 'R left2 k2 v2 right2))
e =
case Either
(Variant f ('N 'R left1 k1 v1 right1))
(Variant f ('N 'R left2 k2 v2 right2))
e of
Left Variant f ('N 'R left1 k1 v1 right1)
l -> case Variant f ('N 'R left1 k1 v1 right1)
l of
LookLeft Variant f t
left1 -> Variant f ('N 'R t k1 v1 s1)
-> Variant
f ('N 'R ('N 'R t k1 v1 s1) z zv ('N 'R s2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'R t k1 v1 s1)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
left1)
Here f v
v1 -> Variant f ('N 'R left1 k1 v s1)
-> Variant
f ('N 'R ('N 'R left1 k1 v s1) z zv ('N 'R s2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (f v -> Variant f ('N 'R left1 k1 v s1)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v1)
LookRight Variant f t
right1 -> case forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @right1 @left2 (Variant f right1 -> Either (Variant f right1) (Variant f left2)
forall a b. a -> Either a b
Left Variant f right1
Variant f t
right1) of
LookLeft Variant f t
s1 -> Variant f ('N 'R left1 k1 v1 t)
-> Variant
f ('N 'R ('N 'R left1 k1 v1 t) z zv ('N 'R s2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'R left1 k1 v1 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
s1)
Here f v
zv -> f v
-> Variant
f ('N 'R ('N 'R left1 k1 v1 s1) z v ('N 'R s2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
zv
LookRight Variant f t
s2 -> Variant f ('N 'R t k2 v2 right2)
-> Variant
f ('N 'R ('N 'R left1 k1 v1 s1) z zv ('N 'R t k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'R t k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
s2)
Right Variant f ('N 'R left2 k2 v2 right2)
r -> case Variant f ('N 'R left2 k2 v2 right2)
r of
LookLeft Variant f t
left2 -> case forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @right1 @left2 (Variant f left2 -> Either (Variant f right1) (Variant f left2)
forall a b. b -> Either a b
Right Variant f left2
Variant f t
left2) of
LookLeft Variant f t
s1 -> Variant f ('N 'R left1 k1 v1 t)
-> Variant
f ('N 'R ('N 'R left1 k1 v1 t) z zv ('N 'R s2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'R left1 k1 v1 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
s1)
Here f v
zv -> f v
-> Variant
f ('N 'R ('N 'R left1 k1 v1 s1) z v ('N 'R s2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
zv
LookRight Variant f t
s2 -> Variant f ('N 'R t k2 v2 right2)
-> Variant
f ('N 'R ('N 'R left1 k1 v1 s1) z zv ('N 'R t k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'R t k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
s2)
Here f v
v2 -> Variant f ('N 'R s2 k2 v right2)
-> Variant
f ('N 'R ('N 'R left1 k1 v1 s1) z zv ('N 'R s2 k2 v right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (f v -> Variant f ('N 'R s2 k2 v right2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v2)
LookRight Variant f t
right2 -> Variant f ('N 'R s2 k2 v2 t)
-> Variant f ('N 'R ('N 'R left1 k1 v1 s1) z zv ('N 'R s2 k2 v2 t))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'R s2 k2 v2 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
right2)
instance (Fuseable right1 left2, Fuse right1 left2 ~ N B s1 z zv s2)
=> FuseableHelper1 (N B s1 z zv s2) (N R left1 k1 v1 right1) (N R left2 k2 v2 right2) where
type Fuse1 (N B s1 z zv s2) (N R left1 k1 v1 right1) (N R left2 k2 v2 right2) = N R left1 k1 v1 (N R (N B s1 z zv s2) k2 v2 right2)
fuseRecord1 :: forall (f :: q -> *).
Record f ('N 'R left1 k1 v1 right1)
-> Record f ('N 'R left2 k2 v2 right2)
-> Record
f (Fuse ('N 'R left1 k1 v1 right1) ('N 'R left2 k2 v2 right2))
fuseRecord1 (Node Record f left
left1 f v
v1 Record f right
right1) (Node Record f left
left2 f v
v2 Record f right
right2) =
case Record f right -> Record f left -> Record f (Fuse right left)
forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Record f l -> Record f r -> Record f (Fuse l r)
forall (f :: q -> *).
Record f right -> Record f left -> Record f (Fuse right left)
fuseRecord Record f right
right1 Record f left
left2 of
Node Record f left
s1 f v
zv Record f right
s2 -> Record f left
-> f v
-> Record f ('N 'R ('N 'B left z v right) k2 v right)
-> Record
f ('N 'R left k1 v ('N 'R ('N 'B left z v right) k2 v right))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left1 f v
v1 (Record f ('N 'B left z v right)
-> f v
-> Record f right
-> Record f ('N 'R ('N 'B left z v right) k2 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f left
-> f v -> Record f right -> Record f ('N 'B left z v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
s1 f v
zv Record f right
s2) f v
v2 Record f right
right2)
fuseVariant1 :: forall (f :: q -> *).
Either
(Variant f ('N 'R left1 k1 v1 right1))
(Variant f ('N 'R left2 k2 v2 right2))
-> Variant
f (Fuse ('N 'R left1 k1 v1 right1) ('N 'R left2 k2 v2 right2))
fuseVariant1 Either
(Variant f ('N 'R left1 k1 v1 right1))
(Variant f ('N 'R left2 k2 v2 right2))
e =
case Either
(Variant f ('N 'R left1 k1 v1 right1))
(Variant f ('N 'R left2 k2 v2 right2))
e of
Left Variant f ('N 'R left1 k1 v1 right1)
l -> case Variant f ('N 'R left1 k1 v1 right1)
l of
LookLeft Variant f t
left1 -> Variant f t
-> Variant
f ('N 'R t k1 v1 ('N 'R ('N 'B s1 z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
left1
Here f v
v1 -> f v
-> Variant
f ('N 'R left1 k1 v ('N 'R ('N 'B s1 z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v1
LookRight Variant f t
right1 -> case forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @right1 @left2 (Variant f right1 -> Either (Variant f right1) (Variant f left2)
forall a b. a -> Either a b
Left Variant f right1
Variant f t
right1) of
LookLeft Variant f t
s1 -> Variant f ('N 'R ('N 'B t z zv s2) k2 v2 right2)
-> Variant
f ('N 'R left1 k1 v1 ('N 'R ('N 'B t z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f ('N 'B t z zv s2)
-> Variant f ('N 'R ('N 'B t z zv s2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B t z zv s2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
s1))
Here f v
zv -> Variant f ('N 'R ('N 'B s1 z v s2) k2 v2 right2)
-> Variant
f ('N 'R left1 k1 v1 ('N 'R ('N 'B s1 z v s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f ('N 'B s1 z v s2)
-> Variant f ('N 'R ('N 'B s1 z v s2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (f v -> Variant f ('N 'B s1 z v s2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
zv))
LookRight Variant f t
s2 -> Variant f ('N 'R ('N 'B s1 z zv t) k2 v2 right2)
-> Variant
f ('N 'R left1 k1 v1 ('N 'R ('N 'B s1 z zv t) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f ('N 'B s1 z zv t)
-> Variant f ('N 'R ('N 'B s1 z zv t) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B s1 z zv t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
s2))
Right Variant f ('N 'R left2 k2 v2 right2)
r -> case Variant f ('N 'R left2 k2 v2 right2)
r of
LookLeft Variant f t
left2 -> case forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @right1 @left2 (Variant f left2 -> Either (Variant f right1) (Variant f left2)
forall a b. b -> Either a b
Right Variant f left2
Variant f t
left2) of
LookLeft Variant f t
s1 -> Variant f ('N 'R ('N 'B t z zv s2) k2 v2 right2)
-> Variant
f ('N 'R left1 k1 v1 ('N 'R ('N 'B t z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f ('N 'B t z zv s2)
-> Variant f ('N 'R ('N 'B t z zv s2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B t z zv s2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
s1))
Here f v
zv -> Variant f ('N 'R ('N 'B s1 z v s2) k2 v2 right2)
-> Variant
f ('N 'R left1 k1 v1 ('N 'R ('N 'B s1 z v s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f ('N 'B s1 z v s2)
-> Variant f ('N 'R ('N 'B s1 z v s2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (f v -> Variant f ('N 'B s1 z v s2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
zv))
LookRight Variant f t
s2 -> Variant f ('N 'R ('N 'B s1 z zv t) k2 v2 right2)
-> Variant
f ('N 'R left1 k1 v1 ('N 'R ('N 'B s1 z zv t) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f ('N 'B s1 z zv t)
-> Variant f ('N 'R ('N 'B s1 z zv t) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B s1 z zv t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
s2))
Here f v
v2 -> Variant f ('N 'R ('N 'B s1 z zv s2) k2 v right2)
-> Variant
f ('N 'R left1 k1 v1 ('N 'R ('N 'B s1 z zv s2) k2 v right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (f v -> Variant f ('N 'R ('N 'B s1 z zv s2) k2 v right2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v2)
LookRight Variant f t
right2 -> Variant f ('N 'R ('N 'B s1 z zv s2) k2 v2 t)
-> Variant f ('N 'R left1 k1 v1 ('N 'R ('N 'B s1 z zv s2) k2 v2 t))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'R ('N 'B s1 z zv s2) k2 v2 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
right2)
instance FuseableHelper1 E (N R left1 k1 v1 E) (N R E k2 v2 right2) where
type Fuse1 E (N R left1 k1 v1 E) (N R E k2 v2 right2) = N R left1 k1 v1 (N R E k2 v2 right2)
fuseRecord1 :: forall (f :: q -> *).
Record f ('N 'R left1 k1 v1 'E)
-> Record f ('N 'R 'E k2 v2 right2)
-> Record f (Fuse ('N 'R left1 k1 v1 'E) ('N 'R 'E k2 v2 right2))
fuseRecord1 (Node Record f left
left1 f v
v1 Record f right
right1) (Node Record f left
left2 f v
v2 Record f right
right2) = Record f left
-> f v
-> Record f ('N 'R 'E k2 v right)
-> Record f ('N 'R left k1 v ('N 'R 'E k2 v right))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left1 f v
v1 (Record f 'E
-> f v -> Record f right -> Record f ('N 'R 'E k2 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f 'E
forall {q} (f :: q -> *). Record f 'E
Empty f v
v2 Record f right
right2)
fuseVariant1 :: forall (f :: q -> *).
Either
(Variant f ('N 'R left1 k1 v1 'E))
(Variant f ('N 'R 'E k2 v2 right2))
-> Variant f (Fuse ('N 'R left1 k1 v1 'E) ('N 'R 'E k2 v2 right2))
fuseVariant1 Either
(Variant f ('N 'R left1 k1 v1 'E))
(Variant f ('N 'R 'E k2 v2 right2))
e =
case Either
(Variant f ('N 'R left1 k1 v1 'E))
(Variant f ('N 'R 'E k2 v2 right2))
e of
Left Variant f ('N 'R left1 k1 v1 'E)
l -> case Variant f ('N 'R left1 k1 v1 'E)
l of
LookLeft Variant f t
left1 -> Variant f t -> Variant f ('N 'R t k1 v1 ('N 'R 'E k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
left1
Here f v
v1 -> f v -> Variant f ('N 'R left1 k1 v ('N 'R 'E k2 v2 right2))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v1
Right Variant f ('N 'R 'E k2 v2 right2)
r -> case Variant f ('N 'R 'E k2 v2 right2)
r of
Here f v
v2 -> Variant f ('N 'R 'E k2 v right2)
-> Variant f ('N 'R left1 k1 v1 ('N 'R 'E k2 v right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (f v -> Variant f ('N 'R 'E k2 v right2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v2)
LookRight Variant f t
right2 -> Variant f ('N 'R 'E k2 v2 t)
-> Variant f ('N 'R left1 k1 v1 ('N 'R 'E k2 v2 t))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'R 'E k2 v2 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
right2)
instance (Fuseable right1 left2, Fuse right1 left2 ~ fused, FuseableHelper2 fused (N B left1 k1 v1 right1) (N B left2 k2 v2 right2))
=> Fuseable (N B left1 k1 v1 right1) (N B left2 k2 v2 right2) where
type Fuse (N B left1 k1 v1 right1) (N B left2 k2 v2 right2) = Fuse2 (Fuse right1 left2) (N B left1 k1 v1 right1) (N B left2 k2 v2 right2)
fuseRecord :: forall (f :: q -> *).
Record f ('N 'B left1 k1 v1 right1)
-> Record f ('N 'B left2 k2 v2 right2)
-> Record
f (Fuse ('N 'B left1 k1 v1 right1) ('N 'B left2 k2 v2 right2))
fuseRecord = forall q (fused :: Map Symbol q) (l :: Map Symbol q)
(r :: Map Symbol q) (f :: q -> *).
FuseableHelper2 fused l r =>
Record f l -> Record f r -> Record f (Fuse l r)
fuseRecord2 @_ @(Fuse right1 left2)
fuseVariant :: forall (f :: q -> *).
Either
(Variant f ('N 'B left1 k1 v1 right1))
(Variant f ('N 'B left2 k2 v2 right2))
-> Variant
f (Fuse ('N 'B left1 k1 v1 right1) ('N 'B left2 k2 v2 right2))
fuseVariant = forall q (fused :: Map Symbol q) (l :: Map Symbol q)
(r :: Map Symbol q) (f :: q -> *).
FuseableHelper2 fused l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant2 @_ @(Fuse right1 left2)
class FuseableHelper2 (fused :: Map Symbol q) (l :: Map Symbol q) (r :: Map Symbol q) where
type Fuse2 fused l r :: Map Symbol q
fuseRecord2 :: Record f l -> Record f r -> Record f (Fuse l r)
fuseVariant2 :: Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
instance (Fuseable right1 left2, Fuse right1 left2 ~ N R s1 z zv s2)
=> FuseableHelper2 (N R s1 z zv s2) (N B left1 k1 v1 right1) (N B left2 k2 v2 right2) where
type Fuse2 (N R s1 z zv s2) (N B left1 k1 v1 right1) (N B left2 k2 v2 right2) = N R (N B left1 k1 v1 s1) z zv (N B s2 k2 v2 right2)
fuseRecord2 :: forall (f :: q -> *).
Record f ('N 'B left1 k1 v1 right1)
-> Record f ('N 'B left2 k2 v2 right2)
-> Record
f (Fuse ('N 'B left1 k1 v1 right1) ('N 'B left2 k2 v2 right2))
fuseRecord2 (Node Record f left
left1 f v
v1 Record f right
right1) (Node Record f left
left2 f v
v2 Record f right
right2) =
case Record f right -> Record f left -> Record f (Fuse right left)
forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Record f l -> Record f r -> Record f (Fuse l r)
forall (f :: q -> *).
Record f right -> Record f left -> Record f (Fuse right left)
fuseRecord Record f right
right1 Record f left
left2 of
Node Record f left
s1 f v
zv Record f right
s2 -> Record f ('N 'B left k1 v left)
-> f v
-> Record f ('N 'B right k2 v right)
-> Record
f ('N 'R ('N 'B left k1 v left) z v ('N 'B right k2 v right))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f left
-> f v -> Record f left -> Record f ('N 'B left k1 v left)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left1 f v
v1 Record f left
s1) f v
zv (Record f right
-> f v -> Record f right -> Record f ('N 'B right k2 v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f right
s2 f v
v2 Record f right
right2)
fuseVariant2 :: forall (f :: q -> *).
Either
(Variant f ('N 'B left1 k1 v1 right1))
(Variant f ('N 'B left2 k2 v2 right2))
-> Variant
f (Fuse ('N 'B left1 k1 v1 right1) ('N 'B left2 k2 v2 right2))
fuseVariant2 Either
(Variant f ('N 'B left1 k1 v1 right1))
(Variant f ('N 'B left2 k2 v2 right2))
e =
case Either
(Variant f ('N 'B left1 k1 v1 right1))
(Variant f ('N 'B left2 k2 v2 right2))
e of
Left Variant f ('N 'B left1 k1 v1 right1)
l -> case Variant f ('N 'B left1 k1 v1 right1)
l of
LookLeft Variant f t
left1 -> Variant f ('N 'B t k1 v1 s1)
-> Variant
f ('N 'R ('N 'B t k1 v1 s1) z zv ('N 'B s2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B t k1 v1 s1)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
left1)
Here f v
v1 -> Variant f ('N 'B left1 k1 v s1)
-> Variant
f ('N 'R ('N 'B left1 k1 v s1) z zv ('N 'B s2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (f v -> Variant f ('N 'B left1 k1 v s1)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v1)
LookRight Variant f t
right1 -> case forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @right1 @left2 (Variant f right1 -> Either (Variant f right1) (Variant f left2)
forall a b. a -> Either a b
Left Variant f right1
Variant f t
right1) of
LookLeft Variant f t
s1 -> Variant f ('N 'B left1 k1 v1 t)
-> Variant
f ('N 'R ('N 'B left1 k1 v1 t) z zv ('N 'B s2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B left1 k1 v1 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
s1)
Here f v
zv -> f v
-> Variant
f ('N 'R ('N 'B left1 k1 v1 s1) z v ('N 'B s2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
zv
LookRight Variant f t
s2 -> Variant f ('N 'B t k2 v2 right2)
-> Variant
f ('N 'R ('N 'B left1 k1 v1 s1) z zv ('N 'B t k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'B t k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
s2)
Right Variant f ('N 'B left2 k2 v2 right2)
r -> case Variant f ('N 'B left2 k2 v2 right2)
r of
LookLeft Variant f t
left2 -> case forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @right1 @left2 (Variant f left2 -> Either (Variant f right1) (Variant f left2)
forall a b. b -> Either a b
Right Variant f left2
Variant f t
left2) of
LookLeft Variant f t
s1 -> Variant f ('N 'B left1 k1 v1 t)
-> Variant
f ('N 'R ('N 'B left1 k1 v1 t) z zv ('N 'B s2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f t -> Variant f ('N 'B left1 k1 v1 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
s1)
Here f v
zv -> f v
-> Variant
f ('N 'R ('N 'B left1 k1 v1 s1) z v ('N 'B s2 k2 v2 right2))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
zv
LookRight Variant f t
s2 -> Variant f ('N 'B t k2 v2 right2)
-> Variant
f ('N 'R ('N 'B left1 k1 v1 s1) z zv ('N 'B t k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'B t k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
s2)
Here f v
v2 -> Variant f ('N 'B s2 k2 v right2)
-> Variant
f ('N 'R ('N 'B left1 k1 v1 s1) z zv ('N 'B s2 k2 v right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (f v -> Variant f ('N 'B s2 k2 v right2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
v2)
LookRight Variant f t
right2 -> Variant f ('N 'B s2 k2 v2 t)
-> Variant f ('N 'R ('N 'B left1 k1 v1 s1) z zv ('N 'B s2 k2 v2 t))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f t -> Variant f ('N 'B s2 k2 v2 t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
right2)
instance (Fuseable right1 left2, Fuse right1 left2 ~ N B s1 z zv s2, BalanceableL left1 k1 v1 (N B (N B s1 z zv s2) k2 v2 right2))
=> FuseableHelper2 (N B s1 z zv s2) (N B left1 k1 v1 right1) (N B left2 k2 v2 right2) where
type Fuse2 (N B s1 z zv s2) (N B left1 k1 v1 right1) (N B left2 k2 v2 right2) = BalL left1 k1 v1 (N B (N B s1 z zv s2) k2 v2 right2)
fuseRecord2 :: forall (f :: q -> *).
Record f ('N 'B left1 k1 v1 right1)
-> Record f ('N 'B left2 k2 v2 right2)
-> Record
f (Fuse ('N 'B left1 k1 v1 right1) ('N 'B left2 k2 v2 right2))
fuseRecord2 (Node Record f left
left1 f v
v1 Record f right
right1) (Node Record f left
left2 f v
v2 Record f right
right2) =
case forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Record f l -> Record f r -> Record f (Fuse l r)
fuseRecord @_ @right1 @left2 Record f right1
Record f right
right1 Record f left2
Record f left
left2 of
Node Record f left
s1 f v
zv Record f right
s2 -> forall q (l :: Map Symbol q) (k :: Symbol) (v :: q)
(r :: Map Symbol q) (f :: q -> *) (color :: Color).
BalanceableL l k v r =>
Record f ('N color l k v r) -> Record f (BalL l k v r)
balLR @_ @left1 @k1 @v1 @(N B (N B s1 z zv s2) k2 v2 right2) (Record f left1
-> f v1
-> Record f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
-> Record
f ('N Any left1 k1 v1 ('N 'B ('N 'B s1 z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left1
Record f left
left1 f v1
f v
v1 (Record f ('N 'B s1 z zv s2)
-> f v2
-> Record f right2
-> Record f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (Record f s1 -> f zv -> Record f s2 -> Record f ('N 'B s1 z zv s2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f s1
Record f left
s1 f zv
f v
zv Record f s2
Record f right
s2) f v2
f v
v2 Record f right2
Record f right
right2))
fuseVariant2 :: forall (f :: q -> *).
Either
(Variant f ('N 'B left1 k1 v1 right1))
(Variant f ('N 'B left2 k2 v2 right2))
-> Variant
f (Fuse ('N 'B left1 k1 v1 right1) ('N 'B left2 k2 v2 right2))
fuseVariant2 Either
(Variant f ('N 'B left1 k1 v1 right1))
(Variant f ('N 'B left2 k2 v2 right2))
e = forall q (l :: Map Symbol q) (k :: Symbol) (v :: q)
(r :: Map Symbol q) (f :: q -> *) (color :: Color).
BalanceableL l k v r =>
Variant f ('N color l k v r) -> Variant f (BalL l k v r)
balLV @_ @left1 @k1 @v1 @(N B (N B s1 z zv s2) k2 v2 right2) (case Either
(Variant f ('N 'B left1 k1 v1 right1))
(Variant f ('N 'B left2 k2 v2 right2))
e of
Left Variant f ('N 'B left1 k1 v1 right1)
l -> case Variant f ('N 'B left1 k1 v1 right1)
l of
LookLeft Variant f t
left1 -> Variant f left1
-> Variant
f ('N Any left1 k1 v1 ('N 'B ('N 'B s1 z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f left1
Variant f t
left1
Here f v
v1 -> f v1
-> Variant
f ('N Any left1 k1 v1 ('N 'B ('N 'B s1 z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v1
f v
v1
LookRight Variant f t
right1 -> case forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @right1 @left2 (Variant f right1 -> Either (Variant f right1) (Variant f left2)
forall a b. a -> Either a b
Left Variant f right1
Variant f t
right1) of
LookLeft Variant f t
s1 -> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
-> Variant
f ('N Any left1 k1 v1 ('N 'B ('N 'B s1 z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f ('N 'B s1 z zv s2)
-> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f s1 -> Variant f ('N 'B s1 z zv s2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f s1
Variant f t
s1))
Here f v
zv -> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
-> Variant
f ('N Any left1 k1 v1 ('N 'B ('N 'B s1 z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f ('N 'B s1 z zv s2)
-> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (f zv -> Variant f ('N 'B s1 z zv s2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f zv
f v
zv))
LookRight Variant f t
s2 -> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
-> Variant
f ('N Any left1 k1 v1 ('N 'B ('N 'B s1 z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f ('N 'B s1 z zv s2)
-> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f s2 -> Variant f ('N 'B s1 z zv s2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f s2
Variant f t
s2))
Right Variant f ('N 'B left2 k2 v2 right2)
r -> case Variant f ('N 'B left2 k2 v2 right2)
r of
LookLeft Variant f t
left2 -> case forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @right1 @left2 (Variant f left2 -> Either (Variant f right1) (Variant f left2)
forall a b. b -> Either a b
Right Variant f left2
Variant f t
left2) of
LookLeft Variant f t
s1 -> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
-> Variant
f ('N Any left1 k1 v1 ('N 'B ('N 'B s1 z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f ('N 'B s1 z zv s2)
-> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f s1 -> Variant f ('N 'B s1 z zv s2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f s1
Variant f t
s1))
Here f v
zv -> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
-> Variant
f ('N Any left1 k1 v1 ('N 'B ('N 'B s1 z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f ('N 'B s1 z zv s2)
-> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (f zv -> Variant f ('N 'B s1 z zv s2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f zv
f v
zv))
LookRight Variant f t
s2 -> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
-> Variant
f ('N Any left1 k1 v1 ('N 'B ('N 'B s1 z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f ('N 'B s1 z zv s2)
-> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (Variant f s2 -> Variant f ('N 'B s1 z zv s2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f s2
Variant f t
s2))
Here f v
v2 -> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
-> Variant
f ('N Any left1 k1 v1 ('N 'B ('N 'B s1 z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (f v2 -> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v2
f v
v2)
LookRight Variant f t
right2 -> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
-> Variant
f ('N Any left1 k1 v1 ('N 'B ('N 'B s1 z zv s2) k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f right2
-> Variant f ('N 'B ('N 'B s1 z zv s2) k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f right2
Variant f t
right2))
instance (BalanceableL left1 k1 v1 (N B E k2 v2 right2))
=> FuseableHelper2 E (N B left1 k1 v1 E) (N B E k2 v2 right2) where
type Fuse2 E (N B left1 k1 v1 E) (N B E k2 v2 right2) = BalL left1 k1 v1 (N B E k2 v2 right2)
fuseRecord2 :: forall (f :: q -> *).
Record f ('N 'B left1 k1 v1 'E)
-> Record f ('N 'B 'E k2 v2 right2)
-> Record f (Fuse ('N 'B left1 k1 v1 'E) ('N 'B 'E k2 v2 right2))
fuseRecord2 (Node Record f left
left1 f v
v1 Record f right
right1) (Node Record f left
left2 f v
v2 Record f right
right2) =
forall q (l :: Map Symbol q) (k :: Symbol) (v :: q)
(r :: Map Symbol q) (f :: q -> *) (color :: Color).
BalanceableL l k v r =>
Record f ('N color l k v r) -> Record f (BalL l k v r)
balLR @_ @left1 @k1 @v1 @(N B E k2 v2 right2) (Record f left1
-> f v1
-> Record f ('N 'B 'E k2 v2 right2)
-> Record f ('N Any left1 k1 v1 ('N 'B 'E k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left1
Record f left
left1 f v1
f v
v1 (Record f 'E
-> f v2 -> Record f right2 -> Record f ('N 'B 'E k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f 'E
forall {q} (f :: q -> *). Record f 'E
Empty f v2
f v
v2 Record f right2
Record f right
right2))
fuseVariant2 :: forall (f :: q -> *).
Either
(Variant f ('N 'B left1 k1 v1 'E))
(Variant f ('N 'B 'E k2 v2 right2))
-> Variant f (Fuse ('N 'B left1 k1 v1 'E) ('N 'B 'E k2 v2 right2))
fuseVariant2 Either
(Variant f ('N 'B left1 k1 v1 'E))
(Variant f ('N 'B 'E k2 v2 right2))
e = forall q (l :: Map Symbol q) (k :: Symbol) (v :: q)
(r :: Map Symbol q) (f :: q -> *) (color :: Color).
BalanceableL l k v r =>
Variant f ('N color l k v r) -> Variant f (BalL l k v r)
balLV @_ @left1 @k1 @v1 @(N B E k2 v2 right2) (case Either
(Variant f ('N 'B left1 k1 v1 'E))
(Variant f ('N 'B 'E k2 v2 right2))
e of
Left Variant f ('N 'B left1 k1 v1 'E)
l -> case Variant f ('N 'B left1 k1 v1 'E)
l of
LookLeft Variant f t
left1 -> Variant f left1
-> Variant f ('N Any left1 k1 v1 ('N 'B 'E k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f left1
Variant f t
left1
Here f v
v1 -> f v1 -> Variant f ('N Any left1 k1 v1 ('N 'B 'E k2 v2 right2))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v1
f v
v1
Right Variant f ('N 'B 'E k2 v2 right2)
r -> case Variant f ('N 'B 'E k2 v2 right2)
r of
Here f v
v2 -> Variant f ('N 'B 'E k2 v2 right2)
-> Variant f ('N Any left1 k1 v1 ('N 'B 'E k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (f v2 -> Variant f ('N 'B 'E k2 v2 right2)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v2
f v
v2)
LookRight Variant f t
right2 -> Variant f ('N 'B 'E k2 v2 right2)
-> Variant f ('N Any left1 k1 v1 ('N 'B 'E k2 v2 right2))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (Variant f right2 -> Variant f ('N 'B 'E k2 v2 right2)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f right2
Variant f t
right2))
type Delable :: Symbol -> q -> Map Symbol q -> Constraint
class Delable (k :: Symbol) (v :: q) (t :: Map Symbol q) where
type Del k v t :: Map Symbol q
del :: Record f t -> Record f (Del k v t)
win :: Variant f t -> Either (Variant f (Del k v t)) (f v)
class DelableL (k :: Symbol) (v :: q) (l :: Map Symbol q) (kx :: Symbol) (vx :: q) (r :: Map Symbol q) where
type DelL k v l kx vx r :: Map Symbol q
delL :: Record f (N color l kx vx r) -> Record f (DelL k v l kx vx r)
winL :: Variant f (N color l kx vx r) -> Either (Variant f (DelL k v l kx vx r)) (f v)
instance (N B leftz kz vz rightz ~ g, Delable k v g, Del k v g ~ deleted, BalanceableL deleted kx vx right)
=> DelableL k v (N B leftz kz vz rightz) kx vx right where
type DelL k v (N B leftz kz vz rightz) kx vx right = BalL (Del k v (N B leftz kz vz rightz)) kx vx right
delL :: forall (f :: q -> *) (color :: Color).
Record f ('N color ('N 'B leftz kz vz rightz) kx vx right)
-> Record f (DelL k v ('N 'B leftz kz vz rightz) kx vx right)
delL (Node Record f left
left f v
vx Record f right
right) = forall q (l :: Map Symbol q) (k :: Symbol) (v :: q)
(r :: Map Symbol q) (f :: q -> *) (color :: Color).
BalanceableL l k v r =>
Record f ('N color l k v r) -> Record f (BalL l k v r)
balLR @_ @(Del k v (N B leftz kz vz rightz)) @kx @vx @right (Record f deleted
-> f vx -> Record f right -> Record f ('N Any deleted kx vx right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Delable k v t =>
Record f t -> Record f (Del k v t)
del @_ @k @v Record f left
left) f vx
f v
vx Record f right
Record f right
right)
winL :: forall (f :: q -> *) (color :: Color).
Variant f ('N color ('N 'B leftz kz vz rightz) kx vx right)
-> Either
(Variant f (DelL k v ('N 'B leftz kz vz rightz) kx vx right)) (f v)
winL Variant f ('N color ('N 'B leftz kz vz rightz) kx vx right)
v = (Variant f ('N Any deleted kx vx right)
-> Variant
f (BalL' (DiscriminateBalL deleted right) deleted kx vx right))
-> Either (Variant f ('N Any deleted kx vx right)) (f v)
-> Either
(Variant
f (BalL' (DiscriminateBalL deleted right) deleted kx vx right))
(f v)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall q (l :: Map Symbol q) (k :: Symbol) (v :: q)
(r :: Map Symbol q) (f :: q -> *) (color :: Color).
BalanceableL l k v r =>
Variant f ('N color l k v r) -> Variant f (BalL l k v r)
balLV @_ @(Del k v (N B leftz kz vz rightz)) @kx @vx @right) (case Variant f ('N color ('N 'B leftz kz vz rightz) kx vx right)
v of
LookLeft Variant f t
l -> (Variant f deleted -> Variant f ('N Any deleted kx vx right))
-> Either (Variant f deleted) (f v)
-> Either (Variant f ('N Any deleted kx vx right)) (f v)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Variant f deleted -> Variant f ('N Any deleted kx vx right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Delable k v t =>
Variant f t -> Either (Variant f (Del k v t)) (f v)
win @_ @k @v Variant f t
l)
Here f v
vx -> Variant f ('N Any deleted kx vx right)
-> Either (Variant f ('N Any deleted kx vx right)) (f v)
forall a b. a -> Either a b
Left (Variant f ('N Any deleted kx vx right)
-> Either (Variant f ('N Any deleted kx vx right)) (f v))
-> Variant f ('N Any deleted kx vx right)
-> Either (Variant f ('N Any deleted kx vx right)) (f v)
forall a b. (a -> b) -> a -> b
$ f v -> Variant f ('N Any deleted kx v right)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
vx
LookRight Variant f t
r -> Variant f ('N Any deleted kx vx right)
-> Either (Variant f ('N Any deleted kx vx right)) (f v)
forall a b. a -> Either a b
Left (Variant f ('N Any deleted kx vx right)
-> Either (Variant f ('N Any deleted kx vx right)) (f v))
-> Variant f ('N Any deleted kx vx right)
-> Either (Variant f ('N Any deleted kx vx right)) (f v)
forall a b. (a -> b) -> a -> b
$ Variant f t -> Variant f ('N Any deleted kx vx t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
r)
instance (Delable k v (N R leftz kz vz rightz))
=> DelableL k v (N R leftz kz vz rightz) kx vx right where
type DelL k v (N R leftz kz vz rightz) kx vx right = N R (Del k v (N R leftz kz vz rightz)) kx vx right
delL :: forall (f :: q -> *) (color :: Color).
Record f ('N color ('N 'R leftz kz vz rightz) kx vx right)
-> Record f (DelL k v ('N 'R leftz kz vz rightz) kx vx right)
delL (Node Record f left
left f v
vx Record f right
right) = Record f (Del' (CmpSymbol kz k) k v leftz kz vz rightz)
-> f v
-> Record f right
-> Record
f ('N 'R (Del' (CmpSymbol kz k) k v leftz kz vz rightz) kx v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Delable k v t =>
Record f t -> Record f (Del k v t)
del @_ @k @v Record f left
left) f v
vx Record f right
right
winL :: forall (f :: q -> *) (color :: Color).
Variant f ('N color ('N 'R leftz kz vz rightz) kx vx right)
-> Either
(Variant f (DelL k v ('N 'R leftz kz vz rightz) kx vx right)) (f v)
winL Variant f ('N color ('N 'R leftz kz vz rightz) kx vx right)
v = case Variant f ('N color ('N 'R leftz kz vz rightz) kx vx right)
v of
LookLeft Variant f t
l -> (Variant f (Del' (CmpSymbol kz k) k v leftz kz vz rightz)
-> Variant
f
('N 'R (Del' (CmpSymbol kz k) k v leftz kz vz rightz) kx vx right))
-> Either
(Variant f (Del' (CmpSymbol kz k) k v leftz kz vz rightz)) (f v)
-> Either
(Variant
f
('N 'R (Del' (CmpSymbol kz k) k v leftz kz vz rightz) kx vx right))
(f v)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Variant f (Del' (CmpSymbol kz k) k v leftz kz vz rightz)
-> Variant
f
('N 'R (Del' (CmpSymbol kz k) k v leftz kz vz rightz) kx vx right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Delable k v t =>
Variant f t -> Either (Variant f (Del k v t)) (f v)
win @_ @k @v Variant f t
l)
Here f v
vx -> Variant
f ('N 'R (Del' (CmpSymbol kz k) k v leftz kz vz rightz) kx v right)
-> Either
(Variant
f
('N 'R (Del' (CmpSymbol kz k) k v leftz kz vz rightz) kx v right))
(f v)
forall a b. a -> Either a b
Left (f v
-> Variant
f ('N 'R (Del' (CmpSymbol kz k) k v leftz kz vz rightz) kx v right)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
vx)
LookRight Variant f t
r -> Variant
f ('N 'R (Del' (CmpSymbol kz k) k v leftz kz vz rightz) kx vx t)
-> Either
(Variant
f ('N 'R (Del' (CmpSymbol kz k) k v leftz kz vz rightz) kx vx t))
(f v)
forall a b. a -> Either a b
Left (Variant f t
-> Variant
f ('N 'R (Del' (CmpSymbol kz k) k v leftz kz vz rightz) kx vx t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
r)
instance DelableL k v E kx vx right where
type DelL k v E kx vx right = N R E kx vx right
delL :: forall (f :: q -> *) (color :: Color).
Record f ('N color 'E kx vx right)
-> Record f (DelL k v 'E kx vx right)
delL (Node Record f left
left f v
vx Record f right
right) = Record f 'E
-> f v -> Record f right -> Record f ('N 'R 'E kx v right)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f 'E
forall {q} (f :: q -> *). Record f 'E
Empty f v
vx Record f right
right
winL :: forall (f :: q -> *) (color :: Color).
Variant f ('N color 'E kx vx right)
-> Either (Variant f (DelL k v 'E kx vx right)) (f v)
winL Variant f ('N color 'E kx vx right)
v = case Variant f ('N color 'E kx vx right)
v of
Here f v
vx -> Variant f ('N 'R 'E kx v right)
-> Either (Variant f ('N 'R 'E kx v right)) (f v)
forall a b. a -> Either a b
Left (f v -> Variant f ('N 'R 'E kx v right)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
vx)
LookRight Variant f t
r -> Variant f ('N 'R 'E kx vx t)
-> Either (Variant f ('N 'R 'E kx vx t)) (f v)
forall a b. a -> Either a b
Left (Variant f t -> Variant f ('N 'R 'E kx vx t)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight Variant f t
r)
class DelableR (k :: Symbol) (v :: q) (l :: Map Symbol q) (kx :: Symbol) (vx :: q) (r :: Map Symbol q) where
type DelR k v l kx vx r :: Map Symbol q
delR :: Record f (N color l kx vx r) -> Record f (DelR k v l kx vx r)
winR :: Variant f (N color l kx vx r) -> Either (Variant f (DelR k v l kx vx r)) (f v)
instance (N B leftz kz vz rightz ~ g, Delable k v g, Del k v g ~ deleted, BalanceableR left kx vx deleted)
=> DelableR k v left kx vx (N B leftz kz vz rightz) where
type DelR k v left kx vx (N B leftz kz vz rightz) = BalR left kx vx (Del k v (N B leftz kz vz rightz))
delR :: forall (f :: q -> *) (color :: Color).
Record f ('N color left kx vx ('N 'B leftz kz vz rightz))
-> Record f (DelR k v left kx vx ('N 'B leftz kz vz rightz))
delR (Node Record f left
left f v
vx Record f right
right) = forall q (l :: Map Symbol q) (k :: Symbol) (v :: q)
(r :: Map Symbol q) (f :: q -> *) (color :: Color).
BalanceableR l k v r =>
Record f ('N color l k v r) -> Record f (BalR l k v r)
balRR @_ @left @kx @vx @(Del k v (N B leftz kz vz rightz)) (Record f left
-> f vx -> Record f deleted -> Record f ('N Any left kx vx deleted)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
Record f left
left f vx
f v
vx (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Delable k v t =>
Record f t -> Record f (Del k v t)
del @_ @k @v Record f right
right))
winR :: forall (f :: q -> *) (color :: Color).
Variant f ('N color left kx vx ('N 'B leftz kz vz rightz))
-> Either
(Variant f (DelR k v left kx vx ('N 'B leftz kz vz rightz))) (f v)
winR Variant f ('N color left kx vx ('N 'B leftz kz vz rightz))
v = (Variant f ('N Any left kx vx deleted)
-> Variant
f (BalR' (DiscriminateBalR left deleted) left kx vx deleted))
-> Either (Variant f ('N Any left kx vx deleted)) (f v)
-> Either
(Variant
f (BalR' (DiscriminateBalR left deleted) left kx vx deleted))
(f v)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall q (l :: Map Symbol q) (k :: Symbol) (v :: q)
(r :: Map Symbol q) (f :: q -> *) (color :: Color).
BalanceableR l k v r =>
Variant f ('N color l k v r) -> Variant f (BalR l k v r)
balRV @_ @left @kx @vx @(Del k v (N B leftz kz vz rightz))) (case Variant f ('N color left kx vx ('N 'B leftz kz vz rightz))
v of
LookLeft Variant f t
l -> Variant f ('N Any left kx vx deleted)
-> Either (Variant f ('N Any left kx vx deleted)) (f v)
forall a b. a -> Either a b
Left (Variant f ('N Any left kx vx deleted)
-> Either (Variant f ('N Any left kx vx deleted)) (f v))
-> Variant f ('N Any left kx vx deleted)
-> Either (Variant f ('N Any left kx vx deleted)) (f v)
forall a b. (a -> b) -> a -> b
$ Variant f t -> Variant f ('N Any t kx vx deleted)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
l
Here f v
vx -> Variant f ('N Any left kx vx deleted)
-> Either (Variant f ('N Any left kx vx deleted)) (f v)
forall a b. a -> Either a b
Left (Variant f ('N Any left kx vx deleted)
-> Either (Variant f ('N Any left kx vx deleted)) (f v))
-> Variant f ('N Any left kx vx deleted)
-> Either (Variant f ('N Any left kx vx deleted)) (f v)
forall a b. (a -> b) -> a -> b
$ f v -> Variant f ('N Any left kx v deleted)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
vx
LookRight Variant f t
r -> (Variant f deleted -> Variant f ('N Any left kx vx deleted))
-> Either (Variant f deleted) (f v)
-> Either (Variant f ('N Any left kx vx deleted)) (f v)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Variant f deleted -> Variant f ('N Any left kx vx deleted)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Delable k v t =>
Variant f t -> Either (Variant f (Del k v t)) (f v)
win @_ @k @v Variant f t
r))
instance (Delable k v (N R leftz kz vz rightz))
=> DelableR k v left kx vx (N R leftz kz vz rightz) where
type DelR k v left kx vx (N R leftz kz vz rightz) = N R left kx vx (Del k v (N R leftz kz vz rightz))
delR :: forall (f :: q -> *) (color :: Color).
Record f ('N color left kx vx ('N 'R leftz kz vz rightz))
-> Record f (DelR k v left kx vx ('N 'R leftz kz vz rightz))
delR (Node Record f left
left f v
vx Record f right
right) = Record f left
-> f v
-> Record f (Del' (CmpSymbol kz k) k v leftz kz vz rightz)
-> Record
f ('N 'R left kx v (Del' (CmpSymbol kz k) k v leftz kz vz rightz))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left f v
vx (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Delable k v t =>
Record f t -> Record f (Del k v t)
del @_ @k @v Record f right
right)
winR :: forall (f :: q -> *) (color :: Color).
Variant f ('N color left kx vx ('N 'R leftz kz vz rightz))
-> Either
(Variant f (DelR k v left kx vx ('N 'R leftz kz vz rightz))) (f v)
winR Variant f ('N color left kx vx ('N 'R leftz kz vz rightz))
v = case Variant f ('N color left kx vx ('N 'R leftz kz vz rightz))
v of
LookLeft Variant f t
l -> Variant
f ('N 'R t kx vx (Del' (CmpSymbol kz k) k v leftz kz vz rightz))
-> Either
(Variant
f ('N 'R t kx vx (Del' (CmpSymbol kz k) k v leftz kz vz rightz)))
(f v)
forall a b. a -> Either a b
Left (Variant f t
-> Variant
f ('N 'R t kx vx (Del' (CmpSymbol kz k) k v leftz kz vz rightz))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
l)
Here f v
vx -> Variant
f ('N 'R left kx v (Del' (CmpSymbol kz k) k v leftz kz vz rightz))
-> Either
(Variant
f ('N 'R left kx v (Del' (CmpSymbol kz k) k v leftz kz vz rightz)))
(f v)
forall a b. a -> Either a b
Left (f v
-> Variant
f ('N 'R left kx v (Del' (CmpSymbol kz k) k v leftz kz vz rightz))
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
vx)
LookRight Variant f t
r -> (Variant f (Del' (CmpSymbol kz k) k v leftz kz vz rightz)
-> Variant
f
('N 'R left kx vx (Del' (CmpSymbol kz k) k v leftz kz vz rightz)))
-> Either
(Variant f (Del' (CmpSymbol kz k) k v leftz kz vz rightz)) (f v)
-> Either
(Variant
f
('N 'R left kx vx (Del' (CmpSymbol kz k) k v leftz kz vz rightz)))
(f v)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Variant f (Del' (CmpSymbol kz k) k v leftz kz vz rightz)
-> Variant
f ('N 'R left kx vx (Del' (CmpSymbol kz k) k v leftz kz vz rightz))
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: q).
Variant f t -> Variant f ('N color' left' k' v' t)
LookRight (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Delable k v t =>
Variant f t -> Either (Variant f (Del k v t)) (f v)
win @_ @k @v Variant f t
r)
instance DelableR k v left kx vx E where
type DelR k v left kx vx E = N R left kx vx E
delR :: forall (f :: q -> *) (color :: Color).
Record f ('N color left kx vx 'E)
-> Record f (DelR k v left kx vx 'E)
delR (Node Record f left
left f v
vx Record f right
right) = Record f left
-> f v -> Record f 'E -> Record f ('N 'R left kx v 'E)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: q)
(left' :: Map Symbol q) (k' :: Color) (v' :: Symbol).
Record f t
-> f color' -> Record f left' -> Record f ('N k' t v' color' left')
Node Record f left
left f v
vx Record f 'E
forall {q} (f :: q -> *). Record f 'E
Empty
winR :: forall (f :: q -> *) (color :: Color).
Variant f ('N color left kx vx 'E)
-> Either (Variant f (DelR k v left kx vx 'E)) (f v)
winR Variant f ('N color left kx vx 'E)
v = case Variant f ('N color left kx vx 'E)
v of
LookLeft Variant f t
l -> Variant f ('N 'R t kx vx 'E)
-> Either (Variant f ('N 'R t kx vx 'E)) (f v)
forall a b. a -> Either a b
Left (Variant f t -> Variant f ('N 'R t kx vx 'E)
forall {q} (f :: q -> *) (t :: Map Symbol q) (color' :: Color)
(left' :: Symbol) (k' :: q) (v' :: Map Symbol q).
Variant f t -> Variant f ('N color' t left' k' v')
LookLeft Variant f t
l)
Here f v
vx -> Variant f ('N 'R left kx v 'E)
-> Either (Variant f ('N 'R left kx v 'E)) (f v)
forall a b. a -> Either a b
Left (f v -> Variant f ('N 'R left kx v 'E)
forall {q} (f :: q -> *) (t :: q) (color' :: Color)
(left' :: Map Symbol q) (k' :: Symbol) (v' :: Map Symbol q).
f t -> Variant f ('N color' left' k' t v')
Here f v
vx)
instance Delable k v E where
type Del k v E = E
del :: forall (f :: q -> *). Record f 'E -> Record f (Del k v 'E)
del Record f 'E
_ = Record f (Del k v 'E)
Record f 'E
forall {q} (f :: q -> *). Record f 'E
unit
win :: forall (f :: q -> *).
Variant f 'E -> Either (Variant f (Del k v 'E)) (f v)
win = Variant f 'E -> Either (Variant f (Del k v 'E)) (f v)
Variant f 'E -> Either (Variant f 'E) (f v)
forall {q} (f :: q -> *) b. Variant f Empty -> b
impossible
instance (CmpSymbol kx k ~ ordering, DelableHelper ordering k v left kx vx right) => Delable k v (N color left kx vx right) where
type Del k v (N color left kx vx right) = Del' (CmpSymbol kx k) k v left kx vx right
del :: forall (f :: q -> *).
Record f ('N color left kx vx right)
-> Record f (Del k v ('N color left kx vx right))
del = forall q (ordering :: Ordering) (k :: Symbol) (v :: q)
(l :: Map Symbol q) (kx :: Symbol) (vx :: q) (r :: Map Symbol q)
(f :: q -> *) (color :: Color).
DelableHelper ordering k v l kx vx r =>
Record f ('N color l kx vx r)
-> Record f (Del' ordering k v l kx vx r)
del' @_ @(CmpSymbol kx k) @k @v @left @kx @vx @right
win :: forall (f :: q -> *).
Variant f ('N color left kx vx right)
-> Either (Variant f (Del k v ('N color left kx vx right))) (f v)
win = forall q (ordering :: Ordering) (k :: Symbol) (v :: q)
(l :: Map Symbol q) (kx :: Symbol) (vx :: q) (r :: Map Symbol q)
(f :: q -> *) (color :: Color).
DelableHelper ordering k v l kx vx r =>
Variant f ('N color l kx vx r)
-> Either (Variant f (Del' ordering k v l kx vx r)) (f v)
win' @_ @(CmpSymbol kx k) @k @v @left @kx @vx @right
class DelableHelper (ordering :: Ordering) (k :: Symbol) (v :: q) (l :: Map Symbol q) (kx :: Symbol) (vx :: q) (r :: Map Symbol q) where
type Del' ordering k v l kx vx r :: Map Symbol q
del' :: Record f (N color l kx vx r) -> Record f (Del' ordering k v l kx vx r)
win' :: Variant f (N color l kx vx r) -> Either (Variant f (Del' ordering k v l kx vx r)) (f v)
instance DelableL k v left kx vx right => DelableHelper GT k v left kx vx right where
type Del' GT k v left kx vx right = DelL k v left kx vx right
del' :: forall (f :: q -> *) (color :: Color).
Record f ('N color left kx vx right)
-> Record f (Del' 'GT k v left kx vx right)
del' = forall q (k :: Symbol) (v :: q) (l :: Map Symbol q) (kx :: Symbol)
(vx :: q) (r :: Map Symbol q) (f :: q -> *) (color :: Color).
DelableL k v l kx vx r =>
Record f ('N color l kx vx r) -> Record f (DelL k v l kx vx r)
delL @_ @k @v @left @kx @vx @right
win' :: forall (f :: q -> *) (color :: Color).
Variant f ('N color left kx vx right)
-> Either (Variant f (Del' 'GT k v left kx vx right)) (f v)
win' = forall q (k :: Symbol) (v :: q) (l :: Map Symbol q) (kx :: Symbol)
(vx :: q) (r :: Map Symbol q) (f :: q -> *) (color :: Color).
DelableL k v l kx vx r =>
Variant f ('N color l kx vx r)
-> Either (Variant f (DelL k v l kx vx r)) (f v)
winL @_ @k @v @left @kx @vx @right
instance Fuseable left right => DelableHelper EQ k v left k v right where
type Del' EQ k v left k v right = Fuse left right
del' :: forall (f :: q -> *) (color :: Color).
Record f ('N color left k v right)
-> Record f (Del' 'EQ k v left k v right)
del' (Node Record f left
left f v
_ Record f right
right) = forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Record f l -> Record f r -> Record f (Fuse l r)
fuseRecord @_ @left @right Record f left
Record f left
left Record f right
Record f right
right
win' :: forall (f :: q -> *) (color :: Color).
Variant f ('N color left k v right)
-> Either (Variant f (Del' 'EQ k v left k v right)) (f v)
win' Variant f ('N color left k v right)
v = case Variant f ('N color left k v right)
v of
LookLeft Variant f t
l -> Variant f (Del' 'EQ k v left k v right)
-> Either (Variant f (Del' 'EQ k v left k v right)) (f v)
forall a b. a -> Either a b
Left (Variant f (Del' 'EQ k v left k v right)
-> Either (Variant f (Del' 'EQ k v left k v right)) (f v))
-> Variant f (Del' 'EQ k v left k v right)
-> Either (Variant f (Del' 'EQ k v left k v right)) (f v)
forall a b. (a -> b) -> a -> b
$ forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @left @right (Variant f left -> Either (Variant f left) (Variant f right)
forall a b. a -> Either a b
Left Variant f left
Variant f t
l)
Here f v
v -> f v -> Either (Variant f (Fuse left right)) (f v)
forall a b. b -> Either a b
Right f v
f v
v
LookRight Variant f t
r -> Variant f (Del' 'EQ k v left k v right)
-> Either (Variant f (Del' 'EQ k v left k v right)) (f v)
forall a b. a -> Either a b
Left (Variant f (Del' 'EQ k v left k v right)
-> Either (Variant f (Del' 'EQ k v left k v right)) (f v))
-> Variant f (Del' 'EQ k v left k v right)
-> Either (Variant f (Del' 'EQ k v left k v right)) (f v)
forall a b. (a -> b) -> a -> b
$ forall q (l :: Map Symbol q) (r :: Map Symbol q) (f :: q -> *).
Fuseable l r =>
Either (Variant f l) (Variant f r) -> Variant f (Fuse l r)
fuseVariant @_ @left @right (Variant f right -> Either (Variant f left) (Variant f right)
forall a b. b -> Either a b
Right Variant f right
Variant f t
r)
instance DelableR k v left kx vx right => DelableHelper LT k v left kx vx right where
type Del' LT k v left kx vx right = DelR k v left kx vx right
del' :: forall (f :: q -> *) (color :: Color).
Record f ('N color left kx vx right)
-> Record f (Del' 'LT k v left kx vx right)
del' = forall q (k :: Symbol) (v :: q) (l :: Map Symbol q) (kx :: Symbol)
(vx :: q) (r :: Map Symbol q) (f :: q -> *) (color :: Color).
DelableR k v l kx vx r =>
Record f ('N color l kx vx r) -> Record f (DelR k v l kx vx r)
delR @_ @k @v @left @kx @vx @right
win' :: forall (f :: q -> *) (color :: Color).
Variant f ('N color left kx vx right)
-> Either (Variant f (Del' 'LT k v left kx vx right)) (f v)
win' = forall q (k :: Symbol) (v :: q) (l :: Map Symbol q) (kx :: Symbol)
(vx :: q) (r :: Map Symbol q) (f :: q -> *) (color :: Color).
DelableR k v l kx vx r =>
Variant f ('N color l kx vx r)
-> Either (Variant f (DelR k v l kx vx r)) (f v)
winR @_ @k @v @left @kx @vx @right
class Deletable (k :: Symbol) (v :: q) (t :: Map Symbol q) where
type Delete k v t :: Map Symbol q
_delete :: Record f t -> Record f (Delete k v t)
_winnow :: Variant f t -> Either (Variant f (Delete k v t)) (f v)
instance (Delable k v t, Del k v t ~ deleted, CanMakeBlack deleted) => Deletable k v t where
type Delete k v t = MakeBlack (Del k v t)
_delete :: forall (f :: q -> *). Record f t -> Record f (Delete k v t)
_delete Record f t
r = Record f deleted -> Record f (MakeBlack deleted)
forall q (t :: Map Symbol q) (f :: q -> *).
CanMakeBlack t =>
Record f t -> Record f (MakeBlack t)
forall (f :: q -> *).
Record f deleted -> Record f (MakeBlack deleted)
makeBlackR (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Delable k v t =>
Record f t -> Record f (Del k v t)
del @_ @k @v Record f t
r)
_winnow :: forall (f :: q -> *).
Variant f t -> Either (Variant f (Delete k v t)) (f v)
_winnow Variant f t
v = (Variant f deleted -> Variant f (MakeBlack deleted))
-> Either (Variant f deleted) (f v)
-> Either (Variant f (MakeBlack deleted)) (f v)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Variant f deleted -> Variant f (MakeBlack deleted)
forall q (t :: Map Symbol q) (f :: q -> *).
CanMakeBlack t =>
Variant f t -> Variant f (MakeBlack t)
forall (f :: q -> *).
Variant f deleted -> Variant f (MakeBlack deleted)
makeBlackV (forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Delable k v t =>
Variant f t -> Either (Variant f (Del k v t)) (f v)
win @_ @k @v Variant f t
v)
delete :: forall k v t f . Deletable k v t => Record f t -> Record f (Delete k v t)
delete :: forall {q} (k :: Symbol) (v :: q) (t :: Map Symbol q)
(f :: q -> *).
Deletable k v t =>
Record f t -> Record f (Delete k v t)
delete = forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Deletable k v t =>
Record f t -> Record f (Delete k v t)
_delete @_ @k @v @t
winnow :: forall k v t f . Deletable k v t => Variant f t -> Either (Variant f (Delete k v t)) (f v)
winnow :: forall {q} (k :: Symbol) (v :: q) (t :: Map Symbol q)
(f :: q -> *).
Deletable k v t =>
Variant f t -> Either (Variant f (Delete k v t)) (f v)
winnow = forall q (k :: Symbol) (v :: q) (t :: Map Symbol q) (f :: q -> *).
Deletable k v t =>
Variant f t -> Either (Variant f (Delete k v t)) (f v)
_winnow @_ @k @v @t
winnowI :: forall k v t . Deletable k v t => Variant I t -> Either (Variant I (Delete k v t)) v
winnowI :: forall (k :: Symbol) v (t :: Map Symbol (*)).
Deletable k v t =>
Variant I t -> Either (Variant I (Delete k v t)) v
winnowI = (I v -> v)
-> Either (Variant I (MakeBlack (Del k v t))) (I v)
-> Either (Variant I (MakeBlack (Del k v t))) v
forall a b.
(a -> b)
-> Either (Variant I (MakeBlack (Del k v t))) a
-> Either (Variant I (MakeBlack (Del k v t))) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap I v -> v
forall a. I a -> a
unI (Either (Variant I (MakeBlack (Del k v t))) (I v)
-> Either (Variant I (MakeBlack (Del k v t))) v)
-> (Variant I t
-> Either (Variant I (MakeBlack (Del k v t))) (I v))
-> Variant I t
-> Either (Variant I (MakeBlack (Del k v t))) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {q} (k :: Symbol) (v :: q) (t :: Map Symbol q)
(f :: q -> *).
Deletable k v t =>
Variant f t -> Either (Variant f (Delete k v t)) (f v)
forall (k :: Symbol) v (t :: Map Symbol (*)) (f :: * -> *).
Deletable k v t =>
Variant f t -> Either (Variant f (Delete k v t)) (f v)
winnow @k @v @t