red-black-record 2.0.2.0 → 2.0.2.1
raw patch · 4 files changed
+327/−267 lines, 4 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Data.RBR: type FromList (es :: [(Symbol, Type)]) = InsertAll es E
+ Data.RBR: type FromList (es :: [(Symbol, Type)]) = InsertAll es Empty
- Data.RBR.Internal: type FromList (es :: [(Symbol, Type)]) = InsertAll es E
+ Data.RBR.Internal: type FromList (es :: [(Symbol, Type)]) = InsertAll es Empty
Files
- README.md +196/−197
- lib/Data/RBR/Examples.hs +30/−0
- lib/Data/RBR/Internal.hs +100/−69
- red-black-record.cabal +1/−1
README.md view
@@ -1,197 +1,196 @@-red-black-record -================ - -What's this? ------------- - -A library that provides extensible records and variants, both indexed by a -type-level [red-black](https://en.wikipedia.org/wiki/Red%E2%80%93black_tree) -tree that maps `Symbol` keys to `Type`s. The keys correspond to fields names in -records, and to branch names in variants. Many record functions have their -variant mirror-images and viceversa. - -Each value type in a field or branch comes wrapped in a type constructor of -kind `Type -> Type`. Typically, it will be an [identity -functor](http://hackage.haskell.org/package/sop-core-0.4.0.0/docs/Data-SOP.html#t:I), -but it can also be `Maybe` or some other `Applicative` for parsing, validation -and so on. - -If we forget about the keys and only keep the values, records are isomorphic to -[n-ary unlabeled -products](http://hackage.haskell.org/package/sop-core-0.4.0.0/docs/Data-SOP.html#t:NP), -and variants are isomorphic to [n-ary unlabeled -sums](http://hackage.haskell.org/package/sop-core-0.4.0.0/docs/Data-SOP.html#t:NS). -The [sop-core](http://hackage.haskell.org/package/sop-core) library provides -such unlabeled types, along with a rich API for manipulating them. Instead of -reinventing the wheel, red-black-record defines conversion functions to -facilitate working in the "unlabeled" world and then coming back to records and -variants. - -There is another world towards which bridges must be built: the everyday -Haskell world of conventional records and sums. In fact, one of the motivations -of extensible records and variants is to serve as "generalized" versions of -vanilla data types. Advanced use cases can rely on these generalized versions, -thereby avoiding intrusive changes to the original types. red-black-record -provides conversion typeclasses with default implementations by way of -[`GHC.Generic`](http://hackage.haskell.org/package/base-4.12.0.0/docs/GHC-Generics.html). - -For examples on how to use the library, check the haddocks for the -`Data.RBR.Examples` module. - -FAQ ---- - -### What extensions do I need to use this library? - -- `DataKinds`. - -- `TypeApplications` to be able to specify field and branch names. - -- `TypeFamilies`. - -- `FlexibleContexts`. - -- `DeriveGeneric` for interfacing with normal records. - -- `PartialTypeSignatures` for hiding complex tree types. - -### My type signatures are getting big and scary because of those type-level trees. What to do? - -The -[`-XPartialTypeSignatures`](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html?#extension-PartialTypeSignatures) -extension can help with that, in combination with the -[-Wno-partial-type-signatures](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/using-warnings.html#ghc-flag--Wpartial-type-signatures) -GHC flag that disables the warning message emitted when the underscore is -encountered in a signature. - -The flag can be set globally in the -[ghc-options](https://www.haskell.org/cabal/users-guide/developing-packages.html?#pkg-field-ghc-options) -section of the .cabal file, and also for particular modules with the -[OPTIONS_GHC](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html?highlight=options_ghc#options-ghc-pragma) -file-header pragma. - -### The `Show` instance for record doesn't show any field names. - -The field names exist only at the type level. Also, the `Show` instance uses -n-ary products and sums from -[sop-core](http://hackage.haskell.org/package/sop-core), which do not have -field labels. - -For fancier output, use the "pretty-show" functions instead. - -### Working with two records, I'm getting errors about incompatible types even as both records have the exact same fields. - -Alas, the order of insertion in the type-level tree matters :( Different -insertion orders can produce structurally different trees, even as they encode -the same symbol-to-type map. - -As a workaround, one can use the `-Subset` functions to convert between -equivalent structures. - -### I can't insert into a record when a field with the same name but different type already exists. Why not simply overwrite it? - -That limitation was intentional, because allowing it would make impossible to -implement of `widen` for `Variant`. One solution is to explicitly delete the -field and then insert it again. - -### The library doesn't use Proxy and relies on type application instead. But what’s the order of the type parameters? - -For typeclass methods, it's the order in which the type variables appear in the -typeclass declaration. - -For standalone functions, it’s the order in which the type variables appear in -the `forall`. - -### What's the deal with all those -I suffixed versions of functions? - -This library aims to provide -[HKD](http://reasonablypolymorphic.com/blog/higher-kinded-data/)-like -functionality by wrapping all the fields of a record in a type constructor. - -But sometimes we are working with "pure" records without effects, and we just -want to get and set a field's value. In that case, the type constructor that -wraps each field will be an identity functor `I` (from -[sop-core](http://hackage.haskell.org/package/sop-core)). The -I suffixed -functions wrap and unwrap the field's value on behalf of the user. - -### What's the deal with all those -Subset suffixed versions of functions? - -These functions target multiple fields or branches at the same time. They can -be used to build lawful lenses and prisms over fragmenst of a structure. - -They can also be used to convert between type-level trees that have the same -entries but different structure. - -### What about compilation times? - -Sadly, compilation times balloon for large records. In the tests folder there's -an example (not run by default in the tests) of the construction of a 50-field -record whose fields are afterwards accessed one by one. It takes about 22 -seconds to compile in my machine. - -The default generics-based implementations of `FromRecord` and `FromVariant` -use the same type-level machinery as the getters and its use will likely slow -down compilation as well :( - -Inspirations ------------- - -- The code for the red-black tree has been lifted from Stefan Kahrs's code - [available - here](https://www.cs.kent.ac.uk/people/staff/smk/redblack/rb.html). See also - [this post](https://www.cs.kent.ac.uk/people/staff/smk/redblack/rb.html). - -- Besides depending on sop-core, I have copied and adapted code from it. In - particular the `KeysValuessAll` typeclass is a version of the `All` typeclass - from sop-core. - -- [Surgery for data - types](https://blog.poisson.chat/posts/2018-11-26-type-surgery.html). - [reddit](https://www.reddit.com/r/haskell/comments/a0gi4z/surgery_for_data_types/). - -Alternatives ------------- - -- [generics-sop](http://hackage.haskell.org/package/generics-sop) and - [records-sop](http://hackage.haskell.org/package/records-sop). Like - red-black-record, both of these libraries build upon sop-core. They are in - fact written by the same author of sop-core. generics-sop can provide - sum-of-products representations of any datatype with a Generic instance - (red-black-record is more limited, it only converts types that fit the named - record or variant mold—so no types with anonymous fields for example). - - If you don't need to explicitly target *individual* fields in the generic - representation, you'll be better off using generics-sop instead of - red-black-record. - - On top of generics-sop, records-sop provides named field accessors and record - subtyping based on a type-level list of fields (unlike the type-level tree - used by red-black-record). It doesn't seem to provide variants. - -- [superrecord](http://hackage.haskell.org/package/superrecord). This library - provides very efficient field access at runtime because the fields are backed - internally by an array. Uses a *sorted* type-level list of fields, to avoid - the problems of multiple orderings of the same fields. - -- [vinyl](http://hackage.haskell.org/package/vinyl). One of the oldest and more - fully-featured extensible records libraries. Uses a type level list of - fields. The fields' values are wrapped in a type constructor, like in - sop-core. The records seem to use an auxiliary sum type that serves as a - "code" for the fields. See also - [vinyl-genercics](https://hackage.haskell.org/package/vinyl-generics). - -- [HTree](https://github.com/i-am-tom/learn-me-a-haskell#htree). Another - implementation of extensible records using type-level red-black trees. - -- [megarecord](https://github.com/jvanbruegge/Megarecord). Seems to be a - proof-of-concept for a future [row polymorphism - extension](https://github.com/ghc-proposals/ghc-proposals/pull/180) for - Haskell. - -- [generic-data-surgery](https://hackage.haskell.org/package/generic-data-surgery). - Lots of useful machinery for manipulating generic representations of - dataytpes, without requiring intrusive changes to the original - representation. - -- [Coxswain](https://ghc.haskell.org/trac/ghc/wiki/Plugins/TypeChecker/RowTypes/Coxswain). - +# red-black-record++## What's this?++A library that provides extensible records and variants, both indexed by a+type-level [red-black](https://en.wikipedia.org/wiki/Red%E2%80%93black_tree)+tree that maps `Symbol` keys to `Type`s. The keys correspond to fields names in+records, and to branch names in variants. Many record functions have their+variant mirror-images and viceversa.++Each value type in a field or branch comes wrapped in a type constructor of+kind `Type -> Type`. Typically, it will be an [identity+functor](http://hackage.haskell.org/package/sop-core-0.4.0.0/docs/Data-SOP.html#t:I),+but it can also be `Maybe` or some other `Applicative` for parsing, validation+and so on.++If we forget about the keys and only keep the values, records are isomorphic to+[n-ary unlabeled+products](http://hackage.haskell.org/package/sop-core-0.4.0.0/docs/Data-SOP.html#t:NP),+and variants are isomorphic to [n-ary unlabeled+sums](http://hackage.haskell.org/package/sop-core-0.4.0.0/docs/Data-SOP.html#t:NS).+The [sop-core](http://hackage.haskell.org/package/sop-core) library provides+such unlabeled types, along with a rich API for manipulating them. Instead of+reinventing the wheel, red-black-record defines conversion functions to+facilitate working in the "unlabeled" world and then coming back to records and+variants.++There is another world towards which bridges must be built: the everyday+Haskell world of conventional records and sums. In fact, one of the motivations+of extensible records and variants is to serve as "generalized" versions of+vanilla data types. Advanced use cases can rely on these generalized versions,+thereby avoiding intrusive changes to the original types. red-black-record+provides conversion typeclasses with default implementations by way of+[`GHC.Generic`](http://hackage.haskell.org/package/base-4.12.0.0/docs/GHC-Generics.html).++For examples on how to use the library, check the haddocks for the+`Data.RBR.Examples` module.++## FAQ++### What extensions do I need to use this library?++* `DataKinds`.++* `TypeApplications` to be able to specify field and branch names.++* `TypeFamilies`.++* `FlexibleContexts`.++* `DeriveGeneric` for interfacing with normal records.++* `PartialTypeSignatures` for hiding complex tree types.++### My type signatures are getting big and scary because of those type-level trees. What to do?++The+[`-XPartialTypeSignatures`](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html?#extension-PartialTypeSignatures)+extension can help with that, in combination with the+[-Wno-partial-type-signatures](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/using-warnings.html#ghc-flag--Wpartial-type-signatures)+GHC flag that disables the warning message emitted when the underscore is+encountered in a signature.++The flag can be set globally in the+[ghc-options](https://www.haskell.org/cabal/users-guide/developing-packages.html?#pkg-field-ghc-options)+section of the .cabal file, and also for particular modules with the+[OPTIONS_GHC](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html?highlight=options_ghc#options-ghc-pragma)+file-header pragma.++### The `Show` instance for record doesn't show any field names.++The field names exist only at the type level. Also, the `Show` instance uses+n-ary products and sums from+[sop-core](http://hackage.haskell.org/package/sop-core), which do not have+field labels.++For fancier output, use the "pretty-show" functions instead.++### Working with two records, I'm getting errors about incompatible types even as both records have the exact same fields.++Alas, the order of insertion in the type-level tree matters :( Different+insertion orders can produce structurally different trees, even as they encode+the same symbol-to-type map.++As a workaround, one can use the `-Subset` functions to convert between+equivalent structures.++### I can't insert into a record when a field with the same name but different type already exists. Why not simply overwrite it?++That limitation was intentional, because allowing it would make impossible to+implement of `widen` for `Variant`. One solution is to explicitly delete the+field and then insert it again.++### The library doesn't use Proxy and relies on type application instead. But what’s the order of the type parameters?++For typeclass methods, it's the order in which the type variables appear in the+typeclass declaration.++For standalone functions, it’s the order in which the type variables appear in+the `forall`.++### What's the deal with all those -I suffixed versions of functions?++This library aims to provide+[HKD](http://reasonablypolymorphic.com/blog/higher-kinded-data/)-like+functionality by wrapping all the fields of a record in a type constructor.++But sometimes we are working with "pure" records without effects, and we just+want to get and set a field's value. In that case, the type constructor that+wraps each field will be an identity functor `I` (from+[sop-core](http://hackage.haskell.org/package/sop-core)). The -I suffixed+functions wrap and unwrap the field's value on behalf of the user.++### What's the deal with all those -Subset suffixed versions of functions?++These functions target multiple fields or branches at the same time. They can+be used to build lawful lenses and prisms over fragmenst of a structure.++They can also be used to convert between type-level trees that have the same+entries but different structure.++### What about compilation times?++Compilation times balloon for large records. In the tests folder there's+an example (not run by default in the tests) of the construction of a 50-field+record whose fields are afterwards accessed one by one. It takes about 22+seconds to compile in my machine. ++Code involving deletion of fields and branches (like using the `winnow`+function for `Variant`s) is currently poorly optimized and will compile [much+slower](https://github.com/danidiaz/red-black-record/issues/12) than that.++The default generics-based implementations of `FromRecord` and `FromVariant`+use the same type-level machinery as the getters and its use will likely slow+down compilation as well.++## Inspirations++* The code for the red-black tree has been lifted from Stefan Kahrs's code+ [available+ here](https://www.cs.kent.ac.uk/people/staff/smk/redblack/rb.html). See also+ [this post](https://www.cs.kent.ac.uk/people/staff/smk/redblack/rb.html).++* Besides depending on sop-core, I have copied and adapted code from it. In+ particular the `KeysValuessAll` typeclass is a version of the `All` typeclass+ from sop-core. ++* [Surgery for data+ types](https://blog.poisson.chat/posts/2018-11-26-type-surgery.html).+ [reddit](https://www.reddit.com/r/haskell/comments/a0gi4z/surgery_for_data_types/).++## Alternatives++* [generics-sop](http://hackage.haskell.org/package/generics-sop) and+ [records-sop](http://hackage.haskell.org/package/records-sop). Like+ red-black-record, both of these libraries build upon sop-core. They are in+ fact written by the same author of sop-core. generics-sop can provide+ sum-of-products representations of any datatype with a Generic instance+ (red-black-record is more limited, it only converts types that fit the named+ record or variant mold—so no types with anonymous fields for example). + + If you don't need to explicitly target *individual* fields in the generic+ representation, you'll be better off using generics-sop instead of+ red-black-record. + + On top of generics-sop, records-sop provides named field accessors and record+ subtyping based on a type-level list of fields (unlike the type-level tree+ used by red-black-record). It doesn't seem to provide variants.++* [superrecord](http://hackage.haskell.org/package/superrecord). This library+ provides very efficient field access at runtime because the fields are backed+ internally by an array. Uses a *sorted* type-level list of fields, to avoid+ the problems of multiple orderings of the same fields.++* [vinyl](http://hackage.haskell.org/package/vinyl). One of the oldest and more+ fully-featured extensible records libraries. Uses a type level list of+ fields. The fields' values are wrapped in a type constructor, like in+ sop-core. The records seem to use an auxiliary sum type that serves as a+ "code" for the fields. See also+ [vinyl-genercics](https://hackage.haskell.org/package/vinyl-generics).++* [HTree](https://github.com/i-am-tom/learn-me-a-haskell#htree). Another+ implementation of extensible records using type-level red-black trees.++* [megarecord](https://github.com/jvanbruegge/Megarecord). Seems to be a+ proof-of-concept for a future [row polymorphism+ extension](https://github.com/ghc-proposals/ghc-proposals/pull/180) for+ Haskell.++* [generic-data-surgery](https://hackage.haskell.org/package/generic-data-surgery).+ Lots of useful machinery for manipulating generic representations of+ dataytpes, without requiring intrusive changes to the original+ representation.++* [Coxswain](https://ghc.haskell.org/trac/ghc/wiki/Plugins/TypeChecker/RowTypes/Coxswain).+
lib/Data/RBR/Examples.hs view
@@ -14,6 +14,9 @@ -- * Injecting into a Variant and eliminating it -- $variant1 + -- * Working with a bigger error type inside a function + -- $variant1bError + -- * Creating a Variant out of a sum type and matching on it -- $variant2 @@ -114,6 +117,33 @@ in eliminate e b :} c + +-} + +{- $variant1bError + + A function can use internally an error 'Variant' bigger than the one it + eventually returns. The internal branches of the 'Variant' can be removed with + 'winnow'. + + This library makes it more involved than it should be, because inserting an + entry and then deleting it can result in structurally dissimilar type-level + maps. So we need extra type annotations in 'winnow', and also a call to + 'injectSubset' to perform the conversion. + +>>> type Smaller = FromList '[ '("foo",Char), '("bar",Int) ] +>>> :{ + let func :: Int -> Variant I Smaller + func i = + let v = if (i == 0) then injectI @"baz" "internal" + else injectI @"foo" 'c' + r = case winnowI @"baz" @String @(Insert "baz" String Smaller) v of + Right e -> error "this is the baz internal error" + Left smaller -> smaller + in injectSubset r + in putStrLn $ prettyShowVariantI (func 1) +:} +foo ('c') -}
lib/Data/RBR/Internal.hs view
@@ -49,7 +49,7 @@ | B deriving (Show,Eq) --- | The Red-Black tree. It will be used, as a kind, to index the 'Record' and 'Variant' types. +-- | A Red-Black tree. It will be used as a kind, to index the 'Record' and 'Variant' types. data Map k v = E | N Color (Map k v) k v (Map k v) deriving (Show,Eq) @@ -125,7 +125,7 @@ go left right = Node left (K (symbolVal (Proxy @k))) right {- | - Two-place constraint saying that the 'Symbol' can be demoted to String. Nothing is required from the value type. + Two-place constraint saying that a 'Symbol' key can be demoted to 'String'. Nothing is required from the corresponding value. Defined using the "class synonym" <https://www.reddit.com/r/haskell/comments/ab8ypl/monthly_hask_anything_january_2019/edk1ot3/ trick>. -} @@ -148,7 +148,7 @@ go left right = Node left (K (symbolVal (Proxy @k),typeRep (Proxy @v))) right {- | - Two-place constraint saying that the symbol can be demoted to String, and that a term-level representation can be obtained for the value type. + Two-place constraint saying that a 'Symbol' key can be demoted to 'String', and that the corresponding value 'Type' has a term-level representation. Defined using the "class synonym" <https://www.reddit.com/r/haskell/comments/ab8ypl/monthly_hask_anything_january_2019/edk1ot3/ trick>. -} @@ -165,6 +165,8 @@ The values in the 'Record' come wrapped in a type constructor @f@, which por pure records will be the identity functor 'I'. + + See also 'insert', 'delete' and 'project'. -} data Record (f :: Type -> Type) (t :: Map Symbol Type) where Empty :: Record f E @@ -213,6 +215,8 @@ The values in the 'Variant' come wrapped in a type constructor @f@, which por pure variants will be the identity functor 'I'. + + See also 'widen', 'winnow' and 'inject'. -} data Variant (f :: Type -> Type) (t :: Map Symbol Type) where Here :: f v -> Variant f (N color left k v right) @@ -251,15 +255,15 @@ -- -- Insertion -{- | Insert a list of type level key / value pairs into a type-level tree. +{- | Insert a list of type level key / value pairs into a type-level map. -} type family InsertAll (es :: [(Symbol,Type)]) (t :: Map Symbol Type) :: Map Symbol Type where InsertAll '[] t = t InsertAll ( '(name,fieldType) ': es ) t = Insert name fieldType (InsertAll es t) -{- | Build a type-level tree out of a list of type level key / value pairs. +{- | Build a type-level map out of a list of type level key / value pairs. -} -type FromList (es :: [(Symbol,Type)]) = InsertAll es E +type FromList (es :: [(Symbol,Type)]) = InsertAll es Empty {- | Alias for 'insert'. -} @@ -277,23 +281,27 @@ addFieldI = insertI @k @v @t {- | Class that determines if the pair of a 'Symbol' key and a 'Type' can - be inserted into a type-level tree. + be inserted into a type-level map. - The associated type family 'Insert' produces the resulting tree. + The associated type family 'Insert' produces the resulting map. At the term level, this manifests in 'insert', which adds a new field to a record, and in 'widen', which lets you use a 'Variant' in a bigger context than the one in which is was defined. 'insert' tends to be more useful in practice. - If the tree already has the key but with a /different/ type, the insertion - fails to compile. + If the map already has the key but with a /different/ 'Type', the + insertion fails to compile. -} class Insertable (k :: Symbol) (v :: Type) (t :: Map Symbol Type) where type Insert k v t :: Map Symbol Type insert :: f v -> Record f t -> Record f (Insert k v t) widen :: Variant f t -> Variant f (Insert k v t) +-- insert x s = +-- T B a z b +-- where +-- T _ a z b = ins s instance (InsertableHelper1 k v t, CanMakeBlack (Insert1 k v t)) => Insertable k v t where type Insert k v t = MakeBlack (Insert1 k v t) insert fv r = makeBlackR (insert1 @k @v fv r) @@ -357,7 +365,7 @@ Balanceable (Insert1 k v left) k' v' right -- TODO remove B here ) => 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 + type Insert2 LT k v B left k' v' right = Balance (Insert1 k v left) k' v' right insert2 fv (Node left fv' right) = balanceR @_ @k' @v' @right (Node (insert1 @k @v fv left) fv' right) widen2 v = balanceV @(Insert1 k v left) @k' @v' @right $ case v of Here x -> Here x @@ -370,7 +378,7 @@ Balanceable (Insert1 k v left) k' v' right-- TODO remove B here ) => 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 + type Insert2 LT k v R left k' v' right = N R (Insert1 k v left) k' v' right insert2 fv (Node left fv' right) = Node (insert1 @k @v fv left) fv' right widen2 v = case v of Here x -> Here x @@ -382,7 +390,7 @@ -- existing key. If we did that, we wouldn't be able to widen Variants that -- happen to match that key! 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 + type Insert2 EQ k v color left k v right = N color left k v right insert2 fv (Node left _ right) = Node left fv right widen2 = id @@ -393,7 +401,7 @@ Balanceable left k' v' (Insert1 k v right) ) => 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) + type Insert2 GT k v B left k' v' right = Balance left k' v' (Insert1 k v right) insert2 fv (Node left fv' right) = balanceR @left @k' @v' @_ (Node left fv' (insert1 @k @v fv right)) widen2 v = balanceV @left @k' @v' @(Insert1 k v right) $ case v of Here x -> Here x @@ -407,7 +415,7 @@ Balanceable left k' v' (Insert1 k v right) ) => 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) + type Insert2 GT k v R left k' v' right = N R left k' v' (Insert1 k v right) insert2 fv (Node left fv' right) = Node left fv' (insert1 @k @v fv right) widen2 v = case v of Here x -> Here x @@ -454,9 +462,10 @@ 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) +-- balance (T R a x b) y (T R c z d) = T R (T B a x b) y (T B c z d) 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) + N R (N B left1 k1 v1 right1) kx vx (N B left2 k2 v2 right2) balanceR' (Node (Node left1 v1 right1) vx (Node left2 v2 right2)) = (Node (Node left1 v1 right1) vx (Node left2 v2 right2)) balanceV' v = case v of @@ -468,10 +477,10 @@ LookRight (Here x) -> LookRight (Here x) LookRight (LookRight x) -> LookRight (LookRight x) - +-- balance (T R (T R a x b) y c) z d = T R (T B a x b) y (T B c z d) 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) + N R (N B a k1 v1 b) k2 v2 (N B c k3 v3 d) balanceR' (Node (Node (Node a fv1 b) fv2 c) fv3 d) = Node (Node a fv1 b) fv2 (Node c fv3 d) balanceV' v = case v of @@ -483,9 +492,10 @@ Here x -> LookRight (Here x) LookRight x -> LookRight (LookRight x) +-- balance (T R a x (T R b y c)) z d = T R (T B a x b) y (T B c z d) 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) + N R (N B a k1 v1 b) k2 v2 (N B c k3 v3 d) balanceR' (Node (Node a fv1 (Node b fv2 c)) fv3 d) = Node (Node a fv1 b) fv2 (Node c fv3 d) balanceV' v = case v of @@ -497,9 +507,10 @@ Here x -> LookRight (Here x) LookRight x -> LookRight (LookRight x) +-- balance a x (T R (T R b y c) z d) = T R (T B a x b) y (T B c z d) 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) + N R (N B a k1 v1 b) k2 v2 (N B c k3 v3 d) balanceR' (Node a fv1 (Node (Node b fv2 c) fv3 d)) = Node (Node a fv1 b) fv2 (Node c fv3 d) balanceV' v = case v of @@ -511,9 +522,11 @@ LookRight (Here x) -> LookRight (Here x) LookRight (LookRight x) -> LookRight (LookRight x) + +-- balance a x (T R b y (T R c z d)) = T R (T B a x b) y (T B c z d) 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) + N R (N B a k1 v1 b) k2 v2 (N B c k3 v3 d) balanceR' (Node a fv1 (Node b fv2 (Node c fv3 d))) = Node (Node a fv1 b) fv2 (Node c fv3 d) balanceV' v = case v of @@ -525,8 +538,9 @@ Here y -> Here y LookRight y -> LookRight y) +-- balance a x b = T B a x b instance BalanceableHelper DoNotBalance a k v b where - type Balance' DoNotBalance a k v b = N B a k v b + type Balance' DoNotBalance a k v b = N B a k v b balanceR' (Node left v right) = (Node left v right) balanceV' v = case v of LookLeft l -> LookLeft l @@ -556,7 +570,7 @@ -- {- | Class that determines if a given 'Symbol' key is present in a type-level - tree. + map. The 'Value' type family gives the 'Type' corresponding to the key. @@ -572,6 +586,7 @@ field :: Field f t (Value k t) branch :: Branch f t (Value k t) +-- member :: Ord a => a -> RB a -> Bool class KeyHelper (ordering :: Ordering) (k :: Symbol) (left :: Map Symbol Type) (v :: Type) (right :: Map Symbol Type) where type Value' ordering k left v right :: Type field' :: Field f (N colorx left kx v right) (Value' ordering k left v right) @@ -582,6 +597,7 @@ field = field' @ordering @k @left @v' @right branch = branch' @ordering @k @left @v' @right +-- | x<y = member x a 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 @@ -594,6 +610,7 @@ _ -> Nothing, \fv -> LookRight (inj fv)) +-- | x>y = member x b 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 @@ -606,8 +623,9 @@ _ -> Nothing, \fv -> LookLeft (inj fv)) +-- | otherwise = True instance KeyHelper EQ k left v right where - type Value' EQ k left v right = v + type Value' EQ k left v right = v field' (Node left fv right) = (\x -> Node left x right, fv) branch' = (\case Here x -> Just x _ -> Nothing, @@ -705,7 +723,7 @@ class (Key k t, Value k t ~ v) => PresentIn (t :: Map Symbol Type) (k :: Symbol) (v :: Type) instance (Key k t, Value k t ~ v) => PresentIn (t :: Map Symbol Type) (k :: Symbol) (v :: Type) -{- | Constraint for trees that represent subsets of fields of 'Record'-like types. +{- | Constraint for maps that represent subsets of fields of 'Record'-like types. -} type ProductlikeSubset (subset :: Map Symbol Type) (whole :: Map Symbol Type) (flat :: [Type]) = (KeysValuesAll (PresentIn whole) subset, @@ -737,8 +755,8 @@ {- | Like 'project', but extracts multiple fields at the same time. - Can also be used to convert between structurally dissimilar trees that - nevertheless have the same entries. + Can also be used to convert between 'Record's with structurally dissimilar + type-level maps that nevertheless hold the same entries. -} projectSubset :: forall subset whole flat f. (ProductlikeSubset subset whole flat) => Record f whole @@ -771,7 +789,7 @@ modifyFieldSubset f r = uncurry ($) (fmap f (fieldSubset @subset @whole r)) -{- | Constraint for trees that represent subsets of branches of 'Variant'-like types. +{- | Constraint for maps that represent subsets of branches of 'Variant'-like types. -} type SumlikeSubset (subset :: Map Symbol Type) (whole :: Map Symbol Type) (subflat :: [Type]) (wholeflat :: [Type]) = (KeysValuesAll (PresentIn whole) subset, @@ -807,6 +825,9 @@ in eliminate injs) {- | Like 'inject', but injects one of several possible branches. + + Can also be used to convert between 'Variant's with structurally + dissimilar type-level maps that nevertheless hold the same entries. -} injectSubset :: forall subset whole subflat wholeflat f. (SumlikeSubset subset whole subflat wholeflat) => Variant f subset -> Variant f whole @@ -1130,7 +1151,7 @@ -- balleft (T R a x b) y c = T R (T B a x b) y c 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) + (N R (N B left1 k1 v1 right1) k2 v2 right2) balLR' (Node (Node left' v' right') v right) = Node (Node left' v' right') v right balLV' v = case v of LookLeft x -> LookLeft (case x of LookLeft y -> LookLeft y Here y -> Here y @@ -1143,7 +1164,7 @@ instance (BalanceableHelper (ShouldBalance t1 (N R t2 z zv t3)) t1 y yv (N R t2 z zv t3)) => 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) + = Balance t1 y yv (N R t2 z zv t3) balLR' (Node left1 v1 (Node left2 v2 right2)) = balanceR @t1 @y @yv @(N R t2 z zv t3) (Node left1 v1 (Node left2 v2 right2)) balLV' v = balanceV @t1 @y @yv @(N R t2 z zv t3) (case v of @@ -1209,7 +1230,7 @@ LookRight y -> LookRight y) -- balright (T B a x b) y bl = balance (T R a x b) y bl -instance (BalanceableHelper (ShouldBalance (N R t2 z zv t3) t1) (N R t2 z zv t3) y yv t1) => +instance (BalanceableHelper (ShouldBalance (N R t2 z zv t3) t1) (N R t2 z zv t3) 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 @@ -1282,8 +1303,9 @@ Left v -> v -- app a (T R b x c) = T R (app a b) x c -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 +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 (Node left1 v1 right1) (Node left2 v2 right2) = Node (fuseRecord @(N B left1 k1 v1 right1) (Node left1 v1 right1) left2) v2 right2 fuseVariant e = case e of Left l -> case l of @@ -1297,8 +1319,9 @@ -- app (T R a x b) c = T R a x (app b c) -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)) +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 (Node left1 v1 right1) (Node left2 v2 right2) = Node left1 v1 (fuseRecord @_ @(N B left2 k2 v2 right2) right1 (Node left2 v2 right2)) fuseVariant e = case e of Left l -> case l of @@ -1312,8 +1335,9 @@ -- app (T R a x b) (T R c y d) = -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) +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 = fuseRecord1 @(Fuse right1 left2) fuseVariant = fuseVariant1 @(Fuse right1 left2) @@ -1326,8 +1350,9 @@ -- case app b c of -- T R b' z c' -> T R (T R a x b') z (T R c' y d) -- FIXME: The Fuseable constraint is repeated from avobe :( -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) +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 (Node left1 v1 right1) (Node left2 v2 right2) = case fuseRecord right1 left2 of Node s1 zv s2 -> Node (Node left1 v1 s1) zv (Node s2 v2 right2) @@ -1354,8 +1379,9 @@ -- ... -- bc -> T R a x (T R bc y d) -- FIXME: The Fuseable constraint is repeated from above :( -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) +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 (Node left1 v1 right1) (Node left2 v2 right2) = case fuseRecord right1 left2 of Node s1 zv s2 -> Node left1 v1 (Node (Node s1 zv s2) v2 right2) @@ -1381,7 +1407,7 @@ -- ... -- bc -> T R a x (T R bc y d) 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) + 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 (Node left1 v1 right1) (Node left2 v2 right2) = Node left1 v1 (Node Empty v2 right2) fuseVariant1 e = case e of @@ -1393,8 +1419,9 @@ LookRight right2 -> LookRight (LookRight right2) -- app (T B a x b) (T B c y d) = -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) +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 = fuseRecord2 @(Fuse right1 left2) fuseVariant = fuseVariant2 @(Fuse right1 left2) @@ -1407,8 +1434,9 @@ -- app (T B a x b) (T B c y d) = -- case app b c of -- T R b' z c' -> T R (T B a x b') z (T B c' y d) -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) +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 (Node left1 v1 right1) (Node left2 v2 right2) = case fuseRecord right1 left2 of Node s1 zv s2 -> Node (Node left1 v1 s1) zv (Node s2 v2 right2) @@ -1433,8 +1461,9 @@ -- case app b c of -- ... -- bc -> balleft a x (T B bc y d) -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) +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 (Node left1 v1 right1) (Node left2 v2 right2) = case fuseRecord @right1 @left2 right1 left2 of Node s1 zv s2 -> balLR @left1 @k1 @v1 @(N B (N B s1 z zv s2) k2 v2 right2) (Node left1 v1 (Node (Node s1 zv s2) v2 right2)) @@ -1458,8 +1487,9 @@ -- case app b c of -- ... -- bc -> balleft a x (T B bc y d) -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) +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 (Node left1 v1 right1) (Node left2 v2 right2) = balLR @left1 @k1 @v1 @(N B E k2 v2 right2) (Node left1 v1 (Node Empty v2 right2)) fuseVariant2 e = balLV @left1 @k1 @v1 @(N B E k2 v2 right2) (case e of @@ -1492,7 +1522,7 @@ -- delformLeft a@(T B _ _ _) y b = balleft (del a) y b instance (Delable k v (N B leftz kz vz rightz), BalanceableL (Del k v (N B leftz kz vz rightz)) 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 + 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 (Node left vx right) = balLR @(Del k v (N B leftz kz vz rightz)) @kx @vx @right (Node (del @k @v left) vx right) winL v = first (balLV @(Del k v (N B leftz kz vz rightz)) @kx @vx @right) (case v of LookLeft l -> first LookLeft (win @k @v l) @@ -1500,8 +1530,9 @@ LookRight r -> Left $ LookRight r) -- delformLeft a y b = T R (del a) y b -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 +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 (Node left vx right) = Node (del @k @v left) vx right winL v = case v of LookLeft l -> first LookLeft (win @k @v l) @@ -1510,7 +1541,7 @@ -- delformLeft a y b = T R (del a) y b instance DelableL k v E kx vx right where - type DelL k v E kx vx right = N R E kx vx right + type DelL k v E kx vx right = N R E kx vx right delL (Node left vx right) = Node Empty vx right winL v = case v of Here vx -> Left (Here vx) @@ -1524,8 +1555,9 @@ winR :: Variant f (N color l kx vx r) -> Either (Variant f (DelR k v l kx vx r)) (f v) -- delformRight a y b@(T B _ _ _) = balright a y (del b) -instance (Delable k v (N B leftz kz vz rightz), BalanceableR left kx vx (Del k v (N B leftz kz vz rightz))) => 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)) +instance (Delable k v (N B leftz kz vz rightz), BalanceableR left kx vx (Del k v (N B leftz kz vz rightz))) + => 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 (Node left vx right) = balRR @left @kx @vx @(Del k v (N B leftz kz vz rightz)) (Node left vx (del @k @v right)) winR v = first (balRV @left @kx @vx @(Del k v (N B leftz kz vz rightz))) (case v of LookLeft l -> Left $ LookLeft l @@ -1533,8 +1565,9 @@ LookRight r -> first LookRight (win @k @v r)) -- delformRight a y b = T R a y (del b) -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)) +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 (Node left vx right) = Node left vx (del @k @v right) winR v = case v of LookLeft l -> Left (LookLeft l) @@ -1543,7 +1576,7 @@ -- delformRight a y b = T R a y (del b) instance DelableR k v left kx vx E where - type DelR k v left kx vx E = N R left kx vx E + type DelR k v left kx vx E = N R left kx vx E delR (Node left vx right) = Node left vx Empty winR v = case v of LookLeft l -> Left (LookLeft l) @@ -1551,7 +1584,7 @@ -- del E = E instance Delable k v E where - type Del k v E = E + type Del k v E = E del _ = unit win = impossible @@ -1572,13 +1605,13 @@ -- | x<y = delformLeft a y b 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 + type Del' GT k v left kx vx right = DelL k v left kx vx right del' = delL @k @v @left @kx @vx @right win' = winL @k @v @left @kx @vx @right -- | otherwise = app a b 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 + type Del' EQ k v left k v right = Fuse left right del' (Node left _ right) = fuseRecord @left @right left right win' v = case v of LookLeft l -> Left $ fuseVariant @left @right (Left l) @@ -1587,24 +1620,22 @@ -- | x>y = delformRight a y b 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 + type Del' LT k v left kx vx right = DelR k v left kx vx right del' = delR @k @v @left @kx @vx @right win' = winR @k @v @left @kx @vx @right {- | Class that determines if the pair of a 'Symbol' key and a 'Type' can - be deleted from a type-level tree. + be deleted from a type-level map. - The associated type family 'Delete' produces the resulting tree. + The associated type family 'Delete' produces the resulting map. At the term level, this manifests in 'delete', which removes a field from a record, and in 'winnow', which checks if a 'Variant' is of a given branch and returns the value in the branch if there's a match, or a - reduced 'Variant' if there isn't. - - 'winnow' tends to be more useful in + reduced 'Variant' if there isn't. 'winnow' tends to be more useful in practice. - If the tree already has the key but with a /different/ type, the deletion + If the map already has the key but with a /different/ 'Type', the deletion fails to compile. -} class Deletable (k :: Symbol) (v :: Type) (t :: Map Symbol Type) where
red-black-record.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: red-black-record -version: 2.0.2.0 +version: 2.0.2.1 synopsis: Extensible records and variants indexed by a type-level Red-Black tree. description: A library that provides extensible records and variants,