data-diverse 0.2.1.0 → 0.3.0.0

raw patch · 10 files changed

+402/−210 lines, 10 filesdep ~data-diversePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: data-diverse

API changes (from Hackage documentation)

Files

• data-diverse.cabal +4/−4
• src/Data/Diverse/Case.hs +9/−1
• src/Data/Diverse/Cases.hs +1/−1
• src/Data/Diverse/Many.hs +14/−8
• src/Data/Diverse/Many/Internal.hs +163/−110
• src/Data/Diverse/PackageId.hs +0/−7
• src/Data/Diverse/Type.hs +27/−13
• src/Data/Diverse/Type/Internal.hs +88/−11
• src/Data/Diverse/Which/Internal.hs +11/−25
• test/Data/Diverse/ManySpec.hs +85/−30

@@ -1,5 +1,5 @@ name:                data-diverse-version:             0.2.1.0+version:             0.3.0.0 synopsis:            Extensible records and polymorphic variants. description:         "Data.Diverse.Many" is an extensible record for any size encoded efficiently as (Int, Map Int Any).                      "Data.Diverse.Which" is a polymorphic variant of possibilities encoded as (Int, Any).@@ -29,13 +29,12 @@                        Data.Diverse.Emit                        Data.Diverse.Many                        Data.Diverse.Many.Internal-                       Data.Diverse.PackageId                        Data.Diverse.Reduce                        Data.Diverse.Reiterate                        Data.Diverse.Type-                       Data.Diverse.Type.Internal                        Data.Diverse.Which                        Data.Diverse.Which.Internal+  other-modules:       Data.Diverse.Type.Internal   build-depends:       base >= 4.7 && < 5                      , containers >= 0.5 && < 0.6                      , ghc-prim >= 0.5 && < 1@@ -52,9 +51,10 @@                        Data.Diverse.TypeSpec                        Data.Diverse.WhichSpec   build-depends:       base-                     , data-diverse+                     , data-diverse >= 0.2.1 && < 1                      , hspec >= 2 && < 3                      , lens >= 4 && < 5+                     , tagged >= 0.8.5 && < 1   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall   default-language:    Haskell2010 

@@ -1,12 +1,15 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}  module Data.Diverse.Case where  import Data.Diverse.Type import Data.Kind+import GHC.Prim (Any)+import Unsafe.Coerce  -- | This class allows defining handlers that can handle the 'Head' type in the @xs@ typelist. -- In conjunction with 'Data.Diverse.Reiterate.Reiterate', you can define handlers that can handle all@@ -15,4 +18,9 @@ -- See "Data.Diverse.CaseTypeable" and "Data.Diverse.Cases". class Case c (xs :: [Type]) r where     -- | Return the handler/continuation when x is observed.-    case' :: c xs r -> (Head xs -> r)+    case' :: c xs r -> Head xs -> r+    case' c v = caseAny c (unsafeCoerce v)++    -- | A variation of 'case'' where x is left as 'Any'+    caseAny :: c xs r -> Any -> r+    caseAny c v = case' c (unsafeCoerce v)

@@ -62,7 +62,7 @@ -- This function imposes additional @SameLength@ constraints than when using the 'Cases' constructor directly. -- It is better practice to use 'cases' to prevent programming confusion with dead code. -- However, the 'Cases' constructor is still exported to allow creating a master-of-all-'Case'.-cases :: SameLength fs (Distinct xs) => Many fs -> (Cases fs) xs r+cases :: SameLength fs (Nub xs) => Many fs -> (Cases fs) xs r cases = Cases  -----------------------------------------------

@@ -29,32 +29,38 @@     -- * Single field     -- ** Getter for single field     , fetch-    , (.^.)     , fetchN     -- ** Setter for single field     , replace-    , (.~.)+    , replace'     , replaceN+    , replaceN'     -- ** Lens for a single field     , item+    , item'     , itemN+    , itemN'      -- * Multiple fields     -- ** Getter for multiple fields-    , Narrow-    , narrow-    , (\^.)-    , NarrowN-    , narrowN+    , Select+    , select+    , SelectN+    , selectN     -- ** Setter for multiple fields     , Amend     , amend-    , (\~.)+    , Amend'+    , amend'     , AmendN     , amendN+    , AmendN'+    , amendN'     -- ** Lens for multiple fields     , project+    , project'     , projectN+    , projectN'      -- * Destruction     -- ** By type

@@ -46,32 +46,38 @@     -- * Single field     -- ** Getter for single field     , fetch-    , (.^.)     , fetchN     -- ** Setter for single field     , replace-    , (.~.)+    , replace'     , replaceN+    , replaceN'     -- ** Lens for a single field     , item+    , item'     , itemN+    , itemN'      -- * Multiple fields     -- ** Getter for multiple fields-    , Narrow-    , narrow-    , (\^.)-    , NarrowN-    , narrowN+    , Select+    , select+    , SelectN+    , selectN     -- ** Setter for multiple fields     , Amend     , amend-    , (\~.)+    , Amend'+    , amend'     , AmendN     , amendN+    , AmendN'+    , amendN'     -- ** Lens for multiple fields     , project+    , project'     , projectN+    , projectN'      -- * Destruction     -- ** By type@@ -93,7 +99,6 @@ import Data.Diverse.Case import Data.Diverse.Collector import Data.Diverse.Emit-import Data.Diverse.PackageId import Data.Diverse.Reiterate import Data.Diverse.Type import Data.Kind@@ -124,7 +129,7 @@ -- The following functions are available can be used to manipulate unique fields -- -- * getter/setter for single field: 'fetch' and 'replace'--- * getter/setter for multiple fields: 'narrow' and 'amend'+-- * getter/setter for multiple fields: 'select' and 'amend' -- * folds: 'forMany' or 'collect' -- -- These functions are type specified. This means labels are not required because the types themselves can be used to access the 'Many.@@ -133,7 +138,7 @@ -- For duplicate fields, Nat-indexed versions of the functions are available: -- -- * getter/setter for single field: 'fetchN' and 'replaceN'--- * getter/setter for multiple fields: 'narrowN' and 'amendN'+-- * getter/setter for multiple fields: 'selectN' and 'amendN' -- * folds: 'forManyN' or 'collectN' -- -- Encoding: The record is encoded as (Offset, Map Int Any).@@ -155,24 +160,16 @@  -- | A terminating 'G.Generic' instance encoded as a 'nul'. instance G.Generic (Many '[]) where-    type Rep (Many '[]) = G.D1 ('G.MetaData-                              "Many"-                              "Data.Diverse.Many.Internal"-                              PackageId-                              'False) G.U1-    from _ = {- G.D1 -} G.M1 {- G.U1 -} G.U1-    to (G.M1 G.U1) = nul+    type Rep (Many '[]) =  G.U1+    from _ = {- G.U1 -} G.U1+    to G.U1 = nul  -- | A 'G.Generic' instance encoded as the 'front' value 'G.:*:' with the 'aft' 'Many'. -- The 'G.C1' and 'G.S1' metadata are not encoded. instance G.Generic (Many (x ': xs)) where-    type Rep (Many (x ': xs)) = G.D1 ('G.MetaData-                              "Many"-                              "Data.Diverse.Many.Internal"-                              PackageId-                              'False) ((G.Rec0 x) G.:*: (G.Rec0 (Many xs)))-    from r = {- G.D1 -} G.M1 (({- G.Rec0 -} G.K1 (front r)) G.:*: ({- G.Rec0 -} G.K1 (aft r)))-    to ({- G.D1 -} G.M1 (({- G.Rec0 -} G.K1 a) G.:*: ({- G.Rec0 -} G.K1 b))) = a ./ b+    type Rep (Many (x ': xs)) = (G.Rec0 x) G.:*: (G.Rec0 (Many xs))+    from r = ({- G.Rec0 -} G.K1 (front r)) G.:*: ({- G.Rec0 -} G.K1 (aft r))+    to (({- G.Rec0 -} G.K1 a) G.:*: ({- G.Rec0 -} G.K1 b)) = a ./ b  ----------------------------------------------------------------------- @@ -410,18 +407,6 @@ fetch (Many o m) = unsafeCoerce (m M.! (Key (o + i)))   where i = fromInteger (natVal @(IndexOf x xs) Proxy) --- | infix version of 'fetch', with a extra proxy to carry the destination type.------ Mnemonic: Like 'Control.Lens.(^.)' but with an extra @.@ in front.------ @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nul'--- x '.^.' (Proxy \@Int) \`shouldBe` 5--- @-(.^.) :: forall x xs proxy. UniqueMember x xs => Many xs -> proxy x -> x-(.^.) v _ = fetch v-infixl 8 .^. -- like Control.Lens.(^.)- --------------------------------------------------  -- | Getter by index. Get the value of the field at index type-level Nat @n@@@ -443,17 +428,15 @@ replace (Many o m) v = Many o (M.insert (Key (o + i)) (unsafeCoerce v) m)   where i = fromInteger (natVal @(IndexOf x xs) Proxy) --- | infix version of 'replace'------ Mnemonic: Like a back to front 'Control.Lens.(.~)' with an extra @.@ in front.+-- | Polymorphic setter by unique type. Set the field with type @x@, and replace with type @y@ -- -- @ -- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nul'--- (x '.~.' (6 :: Int)) \`shouldBe` (6 :: Int) './' False './' \'X' './' Just \'O' './' 'nul'+-- 'replace'' \@Int Proxy x (Just True) \`shouldBe` Just True './' False './' \'X' './' Just \'O' './' 'nul' -- @-(.~.) :: forall x xs. UniqueMember x xs => Many xs -> x -> Many xs-(.~.) = replace-infixl 1 .~. -- like Control.Lens.(.~)+replace' :: forall x y xs. UniqueMember x xs => Proxy x -> Many xs -> y -> Many (Replace x y xs)+replace' _ (Many o m) v = Many o (M.insert (Key (o + i)) (unsafeCoerce v) m)+  where i = fromInteger (natVal @(IndexOf x xs) Proxy)  -------------------------------------------------- @@ -463,10 +446,15 @@ -- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nul' -- 'replaceN' \@0 Proxy x 7 `shouldBe` -- @-replaceN :: forall n x xs proxy. MemberAt n x xs => proxy n -> Many xs -> x -> Many xs+replaceN :: forall n x y xs proxy. MemberAt n x xs => proxy n -> Many xs -> y -> Many xs replaceN p (Many o m) v = Many o (M.insert (Key (o + i)) (unsafeCoerce v) m)   where i = fromInteger (natVal p) +-- | Polymorphic version of 'replaceN'+replaceN' :: forall n x y xs proxy. MemberAt n x xs => proxy n -> Many xs -> y -> Many (ReplaceIndex n y xs)+replaceN' p (Many o m) v = Many o (M.insert (Key (o + i)) (unsafeCoerce v) m)+  where i = fromInteger (natVal p)+ -----------------------------------------------------------------------  -- | 'fetch' ('view' 'item') and 'replace' ('set' 'item') in 'Lens'' form.@@ -480,6 +468,11 @@ item = lens fetch replace {-# INLINE item #-} +-- | Polymorphic version of 'item'+item' :: forall x y xs. UniqueMember x xs => Lens (Many xs) (Many (Replace x y xs)) x y+item' = lens fetch (replace' @x @y Proxy)+{-# INLINE item' #-}+ -- | 'fetchN' ('view' 'item') and 'replaceN' ('set' 'item') in 'Lens'' form. -- -- @@@ -491,12 +484,20 @@ itemN p = lens (fetchN p) (replaceN p) {-# INLINE itemN #-} ++-- | Polymorphic version of 'itemN'+itemN' ::  forall n x y xs proxy. MemberAt n x xs => proxy n -> Lens (Many xs) (Many (ReplaceIndex n y xs)) x y+itemN' p = lens (fetchN p) (replaceN' @n @x @y p)+{-# INLINE itemN' #-}+ -----------------------------------------------------------------------  -- | Internal function for construction - do not expose! fromList' :: Ord k => [(k, WrappedAny)] -> M.Map k Any fromList' xs = M.fromList (coerce xs) +-----------------------------------------------------------------------+ -- | Wraps a 'Case' into an instance of 'Emit', 'reiterate'ing and feeding 'Case' with the value from the 'Many' -- and 'emit'ting the results. --@@ -514,11 +515,13 @@     reiterate (Via (c, xxs)) = Via (reiterate c, Partial.tail xxs)  instance (Case c (x ': xs) r) => Emit (Via c) (x ': xs) r where-    emit (Via (c, xxs)) = case' c (unsafeCoerce v)+    emit (Via (c, xxs)) = caseAny c v       where        -- use of front here is safe as we are guaranteed the length from the typelist        v = Partial.head xxs +-----------------------------------------------------------------------+ -- | Folds any 'Many', even with indistinct types. -- Given __distinct__ handlers for the fields in 'Many', create a 'Collector' -- of the results of running the handlers over the fields in 'Many'.@@ -559,7 +562,7 @@     reiterateN (ViaN (c, xxs)) = ViaN (reiterateN c, Partial.tail xxs)  instance (Case (c n) (x ': xs) r) => Emit (ViaN c n) (x ': xs) r where-    emit (ViaN (c, xxs)) = case' c (unsafeCoerce v)+    emit (ViaN (c, xxs)) = caseAny c v       where        -- use of front here is safe as we are guaranteed the length from the typelist        v = Partial.head xxs@@ -592,10 +595,10 @@  ----------------------------------------------------------------------- --- | A friendlier type constraint synomyn for 'narrow'-type Narrow (smaller :: [Type]) (larger :: [Type]) =+-- | A friendlier type constraint synomyn for 'select'+type Select (smaller :: [Type]) (larger :: [Type]) =     (AFoldable-        ( Collector (Via (CaseNarrow smaller larger)) larger) [(Key, WrappedAny)])+        ( Collector (Via (CaseSelect smaller larger)) larger) [(Key, WrappedAny)])  -- | Construct a 'Many' with a smaller number of fields than the original. -- Analogous to 'fetch' getter but for multiple fields.@@ -604,50 +607,38 @@ -- -- @ -- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nul'--- 'narrow' \@'[Bool, Char] x \`shouldBe` False './' \'X' './' 'nul'+-- 'select' \@'[Bool, Char] x \`shouldBe` False './' \'X' './' 'nul' -- @-narrow :: forall smaller larger. Narrow smaller larger => Many larger -> Many smaller-narrow t = Many 0 (fromList' xs')+select :: forall smaller larger. Select smaller larger => Many larger -> Many smaller+select t = Many 0 (fromList' xs')   where-    xs' = afoldr (++) [] (forMany (CaseNarrow @smaller @larger @larger) t)---- | infix version of 'narrow', with a extra proxy to carry the @smaller@ type.------ Mnemonic: Like 'Control.Lens.(^.)' but with an extra '\' (narrow to the right) in front.------ @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nul'--- x '\^.' (Proxy @'[Bool, Char]) \`shouldBe` False './' \'X' './' 'nul'--- @-(\^.) :: forall smaller larger proxy. Narrow smaller larger => Many larger -> proxy smaller -> Many smaller-(\^.) t _ = narrow t-infixl 8 \^. -- like Control.Lens.(^.)+    xs' = afoldr (++) [] (Collector (via (CaseSelect @smaller @larger @larger) t))  -- | For each type x in @larger@, generate the (k, v) in @smaller@ (if it exists)-data CaseNarrow (smaller :: [Type]) (larger :: [Type]) (xs :: [Type]) r = CaseNarrow+data CaseSelect (smaller :: [Type]) (larger :: [Type]) (xs :: [Type]) r = CaseSelect -instance Reiterate (CaseNarrow smaller larger) (x ': xs) where-    reiterate CaseNarrow = CaseNarrow+instance Reiterate (CaseSelect smaller larger) (x ': xs) where+    reiterate CaseSelect = CaseSelect  -- | For each type x in larger, find the index in ys, and create an (incrementing key, value) instance forall smaller larger x xs. (UniqueIfExists smaller x larger, MaybeUniqueMember x smaller) =>-         Case (CaseNarrow smaller larger) (x ': xs) [(Key, WrappedAny)] where-    case' _ v =+         Case (CaseSelect smaller larger) (x ': xs) [(Key, WrappedAny)] where+    caseAny _ v =         case i of             0 -> []-            i' -> [(Key (i' - 1), WrappedAny (unsafeCoerce v))]+            i' -> [(Key (i' - 1), WrappedAny v)]       where         i = fromInteger (natVal @(PositionOf x smaller) Proxy)  ----------------------------------------------------------------------- --- | A friendlier type constraint synomyn for 'narrowN'-type NarrowN (ns :: [Nat]) (smaller ::[Type]) (larger :: [Type]) =-    ( AFoldable (CollectorN (ViaN (CaseNarrowN ns smaller)) 0 larger) [(Key, WrappedAny)]+-- | A friendlier type constraint synomyn for 'selectN'+type SelectN (ns :: [Nat]) (smaller ::[Type]) (larger :: [Type]) =+    ( AFoldable (CollectorN (ViaN (CaseSelectN ns smaller)) 0 larger) [(Key, WrappedAny)]     , smaller ~ KindsAtIndices ns larger     , IsDistinct ns) --- | A variation of 'narrow' which uses a Nat list @n@ to specify how to reorder the fields, where+-- | A variation of 'select' which uses a Nat list @n@ to specify how to reorder the fields, where -- -- @ -- indices[branch_idx] = tree_idx@@@ -658,28 +649,28 @@ -- -- @ -- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nul'--- 'narrowN' (Proxy @'[5, 4, 0]) x \`shouldBe` Just \'A' './' (6 :: Int) './' (5 ::Int) './' 'nul'+-- 'selectN' (Proxy @'[5, 4, 0]) x \`shouldBe` Just \'A' './' (6 :: Int) './' (5 ::Int) './' 'nul' -- @-narrowN+selectN     :: forall ns smaller larger proxy.-       NarrowN ns smaller larger+       SelectN ns smaller larger     => proxy ns -> Many larger -> Many smaller-narrowN _ xs = Many 0 (fromList' xs')+selectN _ xs = Many 0 (fromList' xs')   where-    xs' = afoldr (++) [] (forManyN (CaseNarrowN @ns @smaller @0 @larger) xs)+    xs' = afoldr (++) [] (forManyN (CaseSelectN @ns @smaller @0 @larger) xs) -data CaseNarrowN (indices :: [Nat]) (smaller :: [Type]) (n :: Nat) (xs :: [Type]) r = CaseNarrowN+data CaseSelectN (indices :: [Nat]) (smaller :: [Type]) (n :: Nat) (xs :: [Type]) r = CaseSelectN -instance ReiterateN (CaseNarrowN indices smaller) n (x ': xs) where-    reiterateN CaseNarrowN = CaseNarrowN+instance ReiterateN (CaseSelectN indices smaller) n (x ': xs) where+    reiterateN CaseSelectN = CaseSelectN  -- | For each type x in @larger@, find the index in ys, and create an (incrementing key, value) instance forall indices smaller n x xs. MaybeMemberAt (PositionOf n indices) x smaller =>-         Case (CaseNarrowN indices smaller n) (x ': xs) [(Key, WrappedAny)] where-    case' _ v =+         Case (CaseSelectN indices smaller n) (x ': xs) [(Key, WrappedAny)] where+    caseAny _ v =         case i of             0 -> []-            i' -> [(Key (i' - 1), WrappedAny (unsafeCoerce v))]+            i' -> [(Key (i' - 1), WrappedAny v)]       where         i = fromInteger (natVal @(PositionOf n indices) Proxy) @@ -702,19 +693,6 @@   where     xs' = afoldr (:) [] (forMany (CaseAmend @larger @smaller lo) t) --- | infix version of 'amend'. Mnemonic: Like 'Control.Lens.(.~)' but with an extra '\' (narrow to the right) in front.------ Mnemonic: Like backwards 'Control.Lens.(^.)' but with an extra '\' (narrow to the right) in front.------ @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nul'--- (x '\~.' (6 :: Int) './' Just \'P' './' 'nul') \`shouldBe`---     (6 :: Int) './' False './' \'X' './' Just \'P' './' 'nul'--- @-(\~.) :: forall smaller larger. Amend smaller larger => Many larger -> Many smaller -> Many larger-(\~.) = amend-infixl 1 \~. -- like Control.Lens.(.~)- newtype CaseAmend (larger :: [Type]) (xs :: [Type]) r = CaseAmend Int  instance Reiterate (CaseAmend larger) (x ': xs) where@@ -722,12 +700,38 @@  -- | for each x in @smaller@, convert it to a (k, v) to insert into the x in @Many larger@ instance UniqueMember x larger => Case (CaseAmend larger) (x ': xs) (Key, WrappedAny) where-    case' (CaseAmend lo) v = (Key (lo + i), WrappedAny (unsafeCoerce v))+    caseAny (CaseAmend lo) v = (Key (lo + i), WrappedAny v)       where         i = fromInteger (natVal @(IndexOf x larger) Proxy)  ----------------------------------------------------------------------- +-- | A friendlier type constraint synomyn for 'amend''+type Amend' smaller smaller' larger = (AFoldable (Collector (Via (CaseAmend' larger)) (Zip smaller smaller')) (Key, WrappedAny), IsDistinct smaller)++amend' :: forall smaller smaller' larger. Amend' smaller smaller' larger+    => Proxy smaller -> Many larger -> Many smaller' -> Many (Replaces smaller smaller' larger)+amend' _ (Many lo lm) t = Many lo (fromList' xs' `M.union` lm)+  where+    xs' = afoldr (:) [] (Collector (via' @smaller Proxy (CaseAmend' @larger @(Zip smaller smaller') lo) t))++-- | We are cheating here and saying that the @y@ can be unsafeCoerced into a type of @(x, y)@+-- but we only every coerce from 'Any' back into @y@in the @caseAny (CaseAmend' lo) v@ below.+via' :: Proxy xs -> c (Zip xs ys) r -> Many ys -> Via c (Zip xs ys) r+via' _ c (Many _ m) = Via (c, snd <$> M.toAscList m)++newtype CaseAmend' (larger :: [Type]) (zs :: [Type]) r = CaseAmend' Int++instance Reiterate (CaseAmend' larger) (z ': zs) where+    reiterate (CaseAmend' lo) = CaseAmend' lo++-- | for each y in @smaller@, convert it to a (k, v) to insert into the x in @Many larger@+instance UniqueMember x larger => Case (CaseAmend' larger) ((x, y) ': zs) (Key, WrappedAny) where+    caseAny (CaseAmend' lo) v = (Key (lo + i), WrappedAny v)+      where+        i = fromInteger (natVal @(IndexOf x larger) Proxy)++----------------------------------------------------------------------- -- | A friendlier type constraint synomyn for 'amendN' type AmendN ns smaller larger =     ( AFoldable (CollectorN (ViaN (CaseAmendN ns larger)) 0 smaller) (Key, WrappedAny)@@ -755,6 +759,8 @@   where     xs' = afoldr (:) [] (forManyN (CaseAmendN @ns @larger @0 @smaller lo) t) +-----------------------------------------------------------------------+ newtype CaseAmendN (indices :: [Nat]) (larger :: [Type]) (n :: Nat) (xs :: [Type]) r = CaseAmendN Int  instance ReiterateN (CaseAmendN indices larger) n (x ': xs) where@@ -763,16 +769,47 @@ -- | for each x in @smaller@, convert it to a (k, v) to insert into the x in @larger@ instance (MemberAt (KindAtIndex n indices) x larger) =>          Case (CaseAmendN indices larger n) (x ': xs) (Key, WrappedAny) where-    case' (CaseAmendN lo) v = (Key (lo + i), WrappedAny (unsafeCoerce v))+    caseAny (CaseAmendN lo) v = (Key (lo + i), WrappedAny v)       where         i = fromInteger (natVal @(KindAtIndex n indices) Proxy) +-- | A friendlier type constraint synomyn for 'amendN'+type AmendN' ns smaller smaller' larger =+    ( AFoldable (CollectorN (ViaN (CaseAmendN' ns larger)) 0 (Zip smaller smaller')) (Key, WrappedAny)+    , smaller ~ KindsAtIndices ns larger+    , IsDistinct ns)++-- | A polymorphic variation of 'amendN'+amendN' :: forall ns smaller smaller' larger proxy.+       (AmendN' ns smaller smaller' larger)+    => proxy ns -> Many larger -> Many smaller' -> Many (ReplacesIndex ns smaller' larger)+amendN' _ (Many lo lm) t = Many lo (fromList' xs' `M.union` lm)+  where+    xs' = afoldr (:) [] (CollectorN (viaN' @smaller Proxy (CaseAmendN' @ns @larger @0 @(Zip smaller smaller') lo) t))++-- | We are cheating here and saying that the @y@ can be unsafeCoerced into a type of @(x, y)@+-- but we only every coerce from 'Any' back into @y@in the @caseAny (CaseAmend' lo) v@ below.+viaN' :: Proxy xs -> c n (Zip xs ys) r -> Many ys -> ViaN c n (Zip xs ys) r+viaN' _ c (Many _ m) = ViaN (c, snd <$> M.toAscList m)++newtype CaseAmendN' (indices :: [Nat]) (larger :: [Type]) (n :: Nat) (zs :: [Type]) r = CaseAmendN' Int++instance ReiterateN (CaseAmendN' indices larger) n (z ': zs) where+    reiterateN (CaseAmendN' lo) = CaseAmendN' lo++-- | for each x in @smaller@, convert it to a (k, v) to insert into the x in @larger@+instance (MemberAt (KindAtIndex n indices) x larger) =>+         Case (CaseAmendN' indices larger n) ((x, y) ': zs) (Key, WrappedAny) where+    caseAny (CaseAmendN' lo) v = (Key (lo + i), WrappedAny v)+      where+        i = fromInteger (natVal @(KindAtIndex n indices) Proxy)+ ----------------------------------------------------------------------- --- | 'narrow' ('view' 'project') and 'amend' ('set' 'project') in 'Lens'' form.+-- | 'select' ('view' 'project') and 'amend' ('set' 'project') in 'Lens'' form. -- -- @--- 'project' = 'lens' 'narrow' 'amend'+-- 'project' = 'lens' 'select' 'amend' -- @ -- -- @@@ -783,15 +820,23 @@ -- @ project     :: forall smaller larger.-       (Narrow smaller larger, Amend smaller larger)+       (Select smaller larger, Amend smaller larger)     => Lens' (Many larger) (Many smaller)-project = lens narrow amend+project = lens select amend {-# INLINE project #-} --- | 'narrowN' ('view' 'projectN') and 'amendN' ('set' 'projectN') in 'Lens'' form.+-- | Polymorphic version of project'+project'+    :: forall smaller smaller' larger.+       (Select smaller larger, Amend' smaller smaller' larger)+    => Lens (Many larger) (Many (Replaces smaller smaller' larger)) (Many smaller) (Many smaller')+project' = lens select (amend' @smaller @smaller' Proxy)+{-# INLINE project' #-}++-- | 'selectN' ('view' 'projectN') and 'amendN' ('set' 'projectN') in 'Lens'' form. -- -- @--- 'projectN' = 'lens' 'narrowN' 'amendN'+-- 'projectN' = 'lens' 'selectN' 'amendN' -- @ -- -- @@@ -802,10 +847,18 @@ -- @ projectN     :: forall ns smaller larger proxy.-       (NarrowN ns smaller larger, AmendN ns smaller larger)+       (SelectN ns smaller larger, AmendN ns smaller larger)     => proxy ns -> Lens' (Many larger) (Many smaller)-projectN p = lens (narrowN p) (amendN p)+projectN p = lens (selectN p) (amendN p) {-# INLINE projectN #-}++-- | Polymorphic version of 'projectN'+projectN'+    :: forall ns smaller smaller' larger proxy.+       (SelectN ns smaller larger, AmendN' ns smaller smaller' larger)+    => proxy ns -> Lens (Many larger) (Many (ReplacesIndex ns smaller' larger)) (Many smaller) (Many smaller')+projectN' p = lens (selectN p) (amendN' p)+{-# INLINE projectN' #-}  ----------------------------------------------------------------------- 

@@ -1,7 +0,0 @@-{-# LANGUAGE DataKinds #-}--module Data.Diverse.PackageId where---- | This is used for the Generic D1 metadata.--- NB. package id is obtained by running `stack exec ghc-pkg describe data-diverse`-type PackageId = "data-diverse-0.2.1.0-HVzNZDHjJfaFyNLHjSdOFm"

@@ -35,9 +35,9 @@ type IsDistinct (xs :: [k]) = IsDistinctImpl xs xs  -- | Return the list of distinct types in a typelist-type family Distinct (xs :: [k]) :: [k] where-    Distinct '[] = '[]-    Distinct (x ': xs) = DistinctImpl xs x xs+type family Nub (xs :: [k]) :: [k] where+    Nub '[] = '[]+    Nub (x ': xs) = NubImpl xs x xs  -- | Ensures that @x@ only ever appears once in @xs@ type Unique (x :: k) (xs :: [k]) = UniqueImpl xs x xs@@ -53,6 +53,9 @@ -- | Get the type at an index type KindAtIndex (n :: Nat) (xs :: [k]) = KindAtIndexImpl n xs n xs +-- | Get the type at a label+type KindAtLabel (l :: k1) (xs :: [k2]) = KindAtLabelImpl l xs xs+ -- | It's actually ok for the position to be zero, but if it's not zero then the types must match type family KindAtPositionIs (n :: Nat) (x :: k) (xs :: [k]) :: Constraint where     KindAtPositionIs 0 x xs = ()@@ -63,33 +66,41 @@     KindsAtIndices '[] xs = '[]     KindsAtIndices (n ': ns) xs = KindAtIndex n xs ': KindsAtIndices ns xs --- | The typelist @xs@ without @x@. It is okay for @x@ not to exist in @xs@+-- | The typelist @xs@ without first @x@. It is okay for @x@ not to exist in @xs@ type family Without (x :: k) (xs :: [k]) :: [k] where     Without x '[] = '[]-    Without x (x ': xs) = Without x xs+    Without x (x ': xs) = xs     Without x (y ': xs) = y ': Without x xs +-- | The typelist @xs@ with the first @x@ replaced by @y@. It is okay for @x@ not to exist in @xs@+type Replace (x :: k) (y :: k) (xs :: [k]) = ReplaceImpl x y xs++-- | The typelist @zs@ with the first @xs@ replaced by @ys@.+-- @xs@ must be the same size as @ys@+type Replaces (xs :: [k]) (ys :: [k]) (zs :: [k]) = ReplacesImpl xs ys xs ys zs+ -- | The typelist @xs@ without the type at Nat @n@. @n@ must be within bounds of @xs@ type WithoutIndex (n :: Nat) (xs :: [k]) = WithoutIndexImpl n xs n xs --- | Gets the ength of a typelist-type family Length (xs :: [k]) :: Nat where-    Length '[] = 0-    Length (x ': xs) = 1 + Length 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 +-- | 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+ -- | Get the typelist without the 'Head' type type family Tail (xs :: [k]) :: [k] where-    Tail '[] = TypeError ('Text "Cannot Tail an empty type list")+    Tail '[] = TypeError ('Text "Tail error: empty type list")     Tail (x ': xs) = xs  -- | Get the first type in a typelist type family Head (xs :: [k]) :: k where-    Head '[] = TypeError ('Text "Cannot Head an empty type list")+    Head '[] = TypeError ('Text "Head error: empty type list")     Head (x ': xs) = x  -- | Get the last type in a typelist type family Last (xs :: [k]) :: k where-    Last '[] = TypeError ('Text "Cannot Last an empty type list")+    Last '[] = TypeError ('Text "Last error: empty type list")     Last (x ': x' ': xs) = Last (x' ': xs)     Last '[x] = x @@ -108,6 +119,9 @@  -- | Returns the typelist without the 'Last' type type family Init (xs :: [k]) :: [k] where-    Init '[]  = TypeError ('Text "Cannot Init an empty type list")+    Init '[]  = TypeError ('Text "Init error: empty type list")     Init '[x] = '[]     Init (x ': xs) = x ': Init xs++-- | Takes two lists which must be the same length and returns a list of corresponding pairs.+type Zip (xs :: [k]) (ys :: [k]) = ZipImpl xs ys xs ys

@@ -20,7 +20,7 @@ type family IndexOfImpl (ctx :: [k]) (x :: k) (xs :: [k]) :: Nat where    IndexOfImpl ctx x (x ': xs) = 0    IndexOfImpl ctx y (x ': xs) = 1 + IndexOfImpl ctx y xs-   IndexOfImpl ctx y '[] = TypeError ('Text "‘"+   IndexOfImpl ctx y '[] = TypeError ('Text "IndexOf error: ‘"                                       ':<>: 'ShowType y                                       ':<>: 'Text "’"                                       ':<>: 'Text " is not a member of "@@ -31,17 +31,17 @@ -- | Searches for y in ys -- if not found, than use y, and repeat search with next (y ': ys) in ctx -- else if found, then don't use y, then repeat search with next (y ': ys) in ctx-type family DistinctImpl (ctx :: [k]) (y :: k) (ys :: [k]) :: [k] where-    DistinctImpl '[] y '[] = y ': '[]-    DistinctImpl '[] y (y ': xs) = '[]-    DistinctImpl (x ': xs) y '[] = y ': DistinctImpl xs x xs-    DistinctImpl (x ': xs) y (y ': ys) = DistinctImpl xs x xs-    DistinctImpl ctx y (x ': xs) = DistinctImpl ctx y xs+type family NubImpl (ctx :: [k]) (y :: k) (ys :: [k]) :: [k] where+    NubImpl '[] y '[] = y ': '[]+    NubImpl '[] y (y ': xs) = '[]+    NubImpl (x ': xs) y '[] = y ': NubImpl xs x xs+    NubImpl (x ': xs) y (y ': ys) = NubImpl xs x xs+    NubImpl ctx y (x ': xs) = NubImpl ctx y xs  -- | Errors if a type exists in a typelist type family MissingImpl (ctx :: [k]) (y :: k) (xs :: [k]) :: Constraint where     MissingImpl ctx y '[] = ()-    MissingImpl ctx x (x ': xs) = TypeError ('Text "‘"+    MissingImpl ctx x (x ': xs) = TypeError ('Text "Missing error: ‘"                                              ':<>: 'ShowType x                                              ':<>: 'Text "’"                                              ':<>: 'Text " is a duplicate in "@@ -63,7 +63,7 @@  -- | Indexed access into the list type family KindAtIndexImpl (orig :: Nat) (ctx :: [k]) (n :: Nat) (xs :: [k]) :: k where-    KindAtIndexImpl i ctx 0 '[] = TypeError ('Text "Index ‘"+    KindAtIndexImpl i ctx 0 '[] = TypeError ('Text "KindAtIndex error: Index ‘"                                        ':<>: 'ShowType i                                        ':<>: 'Text "’"                                        ':<>: 'Text " is out of bounds of "@@ -73,11 +73,23 @@     KindAtIndexImpl i ctx 0 (x ': xs) = x     KindAtIndexImpl i ctx n (x ': xs) = KindAtIndexImpl i ctx (n - 1) xs +-- | Labelled access into the list+type family KindAtLabelImpl (l :: k1) (ctx :: [k2]) (xs :: [k2]) :: k2 where+    KindAtLabelImpl l ctx '[] = TypeError ('Text "KindAtLabel error: Label ‘"+                                       ':<>: 'ShowType l+                                       ':<>: 'Text "’"+                                       ':<>: 'Text " is not found in "+                                       ':<>: 'Text "‘"+                                       ':<>: 'ShowType ctx+                                       ':<>: 'Text "’")+    KindAtLabelImpl l ctx (tagged l x ': xs) = tagged l x+    KindAtLabelImpl l ctx (x ': xs) = KindAtLabelImpl l ctx xs+ -- | Ensures two typelists are the same length type family SameLengthImpl (ctx :: [k1]) (cty :: [k2]) (xs :: [k1]) (yx :: [k2]) :: Constraint where     SameLengthImpl as bs '[] '[] = ()     SameLengthImpl as bs (x ': xs) (y ': ys) = SameLengthImpl as bs xs ys-    SameLengthImpl as bs xs ys = TypeError ('Text "‘"+    SameLengthImpl as bs xs ys = TypeError ('Text "SameLength error: ‘"                                             ':<>: 'ShowType as                                             ':<>: 'Text "’"                                             ':<>: 'Text " is not the same length as "@@ -87,7 +99,7 @@  -- | The typelist @xs@ without the type at Nat @n@. @n@ must be within bounds of @xs@ type family WithoutIndexImpl (i :: Nat) (ctx :: [k]) (n :: Nat) (xs :: [k]) :: [k] where-    WithoutIndexImpl i ctx n '[] = TypeError ('Text "Index ‘"+    WithoutIndexImpl i ctx n '[] = TypeError ('Text "WithoutIndex error: Index ‘"                                        ':<>: 'ShowType i                                        ':<>: 'Text "’"                                        ':<>: 'Text " is out of bounds of "@@ -96,3 +108,68 @@                                        ':<>: 'Text "’")     WithoutIndexImpl i ctx 0 (x ': xs) = xs     WithoutIndexImpl i ctx n (x ': xs) = x ': WithoutIndexImpl 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 ‘"+                                       ':<>: '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++-- | 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 y '[] = '[]+    ReplaceImpl x y (x ': xs) = y ': xs+    ReplaceImpl x y (z ': xs) = z ': ReplaceImpl x y xs++-- | The typelist @zs@ with the first @xs@ replaced by @ys@.+-- @xs@ must be the same size as @ys@+type family ReplacesImpl (xs' :: [k]) (ys' :: [k]) (xs :: [k]) (ys :: [k]) (zs :: [k]) :: [k] where+    ReplacesImpl xs' ys' xs ys '[] = '[]+    ReplacesImpl xs' ys' '[] '[] (z ': zs) = z ': ReplacesImpl xs' ys' xs' ys' zs+    ReplacesImpl xs' ys' (x ': xs) (y ': ys) (x ': zs) = y ': ReplacesImpl xs' ys' xs' ys' zs+    ReplacesImpl xs' ys' (x ': xs) (y ': ys) (z ': zs) = ReplacesImpl xs' ys' xs ys (z ': zs)+    ReplacesImpl xs' ys' xs ys zs = TypeError ('Text "Replaces error: ‘"+                                       ':<>: 'ShowType xs'+                                       ':<>: 'Text "’"+                                       ':<>: 'Text " must be the same size as "+                                       ':<>: 'Text "‘"+                                       ':<>: 'ShowType ys'+                                       ':<>: 'Text "’")++-- | The type @x@ replaced by an @y@ if an @n@ matches @i@.+type family ReplaceIfIndex (ns :: [Nat]) (ys :: [k]) (i :: Nat) (x :: k) :: k where+    ReplaceIfIndex '[] ys i x = x+    ReplaceIfIndex ns '[] i x = x+    ReplaceIfIndex (n ': ns) (y ': ys) n x = y+    ReplaceIfIndex (n ': ns) (y ': ys) i x = ReplaceIfIndex ns ys i x++-- | 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 family ReplacesIndexImpl (i :: Nat) (ns :: [Nat]) (ys :: [k]) (xs :: [k]) :: [k] where+    ReplacesIndexImpl i ns ys '[] = '[]+    ReplacesIndexImpl i '[] '[] xs = xs+    ReplacesIndexImpl i ns ys (x ': xs) = ReplaceIfIndex ns ys i x ': ReplacesIndexImpl (i + 1) ns ys xs+    ReplacesIndexImpl i ns ys xs = TypeError ('Text "ReplacesIndex error: ‘"+                                       ':<>: 'ShowType ns+                                       ':<>: 'Text "’"+                                       ':<>: 'Text " must be the same size as "+                                       ':<>: 'Text "‘"+                                       ':<>: 'ShowType ys+                                       ':<>: 'Text "’")++-- | Zips up @xs@ and @ys@, which must be the same length+type family ZipImpl (xs' :: [k]) (ys' :: [k]) (xs :: [k]) (ys :: [k]) :: [k] where+    ZipImpl xs' ys' '[] '[] = '[]+    ZipImpl xs' ys' (x ': xs) (y ': ys) = (x, y) ': ZipImpl xs' ys' xs ys+    ZipImpl xs' ys' xs ys = TypeError ('Text "Zip error: ‘"+                              ':<>: 'ShowType xs'+                              ':<>: 'Text "’"+                              ':<>: 'Text " must be the same size as "+                              ':<>: 'Text "‘"+                              ':<>: 'ShowType ys'+                              ':<>: 'Text "’")

@@ -64,7 +64,6 @@ import Data.Diverse.Case import Data.Diverse.Collector import Data.Diverse.Emit-import Data.Diverse.PackageId import Data.Diverse.Reduce import Data.Diverse.Reiterate import Data.Diverse.Type@@ -113,38 +112,25 @@ -- | A terminating 'G.Generic' instance for no types encoded as a 'impossible'. -- The 'G.C1' and 'G.S1' metadata are not encoded. instance G.Generic (Which '[]) where-  type Rep (Which '[]) = G.D1 ('G.MetaData-                            "Which"-                            "Data.Diverse.Which.Internal"-                            PackageId-                            'False) G.U1-  from _ = {- G.D1 -} G.M1 {- G.U1 -} G.U1-  to (G.M1 G.U1) = impossible+  type Rep (Which '[]) = G.U1+  from _ = {- G.U1 -} G.U1+  to G.U1 = impossible  -- | A terminating 'G.Generic' instance for one type encoded with 'pick''. -- The 'G.C1' and 'G.S1' metadata are not encoded. instance G.Generic (Which '[x]) where-    type Rep (Which '[x]) = G.D1 ('G.MetaData-                              "Which"-                              "Data.Diverse.Which.Internal"-                              PackageId-                              'False) (G.Rec0 x)-    from v = {- G.D1 -} G.M1 ({- G.Rec0 -} G.K1 (obvious v))-    to ({- G.D1 -} G.M1 ({- G.Rec0 -} G.K1 a)) = pickOnly a+    type Rep (Which '[x]) = G.Rec0 x+    from v = {- G.Rec0 -} G.K1 (obvious v)+    to ({- G.Rec0 -} G.K1 a) = pickOnly a  -- | A 'G.Generic' instance encoded as either the 'x' value ('G.:+:') or the 'diversify0'ed remaining 'Which xs'. -- The 'G.C1' and 'G.S1' metadata are not encoded. instance G.Generic (Which (x ': x' ': xs)) where-    type Rep (Which (x ': x' ': xs)) = G.D1 ('G.MetaData-                              "Which"-                              "Data.Diverse.Which.Internal"-                              PackageId-                              'False) ((G.Rec0 x) G.:+: (G.Rec0 (Which (x' ': xs))))-    from v = {- G.D1 -} G.M1 $-        case trial0 v of+    type Rep (Which (x ': x' ': xs)) = (G.Rec0 x) G.:+: (G.Rec0 (Which (x' ': xs)))+    from v = case trial0 v of             Right x -> G.L1 ({- G.Rec0 -} G.K1 x)             Left v' -> G.R1 ({- G.Rec0 -} G.K1 v')-    to ({- G.D1 -} G.M1 ({- G.Rec0 -} x)) = case x of+    to {- G.Rec0 -} x = case x of         G.L1 ({- G.Rec0 -} G.K1 a) -> pick0 a         G.R1 ({- G.Rec0 -} G.K1 v) -> diversify0 v @@ -327,7 +313,7 @@ -- | A variation of 'diversify' which uses a Nat list @n@ to specify how to reorder the fields, where -- -- @--- indices[branch_idx] = tree_idx@+-- indices[branch_idx] = tree_idx -- @ -- -- This variation allows @tree@ to contain duplicate types with @branch@ since@@ -399,7 +385,7 @@ -- | A limited variation of 'reinterpret' which uses a Nat list @n@ to specify how to reorder the fields, where -- -- @--- indices[branch_idx] = tree_idx@+-- indices[branch_idx] = tree_idx -- @ -- -- This variation allows @tree@ to contain duplicate types with @branch@

@@ -11,6 +11,7 @@ import Control.Lens import Data.Diverse import Data.Typeable+import Data.Tagged import Test.Hspec  -- `main` is here so that this module can be run from GHCi on its own.  It is@@ -18,6 +19,9 @@ main :: IO () main = hspec spec +data Foo+data Bar+ spec :: Spec spec = do     describe "Many" $ do@@ -91,13 +95,9 @@         it "has getter for unique fields using 'fetch'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul             fetch @Int x `shouldBe` 5-            x .^. (Proxy @Int) `shouldBe` 5             fetch @Bool x `shouldBe` False-            x .^. (Proxy @Bool) `shouldBe` False             fetch @Char x `shouldBe` 'X'-            x .^. (Proxy @Char) `shouldBe` 'X'             fetch @(Maybe Char) x `shouldBe` Just 'O'-            x .^. (Proxy @(Maybe Char))`shouldBe` Just 'O'          it "has getter for for unique fields using 'fetchN'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul@@ -118,24 +118,28 @@         it "with duplicate fields can still use 'fetch' for unique fields" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul             fetch @Bool x `shouldBe` False-            x .^. (Proxy @Bool) `shouldBe` False             fetch @Char x `shouldBe` 'X'-            x .^. (Proxy @Char) `shouldBe` 'X' +        it "can 'fetch' usng tagged labels" $ do+            let y = (5 :: Int) ./ False ./ Tagged @Foo 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            fetch @(Tagged Foo _) y `shouldBe` Tagged @Foo 'X'+         it "has setter for unique fields using 'replace'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul             replace @Int x 6 `shouldBe` (6 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul-            (x .~. (6 :: Int)) `shouldBe` (6 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul             replace x True `shouldBe` (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ nul-            (x .~. True) `shouldBe` (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ nul             replace x 'O' `shouldBe` (5 :: Int) ./ False ./ 'O' ./ Just 'O' ./ nul-            (x .~. 'O') `shouldBe` (5 :: Int) ./ False ./ 'O' ./ Just 'O' ./ nul             replace x (Just 'P') `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nul-            (x .~. (Just 'P')) `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nul +        it "has polymorphic setter for unique fields using 'replace'" $ do+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul+            replace' @Int Proxy x 'Z' `shouldBe` 'Z' ./ False ./ 'X' ./ Just 'O' ./ nul+            replace' @Bool Proxy x 'Z' `shouldBe` (5 :: Int) ./ 'Z' ./ 'X' ./ Just 'O' ./ nul+            replace' @(Maybe Char) Proxy x 'Z' `shouldBe` (5 :: Int) ./ False ./ 'X' ./ 'Z' ./ nul+         it "has setter for unique fields using 'replaceN'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul-            replaceN @0 Proxy x 7 `shouldBe`+            replaceN @0 Proxy x (7 :: Int) `shouldBe`                 (7 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul             replaceN @1 Proxy x True `shouldBe`                 (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ nul@@ -144,9 +148,19 @@             replaceN @3 Proxy x (Just 'P') `shouldBe`                 (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nul +        it "has polymorphic setter using 'replaceN''" $ do+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul+            replaceN' @0 Proxy x True `shouldBe`+                True ./ False ./ 'X' ./ Just 'O' ./ nul+            let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            replaceN' @1 Proxy y 'Y' `shouldBe`+                (5 :: Int) ./ 'Y' ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            replaceN' @5 Proxy y 'Y' `shouldBe`+                (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ 'Y' ./ nul+         it "has setter for duplicate fields using 'replaceN'" $ do             let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul-            replaceN @0 Proxy y 7 `shouldBe`+            replaceN @0 Proxy y (7 :: Int) `shouldBe`                 (7 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul             replaceN @1 Proxy y True `shouldBe`                 (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul@@ -154,7 +168,7 @@                 (5 :: Int) ./ False ./ 'Y' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul             replaceN @3 Proxy y (Just 'P') `shouldBe`                 (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ (6 :: Int) ./ Just 'A' ./ nul-            replaceN @4 Proxy y 8 `shouldBe`+            replaceN @4 Proxy y (8 :: Int) `shouldBe`                 (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (8 :: Int) ./ Just 'A' ./ nul             replaceN @5 Proxy y (Just 'B') `shouldBe`                 (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'B' ./ nul@@ -166,6 +180,16 @@             replace @Char y 'Y' `shouldBe`                 (5 :: Int) ./ False ./ 'Y' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul +        it "can 'replace' usng tagged labels" $ do+            let y = (5 :: Int) ./ False ./ Tagged @Foo 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            replace @(Tagged Foo _) y (Tagged @Foo 'Y') `shouldBe`+                (5 :: Int) ./ False ./ Tagged @Foo 'Y' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul++        it "can 'replace'' polymorphically usng tagged labels" $ do+            let y = (5 :: Int) ./ False ./ Tagged @Foo 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            replace' @(Tagged Foo Char) Proxy y (Tagged @Bar 'Y') `shouldBe`+                (5 :: Int) ./ False ./ Tagged @Bar 'Y' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+         it "has getter/setter lens using 'item'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul             x ^. item @Int `shouldBe` 5@@ -173,10 +197,16 @@             x ^. item @Bool `shouldBe` False             (x & item @Bool .~ True) `shouldBe` (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ nul             x ^. item @Char `shouldBe` 'X'-            (x & item @Char .~ 'O') `shouldBe` (5 :: Int) ./ False ./ 'O' ./ Just 'O' ./ nul             x ^. item @(Maybe Char) `shouldBe` Just 'O'-            (x & item @(Maybe Char) .~ Just 'P') `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nul +        it "has polymorphic getter/setter lens using 'item''" $ do+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul+            (x & item' @(Maybe Char) .~ Just 'P') `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nul+            (x & item' @Int .~ 'Z') `shouldBe` 'Z' ./ False ./ 'X' ./ Just 'O' ./ nul+            (x & item' @Bool .~ 'Z') `shouldBe` (5 :: Int) ./ 'Z' ./ 'X' ./ Just 'O' ./ nul+            (x & item' @Char .~ True) `shouldBe` (5 :: Int) ./ False ./ True ./ Just 'O' ./ nul+            (x & item' @(Maybe Char) .~ 'P') `shouldBe` (5 :: Int) ./ False ./ 'X' ./ 'P' ./ nul+         it "has getter/setter lens for duplicate fields using 'itemN'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul             x ^. itemN (Proxy @0) `shouldBe` 5@@ -192,43 +222,58 @@             x ^. itemN (Proxy @5) `shouldBe` Just 'A'             (x & itemN (Proxy @5) .~ Just 'B') `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'B' ./ nul -        it "has getter for multiple fields using 'narrow'" $ do+        it "has polymorphic getter/setter lens for duplicate fields using 'itemN''" $ do+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            (x & itemN' (Proxy @0) .~ "Foo") `shouldBe` "Foo" ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            (x & itemN' (Proxy @1) .~ "Foo") `shouldBe` (5 :: Int) ./ "Foo" ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            (x & itemN' (Proxy @2) .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ "Foo" ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            (x & itemN' (Proxy @3) .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ 'X' ./ "Foo" ./ (6 :: Int) ./ Just 'A' ./ nul+            (x & itemN' (Proxy @4) .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ "Foo" ./ Just 'A' ./ nul+            (x & itemN' (Proxy @5) .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ "Foo" ./ nul++        it "has getter for multiple fields using 'select'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul-            narrow @'[Int, Maybe Char] x `shouldBe` (5 :: Int) ./ Just 'O' ./ nul-            x \^. (Proxy @'[Int, Maybe Char]) `shouldBe` (5 :: Int) ./ Just 'O' ./ nul+            select @'[Int, Maybe Char] x `shouldBe` (5 :: Int) ./ Just 'O' ./ nul -        it "can reorder fields using 'narrow' or 'narrowN'" $ do+        it "can reorder fields using 'select' or 'selectN'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul-            narrow @'[Bool, Int, Maybe Char] x `shouldBe` False ./ (5 :: Int) ./ Just 'O' ./ nul+            select @'[Bool, Int, Maybe Char] x `shouldBe` False ./ (5 :: Int) ./ Just 'O' ./ nul             let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul-            narrowN (Proxy @'[5, 4, 0, 1, 3, 2]) y `shouldBe`+            selectN (Proxy @'[5, 4, 0, 1, 3, 2]) y `shouldBe`                 Just 'A' ./ (6 :: Int) ./ (5 ::Int) ./ False ./ Just 'O' ./ 'X' ./ nul -        it "has getter for multiple fields with duplicates using 'narrowN'" $ do+        it "has getter for multiple fields with duplicates using 'selectN'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul-            narrowN (Proxy @'[5, 4, 0]) x `shouldBe` Just 'A' ./ (6 :: Int) ./ (5 ::Int) ./ nul+            selectN (Proxy @'[5, 4, 0]) x `shouldBe` Just 'A' ./ (6 :: Int) ./ (5 ::Int) ./ nul -        it "can't narrow into types from indistinct fields" $ do+        it "can't select into types from indistinct fields" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul             -- Compile error: Int is a duplicate-            -- narrow @[Bool, Char, Int] x `shouldBe` False ./ 'X' ./ (5 :: Int) ./ nul-            x `shouldBe` x+            -- select @[Bool, Char, Int] x `shouldBe` False ./ 'X' ./ (5 :: Int) ./ nul+            x `shouldBe`  x -        it "with duplicate fields has getter for multiple unique fields 'narrow'" $ do+        it "with duplicate fields has getter for multiple unique fields 'select'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul-            narrow @'[Bool, Char] x `shouldBe` False ./ 'X' ./ nul-            x \^. (Proxy @'[Bool, Char]) `shouldBe` False ./ 'X' ./ nul+            select @'[Bool, Char] x `shouldBe` False ./ 'X' ./ nul          it "has setter for multiple fields using 'amend'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul             amend @'[Int, Maybe Char] x ((6 :: Int) ./ Just 'P' ./ nul) `shouldBe` (6 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nul-            (x \~. (6 :: Int) ./ Just 'P' ./ nul) `shouldBe` (6 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nul +        it "has polymorphc setter for multiple fields using 'amend'" $ do+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul+            amend' @'[Int, Maybe Char] Proxy x ("Foo" ./ "Bar" ./ nul) `shouldBe` "Foo" ./ False ./ 'X' ./ "Bar" ./ nul+         it "has setter for multiple fields with duplicates using 'amendN'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul             amendN (Proxy @'[5, 4, 0]) x (Just 'B' ./ (8 :: Int) ./ (4 ::Int) ./ nul) `shouldBe`                 (4 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (8 :: Int) ./ Just 'B' ./ nul +        it "has polymorphic setter for multiple fields with duplicates using 'amendN''" $ do+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            amendN' @'[5, 4, 0] Proxy x ("Foo" ./ Just 'B' ./ 'Z' ./ nul) `shouldBe`+                'Z' ./ False ./ 'X' ./ Just 'O' ./ Just 'B' ./ "Foo" ./ nul+         it "can't amend into types from indistinct fields" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul             -- Compile error: Int is a duplicate@@ -247,11 +292,21 @@             (x & (project @'[Int, Maybe Char]) .~ ((6 :: Int) ./ Just 'P' ./ nul)) `shouldBe`                 (6 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nul +        it "has polymorphic getter/setter lens for multiple fields using 'project'" $ do+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul+            (x & (project' @'[Int, Maybe Char]) .~ ("Foo" ./ Just "Bar" ./ nul)) `shouldBe`+                "Foo" ./ False ./ 'X' ./ Just "Bar" ./ nul+         it "has getter/setter lens for multiple fields with duplicates using 'projectN'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul             x ^. (projectN @'[5, 4, 0] Proxy) `shouldBe` Just 'A' ./ (6 :: Int) ./ (5 ::Int) ./ nul             (x & (projectN @'[5, 4, 0] Proxy) .~ (Just 'B' ./ (8 :: Int) ./ (4 ::Int) ./ nul)) `shouldBe`                 (4 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (8 :: Int) ./ Just 'B' ./ nul++        it "has polymorphic getter/setter lens for multiple fields with duplicates using 'projectN'" $ do+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            (x & (projectN' @'[5, 4, 0] Proxy) .~ (Just "Foo" ./ (8 :: Int) ./ "Bar" ./ nul)) `shouldBe`+                "Bar" ./ False ./ 'X' ./ Just 'O' ./ (8 :: Int) ./ Just "Foo" ./ nul          it "can be folded with 'Many' handlers using 'forMany' or 'collect'" $ do             let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul