data-diverse 2.0.1.0 → 3.0.0.0

raw patch · 11 files changed

+185/−204 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +20/−13
• data-diverse.cabal +1/−1
• src/Data/Diverse/Cases.hs +4/−4
• src/Data/Diverse/Many.hs +5/−5
• src/Data/Diverse/Many/Internal.hs +70/−70
• src/Data/Diverse/TypeLevel.hs +2/−58
• src/Data/Diverse/TypeLevel/Internal.hs +7/−5
• src/Data/Diverse/Which.hs +4/−2
• src/Data/Diverse/Which/Internal.hs +34/−8
• test/Data/Diverse/ManySpec.hs +30/−30
• test/Data/Diverse/WhichSpec.hs +8/−8

@@ -14,12 +14,19 @@  # Changelog +* 3.0.0.0+  - Renamed `fetch` to `grab` to avoid conflicting with Haxl.+  - Removed unused type functions from removed splitting functions (Before,To,After,From,Length)+  - Added `impossible'` and ability to diversify and reinterpret `Which '[Void]`+  - Added `zilch`+  - Removed `CanAppendUnique` (not useful).+ * 2.0.1.0   - Simplified type synonyms for Which. Added Reinterpreted constraint synonym.  * 2.0.0.0   - Breaking change: the prime (xxx') version of functions are now consistently the simpler or non-polymorphic version.-    - This is more consistent with 'Control.Lens' as well.+    - This is more consistent with `Control.Lens` as well.     - This means the following are swapped:       - `replace`, `replace'`       - `replaceL`, `replaceL'`@@ -28,30 +35,30 @@       - `amend`, `amend'`       - `amendL`, `amendL'`       - `amendN`, `amendN'`-  - Breaking change: Removed proxy argument from 'fetchL/Tag/N', 'replaceXXX', 'selectL/Tag/N', 'amendXXX', 'pickL/Tag/N', 'trialL/Tag/N'-    relying soley on TypeApplications and now requiring AllowAmbiguousTypes.-    The "Proxy" is also removed from the Read/Show serialized format.-  - Rearranged type variables in `fetchL/N`, `replaceL/Tag/N`, 'pickL/Tag/N', 'trialL/Tag/N' type parameters,-    so the type variable ordering is consistently label, orig to change, smaller to larger, ie. 'l/n', 'x', 'y', 'xs'+  - Breaking change: Removed proxy argument from `fetchL/Tag/N`, `replaceXXX`, `selectL/Tag/N`, `amendXXX`, `pickL/Tag/N`, `trialL/Tag/N`+    relying soley on `TypeApplications` and now requiring `AllowAmbiguousTypes`.+    The `Proxy` is also removed from the Read/Show serialized format.+  - Rearranged type variables in `fetchL/N`, `replaceL/Tag/N`, `pickL/Tag/N`, `trialL/Tag/N` type parameters,+    so the type variable ordering is consistently label, orig to change, smaller to larger, ie. `l/n`, `x`, `y`, `xs`  * 1.3.0.0   - Removed splitting operations added in 1.2.0.0   - added `xxxTag` version of label operations that also automatically untags the field.  * 1.2.0.3-  - PolyKinds for Which+  - `PolyKinds` for `Which`   - Removed cabal upper bounds  * 1.2.0.2-  - Added 'insert'/'remove' for GHC < 8.2-  - Removed type functions 'UniqueMemberAt', 'MaybeUniqueMemberAt'+  - Added `insert`/`remove` for GHC < 8.2+  - Removed type functions `UniqueMemberAt`, `MaybeUniqueMemberAt`  * 1.2.0.1-  - 'insert'/'remove' is not available in GHC 8.2 onwards.+  - `insert`/`remove` is not available in GHC 8.2 onwards.  * 1.2.0.0   - Rerranged type variable for xxxL and xxxN functions so that the-    @x@ inferrred from label @l@ or index @n@ is after @proxy@.+    `x` inferrred from label `l` or index `n` is after `proxy`.     - This affects `fetch[L|N]`, `replace[L|N]`, `replace[L|N]'`, `pick[L|N]`   - Depends on at least containers-0.5.8.2 for `Data.Sequence.insertAt`   - Added splitting operations: `split[Before|After][|L|N]`, `inset[Before|After][|L|N]`,@@ -83,7 +90,7 @@   - Removed `zilch` so `Which '[]` is uninhabited like `Data.Void.Void`, making 'impossible' safe to use.   - Removed `Monoid` and changed `Show`, `Read` and `Generic` instances for `Which '[]` to be partial     just like Data.Void.Void.-  - Added instance Reduce (Which '[]) (Switcher c '[] r), which follows from 'impossible'.+  - Added `instance Reduce (Which '[]) (Switcher c '[] r)`, which follows from `impossible`.  * 0.10.0.0   - Renamed `Switch` to `Switcher`. Switch is now a type synonym for `switch` constraints@@ -96,7 +103,7 @@   - Removed zipped type variable from `Amend` constraints.   - Removed r type variable from `Reduce` typeclass.   - Rearranged type variables in `fetch`, `replace`, `pick`, `trial`, `Diversify` type parameters,-    so the type variable ordering is consistently smaller to larger, ie. 'x', 'xs', 'branch', 'tree'+    so the type variable ordering is consistently smaller to larger, ie. `x`, `xs`, `branch`, `tree`   - Added `diversify'` for allowing rearranging the types only.  * 0.9.0.1

@@ -1,5 +1,5 @@ name:                data-diverse-version:             2.0.1.0+version:             3.0.0.0 synopsis:            Extensible records and polymorphic variants. description:         "Data.Diverse.Many" is an extensible record for any size encoded efficiently as (Seq Any).                      "Data.Diverse.Which" is a polymorphic variant of possibilities encoded as (Int, Any).

@@ -29,7 +29,7 @@ import GHC.TypeLits  -- | Contains a 'Many' of handlers/continuations for all the types in the 'xs' typelist.--- This uses __'fetch'__ to get the unique handler for the type at the 'Head' of @xs@.+-- This uses __'grab'__ to get the unique handler for the type at the 'Head' of @xs@. -- -- Use 'cases' to construct this with 'SameLength' constraint to reduce programming confusion. newtype Cases (fs :: [Type]) r (xs :: [Type]) = Cases (Many fs)@@ -41,7 +41,7 @@  -- | UndecidableInstances because @fs@ appers more often. instance UniqueMember (Head xs -> r) fs => Case (Cases fs r) xs where-    case' (Cases s) = fetch @(Head xs -> r) s+    case' (Cases s) = grab @(Head xs -> r) s  -- | Create an instance of 'Case' for either handling 'Data.Diverse.Which.switch'ing a 'Which'. --@@ -87,7 +87,7 @@  ----------------------------------------------- --- | A variation of 'Cases' which uses __'fetchN'__ to get the handler by index.+-- | A variation of 'Cases' which uses __'grabN'__ to get the handler by index. -- There may be different handlers for the same type, but the handlers must be in the same order -- as the input @xs@ typelist. -- Use 'casesN' to construct this safely ensuring @n@ starts at 0.@@ -100,7 +100,7 @@  -- | UndecidableInstances because @fs@ appears more often. instance (MemberAt n (Head xs -> r) fs) => Case (CasesN fs r n) xs where-    case' (CasesN s) = fetchN @n s+    case' (CasesN s) = grabN @n s  -- | Safe Constructor for 'CasesN' ensuring that the @n@ Nat starts at 0. -- It is an instance of 'CaseN' for either handling 'Data.Diverse.Which.switchN'ing a 'Which' in index order.

@@ -19,7 +19,7 @@     , postfix'     , (\.)     , append-    , CanAppendUnique(..)+    -- , CanAppendUnique(..)     , (/./)      -- * Simple queries@@ -32,10 +32,10 @@      -- * Single field     -- ** Getter for single field-    , fetch-    , fetchL-    , fetchTag-    , fetchN+    , grab+    , grabL+    , grabTag+    , grabN     -- ** Setter for single field     , replace     , replace'

@@ -2,8 +2,8 @@  {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -38,7 +38,7 @@     , postfix'     , (\.)     , append-    , CanAppendUnique(..)+    -- , CanAppendUnique(..)     , (/./)      -- * Simple queries@@ -51,10 +51,10 @@      -- * Single field     -- ** Getter for single field-    , fetch-    , fetchL-    , fetchTag-    , fetchN+    , grab+    , grabL+    , grabTag+    , grabN     -- ** Setter for single field     , replace     , replace'@@ -108,11 +108,11 @@ import Data.Foldable import Data.Kind import Data.Proxy-import qualified Data.Sequence as S import Data.Semigroup (Semigroup(..))+import qualified Data.Sequence as S import Data.Tagged-import qualified GHC.Generics as G import GHC.Exts (Any, coerce)+import qualified GHC.Generics as G import GHC.TypeLits import Text.ParserCombinators.ReadPrec import Text.Read@@ -128,7 +128,7 @@ -- -- The following functions are available can be used to manipulate unique fields ----- * getter/setter for single field: 'fetch' and 'replace'+-- * getter/setter for single field: 'grab' and 'replace' -- * getter/setter for multiple fields: 'select' and 'amend' -- * folds: 'forMany' or 'collect' --@@ -137,7 +137,7 @@ -- -- For duplicate fields, Nat-indexed versions of the functions are available: ----- * getter/setter for single field: 'fetchN' and 'replaceN'+-- * getter/setter for single field: 'grabN' and 'replaceN' -- * getter/setter for multiple fields: 'selectN' and 'amendN' -- * folds: 'forManyN' or 'collectN' --@@ -215,82 +215,82 @@ -- Otherwise this instance will overlap. instance IsMany Tagged '[a] a where     toMany (Tagged a) = single a-    fromMany r = Tagged (fetch @a r)+    fromMany r = Tagged (grab @a r)  instance IsMany Tagged '[a,b] (a,b) where     toMany (Tagged (a,b)) = a./b./nil-    fromMany r = Tagged (fetchN @0 r, fetchN @1 r)+    fromMany r = Tagged (grabN @0 r, grabN @1 r)  instance IsMany Tagged '[a,b,c] (a,b,c) where     toMany (Tagged (a,b,c)) = a./b./c./nil-    fromMany r = Tagged (fetchN @0 r, fetchN @1 r, fetchN @2 r)+    fromMany r = Tagged (grabN @0 r, grabN @1 r, grabN @2 r)  instance IsMany Tagged '[a,b,c,d] (a,b,c,d) where     toMany (Tagged (a,b,c,d)) = a./b./c./d./nil-    fromMany r = Tagged (fetchN @0 r, fetchN @1 r, fetchN @2 r, fetchN @3 r)+    fromMany r = Tagged (grabN @0 r, grabN @1 r, grabN @2 r, grabN @3 r)  instance IsMany Tagged '[a,b,c,d,e] (a,b,c,d,e) where     toMany (Tagged (a,b,c,d,e)) = a./b./c./d./e./nil-    fromMany r = Tagged (fetchN @0 r, fetchN @1 r, fetchN @2 r, fetchN @3 r, fetchN @4 r)+    fromMany r = Tagged (grabN @0 r, grabN @1 r, grabN @2 r, grabN @3 r, grabN @4 r)  instance IsMany Tagged '[a,b,c,d,e,f] (a,b,c,d,e,f) where     toMany (Tagged (a,b,c,d,e,f)) = a./b./c./d./e./f./nil-    fromMany r = Tagged ( fetchN @0 r, fetchN @1 r, fetchN @2 r, fetchN @3 r, fetchN @4 r-                        , fetchN @5 r)+    fromMany r = Tagged ( grabN @0 r, grabN @1 r, grabN @2 r, grabN @3 r, grabN @4 r+                        , grabN @5 r)  instance IsMany Tagged '[a,b,c,d,e,f,g] (a,b,c,d,e,f,g) where     toMany (Tagged (a,b,c,d,e,f,g)) = a./b./c./d./e./f./g./nil-    fromMany r = Tagged ( fetchN @0 r, fetchN @1 r, fetchN @2 r, fetchN @3 r, fetchN @4 r-                        , fetchN @5 r, fetchN @6 r)+    fromMany r = Tagged ( grabN @0 r, grabN @1 r, grabN @2 r, grabN @3 r, grabN @4 r+                        , grabN @5 r, grabN @6 r)  instance IsMany Tagged '[a,b,c,d,e,f,g,h] (a,b,c,d,e,f,g,h) where     toMany (Tagged (a,b,c,d,e,f,g,h)) = a./b./c./d./e./f./g./h./nil-    fromMany r = Tagged ( fetchN @0 r, fetchN @1 r, fetchN @2 r, fetchN @3 r, fetchN @4 r-                        , fetchN @5 r, fetchN @6 r, fetchN @7 r)+    fromMany r = Tagged ( grabN @0 r, grabN @1 r, grabN @2 r, grabN @3 r, grabN @4 r+                        , grabN @5 r, grabN @6 r, grabN @7 r)  instance IsMany Tagged '[a,b,c,d,e,f,g,h,i] (a,b,c,d,e,f,g,h,i) where     toMany (Tagged (a,b,c,d,e,f,g,h,i)) = a./b./c./d./e./f./g./h./i./ nil-    fromMany r = Tagged ( fetchN @0 r, fetchN @1 r, fetchN @2 r, fetchN @3 r, fetchN @4 r-                        , fetchN @5 r, fetchN @6 r, fetchN @7 r, fetchN @8 r)+    fromMany r = Tagged ( grabN @0 r, grabN @1 r, grabN @2 r, grabN @3 r, grabN @4 r+                        , grabN @5 r, grabN @6 r, grabN @7 r, grabN @8 r)  instance IsMany Tagged '[a,b,c,d,e,f,g,h,i,j] (a,b,c,d,e,f,g,h,i,j) where     toMany (Tagged (a,b,c,d,e,f,g,h,i,j)) = a./b./c./d./e./f./g./h./i./j./nil-    fromMany r = Tagged ( fetchN @0 r, fetchN @1 r, fetchN @2 r, fetchN @3 r, fetchN @4 r-                        , fetchN @5 r, fetchN @6 r, fetchN @7 r, fetchN @8 r, fetchN @9 r)+    fromMany r = Tagged ( grabN @0 r, grabN @1 r, grabN @2 r, grabN @3 r, grabN @4 r+                        , grabN @5 r, grabN @6 r, grabN @7 r, grabN @8 r, grabN @9 r)  instance IsMany Tagged '[a,b,c,d,e,f,g,h,i,j,k] (a,b,c,d,e,f,g,h,i,j,k) where     toMany (Tagged (a,b,c,d,e,f,g,h,i,j,k)) = a./b./c./d./e./f./g./h./i./j./k./nil-    fromMany r = Tagged ( fetchN @0 r, fetchN @1 r, fetchN @2 r, fetchN @3 r, fetchN @4 r-                        , fetchN @5 r, fetchN @6 r, fetchN @7 r, fetchN @8 r, fetchN @9 r-                        , fetchN @10 r)+    fromMany r = Tagged ( grabN @0 r, grabN @1 r, grabN @2 r, grabN @3 r, grabN @4 r+                        , grabN @5 r, grabN @6 r, grabN @7 r, grabN @8 r, grabN @9 r+                        , grabN @10 r)  instance IsMany Tagged '[a,b,c,d,e,f,g,h,i,j,k,l] (a,b,c,d,e,f,g,h,i,j,k,l) where     toMany (Tagged (a,b,c,d,e,f,g,h,i,j,k,l)) = a./b./c./d./e./f./g./h./i./j./k./l./nil-    fromMany r = Tagged ( fetchN @0 r, fetchN @1 r, fetchN @2 r, fetchN @3 r, fetchN @4 r-                        , fetchN @5 r, fetchN @6 r, fetchN @7 r, fetchN @8 r, fetchN @9 r-                        , fetchN @10 r, fetchN @11 r)+    fromMany r = Tagged ( grabN @0 r, grabN @1 r, grabN @2 r, grabN @3 r, grabN @4 r+                        , grabN @5 r, grabN @6 r, grabN @7 r, grabN @8 r, grabN @9 r+                        , grabN @10 r, grabN @11 r)  instance IsMany Tagged '[a,b,c,d,e,f,g,h,i,j,k,l,m] (a,b,c,d,e,f,g,h,i,j,k,l,m) where     toMany (Tagged (a,b,c,d,e,f,g,h,i,j,k,l,m)) = a./b./c./d./e./f./g./h./i./j./k./l./m./nil-    fromMany r = Tagged ( fetchN @0 r, fetchN @1 r, fetchN @2 r, fetchN @3 r, fetchN @4 r-                        , fetchN @5 r, fetchN @6 r, fetchN @7 r, fetchN @8 r, fetchN @9 r-                        , fetchN @10 r, fetchN @11 r, fetchN @12 r)+    fromMany r = Tagged ( grabN @0 r, grabN @1 r, grabN @2 r, grabN @3 r, grabN @4 r+                        , grabN @5 r, grabN @6 r, grabN @7 r, grabN @8 r, grabN @9 r+                        , grabN @10 r, grabN @11 r, grabN @12 r)  instance IsMany Tagged '[a,b,c,d,e,f,g,h,i,j,k,l,m,n] (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where     toMany (Tagged (a,b,c,d,e,f,g,h,i,j,k,l,m,n)) = a./b./c./d./e./f./g./h./i./j./k./l./m./n./nil-    fromMany r = Tagged ( fetchN @0 r, fetchN @1 r, fetchN @2 r, fetchN @3 r, fetchN @4 r-                        , fetchN @5 r, fetchN @6 r, fetchN @7 r, fetchN @8 r, fetchN @9 r-                        , fetchN @10 r, fetchN @11 r, fetchN @12 r, fetchN @13 r)+    fromMany r = Tagged ( grabN @0 r, grabN @1 r, grabN @2 r, grabN @3 r, grabN @4 r+                        , grabN @5 r, grabN @6 r, grabN @7 r, grabN @8 r, grabN @9 r+                        , grabN @10 r, grabN @11 r, grabN @12 r, grabN @13 r)  instance IsMany Tagged '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o] (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where     toMany (Tagged (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)) = a./b./c./d./e./f./g./h./i./j./k./l./m./n./o./nil-    fromMany r = Tagged ( fetchN @0 r, fetchN @1 r, fetchN @2 r, fetchN @3 r, fetchN @4 r-                        , fetchN @5 r, fetchN @6 r, fetchN @7 r, fetchN @8 r, fetchN @9 r-                        , fetchN @10 r, fetchN @11r, fetchN @12 r, fetchN @13 r, fetchN @14 r)+    fromMany r = Tagged ( grabN @0 r, grabN @1 r, grabN @2 r, grabN @3 r, grabN @4 r+                        , grabN @5 r, grabN @6 r, grabN @7 r, grabN @8 r, grabN @9 r+                        , grabN @10 r, grabN @11r, grabN @12 r, grabN @13 r, grabN @14 r)  ----------------------------------------------------------------------- --- | Analogous to 'Prelude.null'. Named 'nil' to avoid conflicting with 'Prelude.null'.+-- | Empty 'Many'. nil :: Many '[] nil = Many S.empty @@ -349,21 +349,21 @@ append (Many ls) (Many rs) = Many (ls S.>< rs) infixr 5 `append` -- like Data.List (++) -class CanAppendUnique xs ys where-   -- | Appends the unique fields fields from the right Many using 'postfix''-   append' :: Many xs -> Many ys -> Many (AppendUnique xs ys)+-- class CanAppendUnique xs ys where+--    -- | Appends the unique fields fields from the right Many using 'postfix''+--    append' :: Many xs -> Many ys -> Many (AppendUnique xs ys) -instance CanAppendUnique xs '[] where-   append' ls _ = ls+-- instance CanAppendUnique xs '[] where+--    append' ls _ = ls -instance ( MaybeUniqueMember y xs-         , CanAppendUnique (SnocUnique xs y) ys-         , AppendUnique (SnocUnique xs y) ys ~ AppendUnique xs (y : ys)) => CanAppendUnique xs (y ': ys) where-   append' ls rs = append' (postfix' ls r) rs'-     where (r, rs') = viewf rs-   {-# INLINABLE append' #-} -- This makes compiling tests a little faster than with no pragma+-- instance ( MaybeUniqueMember y xs+--          , CanAppendUnique (SnocUnique xs y) ys+--          , AppendUnique (SnocUnique xs y) ys ~ AppendUnique xs (y : ys)) => CanAppendUnique xs (y ': ys) where+--    append' ls rs = append' (postfix' ls r) rs'+--      where (r, rs') = viewf rs+--    {-# INLINABLE append' #-} -- This makes compiling tests a little faster than with no pragma -infixr 5 `append'` -- like Data.List (++)+-- infixr 5 `append'` -- like Data.List (++)  ----------------------------------------------------------------------- @@ -413,13 +413,13 @@ -- -- @ -- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nil'--- 'fetch' \@Int x \`shouldBe` 5+-- 'grab' \@Int x \`shouldBe` 5 -- @-fetch :: forall x xs. UniqueMember x xs => Many xs -> x-fetch (Many xs) = unsafeCoerce $ fetch_ @(IndexOf x xs) xs+grab :: forall x xs. UniqueMember x xs => Many xs -> x+grab (Many xs) = unsafeCoerce $ grab_ @(IndexOf x xs) xs -fetch_ :: forall n. KnownNat n => S.Seq Any -> Any-fetch_ xs = let !x = S.index xs i in x -- forcing x to avoid storing Seq in thunk+grab_ :: forall n. KnownNat n => S.Seq Any -> Any+grab_ xs = let !x = S.index xs i in x -- forcing x to avoid storing Seq in thunk   where i = fromInteger (natVal @n Proxy)  --------------------------------------------------@@ -429,18 +429,18 @@ -- -- @ -- let y = False './' Tagged \@Foo \'X' './' Tagged @"Hi" True './' 'nil'--- 'fetchL' \@Foo y \`shouldBe` Tagged \@Foo \'X'--- 'fetchL' \@"Hi" y \`shouldBe` Tagged \@"Hi" True+-- 'grabL' \@Foo y \`shouldBe` Tagged \@Foo \'X'+-- 'grabL' \@"Hi" y \`shouldBe` Tagged \@"Hi" True -- @-fetchL :: forall l x xs. (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => Many xs -> x-fetchL (Many xs) = unsafeCoerce $ fetch_ @(IndexOf x xs) xs+grabL :: forall l x xs. (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => Many xs -> x+grabL (Many xs) = unsafeCoerce $ grab_ @(IndexOf x xs) xs  -------------------------------------------------- --- | Variation of 'fetchL' specialized for 'Tagged' that untags the field.-fetchTag :: forall l x xs. (UniqueLabelMember l xs, Tagged l x ~ KindAtLabel l xs)+-- | Variation of 'grabL' specialized for 'Tagged' that untags the field.+grabTag :: forall l x xs. (UniqueLabelMember l xs, Tagged l x ~ KindAtLabel l xs)     => Many xs -> x-fetchTag xs = unTagged (fetchL @l xs)+grabTag xs = unTagged (grabL @l xs)  -------------------------------------------------- @@ -448,10 +448,10 @@ -- -- @ -- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nil'--- 'fetchN' @1 x \`shouldBe` False+-- 'grabN' @1 x \`shouldBe` False -- @-fetchN :: forall n x xs. MemberAt n x xs => Many xs -> x-fetchN (Many xs) = unsafeCoerce $ fetch_ @n xs+grabN :: forall n x xs. MemberAt n x xs => Many xs -> x+grabN (Many xs) = unsafeCoerce $ grab_ @n xs  -------------------------------------------------- @@ -529,7 +529,7 @@ replaceN' (Many xs) x = Many $ replace_ @n xs (unsafeCoerce x)  -- | Polymorphic version of 'replaceN''-replaceN :: forall n x y xs. MemberAt n x xs => Many xs -> y -> Many (ReplaceIndex n y xs)+replaceN :: forall n x y xs. MemberAt n x xs => Many xs -> y -> Many (ReplaceIndex n x y xs) replaceN (Many xs) x = Many $ replace_ @n xs (unsafeCoerce x)  -----------------------------------------------------------------------@@ -739,7 +739,7 @@         (CollectorAny (CaseSelect smaller larger) larger) (Maybe (Int, WrappedAny)))  -- | Construct a 'Many' with a smaller number of fields than the original.--- Analogous to 'fetch' getter but for multiple fields.+-- Analogous to 'grab' getter but for multiple fields. -- -- This can also be used to reorder fields in the original 'Many'. --

@@ -3,9 +3,9 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeInType #-}  module Data.Diverse.TypeLevel where @@ -117,63 +117,11 @@ type RemoveIndex (n :: Nat) (xs :: [k]) = RemoveIndexImpl n xs n xs  -- | The typelist @xs@ without the type at Nat @n@ replaced by @y@. @n@ must be within bounds of @xs@-type ReplaceIndex (n :: Nat) (y :: k) (xs :: [k]) = ReplaceIndexImpl n xs n y xs+type ReplaceIndex (n :: Nat) (x :: k) (y :: k) (xs :: [k]) = ReplaceIndexImpl n xs n x y xs  -- | The typelist @xs@ replaced by @ys@ at the indices @ns@. @ns@ and @ys@ must be the same length. @ns@ must be within bounds of @xs@ type ReplacesIndex (ns :: [Nat]) (ys :: [k]) (xs :: [k]) = ReplacesIndexImpl 0 ns ys xs --- | Returns the typelist up to and excluding @x@. If @x@ doesn't exist, then the original @xs@ is returned.-type family Before (x :: k) (xs :: [k]) :: [k] where-     Before x '[] = '[]-     Before x (x ': xs) = '[]-     Before x (y ': xs) = y ': Before x xs---- | Returns the typelist up to and including @x@. If @x@ doesn't exist, then the original @xs@ is returned.-type family To (x :: k) (xs :: [k]) :: [k] where-     To x '[] = '[]-     To x (x ': xs) = '[x]-     To x (y ': xs) = y ': To x xs---- | Returns the typelist after and excluding @x@. If @x@ doesn't exist, then an empty '[] is returned.-type family After (x :: k) (xs :: [k]) :: [k] where-     After x '[] = '[]-     After x (x ': xs) = xs-     After x (y ': xs) = After x xs---- | Returns the typelist after and including @x@. If @x@ doesn't exist, then an empty '[] is returned.-type family From (x :: k) (xs :: [k]) :: [k] where-     From x '[] = '[]-     From x (x ': xs) = (x ': xs)-     From x (y ': xs) = From x xs---- | Returns the typelist before (and exluding) index @n@.--- If @n@ is larger then the @xs@ size, then the original @xs@ is returned.-type family BeforeIndex (n :: Nat) (xs :: [k]) :: [k] where-     BeforeIndex n '[] = '[]-     BeforeIndex 0 xs = '[]-     BeforeIndex n (x ': xs) = x ': BeforeIndex (n - 1) xs---- | Returns the typelist up to (and including) index @n@.--- If @n@ is larger then the @xs@ size, then the original @xs@ is returned.-type family ToIndex (n :: Nat) (xs :: [k]) :: [k] where-     ToIndex n '[] = '[]-     ToIndex 0 (x ': xs) = '[x]-     ToIndex n (x ': xs) = x ': ToIndex (n - 1) xs---- | Returns the typelist after (and exluding) index @n@.--- If @n@ is larger then the @xs@ size, then an empty '[] is returned.-type family AfterIndex (n :: Nat) (xs :: [k]) :: [k] where-     AfterIndex n '[] = '[]-     AfterIndex 0 (_ ': xs) = xs-     AfterIndex n (x ': xs) = AfterIndex (n - 1) xs---- | Returns the typelist from (and including) index @n@.--- If @n@ is larger then the @xs@ size, then an empty '[] is returned.-type family FromIndex (n :: Nat) (xs :: [k]) :: [k] where-     FromIndex n '[] = '[]-     FromIndex 0 xs = xs-     FromIndex n (x ': xs) = FromIndex (n - 1) xs- -- | Get the typelist without the 'Head' type type family Tail (xs :: [k]) :: [k] where     Tail '[] = TypeError ('Text "Tail error: empty type list")@@ -188,10 +136,6 @@     Last '[] = TypeError ('Text "Last error: empty type list")     Last (x ': x' ': xs) = Last (x' ': xs)     Last '[x] = x--type family Length (xs :: [k]) :: Nat where-    Length '[] = 0-    Length (x ': xs) = 1 + Length xs  -- | Ensures two typelists are the same length type SameLength (xs :: [k1]) (ys :: [k2]) = SameLengthImpl xs ys xs ys

@@ -128,20 +128,22 @@     RemoveIndexImpl i ctx 0 (x ': xs) = xs     RemoveIndexImpl i ctx n (x ': xs) = x ': RemoveIndexImpl i ctx (n - 1) xs --- | The typelist @xs@ without the type at Nat @n@ replaced by @y@. @n@ must be within bounds of @xs@-type family ReplaceIndexImpl (i :: Nat) (ctx :: [k]) (n :: Nat) (y :: k) (xs :: [k]) :: [k] where-    ReplaceIndexImpl i ctx n y '[] = TypeError ('Text "ReplaceIndex error: Index ‘"+-- | The typelist @xs@ with the type at Nat @n@ replaced by @y@. @n@ must be within bounds of @xs@+type family ReplaceIndexImpl (i :: Nat) (ctx :: [k]) (n :: Nat) (x :: k) (y :: k) (xs :: [k]) :: [k] where+    ReplaceIndexImpl i ctx n x x xs = xs+    ReplaceIndexImpl i ctx n x y '[] = TypeError ('Text "ReplaceIndex error: Index ‘"                                        ':<>: 'ShowType i                                        ':<>: 'Text "’"                                        ':<>: 'Text " is out of bounds of "                                        ':<>: 'Text "‘"                                        ':<>: 'ShowType ctx                                        ':<>: 'Text "’")-    ReplaceIndexImpl i ctx 0 y (x ': xs) = y ': xs-    ReplaceIndexImpl i ctx n y (x ': xs) = x ': ReplaceIndexImpl i ctx (n - 1) y xs+    ReplaceIndexImpl i ctx 0 x y (z ': xs) = y ': xs+    ReplaceIndexImpl i ctx n x y (z ': xs) = z ': ReplaceIndexImpl i ctx (n - 1) x y xs  -- | The typelist @xs@ with the first @x@ replaced by @y@. It is okay for @x@ not to exist in @xs@ type family ReplaceImpl (x :: k) (y :: k) (xs :: [k]) :: [k] where+    ReplaceImpl x x xs = xs     ReplaceImpl x y '[] = '[]     ReplaceImpl x y (x ': xs) = y ': xs     ReplaceImpl x y (z ': xs) = z ': ReplaceImpl x y xs

@@ -6,6 +6,8 @@       -- * Single type       -- ** Construction     , impossible+    , impossible'+    , zilch     , pick     , pick0     , pickOnly@@ -37,12 +39,12 @@     , diversifyN       -- ** Inverse Injection     , Reinterpret-    , Reinterpreted+    -- , Reinterpreted     , reinterpret     , Reinterpret'     , reinterpret'     , ReinterpretL-    , ReinterpretedL+    -- , ReinterpretedL     , reinterpretL     , ReinterpretL'     , reinterpretL'

@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}  {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-}@@ -26,6 +27,8 @@       -- * Single type       -- ** Construction     , impossible+    , impossible'+    , zilch     , pick     , pick0     , pickOnly@@ -57,12 +60,12 @@     , diversifyN       -- ** Inverse Injection     , Reinterpret-    , Reinterpreted+    -- , Reinterpreted     , reinterpret     , Reinterpret'     , reinterpret'     , ReinterpretL-    , ReinterpretedL+    -- , ReinterpretedL     , reinterpretL     , ReinterpretL'     , reinterpretL'@@ -92,8 +95,9 @@ import Data.Proxy import Data.Semigroup (Semigroup(..)) import Data.Tagged-import qualified GHC.Generics as G+import Data.Void import GHC.Exts (Any, coerce)+import qualified GHC.Generics as G import GHC.TypeLits import Text.ParserCombinators.ReadPrec import Text.Read@@ -136,7 +140,7 @@  ---------------------------------------------- --- | A terminating 'G.Generic' instance for no types encoded as a 'zilch'.+-- | A terminating 'G.Generic' instance for no types encoded as a 'Which '[]'. -- The 'G.C1' and 'G.S1' metadata are not encoded. instance G.Generic (Which '[]) where     type Rep (Which '[]) = G.V1@@ -178,6 +182,16 @@ impossible a = case a of {} -- Copied from http://hackage.haskell.org/package/base/docs/src/Data.Void.html +-- | A @Which '[Void]@ is equivalent to @Which '[]@+-- A @Which '[Void]@ might occur if you lift a 'Void' into a @Which@ with 'pick'.+-- This allows you to convert it back to 'Void' or @Which '[]@+impossible' :: Which '[Void] -> a+impossible' a = case a of {}++-- | Monoid that is always 'mempty'+zilch :: Monoid (t (Which '[])) => t (Which '[])+zilch = mempty+ -- | Lift a value into a 'Which' of possibly other types @xs@. -- @xs@ can be inferred or specified with TypeApplications. -- NB. forall is used to specify @xs@ first, so TypeApplications can be used to specify @xs@ first@@ -465,8 +479,8 @@ -- | A friendlier constraint synonym for 'reinterpret'. type Reinterpret (branch :: [Type]) (tree :: [Type]) = Switch (CaseReinterpret branch tree) (Either (Which (Complement tree branch)) (Which branch)) tree --- | A variation of 'Reinterpret' that exposes @branchlessTree ~ Complement tree branch@-type Reinterpreted branch tree branchlessTree = (Reinterpret branch tree, branchlessTree ~ Complement tree branch)+-- -- | A variation of 'Reinterpret' that exposes @branchlessTree ~ Complement tree branch@+-- type Reinterpreted branch tree branchlessTree = (Reinterpret branch tree, branchlessTree ~ Complement tree branch)  -- | Convert a 'Which' into possibly another 'Which' with a totally different typelist. -- Returns either a 'Which' with the 'Right' value, or a 'Which' with the 'Left'over @compliment@ types.@@ -542,8 +556,8 @@     , IsDistinct ls     ) --- | A variation of 'ReinterpretL' that exposes @branchlessTree ~ Complement tree branch@-type ReinterpretedL ls branch tree branchlessTree = (ReinterpretL ls branch tree, branchlessTree ~ Complement tree branch)+-- -- | A variation of 'ReinterpretL' that exposes @branchlessTree ~ Complement tree branch@+-- type ReinterpretedL ls branch tree branchlessTree = (ReinterpretL ls branch tree, branchlessTree ~ Complement tree branch)  -- | A variation of 'reinterpret' where the @branch@ is additionally specified with a labels list. --@@ -644,6 +658,18 @@ -- can be done with 'impossible' instance Reduce (Which '[]) (Switcher c r '[]) where     reduce _ = impossible++-- | Allow 'Void' to be 'reinterpret''ed or 'diversify'ed into anything else+-- This is safe because @Void@ is uninhabited, and this is already something that+-- can be done with 'impossible'+instance Reduce (Void) (Switcher c r '[]) where+    reduce _ = absurd++-- | Allow 'Which \'[Void]' to be 'reinterpret''ed or 'diversify'ed into anything else+-- This is safe because @Which '[Void]@ is uninhabited, and this is already something that+-- can be done with 'impossible'+instance Reduce (Which '[Void]) (Switcher c r '[]) where+    reduce _ = impossible'  ------------------------------------------------------------------ 

@@ -35,10 +35,10 @@         --     let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             -- ghc 8.0.2: IndexOf error: ‘Maybe Bool’ is not a member of ...             -- ghc 8.0.1 has terrible error message: "No instance for (GHC.TypeLits.KnownNat"-            -- fetch @(Maybe Bool) y `shouldBe` (Just False)+            -- grab @(Maybe Bool) y `shouldBe` (Just False)              -- Not unique error: ‘Maybe Char’ is a duplicate in ...-            -- fetch @(Maybe Bool) y `shouldBe` (Just False)+            -- grab @(Maybe Bool) y `shouldBe` (Just False)          it "is a Typeable" $ do             let x = (5 :: Int) ./ False ./ nil@@ -103,10 +103,10 @@                 y = x `postfix'` True             y `shouldBe` x -        it "can 'append'' the unique types from another Many" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil-                y = (5 :: Int) ./ Just True ./ 'X' ./ Just False ./ Just (6 :: Int) ./ Just 'O' ./ nil-            (x `append'` y) `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ Just True ./ Just (6 :: Int) ./ nil+        -- it "can 'append'' the unique types from another Many" $ do+        --     let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+        --         y = (5 :: Int) ./ Just True ./ 'X' ./ Just False ./ Just (6 :: Int) ./ Just 'O' ./ nil+        --     (x `append'` y) `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ Just True ./ Just (6 :: Int) ./ nil          it "can contain multiple fields of the same type" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil@@ -123,39 +123,39 @@             aft a `shouldBe` (y \. z)             fore a `shouldBe` x ./ y -        it "has getter for unique fields using 'fetch'" $ do+        it "has getter for unique fields using 'grab'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil-            fetch @Int x `shouldBe` 5-            fetch @Bool x `shouldBe` False-            fetch @Char x `shouldBe` 'X'-            fetch @(Maybe Char) x `shouldBe` Just 'O'+            grab @Int x `shouldBe` 5+            grab @Bool x `shouldBe` False+            grab @Char x `shouldBe` 'X'+            grab @(Maybe Char) x `shouldBe` Just 'O' -        it "has getter for for unique fields using 'fetchN'" $ do+        it "has getter for for unique fields using 'grabN'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil-            fetchN @0 x `shouldBe` 5-            fetchN @1 x `shouldBe` False-            fetchN @2 x `shouldBe` 'X'-            fetchN @3 x `shouldBe` Just 'O'+            grabN @0 x `shouldBe` 5+            grabN @1 x `shouldBe` False+            grabN @2 x `shouldBe` 'X'+            grabN @3 x `shouldBe` Just 'O' -        it "has getter for duplicate fields using 'fetchN'" $ do+        it "has getter for duplicate fields using 'grabN'" $ do             let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil-            fetchN @0 y `shouldBe` 5-            fetchN @1 y `shouldBe` False-            fetchN @2 y `shouldBe` 'X'-            fetchN @3 y `shouldBe` Just 'O'-            fetchN @4 y `shouldBe` 6-            fetchN @5 y `shouldBe` Just 'A'+            grabN @0 y `shouldBe` 5+            grabN @1 y `shouldBe` False+            grabN @2 y `shouldBe` 'X'+            grabN @3 y `shouldBe` Just 'O'+            grabN @4 y `shouldBe` 6+            grabN @5 y `shouldBe` Just 'A' -        it "with duplicate fields can still use 'fetch' for unique fields" $ do+        it "with duplicate fields can still use 'grab' for unique fields" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil-            fetch @Bool x `shouldBe` False-            fetch @Char x `shouldBe` 'X'+            grab @Bool x `shouldBe` False+            grab @Char x `shouldBe` 'X' -        it "has getter for unique labels using 'fetchL'" $ do+        it "has getter for unique labels using 'grabL'" $ do             let y = (5 :: Int) ./ False ./ Tagged @Foo 'X' ./ Tagged @"Hello" (6 :: Int) ./ nil-            fetch @(Tagged Foo _) y `shouldBe` Tagged @Foo 'X'-            fetchL @Foo y `shouldBe` Tagged @Foo 'X'-            fetchL @"Hello" y `shouldBe` Tagged @"Hello" (6 :: Int)+            grab @(Tagged Foo _) y `shouldBe` Tagged @Foo 'X'+            grabL @Foo y `shouldBe` Tagged @Foo 'X'+            grabL @"Hello" y `shouldBe` Tagged @"Hello" (6 :: Int)          it "has setter for unique fields using 'replace''" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil

@@ -251,16 +251,16 @@             let x = pick @_ @'[Int] (5 :: Int)             case trial @Int x of                 Right y -> y `shouldBe` y-                Left zilch -> do+                Left z -> do                     -- Which '[] can be diversified into anything                     -- This is safe because Which '[] is uninhabited like Data.Void                     -- and so like Data.Void.absurd, "if given a falsehood, anything follows"-                    diversify @'[] @'[Int, Bool] zilch `shouldBe` impossible zilch-                    reinterpret' @'[] zilch `shouldBe` Just zilch-                    reinterpret @'[] zilch `shouldBe` Right zilch-                    diversify @'[] zilch `shouldBe` zilch-                    read (show zilch) `shouldBe` zilch-                    compare zilch zilch `shouldBe` EQ+                    diversify @'[] @'[Int, Bool] z `shouldBe` impossible z+                    reinterpret' @'[] z `shouldBe` Just z+                    reinterpret @'[] z `shouldBe` Right z+                    diversify @'[] z `shouldBe` z+                    read (show z) `shouldBe` z+                    compare z z `shouldBe` EQ             reinterpret' @'[] x `shouldBe` Nothing             reinterpret @'[] x `shouldBe` Left x @@ -268,4 +268,4 @@             let x = pick @_ @'[Int] (5 :: Int)             case trial @Int x of                 Right y -> y `shouldBe` y-                Left zilch -> impossible zilch+                Left z -> impossible z