data-diverse 0.3.0.0 → 0.4.0.0

raw patch · 13 files changed

+987/−607 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• data-diverse.cabal +3/−5
• src/Data/Diverse.hs +0/−4
• src/Data/Diverse/Case.hs +0/−7
• src/Data/Diverse/Collector.hs +0/−86
• src/Data/Diverse/Emit.hs +0/−10
• src/Data/Diverse/Many.hs +11/−5
• src/Data/Diverse/Many/Internal.hs +522/−299
• src/Data/Diverse/Type.hs +20/−2
• src/Data/Diverse/Type/Internal.hs +22/−3
• src/Data/Diverse/Which.hs +6/−0
• src/Data/Diverse/Which/Internal.hs +171/−48
• test/Data/Diverse/ManySpec.hs +187/−133
• test/Data/Diverse/WhichSpec.hs +45/−5

@@ -1,5 +1,5 @@ name:                data-diverse-version:             0.3.0.0+version:             0.4.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).@@ -20,13 +20,11 @@  library   hs-source-dirs:      src-  exposed-modules:     Data.Diverse.AFoldable-                       Data.Diverse+  exposed-modules:     Data.Diverse+                       Data.Diverse.AFoldable                        Data.Diverse.Case                        Data.Diverse.Cases                        Data.Diverse.CaseTypeable-                       Data.Diverse.Collector-                       Data.Diverse.Emit                        Data.Diverse.Many                        Data.Diverse.Many.Internal                        Data.Diverse.Reduce

@@ -3,8 +3,6 @@     , module Data.Diverse.Case     , module Data.Diverse.Cases     , module Data.Diverse.CaseTypeable-    , module Data.Diverse.Collector-    , module Data.Diverse.Emit     , module Data.Diverse.Many     , module Data.Diverse.Reduce     , module Data.Diverse.Reiterate@@ -16,8 +14,6 @@ import Data.Diverse.Case import Data.Diverse.Cases import Data.Diverse.CaseTypeable-import Data.Diverse.Collector-import Data.Diverse.Emit import Data.Diverse.Many import Data.Diverse.Reduce import Data.Diverse.Reiterate

@@ -8,8 +8,6 @@  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@@ -19,8 +17,3 @@ class Case c (xs :: [Type]) r where     -- | Return the handler/continuation when x is observed.     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)

@@ -1,86 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}--module Data.Diverse.Collector where--import Data.Diverse.AFoldable-import Data.Diverse.Emit-import Data.Diverse.Reiterate-import Data.Kind-import GHC.TypeLits---- | Folds output from an 'Emit'ter of values while __'reiterate'__ing the @xs@ typelist.--- This guarantees that the @Emit e '[]@ is not instantiated.--- Undecidable instances! But this is safe since it's a wrapper-newtype Collector e (xs :: [Type]) r = Collector (e xs r)---- | null case that doesn't even use 'emit', so that an instance of @Emit e '[]@ is not needed.-instance AFoldable (Collector e '[]) r where-    afoldr _ z _ = z---- | Folds values by 'reiterate'ing 'Emit'ters through the @xs@ typelist.-instance ( Emit e (x ': xs) r-         , Reiterate e (x ': xs)-         , AFoldable (Collector e xs) r-         ) =>-         AFoldable (Collector e (x ': xs)) r where-    afoldr f z (Collector e) = f (emit e) (afoldr f z (Collector (reiterate e)))---- | A variation of 'Collector' which does require the @Emit e '[]@ instance for the empty typelist.--- Undecidable instances! But this is safe since it's a wrapper-newtype Collector0 e (xs :: [Type]) r = Collector0 (e xs r)---- | terminating case that does use @Emit e '[]@-instance (Emit e '[] r) =>-         AFoldable (Collector0 e '[]) r where-    afoldr f z (Collector0 e) = f (emit e) z---- | Folds values by 'reiterate'ing 'Emit'ters through the @xs@ typelist.-instance ( Emit e (x ': xs) r-         , Reiterate e (x ': xs)-         , AFoldable (Collector0 e xs) r-         ) =>-         AFoldable (Collector0 e (x ': xs)) r where-    afoldr f z (Collector0 e) = f (emit e) (afoldr f z (Collector0 (reiterate e)))-------------------------------------------------- | A variation of 'Collector' which __'reiterateN'__s the @xs@ typelist.--- This version guarantees that the @Emit (e n) '[]@ is not instantiated.--- Undecidable instances! But this is safe since it's a wrapper-newtype CollectorN e (n :: Nat) (xs :: [Type]) r = CollectorN (e n xs r)---- | null case that doesn't even use 'emit', so that an instance of @Emit (e n) '[]@ is not needed.-instance AFoldable (CollectorN e n '[]) r where-    afoldr _ z _ = z---- | Folds values by 'reiterateN'ing 'Emit'ters through the @xs@ typelist.-instance ( Emit (e n) (x ': xs) r-         , ReiterateN e n (x ': xs)-         , AFoldable (CollectorN e (n + 1) xs) r-         ) =>-         AFoldable (CollectorN e n (x ': xs)) r where-    afoldr f z (CollectorN e) = f (emit e) (afoldr f z (CollectorN (reiterateN e)))---- | A variation of 'Collector0' which __'reiterateN'__s the @xs@ typelist.--- Undecidable instances! But this is safe since it's a wrapper-newtype CollectorN0 e (n :: Nat) (xs :: [Type]) r = CollectorN0 (e n xs r)---- | terminating case that does use @Emit (e n) '[]@-instance (Emit (e n) '[] r) =>-         AFoldable (CollectorN0 e n '[]) r where-    afoldr f z (CollectorN0 e) = f (emit e) z---- | Folds values by 'reiterateN'ing 'Emit'ters through the @xs@ typelist.-instance ( Emit (e n) (x ': xs) r-         , ReiterateN e n (x ': xs)-         , AFoldable (CollectorN0 e (n + 1) xs) r-         ) =>-         AFoldable (CollectorN0 e n (x ': xs)) r where-    afoldr f z (CollectorN0 e) = f (emit e) (afoldr f z (CollectorN0 (reiterateN e)))

@@ -1,10 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}--module Data.Diverse.Emit where---- | 'Emit' can generate a value, and is differentiated with an additional @xs@ typelist-class Emit e (xs :: [k]) r where-    emit :: e xs r -> r

@@ -11,7 +11,7 @@     , _Many'        -- * Construction-    , nul+    , nil     , single     , prefix     , (./)@@ -29,15 +29,20 @@     -- * Single field     -- ** Getter for single field     , fetch+    , fetchL     , fetchN     -- ** Setter for single field     , replace     , replace'+    , replaceL+    , replaceL'     , replaceN     , replaceN'     -- ** Lens for a single field     , item     , item'+    , itemL+    , itemL'     , itemN     , itemN' @@ -45,6 +50,7 @@     -- ** Getter for multiple fields     , Select     , select+    , selectL     , SelectN     , selectN     -- ** Setter for multiple fields@@ -52,6 +58,8 @@     , amend     , Amend'     , amend'+    , amendL+    , amendL'     , AmendN     , amendN     , AmendN'@@ -59,18 +67,16 @@     -- ** Lens for multiple fields     , project     , project'+    , projectL+    , projectL'     , projectN     , projectN'      -- * Destruction     -- ** By type-    , Via -- no constructor-    , via -- safe construction     , forMany     , collect     -- ** By Nat index offset-    , ViaN -- no constructor-    , viaN -- safe construction     , forManyN     , collectN     ) where

@@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -28,7 +27,7 @@     , _Many'        -- * Construction-    , nul+    , nil     , single     , prefix     , (./)@@ -46,15 +45,20 @@     -- * Single field     -- ** Getter for single field     , fetch+    , fetchL     , fetchN     -- ** Setter for single field     , replace     , replace'+    , replaceL+    , replaceL'     , replaceN     , replaceN'     -- ** Lens for a single field     , item     , item'+    , itemL+    , itemL'     , itemN     , itemN' @@ -62,6 +66,7 @@     -- ** Getter for multiple fields     , Select     , select+    , selectL     , SelectN     , selectN     -- ** Setter for multiple fields@@ -69,6 +74,8 @@     , amend     , Amend'     , amend'+    , amendL+    , amendL'     , AmendN     , amendN     , AmendN'@@ -76,18 +83,16 @@     -- ** Lens for multiple fields     , project     , project'+    , projectL+    , projectL'     , projectN     , projectN'      -- * Destruction     -- ** By type-    , Via -- no constructor-    , via -- safe construction     , forMany     , collect     -- ** By Nat index offset-    , ViaN -- no constructor-    , viaN -- safe construction     , forManyN     , collectN     ) where@@ -97,8 +102,6 @@ import Data.Bool import Data.Diverse.AFoldable import Data.Diverse.Case-import Data.Diverse.Collector-import Data.Diverse.Emit import Data.Diverse.Reiterate import Data.Diverse.Type import Data.Kind@@ -118,12 +121,6 @@ -- These usages in this module are safe due to size guarantees provided by the typelist. import Prelude as Partial -newtype Key = Key Int deriving (Eq, Ord, Show)-newtype LeftOffset = LeftOffset Int-newtype LeftSize = LeftSize Int-newtype RightOffset = RightOffset Int-newtype NewRightOffset = NewRightOffset { unNewRightOffset :: Int }- -- | A Many is an anonymous product type (also know as polymorphic record), with no limit on the number of fields. -- -- The following functions are available can be used to manipulate unique fields@@ -151,25 +148,44 @@ -- -- The constructor will guarantee the correct number and types of the elements. -- The constructor is only exported in the "Data.Diverse.Many.Internal" module-data Many (xs :: [Type]) = Many {-# UNPACK #-} !Int (M.Map Key Any)+data Many (xs :: [Type]) = Many {-# UNPACK #-} !Int (M.Map Int Any) --- | Inferred role is phantom which is incorrect+-- Inferred role is phantom which is incorrect+-- representational means:+-- @+-- Coercible '[Int] '[IntLike] => Coercible (Many '[Int]) (Many '[IntLike])+-- @ type role Many representational +-- | Many stored as a list. This is useful when folding over 'Many' efficienty+-- so that the conversion to List is only done once+data Many_ (xs :: [Type]) = Many_ [Any]++type role Many_ representational++toMany_ :: Many xs -> Many_ xs+toMany_ (Many _ m) = Many_ (snd <$> M.toAscList m)++fromMany_ :: Many_ xs -> Many xs+fromMany_ (Many_ xs) = Many 0 (M.fromList (zip [(0 :: Int)..] xs)) ----------------------------------------------------------------------- --- | A terminating 'G.Generic' instance encoded as a 'nul'.+-- | A terminating 'G.Generic' instance encoded as a 'nil'. instance G.Generic (Many '[]) where     type Rep (Many '[]) =  G.U1     from _ = {- G.U1 -} G.U1-    to G.U1 = nul+    to G.U1 = nil  -- | 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.Rec0 x) G.:*: (G.Rec0 (Many xs))     from r = ({- G.Rec0 -} G.K1 (front r)) G.:*: ({- G.Rec0 -} G.K1 (aft r))+    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types+    {-# NOINLINE from #-}     to (({- G.Rec0 -} G.K1 a) G.:*: ({- G.Rec0 -} G.K1 b)) = a ./ b+    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types+    {-# NOINLINE to #-}  ----------------------------------------------------------------------- @@ -190,14 +206,16 @@ -- | @_Many = iso fromMany toMany@ _Many :: IsMany t xs a => Iso' (Many xs) (t xs a) _Many = iso fromMany toMany+{-# INLINE _Many #-}  -- | @_Many' = iso fromMany' toMany'@ _Many' :: IsMany Tagged xs a => Iso' (Many xs) a _Many' = iso fromMany' toMany'+{-# INLINE _Many' #-}  -- | These instances add about 7 seconds to the compile time! instance IsMany Tagged '[] () where-    toMany _ = nul+    toMany _ = nil     fromMany _ = Tagged ()  -- | This single field instance is the reason for 'Tagged' wrapper.@@ -207,72 +225,72 @@     fromMany r = Tagged (fetch @a r)  instance IsMany Tagged '[a,b] (a,b) where-    toMany (Tagged (a,b)) = a./b./nul+    toMany (Tagged (a,b)) = a./b./nil     fromMany r = Tagged (fetchN (Proxy @0) r, fetchN (Proxy @1) r)  instance IsMany Tagged '[a,b,c] (a,b,c) where-    toMany (Tagged (a,b,c)) = a./b./c./nul+    toMany (Tagged (a,b,c)) = a./b./c./nil     fromMany r = Tagged (fetchN (Proxy @0) r, fetchN (Proxy @1) r, fetchN (Proxy @2) r)  instance IsMany Tagged '[a,b,c,d] (a,b,c,d) where-    toMany (Tagged (a,b,c,d)) = a./b./c./d./nul+    toMany (Tagged (a,b,c,d)) = a./b./c./d./nil     fromMany r = Tagged (fetchN (Proxy @0) r, fetchN (Proxy @1) r, fetchN (Proxy @2) r, fetchN (Proxy @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./nul+    toMany (Tagged (a,b,c,d,e)) = a./b./c./d./e./nil     fromMany r = Tagged (fetchN (Proxy @0) r, fetchN (Proxy @1) r, fetchN (Proxy @2) r, fetchN (Proxy @3) r, fetchN (Proxy @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./nul+    toMany (Tagged (a,b,c,d,e,f)) = a./b./c./d./e./f./nil     fromMany r = Tagged ( fetchN (Proxy @0) r, fetchN (Proxy @1) r, fetchN (Proxy @2) r, fetchN (Proxy @3) r, fetchN (Proxy @4) r                         , fetchN (Proxy @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./nul+    toMany (Tagged (a,b,c,d,e,f,g)) = a./b./c./d./e./f./g./nil     fromMany r = Tagged ( fetchN (Proxy @0) r, fetchN (Proxy @1) r, fetchN (Proxy @2) r, fetchN (Proxy @3) r, fetchN (Proxy @4) r                         , fetchN (Proxy @5) r, fetchN (Proxy @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./nul+    toMany (Tagged (a,b,c,d,e,f,g,h)) = a./b./c./d./e./f./g./h./nil     fromMany r = Tagged ( fetchN (Proxy @0) r, fetchN (Proxy @1) r, fetchN (Proxy @2) r, fetchN (Proxy @3) r, fetchN (Proxy @4) r                         , fetchN (Proxy @5) r, fetchN (Proxy @6) r, fetchN (Proxy @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./ nul+    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 (Proxy @0) r, fetchN (Proxy @1) r, fetchN (Proxy @2) r, fetchN (Proxy @3) r, fetchN (Proxy @4) r                         , fetchN (Proxy @5) r, fetchN (Proxy @6) r, fetchN (Proxy @7) r, fetchN (Proxy @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./nul+    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 (Proxy @0) r, fetchN (Proxy @1) r, fetchN (Proxy @2) r, fetchN (Proxy @3) r, fetchN (Proxy @4) r                         , fetchN (Proxy @5) r, fetchN (Proxy @6) r, fetchN (Proxy @7) r, fetchN (Proxy @8) r, fetchN (Proxy @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./nul+    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 (Proxy @0) r, fetchN (Proxy @1) r, fetchN (Proxy @2) r, fetchN (Proxy @3) r, fetchN (Proxy @4) r                         , fetchN (Proxy @5) r, fetchN (Proxy @6) r, fetchN (Proxy @7) r, fetchN (Proxy @8) r, fetchN (Proxy @9) r                         , fetchN (Proxy @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./nul+    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 (Proxy @0) r, fetchN (Proxy @1) r, fetchN (Proxy @2) r, fetchN (Proxy @3) r, fetchN (Proxy @4) r                         , fetchN (Proxy @5) r, fetchN (Proxy @6) r, fetchN (Proxy @7) r, fetchN (Proxy @8) r, fetchN (Proxy @9) r                         , fetchN (Proxy @10) r, fetchN (Proxy @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./nul+    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 (Proxy @0) r, fetchN (Proxy @1) r, fetchN (Proxy @2) r, fetchN (Proxy @3) r, fetchN (Proxy @4) r                         , fetchN (Proxy @5) r, fetchN (Proxy @6) r, fetchN (Proxy @7) r, fetchN (Proxy @8) r, fetchN (Proxy @9) r                         , fetchN (Proxy @10) r, fetchN (Proxy @11) r, fetchN (Proxy @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./nul+    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 (Proxy @0) r, fetchN (Proxy @1) r, fetchN (Proxy @2) r, fetchN (Proxy @3) r, fetchN (Proxy @4) r                         , fetchN (Proxy @5) r, fetchN (Proxy @6) r, fetchN (Proxy @7) r, fetchN (Proxy @8) r, fetchN (Proxy @9) r                         , fetchN (Proxy @10) r, fetchN (Proxy @11) r, fetchN (Proxy @12) r, fetchN (Proxy @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./nul+    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 (Proxy @0) r, fetchN (Proxy @1) r, fetchN (Proxy @2) r, fetchN (Proxy @3) r, fetchN (Proxy @4) r                         , fetchN (Proxy @5) r, fetchN (Proxy @6) r, fetchN (Proxy @7) r, fetchN (Proxy @8) r, fetchN (Proxy @9) r                         , fetchN (Proxy @10) r, fetchN (Proxy @11) r, fetchN (Proxy @12) r, fetchN (Proxy @13) r, fetchN (Proxy @14) r)@@ -288,16 +306,17 @@ -- So we need to adjust the existing index on the RightMap by -- \OldRightKey -> RightIndex + LeftOffset + LeftSize (as above) -- \OldRightKey -> OldRightKey - RightOffset + LeftOffset + LeftSize-rightKeyForSnoc :: LeftOffset -> LeftSize -> RightOffset -> Key -> Key-rightKeyForSnoc (LeftOffset lo) (LeftSize ld) (RightOffset ro) (Key rk) =-    Key (rk - ro + lo + ld)+rightKeyForSnoc :: Int -> Int -> Int -> Int -> Int+rightKeyForSnoc lo ld ro rk = rk - ro + lo + ld+{-# INLINE rightKeyForSnoc #-}  -- | When appending two maps together, get the function to modify the RightMap's offset -- when adding LeftMap into RightMap. -- The existing contents of RightMap will not be changed. -- NewRightOffset = OldRightOffset - LeftSize-rightOffsetForCons :: LeftSize -> RightOffset -> NewRightOffset-rightOffsetForCons (LeftSize ld) (RightOffset ro) = NewRightOffset (ro - ld)+rightOffsetForCons :: Int -> Int -> Int+rightOffsetForCons ld ro = ro - ld+{-# INLINE rightOffsetForCons #-}  -- | When appending two maps together, get the function to 'M.mapKeys' the LeftMap -- when adding LeftMap into RightMap.@@ -308,30 +327,33 @@ -- So we need to adjust the existing index on the LeftMap by -- \OldLeftKey -> LeftIndex + NewRightOffset (as above) -- \OldLeftKey -> OldLeftKey - LeftOffset + NewRightOffset (as above)-leftKeyForCons :: LeftOffset -> NewRightOffset -> Key -> Key-leftKeyForCons (LeftOffset lo) (NewRightOffset ro) (Key lk) = Key (lk - lo + ro)+leftKeyForCons :: Int -> Int -> Int -> Int+leftKeyForCons lo ro lk = lk - lo + ro+{-# INLINE leftKeyForCons #-} --- | Analogous to 'Prelude.null'. Named 'nul' to avoid conflicting with 'Prelude.null'.-nul :: Many '[]-nul = Many 0 M.empty-infixr 5 `nul` -- to be the same as 'prefix'+-- | Analogous to 'Prelude.nill'. Named 'nil' to avoid conflicting with 'Prelude.nill'.+nil :: Many '[]+nil = Many 0 M.empty  -- | Create a Many from a single value. Analogous to 'M.singleton' single :: x -> Many '[x]-single v = Many 0 (M.singleton (Key 0) (unsafeCoerce v))+single v = Many 0 (M.singleton 0 (unsafeCoerce v))  -- | Add an element to the left of a Many. -- Not named @cons@ to avoid conflict with 'Control.Lens.cons' prefix :: x -> Many xs -> Many (x ': xs)-prefix x (Many ro rm) = Many (unNewRightOffset nro)+prefix x (Many ro rm) = Many nro     (M.insert-        (leftKeyForCons (LeftOffset 0) nro (Key 0))+        (leftKeyForCons 0 nro 0)         (unsafeCoerce x)         rm)   where-    nro = rightOffsetForCons (LeftSize 1) (RightOffset ro)+    nro = rightOffsetForCons 1 ro infixr 5 `prefix` +prefix' :: x -> Many_ xs -> Many_ (x ': xs)+prefix' x (Many_ xs) = Many_ (unsafeCoerce x : xs)+ -- | Infix version of 'prefix'. -- -- Mnemonic: Element on the left is smaller './' than the larger 'Many' to the right.@@ -343,7 +365,7 @@ -- Not named 'snoc' to avoid conflict with 'Control.Lens.snoc' postfix :: Many xs -> y -> Many (Append xs '[y]) postfix (Many lo lm) y = Many lo-    (M.insert (rightKeyForSnoc (LeftOffset lo) (LeftSize (M.size lm)) (RightOffset 0) (Key 0))+    (M.insert (rightKeyForSnoc lo (M.size lm) 0 0)         (unsafeCoerce y)         lm) infixl 5 `postfix`@@ -363,14 +385,14 @@ append (Many lo lm) (Many ro rm) = if ld >= rd     then Many          lo-         (lm `M.union` (M.mapKeys (rightKeyForSnoc (LeftOffset lo) (LeftSize ld) (RightOffset ro)) rm))+         (lm `M.union` (M.mapKeys (rightKeyForSnoc lo ld ro) rm))     else Many-         (unNewRightOffset nro)-         ((M.mapKeys (leftKeyForCons (LeftOffset lo) nro) lm) `M.union` rm)+         nro+         ((M.mapKeys (leftKeyForCons lo nro) lm) `M.union` rm)   where     ld = M.size lm     rd = M.size rm-    nro = rightOffsetForCons (LeftSize ld) (RightOffset ro)+    nro = rightOffsetForCons ld ro infixr 5 `append` -- like Data.List (++)  -----------------------------------------------------------------------@@ -380,6 +402,9 @@ front :: Many (x ': xs) -> x front (Many _ m) = unsafeCoerce (snd . Partial.head $ M.toAscList m) +front' :: Many_ (x ': xs) -> x+front' (Many_ xs) = unsafeCoerce (Partial.head xs)+ -- | Extract the 'back' element of a Many, which guaranteed to be non-empty. -- Analogous to 'Prelude.last' back :: Many (x ': xs) -> Last (x ': xs)@@ -388,32 +413,54 @@ -- | Extract the elements after the front of a Many, which guaranteed to be non-empty. -- Analogous to 'Partial.tail' aft :: Many (x ': xs) -> Many xs-aft (Many o m) = Many (o + 1) (M.delete (Key o) m)+aft (Many o m) = Many (o + 1) (M.delete o m) +aft' :: Many_ (x ': xs) -> Many_ xs+aft' (Many_ xs) = Many_ (Partial.tail xs)+ -- | Return all the elements of a Many except the 'back' one, which guaranteed to be non-empty. -- Analogous to 'Prelude.init' fore :: Many (x ': xs) -> Many (Init (x ': xs))-fore (Many o m) = Many o (M.delete (Key (o + M.size m - 1)) m)+fore (Many o m) = Many o (M.delete (o + M.size m - 1) m)  --------------------------------------------------  -- | Getter by unique type. Get the field with type @x@. -- -- @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nul'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nil' -- 'fetch' \@Int x \`shouldBe` 5 -- @ fetch :: forall x xs. UniqueMember x xs => Many xs -> x-fetch (Many o m) = unsafeCoerce (m M.! (Key (o + i)))-  where i = fromInteger (natVal @(IndexOf x xs) Proxy)+fetch = fetch_ +fetch_ :: forall x xs n. (KnownNat n, n ~ IndexOf x xs) => Many xs -> x+fetch_ (Many o m) = unsafeCoerce (m M.! (o + i))+  where i = fromInteger (natVal @n Proxy)+ -------------------------------------------------- +-- | Getter by label. Get the value of the field with tag @label@ which can be any type+-- not just @KnownSymbol@.+-- @+--+-- let y = False './' Tagged \@Foo \'X' './' Tagged @"Hi" True './' 'nil'+-- 'fetchL' \@Foo Proxy y \`shouldBe` Tagged \@Foo \'X'+-- 'fetchL' \@"Hi" Proxy y \`shouldBe` Tagged \@"Hi" True+-- @+fetchL :: forall l xs x proxy. (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => proxy l -> Many xs -> x+fetchL _ = fetch_ @x++--------------------------------------------------+ -- | Getter by index. Get the value of the field at index type-level Nat @n@ ----- @getchN (Proxy \@2) t@+-- @+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nil'+-- 'fetchN' @1 Proxy x \`shouldBe` False+-- @ fetchN :: forall n x xs proxy. MemberAt n x xs => proxy n -> Many xs -> x-fetchN p (Many o m) = unsafeCoerce (m M.! (Key (o + i)))+fetchN p (Many o m) = unsafeCoerce (m M.! (o + i))   where i = fromInteger (natVal p)  --------------------------------------------------@@ -421,38 +468,70 @@ -- | Setter by unique type. Set the field with type @x@. -- -- @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nul'--- 'replace' \@Int x 6 \`shouldBe` (6 :: Int) './' False './' \'X' './' Just \'O' './' 'nul'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nil'+-- 'replace' \@Int x 6 \`shouldBe` (6 :: Int) './' False './' \'X' './' Just \'O' './' 'nil' -- @ replace :: forall x xs. UniqueMember x xs => Many xs -> x -> Many xs-replace (Many o m) v = Many o (M.insert (Key (o + i)) (unsafeCoerce v) m)-  where i = fromInteger (natVal @(IndexOf x xs) Proxy)+replace = replace_ +replace_ :: forall x xs n. (KnownNat n, n ~ IndexOf x xs) => Many xs -> x -> Many xs+replace_ (Many o m) v = Many o (M.insert (o + i) (unsafeCoerce v) m)+  where i = fromInteger (natVal @n Proxy)+ -- | 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'--- 'replace'' \@Int Proxy x (Just True) \`shouldBe` Just True './' False './' \'X' './' Just \'O' './' 'nul'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nil'+-- 'replace'' \@Int Proxy x (Just True) \`shouldBe` Just True './' False './' \'X' './' Just \'O' './' 'nil' -- @-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)+replace' :: forall x y xs proxy. UniqueMember x xs => proxy x -> Many xs -> y -> Many (Replace x y xs)+replace' = replace'_ +replace'_ :: forall x y xs n proxy. (KnownNat n, n ~ IndexOf x xs) => proxy x -> Many xs -> y -> Many (Replace x y xs)+replace'_ _ (Many o m) v = Many o (M.insert (o + i) (unsafeCoerce v) m)+  where i = fromInteger (natVal @n Proxy)+ -------------------------------------------------- +-- | Setter by unique label. Set the field with label @l@.+--+-- @+-- let y = (5 :: Int) './' False './' Tagged \@Foo \'X' './' Tagged \@\"Hello" (6 :: Int) './' 'nil'+-- 'replaceL' \@Foo Proxy y (Tagged \@Foo \'Y') \`shouldBe`+--     (5 :: Int) './' False './' Tagged \@Foo \'Y' './' Tagged \@\"Hello" (6 :: Int) './' 'nil'+-- 'replaceL' \@\"Hello" Proxy y (Tagged \@\"Hello" 7) \`shouldBe`+--     (5 :: Int) './' False './' Tagged \@Foo \'X' './' Tagged \@\"Hello" (7 :: Int) './' 'nil'+-- @+replaceL :: forall l xs x proxy. (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => proxy l -> Many xs -> x -> Many xs+replaceL _ = replace_ @x++-- | Polymorphic setter by unique type. Set the field with type @x@, and replace with type @y@+--+-- @+-- let y = (5 :: Int) './' False './' Tagged \@Foo \'X' './' Tagged \@\"Hello" (6 :: Int) './' 'nil'+-- replaceL' \@Foo Proxy y (Tagged \@Bar \'Y') `shouldBe`+--     (5 :: Int) './' False './' Tagged @Bar 'Y' './' Tagged @"Hello" (6 :: Int) './' 'nil'+-- replaceL' \@\"Hello" Proxy y (Tagged \@\"Hello" False) \`shouldBe`+--     (5 :: Int) './' False './' Tagged \@Foo \'X' './' Tagged \@\"Hello" False './' 'nil'+-- @+replaceL' :: forall l y xs x proxy. (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => proxy l -> Many xs -> y -> Many (Replace x y xs)+replaceL' _ = replace'_ @x Proxy++--------------------------------------------------+ -- | Setter by index. Set the value of the field at index type-level Nat @n@ -- -- @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nul'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nil' -- 'replaceN' \@0 Proxy x 7 `shouldBe` -- @ 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)+replaceN p (Many o m) v = Many o (M.insert (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)+replaceN' p (Many o m) v = Many o (M.insert (o + i) (unsafeCoerce v) m)   where i = fromInteger (natVal p)  -----------------------------------------------------------------------@@ -460,9 +539,9 @@ -- | 'fetch' ('view' 'item') and 'replace' ('set' 'item') in 'Lens'' form. -- -- @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nul'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nil' -- x '^.' 'item' \@Int \`shouldBe` 5--- (x '&' 'item' \@Int .~ 6) \`shouldBe` (6 :: Int) './' False './' \'X' './' Just \'O' './' 'nul'+-- (x '&' 'item' \@Int .~ 6) \`shouldBe` (6 :: Int) './' False './' \'X' './' Just \'O' './' 'nil' -- @ item :: forall x xs. UniqueMember x xs => Lens' (Many xs) x item = lens fetch replace@@ -473,12 +552,35 @@ item' = lens fetch (replace' @x @y Proxy) {-# INLINE item' #-} ++-- | 'fetchL' ('view' 'itemL') and 'replaceL' ('set' 'itemL') in 'Lens'' form.+--+-- @+-- let x = (5 :: Int) './' Tagged \@Foo False './' Tagged \@Bar \'X' './' 'nil'+-- x '^.' 'itemL' \@Foo Proxy \`shouldBe` Tagged \@Foo False+-- (x '&' 'itemL' \@Foo Proxy '.~' Tagged \@Foo True) \`shouldBe` (5 :: Int) './' Tagged \@Foo True './' Tagged \@Bar \'X' './' 'nil'+-- @+itemL :: forall l xs x proxy. (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => proxy l -> Lens' (Many xs) x+itemL p = lens (fetchL p) (replaceL p)+{-# INLINE itemL #-}++-- | Polymorphic version of 'itemL'+--+-- @+-- let x = (5 :: Int) './' Tagged @Foo False './' Tagged \@Bar \'X' './' 'nil'+-- (x '&' itemL' \@Foo Proxy '.~' \"foo") \`shouldBe` (5 :: Int) './' \"foo" './' Tagged \@Bar \'X' './' 'nil'+-- @+itemL' :: forall l y xs x proxy. (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => proxy l -> Lens (Many xs) (Many (Replace x y xs)) x y+itemL' p = lens (fetchL p) (replaceL' p)+{-# INLINE itemL' #-}++ -- | 'fetchN' ('view' 'item') and 'replaceN' ('set' 'item') in 'Lens'' form. -- -- @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' ./ nul+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' ./ nil -- x '^.' 'itemN' (Proxy \@0) \`shouldBe` 5--- (x '&' 'itemN' (Proxy @0) '.~' 6) \`shouldBe` (6 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nul'+-- (x '&' 'itemN' (Proxy @0) '.~' 6) \`shouldBe` (6 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nil' -- @ itemN ::  forall n x xs proxy. MemberAt n x xs => proxy n -> Lens' (Many xs) x itemN p = lens (fetchN p) (replaceN p)@@ -498,27 +600,87 @@  ----------------------------------------------------------------------- --- | Wraps a 'Case' into an instance of 'Emit', 'reiterate'ing and feeding 'Case' with the value from the 'Many'--- and 'emit'ting the results.+class CaseAny c (xs :: [Type]) r where+    -- | Return the handler/continuation when x is observed.+    caseAny :: c xs r -> Any -> r++-----------------------------------------------------------------------++-- | Variation of 'Collector' which uses 'CaseAny' instead of 'Case'+data CollectorAny c (xs :: [Type]) r = CollectorAny (c xs r) [Any]++-- | nill case that doesn't even use 'caseAny', so that an instance of @CaseAny '[]@ is not needed.+instance AFoldable (CollectorAny c '[]) r where+    afoldr _ z _ = z++instance ( CaseAny c (x ': xs) r+         , Reiterate c (x ': xs)+         , AFoldable (CollectorAny c xs) r+         ) =>+         AFoldable (CollectorAny c (x ': xs)) r where+    afoldr f z (CollectorAny c xs) = f (caseAny c x) (afoldr f z (CollectorAny (reiterate c) xs'))+      where+       -- use of head/tail here is safe as we are guaranteed the length from the typelist+       x = Partial.head xs+       xs' = Partial.tail xs+    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types+    {-# NOINLINE afoldr #-}++forMany' :: c xs r -> Many xs -> CollectorAny c xs r+forMany' c (Many _ xs) = CollectorAny c (snd <$> M.toAscList xs)++-----------------------------------------------------------------------++-- | A variation of 'CollectorN' which uses 'CaseAny' instead of 'Case'+data CollectorAnyN c n (xs :: [Type]) r = CollectorAnyN (c n xs r) [Any]++-- | nill case that doesn't even use 'caseAnyN', so that an instance of @CaseAnyN '[]@ is not needed.+instance AFoldable (CollectorAnyN c n '[]) r where+    afoldr _ z _ = z++instance ( CaseAny (c n) (x ': xs) r+         , ReiterateN c n (x ': xs)+         , AFoldable (CollectorAnyN c (n + 1) xs) r+         ) =>+         AFoldable (CollectorAnyN c n (x ': xs)) r where+    afoldr f z (CollectorAnyN c xs) = f (caseAny c x) (afoldr f z (CollectorAnyN (reiterateN c) xs'))+      where+       -- use of head/tail here is safe as we are guaranteed the length from the typelist+       x = Partial.head xs+       xs' = Partial.tail xs+    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types+    {-# NOINLINE afoldr #-}++forManyN' :: c n xs r -> Many xs -> CollectorAnyN c n xs r+forManyN' c (Many _ xs) = CollectorAnyN c (snd <$> M.toAscList xs)++-----------------------------------------------------------------------++-- | Collects the output from 'case''ing each field in a 'Many'.+-- Uses 'Reiterate' to prepare the 'Case' to accept the next type in the @xs@ typelist. ----- Internally, this holds the left-over [(k, v)] from the original 'Many' for the remaining typelist @xs@.+--  Internally, this holds the left-over [(k, v)] from the original 'Many' for the remaining typelist @xs@. ----- That is the first v in the (k, v) is of type @x@, and the length of the list is equal to the length of @xs@.-newtype Via c (xs :: [Type]) r = Via (c xs r, [Any])---- | Creates an 'Via' safely, so that the invariant of \"typelist to the value list type and size\" holds.-via :: c xs r -> Many xs -> Via c xs r-via c (Many _ m) = Via (c, snd <$> M.toAscList m)+-- That is, the first v in the (k, v) is of type @x@, and the length of the list is equal to the length of @xs@.+data Collector c (xs :: [Type]) r = Collector (c xs r) [Any] -instance Reiterate c (x ': xs) => Reiterate (Via c) (x ': xs) where-    -- use of tail here is safe as we are guaranteed the length from the typelist-    reiterate (Via (c, xxs)) = Via (reiterate c, Partial.tail xxs)+-- | nill case that doesn't even use 'case'', so that an instance of @Case '[]@ is not needed.+instance AFoldable (Collector c '[]) r where+    afoldr _ z _ = z -instance (Case c (x ': xs) r) => Emit (Via c) (x ': xs) r where-    emit (Via (c, xxs)) = caseAny c v+-- | Folds values by 'reiterate'ing 'Emit'ters through the @xs@ typelist.+instance ( Case c (x ': xs) r+         , Reiterate c (x ': xs)+         , AFoldable (Collector c xs) r+         ) =>+         AFoldable (Collector c (x ': xs)) r where+    afoldr f z (Collector c xs) = f (case' c v) (afoldr f z (Collector (reiterate c) xs'))       where-       -- use of front here is safe as we are guaranteed the length from the typelist-       v = Partial.head xxs+       -- use of head/tail here is safe as we are guaranteed the length from the typelist+       v = unsafeCoerce $ Partial.head xs+       xs' = Partial.tail xs+    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types+    {-# NOINLINE afoldr #-}  ----------------------------------------------------------------------- @@ -529,43 +691,47 @@ -- The 'Collector' is 'AFoldable' to combine the results. -- -- @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nul'---     y = show \@Int './' show \@Char './' show \@(Maybe Char) './' show \@Bool './' 'nul'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nil'+--     y = show \@Int './' show \@Char './' show \@(Maybe Char) './' show \@Bool './' 'nil' -- 'afoldr' (:) [] ('forMany' ('Data.Diverse.Cases.cases' y) x) \`shouldBe` --     [\"5", \"False", \"\'X'", \"Just \'O'", \"6", \"Just \'A'"] -- @-forMany :: c xs r -> Many xs -> Collector (Via c) xs r-forMany c x = Collector (via c x)+forMany :: c xs r -> Many xs -> Collector c xs r+forMany c (Many _ xs) = Collector c (snd <$> M.toAscList xs)  -- | This is @flip 'forMany'@ -- -- @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nul'---     y = show \@Int './' show \@Char './' show \@(Maybe Char) './' show \@Bool './' 'nul'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nil'+--     y = show \@Int './' show \@Char './' show \@(Maybe Char) './' show \@Bool './' 'nil' -- 'afoldr' (:) [] ('collect' x ('Data.Diverse.Cases.cases' y)) \`shouldBe` --     [\"5", \"False", \"\'X'", \"Just \'O'", \"6", \"Just \'A'"] -- @-collect :: Many xs -> c xs r -> Collector (Via c) xs r+collect :: Many xs -> c xs r -> Collector c xs r collect = flip forMany  ----------------------------------------------------------------------- --- | A variation of 'Via' which __'reiterateN'__ instead.-newtype ViaN c (n :: Nat) (xs :: [Type]) r = ViaN (c n xs r, [Any])---- | Creates an 'ViaN' safely, so that the invariant of \"typelist to the value list type and size\" holds.-viaN :: c n xs r -> Many xs -> ViaN c n xs r-viaN c (Many _ m) = ViaN (c, snd <$> M.toAscList m)+-- | A variation of 'Collector' which uses 'ReiterateN' instead of 'Reiterate'+data CollectorN c (n :: Nat) (xs :: [Type]) r = CollectorN (c n xs r) [Any] -instance ReiterateN c n (x ': xs) => ReiterateN (ViaN c) n (x ': xs) where-    -- use of tail here is safe as we are guaranteed the length from the typelist-    reiterateN (ViaN (c, xxs)) = ViaN (reiterateN c, Partial.tail xxs)+-- | nill case that doesn't even use 'case'', so that an instance of @Case '[]@ is not needed.+instance AFoldable (CollectorN c n '[]) r where+    afoldr _ z _ = z -instance (Case (c n) (x ': xs) r) => Emit (ViaN c n) (x ': xs) r where-    emit (ViaN (c, xxs)) = caseAny c v+-- | Folds values by 'reiterate'ing 'Emit'ters through the @xs@ typelist.+instance ( Case (c n) (x ': xs) r+         , ReiterateN c n (x ': xs)+         , AFoldable (CollectorN c (n + 1) xs) r+         ) =>+         AFoldable (CollectorN c n (x ': xs)) r where+    afoldr f z (CollectorN c xs) = f (case' c v) (afoldr f z (CollectorN (reiterateN c) xs'))       where-       -- use of front here is safe as we are guaranteed the length from the typelist-       v = Partial.head xxs+       -- use of head/tail here is safe as we are guaranteed the length from the typelist+       v = unsafeCoerce $ Partial.head xs+       xs' = Partial.tail xs+    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types+    {-# NOINLINE afoldr #-}  -- | Folds any 'Many', even with indistinct types. -- Given __index__ handlers for the fields in 'Many', create a 'CollectorN'@@ -574,23 +740,23 @@ -- The 'CollectorN' is 'AFoldable' to combine the results. -- -- @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nul'---     y = show \@Int './' show \@Bool './' show \@Char './' show \@(Maybe Char) './' show \@Int './' show \@(Maybe Char) './' 'nul'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nil'+--     y = show \@Int './' show \@Bool './' show \@Char './' show \@(Maybe Char) './' show \@Int './' show \@(Maybe Char) './' 'nil' -- 'afoldr' (:) [] ('forManyN' ('Data.Diverse.Cases.casesN' y) x) \`shouldBe` --     [\"5", \"False", \"\'X'", \"Just \'O'", \"6", \"Just \'A'"] -- @-forManyN :: c n xs r -> Many xs -> CollectorN (ViaN c) n xs r-forManyN c x = CollectorN (viaN c x)+forManyN :: c n xs r -> Many xs -> CollectorN c n xs r+forManyN c (Many _ xs) = CollectorN c (snd <$> M.toAscList xs)  -- | This is @flip 'forManyN'@ -- -- @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nul'---     y = show \@Int './' show \@Bool './' show \@Char './' show \@(Maybe Char) './' show \@Int './' show \@(Maybe Char) './' 'nul'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nil'+--     y = show \@Int './' show \@Bool './' show \@Char './' show \@(Maybe Char) './' show \@Int './' show \@(Maybe Char) './' 'nil' -- 'afoldr' (:) [] ('collectN' x ('Data.Diverse.Cases.casesN' y)) \`shouldBe` --     [\"5", \"False", \"\'X'", \"Just \'O'", \"6", \"Just \'A'"] -- @-collectN :: Many xs -> c n xs r -> CollectorN (ViaN c) n xs r+collectN :: Many xs -> c n xs r -> CollectorN c n xs r collectN = flip forManyN  -----------------------------------------------------------------------@@ -598,7 +764,7 @@ -- | A friendlier type constraint synomyn for 'select' type Select (smaller :: [Type]) (larger :: [Type]) =     (AFoldable-        ( Collector (Via (CaseSelect smaller larger)) larger) [(Key, WrappedAny)])+        ( 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.@@ -606,35 +772,53 @@ -- This can also be used to reorder fields in the original 'Many'. -- -- @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nul'--- 'select' \@'[Bool, Char] x \`shouldBe` False './' \'X' './' 'nul'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nil'+-- 'select' \@'[Bool, Char] x \`shouldBe` False './' \'X' './' 'nil' -- @ select :: forall smaller larger. Select smaller larger => Many larger -> Many smaller select t = Many 0 (fromList' xs')   where-    xs' = afoldr (++) [] (Collector (via (CaseSelect @smaller @larger @larger) t))+    xs' = afoldr (\a z -> maybe z (: z) a) [] (forMany' (CaseSelect @smaller @larger @larger) t)  -- | For each type x in @larger@, generate the (k, v) in @smaller@ (if it exists) data CaseSelect (smaller :: [Type]) (larger :: [Type]) (xs :: [Type]) r = CaseSelect  instance Reiterate (CaseSelect smaller larger) (x ': xs) where-    reiterate CaseSelect = CaseSelect+    reiterate = coerce --- | 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 (CaseSelect smaller larger) (x ': xs) [(Key, WrappedAny)] where+-- | For each type x in larger, find the index in ys, and create a (key, value)+instance forall smaller larger x xs n. (UniqueIfExists smaller x larger, MaybeUniqueMemberAt n x smaller) =>+         CaseAny (CaseSelect smaller larger) (x ': xs) (Maybe (Int, WrappedAny)) where     caseAny _ v =         case i of-            0 -> []-            i' -> [(Key (i' - 1), WrappedAny v)]+            0 -> Nothing+            i' -> Just (i' - 1, WrappedAny v)       where-        i = fromInteger (natVal @(PositionOf x smaller) Proxy)+        i = fromInteger (natVal @n Proxy)  ----------------------------------------------------------------------- +-- | A variation of 'select' which selects by labels+--+-- @+-- let x = False './' Tagged \@\"Hi" (5 :: Int) './' Tagged \@Foo False './' Tagged \@Bar \'X' './' Tagged \@\"Bye" 'O' './' 'nil'+-- 'selectL' \@'[Foo, Bar] Proxy x \`shouldBe` Tagged \@Foo False './' Tagged \@Bar \'X' './' 'nil'+-- 'selectL' \@'[\"Hi", \"Bye"] Proxy x \`shouldBe` Tagged \@\"Hi" (5 :: Int) './' Tagged \@\"Bye" \'O' './' 'nil'+-- @+selectL+    :: forall ls smaller larger proxy.+       ( Select smaller larger+       , smaller ~ KindsAtLabels ls larger+       , IsDistinct ls+       , UniqueLabels ls larger)+    => proxy ls -> Many larger -> Many smaller+selectL _ = select @smaller++-----------------------------------------------------------------------+ -- | 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)]+    ( AFoldable (CollectorAnyN (CaseSelectN ns smaller) 0 larger) (Maybe (Int, WrappedAny))     , smaller ~ KindsAtIndices ns larger     , IsDistinct ns) @@ -648,8 +832,8 @@ -- the mapping is specified by @indicies@. -- -- @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nul'--- 'selectN' (Proxy @'[5, 4, 0]) x \`shouldBe` Just \'A' './' (6 :: Int) './' (5 ::Int) './' 'nul'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nil'+-- 'selectN' (Proxy @'[5, 4, 0]) x \`shouldBe` Just \'A' './' (6 :: Int) './' (5 ::Int) './' 'nil' -- @ selectN     :: forall ns smaller larger proxy.@@ -657,7 +841,7 @@     => proxy ns -> Many larger -> Many smaller selectN _ xs = Many 0 (fromList' xs')   where-    xs' = afoldr (++) [] (forManyN (CaseSelectN @ns @smaller @0 @larger) xs)+    xs' = afoldr (\a z -> maybe z (: z) a) [] (forManyN' (CaseSelectN @ns @smaller @0 @larger) xs)  data CaseSelectN (indices :: [Nat]) (smaller :: [Type]) (n :: Nat) (xs :: [Type]) r = CaseSelectN @@ -665,76 +849,121 @@     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 (CaseSelectN indices smaller n) (x ': xs) [(Key, WrappedAny)] where+instance forall indices smaller n x xs n'. (MaybeMemberAt n' x smaller, n' ~ PositionOf n indices) =>+         CaseAny (CaseSelectN indices smaller n) (x ': xs) (Maybe (Int, WrappedAny)) where     caseAny _ v =         case i of-            0 -> []-            i' -> [(Key (i' - 1), WrappedAny v)]+            0 -> Nothing+            i' -> Just (i' - 1, WrappedAny v)       where-        i = fromInteger (natVal @(PositionOf n indices) Proxy)+        i = fromInteger (natVal @n' Proxy)  -----------------------------------------------------------------------  -- | A friendlier type constraint synomyn for 'amend'-type Amend smaller larger = (AFoldable (Collector (Via (CaseAmend larger)) smaller) (Key, WrappedAny)+type Amend smaller larger = (AFoldable (CollectorAny (CaseAmend larger) smaller) (Int, WrappedAny)        , IsDistinct smaller)  -- | Sets the subset of 'Many' in the larger 'Many'. -- Analogous to 'replace' setter but for multiple fields. -- -- @--- 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'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nil'+-- 'amend' \@'[Int, Maybe Char] x ((6 :: Int) './' Just \'P' './' 'nil') \`shouldBe`+--     (6 :: Int) './' False './' \'X' './' Just \'P' './' 'nil' -- @ amend :: forall smaller larger. Amend smaller larger => Many larger -> Many smaller -> Many larger amend (Many lo lm) t = Many lo (fromList' xs' `M.union` lm)   where-    xs' = afoldr (:) [] (forMany (CaseAmend @larger @smaller lo) t)+    xs' = afoldr (:) [] (forMany' (CaseAmend @larger @smaller lo) t)  newtype CaseAmend (larger :: [Type]) (xs :: [Type]) r = CaseAmend Int  instance Reiterate (CaseAmend larger) (x ': xs) where-    reiterate (CaseAmend lo) = CaseAmend lo+    reiterate = coerce  -- | 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-    caseAny (CaseAmend lo) v = (Key (lo + i), WrappedAny v)+instance UniqueMemberAt n x larger => CaseAny (CaseAmend larger) (x ': xs) (Int, WrappedAny) where+    caseAny (CaseAmend lo) v = (lo + i, WrappedAny v)       where-        i = fromInteger (natVal @(IndexOf x larger) Proxy)+        i = fromInteger (natVal @n Proxy)  ----------------------------------------------------------------------- +-- | A variation of 'amend' which amends via labels.+--+-- @+-- let x = False ./ Tagged \@\"Hi" (5 :: Int) ./ Tagged \@Foo False ./ Tagged \@Bar \'X' ./ Tagged \@\"Bye" \'O' ./ 'nil'+-- 'amendL' \@'[Foo, Bar] Proxy x (Tagged \@Foo True ./ Tagged \@Bar \'Y' ./ nil) `shouldBe`+--     False ./ Tagged \@\"Hi" (5 :: Int) ./ Tagged \@Foo True ./ Tagged \@Bar \'Y' ./ Tagged \@\"Bye" \'O' ./ 'nil'+-- 'amendL' \@'[\"Hi", \"Bye"] Proxy x (Tagged \@\"Hi" (6 :: Int) ./ Tagged \@\"Bye" \'P' ./ nil) `shouldBe`+--     False ./ Tagged \@\"Hi" (6 :: Int) ./ Tagged \@Foo False ./ Tagged \@Bar \'X' ./ Tagged \@\"Bye" \'P' ./ 'nil'+-- @+amendL+    :: forall ls smaller larger proxy.+       ( Amend smaller larger+       , smaller ~ KindsAtLabels ls larger+       , IsDistinct ls+       , UniqueLabels ls larger)+    => proxy ls -> Many larger -> Many smaller -> Many larger+amendL _ = amend @(KindsAtLabels ls larger)++-----------------------------------------------------------------------+ -- | A friendlier type constraint synomyn for 'amend''-type Amend' smaller smaller' larger = (AFoldable (Collector (Via (CaseAmend' larger)) (Zip smaller smaller')) (Key, WrappedAny), IsDistinct smaller)+type Amend' smaller smaller' larger zipped =+    ( AFoldable (CollectorAny (CaseAmend' larger) zipped) (Int, WrappedAny)+    , IsDistinct smaller+    , zipped ~ Zip smaller smaller') -amend' :: forall smaller smaller' larger. Amend' smaller smaller' larger-    => Proxy smaller -> Many larger -> Many smaller' -> Many (Replaces smaller smaller' larger)+amend' :: forall smaller smaller' larger proxy zipped. Amend' smaller smaller' larger zipped+    => 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))+    xs' = afoldr (:) [] (forMany'' @smaller Proxy (CaseAmend' @larger @zipped 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)+forMany'' :: Proxy xs -> c (Zip xs ys) r -> Many ys -> CollectorAny c (Zip xs ys) r+forMany'' _ c (Many _ ys) = CollectorAny c (snd <$> M.toAscList ys)  newtype CaseAmend' (larger :: [Type]) (zs :: [Type]) r = CaseAmend' Int  instance Reiterate (CaseAmend' larger) (z ': zs) where-    reiterate (CaseAmend' lo) = CaseAmend' lo+    reiterate = coerce  -- | 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)+instance (UniqueMemberAt n x larger) => CaseAny (CaseAmend' larger) ((x, y) ': zs) (Int, WrappedAny) where+    caseAny (CaseAmend' lo) v = (lo + i, WrappedAny v)       where-        i = fromInteger (natVal @(IndexOf x larger) Proxy)+        i = fromInteger (natVal @n Proxy)  -----------------------------------------------------------------------++-- | A variation of 'amend' which amends via labels.+--+-- @+-- let x = False './' Tagged \@\"Hi" (5 :: Int) './' Tagged \@Foo False './' Tagged \@Bar 'X' './' Tagged \@\"Bye" \'O' './' 'nil'+-- 'amendL'' \@'[Foo, Bar] Proxy x (\'Y' './' True './' 'ni'l) \`shouldBe`+--     False './' Tagged \@\"Hi" (5 :: Int) './' \'Y' './' True './' Tagged \@\"Bye" \'O' './' 'nil'+-- 'amendL'' \@'[\"Hi", \"Bye"] Proxy x (True './' Tagged \@\"Changed" True './' 'nil') \`shouldBe`+--     False './' True './' Tagged \@Foo False './' Tagged \@Bar \'X' './' Tagged \@\"Changed" True './' 'nil'+-- @+amendL'+    :: forall ls smaller smaller' larger proxy zipped.+       ( Amend' smaller smaller' larger zipped+       , smaller ~ KindsAtLabels ls larger+       , IsDistinct ls+       , UniqueLabels ls larger+       )+    => proxy ls+    -> Many larger+    -> Many smaller'+    -> Many (Replaces smaller smaller' larger)+amendL' _ = amend' @(KindsAtLabels ls larger) Proxy++----------------------------------------------------------------------- -- | A friendlier type constraint synomyn for 'amendN' type AmendN ns smaller larger =-    ( AFoldable (CollectorN (ViaN (CaseAmendN ns larger)) 0 smaller) (Key, WrappedAny)+    ( AFoldable (CollectorAnyN (CaseAmendN ns larger) 0 smaller) (Int, WrappedAny)     , smaller ~ KindsAtIndices ns larger     , IsDistinct ns) @@ -748,61 +977,60 @@ -- the mapping is specified by @indicies@. -- -- @--- 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'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nil'+-- 'amendN' (Proxy \@'[5, 4, 0]) x (Just \'B' './' (8 :: Int) './' (4 ::Int) './' 'nil') \`shouldBe`+--     (4 :: Int) './' False './' \'X' './' Just \'O' './' (8 :: Int) './' Just \'B' './' 'nil' -- @ amendN :: forall ns smaller larger proxy.        (AmendN ns smaller larger)     => proxy ns -> Many larger -> Many smaller -> Many larger amendN _ (Many lo lm) t = Many lo (fromList' xs' `M.union` lm)   where-    xs' = afoldr (:) [] (forManyN (CaseAmendN @ns @larger @0 @smaller lo) t)-------------------------------------------------------------------------+    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-    reiterateN (CaseAmendN lo) = CaseAmendN lo+    reiterateN = coerce  -- | 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-    caseAny (CaseAmendN lo) v = (Key (lo + i), WrappedAny v)+instance (MemberAt n' x larger, n' ~ KindAtIndex n indices) =>+         CaseAny (CaseAmendN indices larger n) (x ': xs) (Int, WrappedAny) where+    caseAny (CaseAmendN lo) v = (lo + i, WrappedAny v)       where-        i = fromInteger (natVal @(KindAtIndex n indices) Proxy)+        i = fromInteger (natVal @n' 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)+type AmendN' ns smaller smaller' larger zipped =+    ( AFoldable (CollectorAnyN (CaseAmendN' ns larger) 0 zipped) (Int, WrappedAny)     , smaller ~ KindsAtIndices ns larger-    , IsDistinct ns)+    , IsDistinct ns+    , zipped ~ Zip smaller smaller')  -- | A polymorphic variation of 'amendN'-amendN' :: forall ns smaller smaller' larger proxy.-       (AmendN' ns smaller smaller' larger)+amendN' :: forall ns smaller smaller' larger proxy zipped.+       (AmendN' ns smaller smaller' larger zipped)     => 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))+    xs' = afoldr (:) [] (forManyN'' @smaller Proxy (CaseAmendN' @ns @larger @0 @zipped 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)+forManyN'' :: Proxy xs -> c n (Zip xs ys) r -> Many ys -> CollectorAnyN c n (Zip xs ys) r+forManyN'' _ c (Many _ ys) = CollectorAnyN c (snd <$> M.toAscList ys)  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+    reiterateN = coerce  -- | 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)+instance (MemberAt n' x larger, n' ~ KindAtIndex n indices) =>+         CaseAny (CaseAmendN' indices larger n) ((x, y) ': zs) (Int, WrappedAny) where+    caseAny (CaseAmendN' lo) v = (lo + i, WrappedAny v)       where-        i = fromInteger (natVal @(KindAtIndex n indices) Proxy)+        i = fromInteger (natVal @n' Proxy)  ----------------------------------------------------------------------- @@ -813,10 +1041,10 @@ -- @ -- -- @--- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nul'--- x '^.' ('project' \@'[Int, Maybe Char]) \`shouldBe` (5 :: Int) './' Just \'O' './' 'nul'--- (x '&' ('project' \@'[Int, Maybe Char]) '.~' ((6 :: Int) './' Just 'P' './' 'nul')) \`shouldBe`---     (6 :: Int) './' False './' \'X' './' Just \'P' './' 'nul'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nil'+-- x '^.' ('project' \@'[Int, Maybe Char]) \`shouldBe` (5 :: Int) './' Just \'O' './' 'nil'+-- (x '&' ('project' \@'[Int, Maybe Char]) '.~' ((6 :: Int) './' Just 'P' './' 'nil')) \`shouldBe`+--     (6 :: Int) './' False './' \'X' './' Just \'P' './' 'nil' -- @ project     :: forall smaller larger.@@ -827,12 +1055,49 @@  -- | Polymorphic version of project' project'-    :: forall smaller smaller' larger.-       (Select smaller larger, Amend' smaller smaller' larger)+    :: forall smaller smaller' larger zipped.+       (Select smaller larger, Amend' smaller smaller' larger zipped)     => Lens (Many larger) (Many (Replaces smaller smaller' larger)) (Many smaller) (Many smaller') project' = lens select (amend' @smaller @smaller' Proxy) {-# INLINE project' #-} +-- | 'selectL' ('view' 'projectL') and 'amendL' ('set' 'projectL') in 'Lens'' form.+--+-- @+-- let x = False './' Tagged \@\"Hi" (5 :: Int) './' Tagged \@Foo False './' Tagged \@Bar \'X' './' Tagged \@\"Bye" \'O' './' 'nil'+-- x '^.' ('projectL' \@'[Foo, Bar] Proxy) \`shouldBe` Tagged \@Foo False './' Tagged \@Bar \'X' './' nil+-- (x '&' ('projectL' \@'[\"Hi", \"Bye"] Proxy) '.~' (Tagged \@\"Hi" (6 :: Int) './' Tagged \@\"Bye" \'P' './' nil)) '`shouldBe`+--     False './' Tagged \@\"Hi" (6 :: Int) './' Tagged \@Foo False './' Tagged \@Bar \'X' './' Tagged \@\"Bye" \'P' './' 'nil'+-- @+projectL+    :: forall ls smaller larger proxy.+       ( Select smaller larger+       , Amend smaller larger+       , smaller ~ KindsAtLabels ls larger+       , IsDistinct ls+       , UniqueLabels ls larger)+    => proxy ls -> Lens' (Many larger) (Many smaller)+projectL p = lens (selectL p) (amendL p)+{-# INLINE projectL #-}++-- | Polymorphic version of projectL'+--+-- @+-- let x = False './' Tagged \@\"Hi" (5 :: Int) './' Tagged \@Foo False './' Tagged \@Bar \'X' './' Tagged \@\"Bye" \'O' './' 'nil'+-- (x '&' ('projectL'' \@'[\"Hi", \"Bye"] Proxy) '.~' (True './' Tagged \@\"Changed" False './' 'nil')) \`shouldBe`+--     False './' True './' Tagged \@Foo False './' Tagged \@Bar \'X' './' Tagged \@\"Changed" False './' 'nil'+-- @+projectL'+    :: forall ls smaller smaller' larger proxy zipped.+       ( Select smaller larger+       , Amend' smaller smaller' larger zipped+       , smaller ~ KindsAtLabels ls larger+       , IsDistinct ls+       , UniqueLabels ls larger)+    => proxy ls -> Lens (Many larger) (Many (Replaces smaller smaller' larger)) (Many smaller) (Many smaller')+projectL' p = lens (selectL p) (amendL' p)+{-# INLINE projectL' #-}+ -- | 'selectN' ('view' 'projectN') and 'amendN' ('set' 'projectN') in 'Lens'' form. -- -- @@@ -840,10 +1105,10 @@ -- @ -- -- @--- 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'+-- let x = (5 :: Int) './' False './' \'X' './' Just \'O' './' (6 :: Int) './' Just \'A' './' 'nil'+-- x '^.' ('projectN' \@'[5, 4, 0] Proxy) \`shouldBe` Just \'A' './' (6 :: Int) './' (5 ::Int) './' 'nil'+-- (x '&' ('projectN' \@'[5, 4, 0] Proxy) '.~' (Just \'B' './' (8 :: Int) './' (4 ::Int) './' nil)) \`shouldBe`+--     (4 :: Int) './' False './' \'X' './' Just \'O' './' (8 :: Int) './' Just \'B' './' 'nil' -- @ projectN     :: forall ns smaller larger proxy.@@ -854,136 +1119,94 @@  -- | Polymorphic version of 'projectN' projectN'-    :: forall ns smaller smaller' larger proxy.-       (SelectN ns smaller larger, AmendN' ns smaller smaller' larger)+    :: forall ns smaller smaller' larger proxy zipped.+       (SelectN ns smaller larger, AmendN' ns smaller smaller' larger zipped)     => proxy ns -> Lens (Many larger) (Many (ReplacesIndex ns smaller' larger)) (Many smaller) (Many smaller') projectN' p = lens (selectN p) (amendN' p) {-# INLINE projectN' #-}  ----------------------------------------------------------------------- --- | Stores the left & right Many and a list of Any which must be the same length and types in xs typelist.-newtype EmitEqMany (xs :: [Type]) r = EmitEqMany ([Any], [Any])--instance Reiterate EmitEqMany (x ': xs) where-    -- use of tail here is safe as we are guaranteed the length from the typelist-    reiterate (EmitEqMany (ls, rs)) = EmitEqMany (Partial.tail ls, Partial.tail rs)--instance Eq x => Emit EmitEqMany (x ': xs) Bool where-    emit (EmitEqMany (ls, rs)) = l == r-      where-        -- use of front here is safe as we are guaranteed the length from the typelist-        l = unsafeCoerce (Partial.head ls) :: x-        r = unsafeCoerce (Partial.head rs) :: x+instance Eq (Many_ '[]) where+    _ == _ = True -eqMany-    :: forall xs.-       AFoldable (Collector EmitEqMany xs) Bool-    => Many xs -> Many xs -> [Bool]-eqMany (Many _ lm) (Many _ rm) = afoldr (:) []-    (Collector (EmitEqMany @xs (snd <$> M.toAscList lm, snd <$> M.toAscList rm)))+instance (Eq x, Eq (Many_ xs)) => Eq (Many_ (x ': xs)) where+    ls == rs = case front' ls == front' rs of+        False -> False+        _ -> (aft' ls) == (aft' rs)+    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types+    {-# NOINLINE (==) #-}  -- | Two 'Many's are equal if all their fields equal-instance AFoldable (Collector EmitEqMany xs) Bool => Eq (Many xs) where-    lt == rt = foldr (\e z -> bool False z e) True eqs-      where-        eqs = eqMany lt rt+instance Eq (Many_ xs) => Eq (Many xs) where+    lt == rt = toMany_ lt == toMany_ rt  ----------------------------------------------------------------------- --- | Stores the left & right Many and a list of Any which must be the same length and types in xs typelist.-newtype EmitOrdMany (xs :: [Type]) r = EmitOrdMany ([Any], [Any])--instance Reiterate EmitOrdMany (x ': xs) where-    -- use of tail here is safe as we are guaranteed the length from the typelist-    reiterate (EmitOrdMany (ls, rs)) = EmitOrdMany (Partial.tail ls, Partial.tail rs)--instance Ord x => Emit EmitOrdMany (x ': xs) Ordering where-    emit (EmitOrdMany (ls, rs)) = compare l r-      where-        -- use of front here is safe as we are guaranteed the length from the typelist-        l = unsafeCoerce (Partial.head ls) :: x-        r = unsafeCoerce (Partial.head rs) :: x+instance Ord (Many_ '[]) where+    compare _ _ = EQ -ordMany-    :: forall xs.-       AFoldable (Collector EmitOrdMany xs) Ordering-    => Many xs -> Many xs -> [Ordering]-ordMany (Many _ lm) (Many _ rm) = afoldr (:) []-    (Collector (EmitOrdMany @xs (snd <$> M.toAscList lm, snd <$> M.toAscList rm)))+instance (Ord x, Ord (Many_ xs)) => Ord (Many_ (x ': xs)) where+    compare ls rs = case compare (front' ls) (front' rs) of+        LT -> LT+        GT -> GT+        EQ -> compare (aft' ls) (aft' rs)+    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types+    {-# NOINLINE compare #-}  -- | Two 'Many's are ordered by 'compare'ing their fields in index order-instance (Eq (Many xs), AFoldable (Collector EmitOrdMany xs) Ordering) => Ord (Many xs) where-    compare lt rt = foldr (\o z -> case o of-                                       EQ -> z-                                       o' -> o') EQ ords-      where-        ords = ordMany lt rt+instance Ord (Many_ xs) => Ord (Many xs) where+    compare xs ys = compare (toMany_ xs) (toMany_ ys)  ----------------------------------------------------------------------- --- | Internally uses [Any] like Via, except also handle the empty type list.-newtype EmitShowMany (xs :: [Type]) r = EmitShowMany [Any]--instance Reiterate EmitShowMany (x ': xs) where-    -- use of tail here is safe as we are guaranteed the length from the typelist-    reiterate (EmitShowMany xxs) = EmitShowMany (Partial.tail xxs)--instance Emit EmitShowMany '[] ShowS where-    emit _ = showString "nul"-+instance Show (Many_ '[]) where+    showsPrec d _ = showParen (d > app_prec) $ showString "nil"+      where+        app_prec = 10 -instance Show x => Emit EmitShowMany (x ': xs) ShowS where-    emit (EmitShowMany xxs) = showsPrec (cons_prec + 1) v . showString " ./ "+instance (Show x, Show (Many_ xs)) => Show (Many_ (x ': xs)) where+    showsPrec d ls@(Many_ xs) =+        showParen (d > cons_prec) $+        showsPrec (cons_prec + 1) v .+        showString " ./ " .+        showsPrec cons_prec (aft' ls) -- not (cons-prec+1) for right associativity       where+        cons_prec = 5 -- infixr 5 prefix         -- use of front here is safe as we are guaranteed the length from the typelist-        v = unsafeCoerce (Partial.head xxs) :: x-        cons_prec = 5 -- infixr 5 cons--showMany-    :: forall xs.-       AFoldable (Collector0 EmitShowMany xs) ShowS-    => Many xs -> ShowS-showMany (Many _ m) = afoldr (.) id (Collector0 (EmitShowMany @xs (snd <$> M.toAscList m)))+        v = unsafeCoerce (Partial.head xs) :: x+    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types+    {-# NOINLINE showsPrec #-} --- | @read "5 ./ False ./ 'X' ./ Just 'O' ./ nul" == (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nul'@-instance AFoldable (Collector0 EmitShowMany xs) ShowS => Show (Many xs) where-    showsPrec d t = showParen (d > cons_prec) $ showMany t-      where-        cons_prec = 5 -- infixr 5 cons+-- | Two 'Many's are equal if all their fields equal+instance Show (Many_ xs) => Show (Many xs) where+    showsPrec d xs = showsPrec d (toMany_ xs)  ----------------------------------------------------------------------- -newtype EmitReadMany (xs :: [Type]) r = EmitReadMany Key--instance Reiterate EmitReadMany (x ': xs) where-    reiterate (EmitReadMany (Key i)) = EmitReadMany (Key (i + 1))--instance Emit EmitReadMany '[] (ReadPrec [(Key, WrappedAny)]) where-    emit (EmitReadMany _) = do-        lift $ L.expect (Ident "nul")-        pure []+instance Read (Many_ '[]) where+    readPrec = parens $ prec app_prec $ do+        lift $ L.expect (Ident "nil")+        pure $ Many_ []+      where+        app_prec = 10 -instance Read x => Emit EmitReadMany (x ': xs) (ReadPrec [(Key, WrappedAny)]) where-    emit (EmitReadMany i) = do-        a <- readPrec @x+instance (Read x, Read (Many_ xs)) => Read (Many_ (x ': xs)) where+    readPrec = parens $ prec cons_prec $ do+        a <- step (readPrec @x)         lift $ L.expect (Symbol "./")-        pure [(i, WrappedAny (unsafeCoerce a))]--readMany-    :: forall xs.-       AFoldable (Collector0 EmitReadMany xs) (ReadPrec [(Key, WrappedAny)])-    => Proxy (xs :: [Type]) -> ReadPrec [(Key, WrappedAny)]-readMany _ = afoldr (liftA2 (++)) (pure []) (Collector0 (EmitReadMany @xs (Key 0)))+        as <- readPrec @(Many_ xs) -- no 'step' to allow right associatitive './'+        pure $ prefix' a as+      where+        cons_prec = 5 -- infixr `prefix`+    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types+    {-# NOINLINE readPrec #-} --- | @read "5 ./ False ./ 'X' ./ Just 'O' ./ nul" == (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nul'@-instance (AFoldable (Collector0 EmitReadMany xs) (ReadPrec [(Key, WrappedAny)])) =>-         Read (Many xs) where-    readPrec =-        parens $-        prec 10 $ do-            xs <- readMany @xs Proxy-            pure (Many 0 (fromList' xs))+-- | @read "5 ./ False ./ 'X' ./ Just 'O' ./ nil" == (5 :: Int) './' False './' \'X' './' Just \'O' './' 'nil'@+instance Read (Many_ xs) => Read (Many xs) where+    readPrec = do+        xs <- readPrec @(Many_ xs)+        pure $ fromMany_ xs  -- | 'WrappedAny' avoids the following: -- Illegal type synonym family application in instance: Any

@@ -16,8 +16,14 @@ -- | Ensures that @x@ is a unique member of @xs@, and that 'natVal' can be used. type UniqueMember x xs = (Unique x xs, KnownNat (IndexOf x xs)) +-- | Ensures that @x@ is a unique member of @xs@, and that 'natVal' can be used.+type UniqueMemberAt n x xs = (Unique x xs, KnownNat n, n ~ IndexOf x xs)++-- | Ensures that @x@ is a unique member of @xs@, and that 'natVal' can be used.+type UniqueLabelMember l xs = (UniqueLabel l xs, KnownNat (IndexOf (KindAtLabel l xs) xs))+ -- | Ensures that @x@ is a unique member of @xs@ if it exists, and that 'natVal' can be used.-type MaybeUniqueMember x xs = (Unique x xs, KnownNat (PositionOf x xs))+type MaybeUniqueMemberAt n x xs = (Unique x xs, KnownNat n, n ~ PositionOf x xs)  -- | Ensures that @x@ is a member of @xs@ at @n@, and that 'natVal' can be used. type MemberAt n x xs = (KnownNat n, x ~ KindAtIndex n xs)@@ -42,6 +48,14 @@ -- | Ensures that @x@ only ever appears once in @xs@ type Unique (x :: k) (xs :: [k]) = UniqueImpl xs x xs +-- | Ensures that the @label@ in @tagged label v@ only ever appears once in @xs@.+type UniqueLabel (l :: k1) (xs :: [k]) = UniqueLabelImpl xs l xs++-- | Ensures that the @label@ list all 'UniqueLabel's+type family UniqueLabels (ls :: [k1]) (xs :: [k]) :: Constraint where+    UniqueLabels '[] xs = ()+    UniqueLabels (l ': ls) xs = (UniqueLabel l xs, UniqueLabels ls xs)+ -- | Get the first index of a type (Indexed by 0) -- Will result in type error if x doesn't exist in xs. type IndexOf (x :: k) (xs :: [k]) = IndexOfImpl xs x xs@@ -54,7 +68,7 @@ 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+type KindAtLabel (l :: k1) (xs :: [k]) = 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@@ -65,6 +79,10 @@ type family KindsAtIndices (ns :: [Nat]) (xs :: [k]) :: [k] where     KindsAtIndices '[] xs = '[]     KindsAtIndices (n ': ns) xs = KindAtIndex n xs ': KindsAtIndices ns xs++type family KindsAtLabels (ls :: [k1]) (xs :: [k]) :: [k] where+    KindsAtLabels '[] xs = '[]+    KindsAtLabels (l ': ls) xs = KindAtLabel l xs ': KindsAtLabels ls 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

@@ -41,7 +41,7 @@ -- | 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 "Missing error: ‘"+    MissingImpl ctx x (x ': xs) = TypeError ('Text "Not unique error: ‘"                                              ':<>: 'ShowType x                                              ':<>: 'Text "’"                                              ':<>: 'Text " is a duplicate in "@@ -50,7 +50,20 @@                                              ':<>: 'Text "’")     MissingImpl ctx y (x ': xs) = (MissingImpl ctx y xs) --- | Ensures that the type list contain unique types+-- | Errors if a label exists in a typelist+type family MissingLabelImpl (ctx :: [k]) (l :: k2) (xs :: [k]) :: Constraint where+    MissingLabelImpl ctx y '[] = ()+    MissingLabelImpl ctx l (tagged l x ': xs) = TypeError ('Text "Not unique label error: ‘"+                                             ':<>: 'ShowType l+                                             ':<>: 'Text "’"+                                             ':<>: 'Text " is a duplicate in "+                                             ':<>: 'Text "‘"+                                             ':<>: 'ShowType ctx+                                             ':<>: 'Text "’")+    MissingLabelImpl ctx l (x ': xs) = (MissingLabelImpl ctx l xs)++-- | Ensures that the type list contain unique types.+-- Not implemented as @(xs ~ Nub xs)@ for better type error messages. type family IsDistinctImpl (ctx :: [k]) (xs :: [k]) :: Constraint where     IsDistinctImpl ctx '[] = ()     IsDistinctImpl ctx (x ': xs) = (MissingImpl ctx x xs, IsDistinctImpl ctx xs)@@ -61,6 +74,12 @@     UniqueImpl ctx x (x ': xs) = MissingImpl ctx x xs     UniqueImpl ctx x (y ': xs) = UniqueImpl ctx x xs +-- | Ensures that the @label@ in @tagged label v@ only ever appears once in @xs@.+type family UniqueLabelImpl (ctx :: [k]) (l :: k1) (xs :: [k]) :: Constraint where+    UniqueLabelImpl ctx l '[] = ()+    UniqueLabelImpl ctx l (tagged l x ': xs) = MissingLabelImpl ctx l xs+    UniqueLabelImpl ctx l (y ': xs) = UniqueLabelImpl ctx l xs+ -- | Indexed access into the list type family KindAtIndexImpl (orig :: Nat) (ctx :: [k]) (n :: Nat) (xs :: [k]) :: k where     KindAtIndexImpl i ctx 0 '[] = TypeError ('Text "KindAtIndex error: Index ‘"@@ -74,7 +93,7 @@     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+type family KindAtLabelImpl (l :: k1) (ctx :: [k]) (xs :: [k]) :: k where     KindAtLabelImpl l ctx '[] = TypeError ('Text "KindAtLabel error: Label ‘"                                        ':<>: 'ShowType l                                        ':<>: 'Text "’"

@@ -9,14 +9,17 @@     , pick     , pick0     , pickOnly+    , pickL     , pickN       -- ** Destruction     , obvious     , trial     , trial0+    , trialL     , trialN       -- ** Lens     , facet+    , facetL     , facetN        -- * Multiple types@@ -24,15 +27,18 @@     , Diversify     , diversify     , diversify0+    , diversifyL     , DiversifyN     , diversifyN       -- ** Inverse Injection     , Reinterpret     , reinterpret+    , reinterpretL     , ReinterpretN     , reinterpretN       -- ** Lens     , inject+    , injectL     , injectN        -- * Catamorphism

@@ -23,14 +23,17 @@     , pick     , pick0     , pickOnly+    , pickL     , pickN       -- ** Destruction     , obvious     , trial     , trial0+    , trialL     , trialN       -- ** Lens     , facet+    , facetL     , facetN        -- * Multiple types@@ -38,15 +41,18 @@     , Diversify     , diversify     , diversify0+    , diversifyL     , DiversifyN     , diversifyN       -- ** Inverse Injection     , Reinterpret     , reinterpret+    , reinterpretL     , ReinterpretN     , reinterpretN       -- ** Lens     , inject+    , injectL     , injectN        -- * Catamorphism@@ -60,17 +66,15 @@  import Control.Applicative import Control.Lens-import Data.Diverse.AFoldable+import Control.Monad import Data.Diverse.Case-import Data.Diverse.Collector-import Data.Diverse.Emit import Data.Diverse.Reduce import Data.Diverse.Reiterate import Data.Diverse.Type import Data.Kind import Data.Proxy import qualified GHC.Generics as G-import GHC.Prim (Any)+import GHC.Prim (Any, coerce) import GHC.TypeLits import Text.ParserCombinators.ReadPrec import Text.Read@@ -105,6 +109,10 @@ data Which (xs :: [Type]) = Which {-# UNPACK #-} !Int Any  -- Just like Haskus and HList versions, inferred type is phantom which is wrong+-- representational means:+-- @+-- Coercible '[Int] '[IntLike] => Coercible (Which '[Int]) (Which '[IntLike])+-- @ type role Which representational  ----------------------------------------------@@ -151,8 +159,21 @@ -- 'pick' \'A' \@'[Int, Bool, Char, Maybe String] :: Which '[Int, Bool, Char, Maybe String] -- @ pick :: forall xs x. UniqueMember x xs => x -> Which xs-pick = Which (fromInteger (natVal @(IndexOf x xs) Proxy)) . unsafeCoerce+pick = pick_ +pick_ :: forall x xs n. (KnownNat n, n ~ IndexOf x xs) => x -> Which xs+pick_ = Which (fromInteger (natVal @n Proxy)) . unsafeCoerce++-- | A variation of 'pick' where @x@ is specified via a label+--+-- @+-- let y = 'pickL' \@Foo Proxy (Tagged (5 :: Int)) :: Which '[Bool, Tagged Foo Int, Tagged Bar Char]+--     x = 'trialL' \@Foo Proxy y+-- x `shouldBe` (Right (Tagged 5))+-- @+pickL :: forall l xs x proxy. (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => proxy l -> x -> Which xs+pickL _ = pick_ @x+ -- | A variation of 'pick' into a 'Which' of a single type. -- -- @@@ -197,13 +218,32 @@     :: forall x xs.        (UniqueMember x xs)     => Which xs -> Either (Which (Without x xs)) x-trial (Which n v) = let i = fromInteger (natVal @(IndexOf x xs) Proxy)+trial = trial_++trial_+    :: forall x xs n.+       (KnownNat n, n ~ IndexOf x xs)+    => Which xs -> Either (Which (Without x xs)) x+trial_ (Which n v) = let i = fromInteger (natVal @n Proxy)                   in if n == i                      then Right (unsafeCoerce v)                      else if n > i                           then Left (Which (n - 1) v)                           else Left (Which n v) +-- | A variation of 'trial' where x is specified via a label+--+-- @+-- let y = 'pickL' \@Foo Proxy (Tagged (5 :: Int)) :: Which '[Bool, Tagged Foo Int, Tagged Bar Char]+--     x = 'trialL' \@Foo Proxy y+-- x `shouldBe` (Right (Tagged 5))+-- @+trialL+    :: forall l xs x proxy.+       (UniqueLabelMember l xs, x ~ KindAtLabel l xs)+    => proxy l -> Which xs -> Either (Which (Without x xs)) x+trialL _ = trial_ @x+ -- | A variation of a 'Which' 'trial' which 'trial's the first type in the type list. -- -- @@@ -215,7 +255,6 @@            then Right (unsafeCoerce v)            else Left (Which (n - 1) v) - -- | 'trialN' the n-th type of a 'Which', and get 'Either' the 'Right' value or the 'Left'-over possibilities. -- -- @@@ -254,6 +293,17 @@ facet = prism' pick (hush . trial) {-# INLINE facet #-} +-- | 'pickL' ('review' 'facetL') and 'trialL' ('preview' 'facetL') in 'Prism'' form.+--+-- @+-- let y = 'review' ('facetL' \@Bar Proxy) (Tagged (5 :: Int)) :: Which '[Tagged Foo Bool, Tagged Bar Int, Char, Bool, Char]+--     x = 'preview' ('facetL' \@Bar Proxy) y+-- x \`shouldBe` (Just (Tagged 5))+-- @+facetL :: forall l xs x proxy. (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => proxy l -> Prism' (Which xs) x+facetL p = prism' (pickL p) (hush . trialL p)+{-# INLINE facetL #-}+ -- | 'pickN' ('review' 'facetN') and 'trialN' ('preview' 'facetN') in 'Prism'' form. -- -- @@@ -307,10 +357,30 @@  ------------------------------------------------------------------ +-- | A variation of 'diversify' where @branch@is additionally specified by a labels list.+--+-- @+-- let y = 'pickOnly' (5 :: Tagged Bar Int)+--     y' = 'diversifyL' \@'[Bar] Proxy y :: 'Which' '[Tagged Bar Int, Tagged Foo Bool]+--     y'' = 'diversifyL' \@'[Bar, Foo] Proxy y' :: 'Which' '[Tagged Foo Bool, Tagged Bar Int]+-- 'switch' y'' ('Data.Diverse.CaseTypeable.CaseTypeable' (show . typeRep . (pure \@Proxy))) \`shouldBe` \"Tagged * Bar Int"+-- @+diversifyL+    :: forall ls tree branch proxy.+       ( Diversify tree branch+       , branch ~ KindsAtLabels ls tree+       , UniqueLabels ls tree+       , IsDistinct ls+       )+    => proxy ls -> Which branch -> Which tree+diversifyL _ = which (CaseDiversify @tree @branch @branch)++------------------------------------------------------------------+ -- | A friendlier constraint synonym for 'diversifyN'. type DiversifyN (indices :: [Nat]) (tree :: [Type]) (branch :: [Type]) = (Reduce Which (SwitchN (CaseDiversifyN indices) 0) (KindsAtIndices indices tree) (Which tree), KindsAtIndices indices tree ~ branch) --- | A variation of 'diversify' which uses a Nat list @n@ to specify how to reorder the fields, where+-- | A variation of 'diversify' which uses a Nat list @indices@ to specify how to reorder the fields, where -- -- @ -- indices[branch_idx] = tree_idx@@ -364,21 +434,43 @@ instance Reiterate (CaseReinterpret branch tree) tree' where     reiterate CaseReinterpret = CaseReinterpret -instance ( MaybeUniqueMember x branch+instance ( MaybeUniqueMemberAt n x branch          , comp ~ Complement tree branch-         , MaybeUniqueMember x comp+         , MaybeUniqueMemberAt n' x comp          , Unique x tree -- Compile error to ensure reinterpret only works with unique fields          ) =>          Case (CaseReinterpret branch tree) (x ': tree') (Either (Which comp) (Which branch)) where     case' CaseReinterpret a =-        case fromInteger (natVal @(PositionOf x branch) Proxy) of-            0 -> let j = fromInteger (natVal @(PositionOf x (Complement tree branch)) Proxy)+        case fromInteger (natVal @n Proxy) of+            0 -> let j = fromInteger (natVal @n' Proxy)                  -- safe use of partial! j will never be zero due to check above                  in Left $ Which (j - 1) (unsafeCoerce a)             i -> Right $ Which (i - 1) (unsafeCoerce a)  ------------------------------------------------------------------ +-- | A variation of 'reinterpret' where the @branch@ is additionally specified with a labels list.+--+-- @+-- let y = 'pick' \@[Tagged Bar Int, Tagged Foo Bool, Tagged Hi Char, Tagged Bye Bool] (5 :: Tagged Bar Int)+--     y' = 'reinterpretL' \@[Foo, Bar] Proxy y+--     x = 'pick' \@[Tagged Foo Bool, Tagged Bar Int] (5 :: Tagged Bar Int)+-- y' \`shouldBe` Right x+-- @+reinterpretL+    :: forall ls branch tree proxy.+       ( Reinterpret branch tree+       , branch ~ KindsAtLabels ls tree+       , UniqueLabels ls tree+       , IsDistinct ls+       )+    => proxy ls+    -> Which tree+    -> Either (Which (Complement tree branch)) (Which branch)+reinterpretL _ = which (CaseReinterpret @branch @tree @tree)++------------------------------------------------------------------+ -- | A friendlier constraint synonym for 'reinterpretN'. type ReinterpretN (indices :: [Nat]) (branch :: [Type]) (tree :: [Type]) = (Reduce Which (SwitchN (CaseReinterpretN indices) 0) tree (Maybe (Which (KindsAtIndices indices tree))), KindsAtIndices indices tree ~ branch) @@ -404,9 +496,9 @@ instance ReiterateN (CaseReinterpretN indices) n tree' where     reiterateN CaseReinterpretN = CaseReinterpretN -instance MaybeMemberAt (PositionOf n indices) x branch => Case (CaseReinterpretN indices n) (x ': tree) (Maybe (Which branch)) where+instance (MaybeMemberAt n' x branch, n' ~ PositionOf n indices) => Case (CaseReinterpretN indices n) (x ': tree) (Maybe (Which branch)) where     case' CaseReinterpretN a =-        case fromInteger (natVal @(PositionOf n indices) Proxy) of+        case fromInteger (natVal @n' Proxy) of             0 -> Nothing             i -> Just $ Which (i - 1) (unsafeCoerce a) @@ -430,6 +522,29 @@ inject = prism' diversify (hush . reinterpret) {-# INLINE inject #-} ++-- | 'diversifyL' ('review' 'injectL') and 'reinterpretL' ('preview' 'injectL') in 'Prism'' form.+--+-- @+-- let t = 'pick' \@[Tagged Bar Int, Tagged Foo Bool, Tagged Hi Char, Tagged Bye Bool] (5 :: Tagged Bar Int)+--     b = 'pick' \@'[Tagged Foo Bool, Tagged Bar Int] (5 :: Tagged Bar Int)+--     t' = 'review' ('injectL' \@[Foo, Bar] \@_ \@[Tagged Bar Int, Tagged Foo Bool, Tagged Hi Char, Tagged Bye Bool] Proxy) b+--     b' = 'preview' ('injectL' \@[Foo, Bar] Proxy) t'+-- t \`shouldBe` t'+-- b' \`shouldBe` Just b+-- @+injectL+    :: forall ls branch tree proxy.+       ( Diversify tree branch+       , Reinterpret branch tree+       , branch ~ KindsAtLabels ls tree+       , UniqueLabels ls tree+       , IsDistinct ls+       )+    => proxy ls -> Prism' (Which tree) (Which branch)+injectL p = prism' (diversifyL p) (hush . reinterpretL p)+{-# INLINE injectL #-}+ -- | 'diversifyN' ('review' 'injectN') and 'reinterpretN' ('preview' 'injectN') in 'Prism'' form. -- -- @@@ -456,15 +571,14 @@  -- | 'trial0' each type in a 'Which', and either handle the 'case'' with value discovered, or __'reiterate'__ -- trying the next type in the type list.--- This code will be efficiently compiled into a single case statement in GHC 8.2.1--- See http://hsyl20.fr/home/posts/2016-12-12-control-flow-in-haskell-part-2.html instance (Case c (x ': x' ': xs) r, Reduce Which (Switch c) (x' ': xs) r, Reiterate c (x : x' : xs)) =>          Reduce Which (Switch c) (x ': x' ': xs) r where     reduce (Switch c) v =         case trial0 v of             Right a -> case' c a             Left v' -> reduce (Switch (reiterate c)) v'-    {-# INLINE reduce #-}+    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types+    {-# NOINLINE reduce #-}  -- | Terminating case of the loop, ensuring that a instance of @Case '[]@ -- with an empty typelist is not required.@@ -486,7 +600,7 @@ -- 'Data.Diverse.Which.switch' y ( --     'Data.Diverse.Cases.cases' (show \@Bool --         'Data.Diverse.Many../' show \@Int---         'Data.Diverse.Many../' 'Data.Diverse.Many.nul')) \`shouldBe` "5"+--         'Data.Diverse.Many../' 'Data.Diverse.Many.nil')) \`shouldBe` "5" -- @ -- -- Or 'Data.Diverse.CaseTypeable.CaseTypeable' to apply a polymorphic function that work on all 'Typeables'.@@ -508,15 +622,14 @@  -- | 'trial0' each type in a 'Which', and either handle the 'case'' with value discovered, or __'reiterateN'__ -- trying the next type in the type list.--- This code will be efficiently compiled into a single case statement in GHC 8.2.1--- See http://hsyl20.fr/home/posts/2016-12-12-control-flow-in-haskell-part-2.html instance (Case (c n) (x ': x' ': xs) r, Reduce Which (SwitchN c (n + 1)) (x' ': xs) r, ReiterateN c n (x : x' : xs)) =>          Reduce Which (SwitchN c n) (x ': x' ': xs) r where     reduce (SwitchN c) v =         case trial0 v of             Right a -> case' c a             Left v' -> reduce (SwitchN (reiterateN c)) v'-    {-# INLINE reduce #-}+    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types+    {-# NOINLINE reduce #-}  -- | Terminating case of the loop, ensuring that a instance of @Case '[]@ -- with an empty typelist is not required.@@ -541,7 +654,7 @@ --         'Data.Diverse.Many../' show \@Bool --         'Data.Diverse.Many../' show \@Bool --         'Data.Diverse.Many../' show \@Int---         'Data.Diverse.Many../' 'Data.Diverse.Many.nul')) \`shouldBe` "5"+--         'Data.Diverse.Many../' 'Data.Diverse.Many.nil')) \`shouldBe` "5" -- @ -- -- Or you may use your own custom instance of 'Case'.@@ -598,7 +711,7 @@  -- | @show ('pick'' \'A') == "pick \'A'"@ instance (Reduce Which (Switch CaseShowWhich) (x ': xs) ShowS) => Show (Which (x ': xs)) where-    showsPrec d v = showParen (d > app_prec) ((showString "pick ") . (which CaseShowWhich v))+    showsPrec d v = showParen (d > app_prec) (which (CaseShowWhich 0) v)       where app_prec = 10  -- | @read "impossible" == 'impossible'@@@ -606,49 +719,59 @@     showsPrec d _ = showParen (d > app_prec) (showString "impossible")       where app_prec = 10 -data CaseShowWhich (xs :: [Type]) r = CaseShowWhich+newtype CaseShowWhich (xs :: [Type]) r = CaseShowWhich Int  instance Reiterate CaseShowWhich (x ': xs) where-    reiterate CaseShowWhich = CaseShowWhich+    reiterate (CaseShowWhich i) = CaseShowWhich (i + 1)  instance Show x => Case CaseShowWhich (x ': xs) ShowS where-    case' _ = showsPrec (app_prec + 1)+    case' (CaseShowWhich i) v = showString "pickN @" . showString (show i) . showString " Proxy " . showsPrec (app_prec + 1) v       where app_prec = 10  ------------------------------------------------------------------ -newtype EmitReadWhich (xs :: [Type]) r = EmitReadWhich Int+class WhichRead v where+    whichReadPrec :: Int -> Int -> ReadPrec v -instance Reiterate EmitReadWhich (x ': xs) where-    reiterate (EmitReadWhich i) = EmitReadWhich (i + 1)+data Which_ (xs ::[Type]) = Which_ Int Any -instance Read x => Emit EmitReadWhich (x ': xs) (ReadPrec (Int, WrappedAny)) where-    emit (EmitReadWhich i) = (\a -> (i, WrappedAny (unsafeCoerce a))) <$> readPrec @x+diversify0' :: forall x xs. Which_ xs -> Which_ (x ': xs)+diversify0' = coerce -readWhich-    :: forall xs.-       AFoldable (Collector EmitReadWhich xs) (ReadPrec (Int, WrappedAny))-    => Proxy (xs :: [Type]) -> ReadPrec (Int, WrappedAny)-readWhich _ = afoldr (<|>) empty (Collector (EmitReadWhich @xs 0))+readWhich_ :: forall x xs. Read x => Int -> Int -> ReadPrec (Which_ (x ': xs))+readWhich_ i j = guard (i == j) >> parens (prec app_prec $ (Which_ i . unsafeCoerce) <$> readPrec @x)+      where+        app_prec = 10 +instance Read x => WhichRead (Which_ '[x]) where+    whichReadPrec = readWhich_++instance (Read x, WhichRead (Which_ (x' ': xs))) => WhichRead (Which_ (x ': x' ': xs)) where+    whichReadPrec i j = readWhich_ i j+               <|> (diversify0' <$> (whichReadPrec i (j + 1) :: ReadPrec (Which_ (x' ': xs))))+    -- GHC compilation is SLOW if there is no pragma for recursive typeclass functions for different types+    {-# NOINLINE whichReadPrec #-}++ -- | This 'Read' instance tries to read using the each type in the typelist, using the first successful type read.-instance AFoldable (Collector EmitReadWhich (x ': xs)) (ReadPrec (Int, WrappedAny)) =>+instance WhichRead (Which_ (x ': xs)) =>          Read (Which (x ': xs)) where     readPrec =-        parens $-        prec 10 $ do-            lift $ L.expect (Ident "pick")-            (n, WrappedAny v) <- step (readWhich @(x ': xs) Proxy)-            pure (Which n v)+        parens $ prec app_prec $ do+            lift $ L.expect (Ident "pickN")+            lift $ L.expect (Punc "@")+            i <- lift L.readDecP+            lift $ L.expect (Ident "Proxy")+            Which_ n v <- whichReadPrec i 0 :: ReadPrec (Which_ (x ': xs))+            pure $ Which n v+      where+        app_prec = 10  -- | @read "impossible" == 'impossible'@ instance Read (Which '[]) where     readPrec =-        parens $-        prec 10 $ do+        parens $ prec app_prec $ do             lift $ L.expect (Ident "impossible")             pure impossible---- | 'WrappedAny' avoids the following:--- Illegal type synonym family application in instance: Any-newtype WrappedAny = WrappedAny Any+      where+        app_prec = 10

@@ -10,8 +10,8 @@  import Control.Lens import Data.Diverse-import Data.Typeable import Data.Tagged+import Data.Typeable import Test.Hspec  -- `main` is here so that this module can be run from GHCi on its own.  It is@@ -26,7 +26,7 @@ spec = do     describe "Many" $ do         it "is a Typeable" $ do-            let x = (5 :: Int) ./ False ./ nul+            let x = (5 :: Int) ./ False ./ nil                 y = cast x :: Maybe (Many '[Int, String])                 z = cast x :: Maybe (Many '[Int, Bool])             y `shouldBe` Nothing@@ -34,22 +34,25 @@             (show . typeRep . (pure @Proxy) $ x) `shouldBe` "Many (': * Int (': * Bool '[]))"          it "is a Read and Show" $ do-            let s = "5 ./ False ./ 'X' ./ Just 'O' ./ nul"+            let s = "5 ./ False ./ 'X' ./ Just 'O' ./ nil"+                s' = "5 ./ False ./ 'X' ./ (Just 'O' ./ (nil))"                 x = read s :: Many '[Int, Bool, Char, Maybe Char]+                x' = read s' :: Many '[Int, Bool, Char, Maybe Char]             show x `shouldBe` s+            show x' `shouldBe` s          it "is a Eq" $ do-            let s = "5 ./ False ./ 'X' ./ Just 'O' ./ nul"+            let s = "5 ./ False ./ 'X' ./ Just 'O' ./ nil"                 x = read s :: Many '[Int, Bool, Char, Maybe Char]-                y = 5 ./ False ./ 'X' ./ Just 'O' ./ nul+                y = 5 ./ False ./ 'X' ./ Just 'O' ./ nil             x `shouldBe` y          it "is an Ord" $ do-            let s = "5 ./ False ./ 'X' ./ Just 'O' ./ nul"+            let s = "5 ./ False ./ 'X' ./ Just 'O' ./ nil"                 x = read s :: Many '[Int, Bool, Char, Maybe Char]-                y5o = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul-                y4o = (4 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul-                y5p = (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nul+                y5o = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+                y4o = (4 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+                y5p = (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nil             compare x y5o `shouldBe` EQ             compare y4o y5o `shouldBe` LT             compare y5o y4o `shouldBe` GT@@ -57,16 +60,16 @@             compare y5p y5o `shouldBe` GT          it "can converted to and from a tuple" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil                 t = ((5 :: Int), False, 'X', Just 'O')             x `shouldBe` toMany' t             x `shouldBe` review _Many' t             t `shouldBe` fromMany' x             t `shouldBe` view _Many' x -        it "can construct using 'single', 'nul', 'prefix', 'postfix', 'append'" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul-                x' = (5 :: Int) `prefix` False `prefix` 'X' `prefix` Just 'O' `prefix` nul+        it "can construct using 'single', 'nil', 'prefix', 'postfix', 'append'" $ do+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+                x' = (5 :: Int) `prefix` False `prefix` 'X' `prefix` Just 'O' `prefix` nil                 y = single (5 :: Int) \. False \. 'X' \. Just 'O'                 y' = single (5 :: Int) `postfix` False `postfix` 'X' `postfix` Just 'O'                 a = single (5 :: Int) `postfix` False@@ -78,14 +81,14 @@             a `append` b `shouldBe` x          it "can contain multiple fields of the same type" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul-                y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul-            (x /./ (6 :: Int) ./ Just 'A' ./ nul) `shouldBe` y+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+                y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            (x /./ (6 :: Int) ./ Just 'A' ./ nil) `shouldBe` y          it "can destruct using 'front', 'back', 'aft', 'fore'" $ do             let a = (x ./ y) \. z                 x = 5 :: Int-                y = single False ./ 'X' ./ nul+                y = single False ./ 'X' ./ nil                 z = Just 'O'             front a `shouldBe` x             back a `shouldBe` z@@ -93,21 +96,21 @@             fore a `shouldBe` x ./ y          it "has getter for unique fields using 'fetch'" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul+            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'          it "has getter for for unique fields using 'fetchN'" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil             fetchN @0 Proxy x `shouldBe` 5             fetchN @1 Proxy x `shouldBe` False             fetchN @2 Proxy x `shouldBe` 'X'             fetchN @3 Proxy x `shouldBe` Just 'O'          it "has getter for duplicate fields using 'fetchN'" $ do-            let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             fetchN @0 Proxy y `shouldBe` 5             fetchN @1 Proxy y `shouldBe` False             fetchN @2 Proxy y `shouldBe` 'X'@@ -116,213 +119,264 @@             fetchN @5 Proxy y `shouldBe` Just 'A'          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+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             fetch @Bool x `shouldBe` False             fetch @Char x `shouldBe` 'X' -        it "can 'fetch' usng tagged labels" $ do-            let y = (5 :: Int) ./ False ./ Tagged @Foo 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+        it "has getter for unique labels using 'fetchL'" $ do+            let y = (5 :: Int) ./ False ./ Tagged @Foo 'X' ./ Tagged @"Hello" (6 :: Int) ./ nil             fetch @(Tagged Foo _) y `shouldBe` Tagged @Foo 'X'+            fetchL @Foo Proxy y `shouldBe` Tagged @Foo 'X'+            fetchL @"Hello" Proxy y `shouldBe` Tagged @"Hello" (6 :: Int)          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-            replace x True `shouldBe` (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ nul-            replace x 'O' `shouldBe` (5 :: Int) ./ False ./ 'O' ./ Just 'O' ./ nul-            replace x (Just 'P') `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+            replace @Int x 6 `shouldBe` (6 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+            replace x True `shouldBe` (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ nil+            replace x 'O' `shouldBe` (5 :: Int) ./ False ./ 'O' ./ Just 'O' ./ nil+            replace x (Just 'P') `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nil          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+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+            replace' @Int Proxy x 'Z' `shouldBe` 'Z' ./ False ./ 'X' ./ Just 'O' ./ nil+            replace' @Bool Proxy x 'Z' `shouldBe` (5 :: Int) ./ 'Z' ./ 'X' ./ Just 'O' ./ nil+            replace' @(Maybe Char) Proxy x 'Z' `shouldBe` (5 :: Int) ./ False ./ 'X' ./ 'Z' ./ nil +        it "has setter for unique labels using 'replaceL'" $ do+            let y = (5 :: Int) ./ False ./ Tagged @Foo 'X' ./ Tagged @"Hello" (6 :: Int) ./ nil+            replace @(Tagged Foo _) y (Tagged @Foo 'Y') `shouldBe`+                (5 :: Int) ./ False ./ Tagged @Foo 'Y' ./ Tagged @"Hello" (6 :: Int) ./ nil+            replaceL @Foo Proxy y (Tagged @Foo 'Y') `shouldBe`+                (5 :: Int) ./ False ./ Tagged @Foo 'Y' ./ Tagged @"Hello" (6 :: Int) ./ nil+            replaceL @"Hello" Proxy y (Tagged @"Hello" 7) `shouldBe`+                (5 :: Int) ./ False ./ Tagged @Foo 'X' ./ Tagged @"Hello" (7 :: Int) ./ nil++        it "has polymorphic setter for unique labels using 'replaceL'" $ do+            let y = (5 :: Int) ./ False ./ Tagged @Foo 'X' ./ Tagged @"Hello" (6 :: Int) ./ nil+            replace' @(Tagged Foo Char) Proxy y (Tagged @Bar 'Y') `shouldBe`+                (5 :: Int) ./ False ./ Tagged @Bar 'Y' ./ Tagged @"Hello" (6 :: Int) ./ nil+            replaceL' @Foo Proxy y (Tagged @Bar 'Y') `shouldBe`+                (5 :: Int) ./ False ./ Tagged @Bar 'Y' ./ Tagged @"Hello" (6 :: Int) ./ nil+            replaceL' @"Hello" Proxy y (Tagged @"Hello" False) `shouldBe`+                (5 :: Int) ./ False ./ Tagged @Foo 'X' ./ Tagged @"Hello" False ./ nil+         it "has setter for unique fields using 'replaceN'" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil             replaceN @0 Proxy x (7 :: Int) `shouldBe`-                (7 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul+                (7 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil             replaceN @1 Proxy x True `shouldBe`-                (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ nul+                (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ nil             replaceN @2 Proxy x 'Y' `shouldBe`-                (5 :: Int) ./ False ./ 'Y' ./ Just 'O' ./ nul+                (5 :: Int) ./ False ./ 'Y' ./ Just 'O' ./ nil             replaceN @3 Proxy x (Just 'P') `shouldBe`-                (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nul+                (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nil          it "has polymorphic setter using 'replaceN''" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil             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+                True ./ False ./ 'X' ./ Just 'O' ./ nil+            let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             replaceN' @1 Proxy y 'Y' `shouldBe`-                (5 :: Int) ./ 'Y' ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+                (5 :: Int) ./ 'Y' ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             replaceN' @5 Proxy y 'Y' `shouldBe`-                (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ 'Y' ./ nul+                (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ 'Y' ./ nil          it "has setter for duplicate fields using 'replaceN'" $ do-            let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             replaceN @0 Proxy y (7 :: Int) `shouldBe`-                (7 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+                (7 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             replaceN @1 Proxy y True `shouldBe`-                (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+                (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             replaceN @2 Proxy y 'Y' `shouldBe`-                (5 :: Int) ./ False ./ 'Y' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+                (5 :: Int) ./ False ./ 'Y' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             replaceN @3 Proxy y (Just 'P') `shouldBe`-                (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ (6 :: Int) ./ Just 'A' ./ nul+                (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ (6 :: Int) ./ Just 'A' ./ nil             replaceN @4 Proxy y (8 :: Int) `shouldBe`-                (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (8 :: Int) ./ Just 'A' ./ nul+                (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (8 :: Int) ./ Just 'A' ./ nil             replaceN @5 Proxy y (Just 'B') `shouldBe`-                (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'B' ./ nul+                (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'B' ./ nil          it "has setter for unique fields using 'replace' (even if there are other duplicate fields)" $ do-            let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             replace @Bool y True `shouldBe`-                (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+                (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             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+                (5 :: Int) ./ False ./ 'Y' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil          it "has getter/setter lens using 'item'" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil             x ^. item @Int `shouldBe` 5-            (x & item @Int .~ 6) `shouldBe` (6 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul+            (x & item @Int .~ 6) `shouldBe` (6 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil             x ^. item @Bool `shouldBe` False-            (x & item @Bool .~ True) `shouldBe` (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ nul+            (x & item @Bool .~ True) `shouldBe` (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ nil             x ^. item @Char `shouldBe` 'X'             x ^. item @(Maybe Char) `shouldBe` Just 'O'          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+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+            (x & item' @(Maybe Char) .~ Just 'P') `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nil+            (x & item' @Int .~ 'Z') `shouldBe` 'Z' ./ False ./ 'X' ./ Just 'O' ./ nil+            (x & item' @Bool .~ 'Z') `shouldBe` (5 :: Int) ./ 'Z' ./ 'X' ./ Just 'O' ./ nil+            (x & item' @Char .~ True) `shouldBe` (5 :: Int) ./ False ./ True ./ Just 'O' ./ nil+            (x & item' @(Maybe Char) .~ 'P') `shouldBe` (5 :: Int) ./ False ./ 'X' ./ 'P' ./ nil +        it "has getter/setter lens using 'item'" $ do+            let x = (5 :: Int) ./ Tagged @Foo False ./ Tagged @Bar 'X' ./ nil+            x ^. itemL @Foo Proxy `shouldBe` Tagged @Foo False+            (x & itemL @Foo Proxy .~ Tagged @Foo True) `shouldBe` (5 :: Int) ./ Tagged @Foo True ./ Tagged @Bar 'X' ./ nil++        it "has polymorphic getter/setter lens using 'itemL''" $ do+            let x = (5 :: Int) ./ Tagged @Foo False ./ Tagged @Bar 'X' ./ nil+            (x & itemL' @Foo Proxy .~ "foo") `shouldBe` (5 :: Int) ./ "foo" ./ Tagged @Bar 'X' ./ nil+         it "has getter/setter lens for duplicate fields using 'itemN'" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             x ^. itemN (Proxy @0) `shouldBe` 5-            (x & itemN (Proxy @0) .~ 6) `shouldBe` (6 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            (x & itemN (Proxy @0) .~ 6) `shouldBe` (6 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             x ^. itemN (Proxy @1) `shouldBe` False-            (x & itemN (Proxy @1) .~ True) `shouldBe` (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            (x & itemN (Proxy @1) .~ True) `shouldBe` (5 :: Int) ./ True ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             x ^. itemN (Proxy @2) `shouldBe` 'X'-            (x & itemN (Proxy @2) .~ 'O') `shouldBe` (5 :: Int) ./ False ./ 'O' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            (x & itemN (Proxy @2) .~ 'O') `shouldBe` (5 :: Int) ./ False ./ 'O' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             x ^. itemN (Proxy @3) `shouldBe` Just 'O'-            (x & itemN (Proxy @3) .~ Just 'P') `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ (6 :: Int) ./ Just 'A' ./ nul+            (x & itemN (Proxy @3) .~ Just 'P') `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'P' ./ (6 :: Int) ./ Just 'A' ./ nil             x ^. itemN (Proxy @4) `shouldBe` 6-            (x & itemN (Proxy @4) .~ 7) `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (7 :: Int) ./ Just 'A' ./ nul+            (x & itemN (Proxy @4) .~ 7) `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (7 :: Int) ./ Just 'A' ./ nil             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+            (x & itemN (Proxy @5) .~ Just 'B') `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'B' ./ nil          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+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            (x & itemN' (Proxy @0) .~ "Foo") `shouldBe` "Foo" ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            (x & itemN' (Proxy @1) .~ "Foo") `shouldBe` (5 :: Int) ./ "Foo" ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            (x & itemN' (Proxy @2) .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ "Foo" ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            (x & itemN' (Proxy @3) .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ 'X' ./ "Foo" ./ (6 :: Int) ./ Just 'A' ./ nil+            (x & itemN' (Proxy @4) .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ "Foo" ./ Just 'A' ./ nil+            (x & itemN' (Proxy @5) .~ "Foo") `shouldBe` (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ "Foo" ./ nil          it "has getter for multiple fields using 'select'" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul-            select @'[Int, Maybe Char] x `shouldBe` (5 :: Int) ./ Just 'O' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+            select @'[Int, Maybe Char] x `shouldBe` (5 :: Int) ./ Just 'O' ./ nil +        it "has getter for multiple labelled fields using 'selectL'" $ do+            let x = False ./ Tagged @"Hi" (5 :: Int) ./ Tagged @Foo False ./ Tagged @Bar 'X' ./ Tagged @"Bye" 'O' ./ nil+            selectL @'[Foo, Bar] Proxy x `shouldBe` Tagged @Foo False ./ Tagged @Bar 'X' ./ nil+            selectL @'["Hi", "Bye"] Proxy x `shouldBe` Tagged @"Hi" (5 :: Int) ./ Tagged @"Bye" 'O' ./ nil+            -- below won't compile because the type of labels must match+            -- selectL @'["Hi", 'Foo, "Bye"] Proxy x `shouldBe` Tagged @"Hi" (5 :: Int) ./ Tagged @Foo False ./ Tagged @"Bye" 'O' ./ nil+         it "can reorder fields using 'select' or 'selectN'" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ 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+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+            select @'[Bool, Int, Maybe Char] x `shouldBe` False ./ (5 :: Int) ./ Just 'O' ./ nil+            let y = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             selectN (Proxy @'[5, 4, 0, 1, 3, 2]) y `shouldBe`-                Just 'A' ./ (6 :: Int) ./ (5 ::Int) ./ False ./ Just 'O' ./ 'X' ./ nul+                Just 'A' ./ (6 :: Int) ./ (5 ::Int) ./ False ./ Just 'O' ./ 'X' ./ nil          it "has getter for multiple fields with duplicates using 'selectN'" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul-            selectN (Proxy @'[5, 4, 0]) x `shouldBe` Just 'A' ./ (6 :: Int) ./ (5 ::Int) ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            selectN (Proxy @'[5, 4, 0]) x `shouldBe` Just 'A' ./ (6 :: Int) ./ (5 ::Int) ./ nil          it "can't select into types from indistinct fields" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             -- Compile error: Int is a duplicate-            -- select @[Bool, Char, Int] x `shouldBe` False ./ 'X' ./ (5 :: Int) ./ nul-            x `shouldBe`  x+            -- select @[Bool, Char, Int] x `shouldBe` False ./ 'X' ./ (5 :: Int) ./ nil+            x `shouldBe` x          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-            select @'[Bool, Char] x `shouldBe` False ./ 'X' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            select @'[Bool, Char] x `shouldBe` False ./ 'X' ./ nil          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+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+            amend @'[Int, Maybe Char] x ((6 :: Int) ./ Just 'P' ./ nil) `shouldBe` (6 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nil          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+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+            amend' @'[Int, Maybe Char] Proxy x ("Foo" ./ "Bar" ./ nil) `shouldBe` "Foo" ./ False ./ 'X' ./ "Bar" ./ nil +        it "has setter for multiple labelled fields using 'amendL'" $ do+            let x = False ./ Tagged @"Hi" (5 :: Int) ./ Tagged @Foo False ./ Tagged @Bar 'X' ./ Tagged @"Bye" 'O' ./ nil+            amendL @'[Foo, Bar] Proxy x (Tagged @Foo True ./ Tagged @Bar 'Y' ./ nil) `shouldBe`+                False ./ Tagged @"Hi" (5 :: Int) ./ Tagged @Foo True ./ Tagged @Bar 'Y' ./ Tagged @"Bye" 'O' ./ nil+            amendL @'["Hi", "Bye"] Proxy x (Tagged @"Hi" (6 :: Int) ./ Tagged @"Bye" 'P' ./ nil) `shouldBe`+                False ./ Tagged @"Hi" (6 :: Int) ./ Tagged @Foo False ./ Tagged @Bar 'X' ./ Tagged @"Bye" 'P' ./ nil++        it "has polymorphic setter for multiple labelled fields using 'amendL'" $ do+            let x = False ./ Tagged @"Hi" (5 :: Int) ./ Tagged @Foo False ./ Tagged @Bar 'X' ./ Tagged @"Bye" 'O' ./ nil+            amendL' @'[Foo, Bar] Proxy x ('Y' ./ True ./ nil) `shouldBe`+                False ./ Tagged @"Hi" (5 :: Int) ./ 'Y' ./ True ./ Tagged @"Bye" 'O' ./ nil+            amendL' @'["Hi", "Bye"] Proxy x (True ./ Tagged @"Changed" True ./ nil) `shouldBe`+                False ./ True ./ Tagged @Foo False ./ Tagged @Bar 'X' ./ Tagged @"Changed" True ./ nil+         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+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            amendN (Proxy @'[5, 4, 0]) x (Just 'B' ./ (8 :: Int) ./ (4 ::Int) ./ nil) `shouldBe`+                (4 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (8 :: Int) ./ Just 'B' ./ nil          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+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            amendN' @'[5, 4, 0] Proxy x ("Foo" ./ Just 'B' ./ 'Z' ./ nil) `shouldBe`+                'Z' ./ False ./ 'X' ./ Just 'O' ./ Just 'B' ./ "Foo" ./ nil          it "can't amend into types from indistinct fields" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             -- Compile error: Int is a duplicate-            -- amend @ '[Bool, Char, Int] x (True ./ 'B' ./ (8 :: Int) ./ nul) `shouldBe`-            --     (5 :: Int) ./ True ./ 'B' ./ Just 'O' ./ (8 :: Int) ./ Just 'A' ./ nul+            -- amend @ '[Bool, Char, Int] x (True ./ 'B' ./ (8 :: Int) ./ nil) `shouldBe`+            --     (5 :: Int) ./ True ./ 'B' ./ Just 'O' ./ (8 :: Int) ./ Just 'A' ./ nil             x `shouldBe` x          it "with duplicate fields has setter for unique fields 'amend'" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul-            amend @ '[Bool, Char] x (True ./ 'B' ./ nul) `shouldBe`-                (5 :: Int) ./ True ./ 'B' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            amend @ '[Bool, Char] x (True ./ 'B' ./ nil) `shouldBe`+                (5 :: Int) ./ True ./ 'B' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil          it "has getter/setter lens for multiple fields using 'project'" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nul-            x ^. (project @'[Int, Maybe Char]) `shouldBe` (5 :: Int) ./ Just 'O' ./ nul-            (x & (project @'[Int, Maybe Char]) .~ ((6 :: Int) ./ Just 'P' ./ nul)) `shouldBe`-                (6 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+            x ^. (project @'[Int, Maybe Char]) `shouldBe` (5 :: Int) ./ Just 'O' ./ nil+            (x & (project @'[Int, Maybe Char]) .~ ((6 :: Int) ./ Just 'P' ./ nil)) `shouldBe`+                (6 :: Int) ./ False ./ 'X' ./ Just 'P' ./ nil          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+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ nil+            (x & (project' @'[Int, Maybe Char]) .~ ("Foo" ./ Just "Bar" ./ nil)) `shouldBe`+                "Foo" ./ False ./ 'X' ./ Just "Bar" ./ nil +        it "has getter/setter lens for multiple labelled fields using 'projectL'" $ do+            let x = False ./ Tagged @"Hi" (5 :: Int) ./ Tagged @Foo False ./ Tagged @Bar 'X' ./ Tagged @"Bye" 'O' ./ nil+            x ^. (projectL @'[Foo, Bar] Proxy) `shouldBe` Tagged @Foo False ./ Tagged @Bar 'X' ./ nil+            (x & (projectL @'["Hi", "Bye"] Proxy) .~ (Tagged @"Hi" (6 :: Int) ./ Tagged @"Bye" 'P' ./ nil)) `shouldBe`+                False ./ Tagged @"Hi" (6 :: Int) ./ Tagged @Foo False ./ Tagged @Bar 'X' ./ Tagged @"Bye" 'P' ./ nil++        it "has polymorphic getter/setter lens for multiple labelled fields using 'projectL''" $ do+            let x = False ./ Tagged @"Hi" (5 :: Int) ./ Tagged @Foo False ./ Tagged @Bar 'X' ./ Tagged @"Bye" 'O' ./ nil+            (x & (projectL' @'["Hi", "Bye"] Proxy) .~ (True ./ Tagged @"Changed" False ./ nil)) `shouldBe`+                False ./ True ./ Tagged @Foo False ./ Tagged @Bar 'X' ./ Tagged @"Changed" False ./ nil+         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+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            x ^. (projectN @'[5, 4, 0] Proxy) `shouldBe` Just 'A' ./ (6 :: Int) ./ (5 ::Int) ./ nil+            (x & (projectN @'[5, 4, 0] Proxy) .~ (Just 'B' ./ (8 :: Int) ./ (4 ::Int) ./ nil)) `shouldBe`+                (4 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (8 :: Int) ./ Just 'B' ./ nil          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+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+            (x & (projectN' @'[5, 4, 0] Proxy) .~ (Just "Foo" ./ (8 :: Int) ./ "Bar" ./ nil)) `shouldBe`+                "Bar" ./ False ./ 'X' ./ Just 'O' ./ (8 :: Int) ./ Just "Foo" ./ nil          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-                y = show @Int ./ show @Char ./ show @(Maybe Char) ./ show @Bool ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+                y = show @Int ./ show @Char ./ show @(Maybe Char) ./ show @Bool ./ nil                 ret = ["5", "False", "'X'", "Just 'O'", "6", "Just 'A'"]             afoldr (:) [] (collect x (cases y)) `shouldBe` ret             afoldr (:) [] (forMany (cases y) x) `shouldBe` ret             afoldr (:) [] (forMany (cases y) x) `shouldBe` ret          it "can be folded with single 'CaseTypeable' handlers using 'forMany' or 'collect'" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil             afoldr (:) [] (forMany (CaseTypeable (show . typeRep . (pure @Proxy))) x) `shouldBe` ["Int", "Bool", "Char", "Maybe Char", "Int", "Maybe Char"]          it "can be folded with 'Many' handlers in index order using 'forManyN' or 'collectN'" $ do-            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nul-                y = show @Int ./ show @Bool ./ show @Char ./ show @(Maybe Char) ./ show @Int ./ show @(Maybe Char) ./ nul+            let x = (5 :: Int) ./ False ./ 'X' ./ Just 'O' ./ (6 :: Int) ./ Just 'A' ./ nil+                y = show @Int ./ show @Bool ./ show @Char ./ show @(Maybe Char) ./ show @Int ./ show @(Maybe Char) ./ nil                 ret = ["5", "False", "'X'", "Just 'O'", "6", "Just 'A'"]             afoldr (:) [] (collectN x (casesN y)) `shouldBe` ret             afoldr (:) [] (forManyN (casesN y) x) `shouldBe` ret

@@ -10,9 +10,15 @@  import Control.Lens import Data.Diverse+import Data.Tagged import Data.Typeable import Test.Hspec +data Foo+data Bar+data Hi+data Bye+ -- `main` is here so that this module can be run from GHCi on its own.  It is -- not needed for automatic spec discovery. main :: IO ()@@ -26,10 +32,14 @@ spec = do     describe "Which" $ do +        it "is a Show" $ do+            let x = pickN @0 Proxy 5 :: Which '[Int, Bool]+            show x `shouldBe` "pickN @0 Proxy 5"+         it "is a Read and Show" $ do-            let s = "pick 5"+            let s = "pickN @0 Proxy 5"                 x = read s :: Which '[Int, Bool]-            show x `shouldBe` "pick 5"+            show x `shouldBe` s             "impossible" `shouldBe` show impossible             "impossible" `shouldBe` show (read "impossible" :: Which '[]) @@ -52,6 +62,11 @@                 x = hush $ trial @Int y             x `shouldBe` (Just 5) +        it "can be constructed by label with 'pickL' and destructed with 'trialL'" $ do+            let y = pickL @Foo Proxy (Tagged (5 :: Int)) :: Which '[Bool, Tagged Foo Int, Tagged Bar Char]+                x = hush $ trialL @Foo Proxy y+            x `shouldBe` (Just (Tagged 5))+         it "may contain possiblities of duplicate types" $ do             let y = pick (5 :: Int) :: Which '[Bool, Int, Char, Bool, Char]                 x = hush $ trial @Int y@@ -121,6 +136,11 @@                 x = preview (facet @Int) y             x `shouldBe` (Just 5) +        it "can be constructed and destructed by label with 'facetL'" $ do+            let y = review (facetL @Bar Proxy) (Tagged (5 :: Int)) :: Which '[Tagged Foo Bool, Tagged Bar Int, Char, Bool, Char]+                x = preview (facetL @Bar Proxy) y+            x `shouldBe` (Just (Tagged 5))+         it "can be constructed and destructed by index with 'facetN'" $ do             let y = review (facetN (Proxy @4)) (5 :: Int) :: Which '[Bool, Int, Char, Bool, Int, Char]                 x = preview (facetN (Proxy @4)) y@@ -132,6 +152,12 @@                 y'' = diversify @[Bool, Int] y'             switch y'' (CaseTypeable (show . typeRep . (pure @Proxy))) `shouldBe` "Int" +        it "can be extended and rearranged by type with 'diversify'" $ do+            let y = pickOnly (5 :: Tagged Bar Int)+                y' = diversifyL @'[Bar] Proxy y :: Which '[Tagged Bar Int, Tagged Foo Bool]+                y'' = diversifyL @'[Bar, Foo] Proxy y' :: Which '[Tagged Foo Bool, Tagged Bar Int]+            switch y'' (CaseTypeable (show . typeRep . (pure @Proxy))) `shouldBe` "Tagged * Bar Int"+         it "can be extended and rearranged by index with 'diversifyN'" $ do             let y = pickOnly (5 :: Int)                 y' = diversifyN @'[0] @[Int, Bool] Proxy y@@ -160,6 +186,12 @@             let c = reinterpret @[String, Int] y             c `shouldBe` Right (pick (5 :: Int)) +        it "can be 'reinterpretL'ed by label into a totally different Which" $ do+            let y = pick @[Tagged Bar Int, Tagged Foo Bool, Tagged Hi Char, Tagged Bye Bool] (5 :: Tagged Bar Int)+                y' = reinterpretL @[Foo, Bar] Proxy y+                x = pick @[Tagged Foo Bool, Tagged Bar Int] (5 :: Tagged Bar Int)+            y' `shouldBe` Right x+         it "the 'reinterpret' type can contain indistinct fields if they aren't in the original 'Many'" $ do             let y = pick @[Int, Char] (5 :: Int)                 x = reinterpret @[String, String, Char, Bool] y@@ -193,6 +225,14 @@             let y' = preview (inject @[String, Int]) y             y' `shouldBe` Just (pick (5 :: Int)) +        it "can be 'diversifyL'ed and 'reinterpretedL' by label with 'injectL'" $ do+            let t = pick @[Tagged Bar Int, Tagged Foo Bool, Tagged Hi Char, Tagged Bye Bool] (5 :: Tagged Bar Int)+                b = pick @'[Tagged Foo Bool, Tagged Bar Int] (5 :: Tagged Bar Int)+                t' = review (injectL @[Foo, Bar] @_ @[Tagged Bar Int, Tagged Foo Bool, Tagged Hi Char, Tagged Bye Bool] Proxy) b+                b' = preview (injectL @[Foo, Bar] Proxy) t'+            t `shouldBe` t'+            b' `shouldBe` Just b+         it "can be 'diversifyN'ed and 'reinterpretedN' by index with 'injectN'" $ do             let x = pick (5 :: Int) :: Which '[String, Int]                 y = review (injectN @[3, 1] @_ @[Bool, Int, Char, String] Proxy) x@@ -205,7 +245,7 @@             switch y (                 cases (show @Bool                     ./ show @Int-                    ./ nul)) `shouldBe` "5"+                    ./ nil)) `shouldBe` "5"          it "can be 'switch'ed with 'Many' handlers with extraneous content" $ do             let y = pick (5 :: Int) :: Which '[Int, Bool]@@ -216,7 +256,7 @@                     ./ show @Char                     ./ 'X'                     ./ False-                    ./ nul+                    ./ nil                 )) `shouldBe` "5"          it "can be 'switchN'ed with 'Many' handlers in index order" $ do@@ -226,7 +266,7 @@                     ./ show @Bool                     ./ show @Bool                     ./ show @Int-                    ./ nul)) `shouldBe` "5"+                    ./ nil)) `shouldBe` "5"          it "can be switched with a single 'CaseTypeable' handler" $ do             let y = pick (5 :: Int) :: Which '[Int, Bool]