| Copyright | (c) Justin Le 2018 | 
|---|---|
| License | BSD3 | 
| Maintainer | justin@jle.im | 
| Stability | experimental | 
| Portability | non-portable | 
| Safe Haskell | None | 
| Language | Haskell2010 | 
Data.Type.List.Sublist
Description
Witnesses regarding sublists of lists.
Synopsis
- data Prefix :: [k] -> [k] -> Type where
- type IsPrefix as = TyPred (Prefix as)
- autoPrefix :: forall as bs. Auto (IsPrefix as) bs => Prefix as bs
- takeRec :: Prefix as bs -> Rec f bs -> Rec f as
- prefixLens :: Prefix as bs -> Lens' (Rec f bs) (Rec f as)
- takeIndex :: Prefix as bs -> Index bs x -> Maybe (Index as x)
- weakenIndex :: Prefix as bs -> Index as x -> Index bs x
- prefixShape :: Prefix as bs -> Shape [] as
- data Suffix :: [k] -> [k] -> Type where
- type IsSuffix as = TyPred (Suffix as)
- autoSuffix :: forall as bs. Auto (IsSuffix as) bs => Suffix as bs
- dropRec :: Suffix as bs -> Rec f bs -> Rec f as
- suffixLens :: Suffix as bs -> Lens' (Rec f bs) (Rec f as)
- dropIndex :: Suffix as bs -> Index bs x -> Maybe (Index as x)
- shiftIndex :: Suffix as bs -> Index as x -> Index bs x
- data Append :: [k] -> [k] -> [k] -> Type where
- type IsAppend as bs = TyPred (Append as bs)
- autoAppend :: forall as bs cs. Auto (IsAppend as bs) cs => Append as bs cs
- withAppend :: Rec f as -> Rec f bs -> (forall cs. Rec f cs -> Append as bs cs -> r) -> r
- prefixToAppend :: Prefix as cs -> (forall bs. Append as bs cs -> r) -> r
- suffixToAppend :: Suffix bs cs -> (forall as. Append as bs cs -> r) -> r
- appendToPrefix :: Append as bs cs -> Prefix as cs
- appendToSuffix :: Append as bs cs -> Suffix bs cs
- splitAppend :: Append as bs cs -> (Prefix as cs, Suffix bs cs)
- appendShape :: Append as bs cs -> Shape [] as
- splitRec :: Append as bs cs -> Rec f cs -> (Rec f as, Rec f bs)
- appendRec :: Append as bs cs -> Rec f as -> Rec f bs -> Rec f cs
- splitRecIso :: (Profunctor p, Functor f) => Append as bs cs -> p (Rec g as, Rec g bs) (f (Rec g as, Rec g bs)) -> p (Rec g cs) (f (Rec g cs))
- splitIndex :: Append as bs cs -> Index cs x -> Either (Index as x) (Index bs x)
- pattern AppendWit :: forall as bs cs. (RecApplicative as, RecApplicative bs) => (as ++ bs) ~ cs => Append as bs cs
- appendWit :: Append as bs cs -> (as ++ bs) :~: cs
- implyAppend :: IsAppend as bs --> EqualTo (as ++ bs)
- unAppendWit :: (as ++ bs) ~ cs => Rec f as -> Rec f bs -> Append as bs cs
- pattern AppendWitV :: forall as bs cs. (RecApplicative as, RecApplicative bs) => (as ++ bs) ~ cs => Append as bs cs
- appendWitV :: Append as bs cs -> (as ++ bs) :~: cs
- implyAppendV :: IsAppend as bs --> EqualTo (as ++ bs)
- unAppendWitV :: (as ++ bs) ~ cs => Rec f as -> Rec f bs -> Append as bs cs
- pattern AppendWit' :: forall as bs cs. (RecApplicative as, RecApplicative bs) => ((as ++ bs) ~ cs, (as ++ bs) ~ cs) => Append as bs cs
- convertAppends :: Append as bs cs -> (as ++ bs) :~: (as ++ bs)
- type AppendedTo as = TyPP (Append as)
- data Interleave :: [k] -> [k] -> [k] -> Type where- IntZ :: Interleave '[] '[] '[]
- IntL :: Interleave as bs cs -> Interleave (a ': as) bs (a ': cs)
- IntR :: Interleave as bs cs -> Interleave as (b ': bs) (b ': cs)
 
- type IsInterleave as bs = TyPred (Interleave as bs)
- autoInterleave :: forall as bs cs. Auto (IsInterleave as bs) cs => Interleave as bs cs
- interleaveRec :: Interleave as bs cs -> Rec f as -> Rec f bs -> Rec f cs
- unweaveRec :: Interleave as bs cs -> Rec f cs -> (Rec f as, Rec f bs)
- interleaveRecIso :: (Profunctor p, Functor f) => Interleave as bs cs -> p (Rec g as, Rec g bs) (f (Rec g as, Rec g bs)) -> p (Rec g cs) (f (Rec g cs))
- injectIndexL :: Interleave as bs cs -> Index as a -> Index cs a
- injectIndexR :: Interleave as bs cs -> Index bs b -> Index cs b
- unweaveIndex :: Interleave as bs cs -> Index cs c -> Either (Index as c) (Index bs c)
- interleavedIxes :: Interleave as bs cs -> Rec (Index as :+: Index bs) cs
- swapInterleave :: Interleave as bs cs -> Interleave bs as cs
- interleaveShapes :: Interleave as bs cs -> (Shape [] as, Shape [] bs, Shape [] cs)
- data Subset :: [k] -> [k] -> Type where
- type IsSubset as = TyPred (Subset as)
- autoSubset :: forall as bs. Auto (IsSubset as) bs => Subset as bs
- subsetComplement :: Subset as cs -> (forall bs. Subset bs cs -> r) -> r
- interleaveRToSubset :: Interleave as bs cs -> Subset bs cs
- interleaveLToSubset :: Interleave as bs cs -> Subset as cs
- subsetToInterleaveL :: Subset as cs -> (forall bs. Interleave as bs cs -> r) -> r
- subsetToInterleaveR :: Subset bs cs -> (forall as. Interleave as bs cs -> r) -> r
- subsetRec :: Subset as bs -> Lens' (Rec f bs) (Rec f as)
- getSubset :: Subset as bs -> Rec f bs -> Rec f as
- subsetShapes :: Subset as bs -> (Shape [] as, Shape [] bs)
- subsetIxes :: Subset as bs -> Rec (Index bs) as
- weakenSubsetIndex :: Subset as bs -> Index as a -> Index bs a
- strengthenSubsetIndex :: Subset as bs -> Index bs a -> Maybe (Index as a)
Prefix and Suffix
Prefix
data Prefix :: [k] -> [k] -> Type where Source #
A Prefix as bsas is a prefix of bs.
Some examples:
PreZ :: Prefix '[] '[1,2,3] PreS PreZ :: Prefix '[1] '[1,2,3] PreS (PreS PreZ) :: Prefix '[1,2] '[1,2,3] PreS (PreS (PreS PreZ)) :: Prefix '[1,2,3] '[1,2,3]
Rule of thumb for construction: the number of PreS is the number of
 items in the prefix.
This is essentially the first half of an Append, but is conceptually
 easier to work with.
Instances
| (SDecide k, SingI as) => Decidable (IsPrefix as :: TyFun [k] Type -> Type) Source # | |
| Defined in Data.Type.List.Sublist | |
| Auto (IsPrefix ([] :: [k]) :: TyFun [k] Type -> Type) (bs :: [k]) Source # | |
| Defined in Data.Type.List.Sublist | |
| Auto (IsPrefix as) bs => Auto (IsPrefix (a2 ': as) :: TyFun [a1] Type -> Type) (a2 ': bs :: [a1]) Source # | |
| Defined in Data.Type.List.Sublist | |
| Show (Prefix as bs) Source # | |
type IsPrefix as = TyPred (Prefix as) Source #
A type-level predicate that a given list has as as a prefix.
Since: 0.1.2.0
autoPrefix :: forall as bs. Auto (IsPrefix as) bs => Prefix as bs Source #
Automatically generate a Prefix if as and bs are known
 statically.
Since: 0.1.2.0
takeIndex :: Prefix as bs -> Index bs x -> Maybe (Index as x) Source #
Shave off the final inhabitants of an Index, keeping only indices
 a part of a given prefix.  If the index is out of range, Nothing will
 be returned.
This is essentially splitIndex, but taking only Left results.
weakenIndex :: Prefix as bs -> Index as x -> Index bs x Source #
An index pointing to a given item in a prefix is also an index
 pointing to the same item in the full list.  This "weakens" the bounds
 of an index, widening the list at the end but preserving the original
 index.  This is the inverse of takeIndex.
prefixShape :: Prefix as bs -> Shape [] as Source #
Suffix
data Suffix :: [k] -> [k] -> Type where Source #
A Suffix as bsas is a suffix of bs.
Some examples:
SufZ :: Suffix '[1,2,3] '[1,2,3] SufS SufZ :: Suffix '[2,3] '[1,2,3] SufS (SufS SufZ) :: Suffix '[3] '[1,2,3] SufS (SufS (SufS SufZ)) :: Suffix '[] '[1,2,3]
Rule of thumb for construction: the number of SufS is the number of
 items to "drop" before getting the suffix.
This is essentially the second half of an Append, but is conceptually
 easier to work with.
Instances
| (SDecide k, SingI as) => Decidable (IsSuffix as :: TyFun [k] Type -> Type) Source # | |
| Defined in Data.Type.List.Sublist | |
| Auto (IsSuffix ([] :: [k]) :: TyFun [k] Type -> Type) ([] :: [k]) Source # | |
| Defined in Data.Type.List.Sublist | |
| Auto (IsSuffix as) bs => Auto (IsSuffix as :: TyFun [a] Type -> Type) (b ': bs :: [a]) Source # | |
| Defined in Data.Type.List.Sublist | |
| Auto (IsSuffix (a2 ': as) :: TyFun [a1] Type -> Type) (a2 ': as :: [a1]) Source # | |
| Defined in Data.Type.List.Sublist | |
| Show (Suffix as bs) Source # | |
type IsSuffix as = TyPred (Suffix as) Source #
A type-level predicate that a given list has as as a suffix.
Since: 0.1.2.0
autoSuffix :: forall as bs. Auto (IsSuffix as) bs => Suffix as bs Source #
Automatically generate a Suffix if as and bs are known
 statically.
Since: 0.1.2.0
dropIndex :: Suffix as bs -> Index bs x -> Maybe (Index as x) Source #
Shave off the initial inhabitants of an Index, keeping only indices
 a part of a given suffix  If the index is out of range, Nothing will
 be returned.
This is essentially splitIndex, but taking only Right results.
shiftIndex :: Suffix as bs -> Index as x -> Index bs x Source #
An index pointing to a given item in a suffix can be transformed into
 an index pointing to the same item in the full list.  This is the
 inverse of dropIndex.
Append
data Append :: [k] -> [k] -> [k] -> Type where Source #
An Append as bs cscs is the result of appending
 as and bs.
Some examples:
AppZ :: Append '[] '[1,2] '[1,2] AppZ :: Append '[] '[1,2,3] '[1,2,3] AppS AppZ :: Append '[0] '[1,2] '[0,1,2]
Rule of thumb for construction: the number of AppS is the number of
 items in the first list.
Instances
| (SDecide k, SingI as, SingI bs) => Decidable (IsAppend as bs :: TyFun [k] Type -> Type) Source # | |
| Defined in Data.Type.List.Sublist | |
| SingI as => Decidable (Found (AppendedTo as) :: TyFun [k] Type -> Type) Source # | |
| Defined in Data.Type.List.Sublist Methods decide :: Decide (Found (AppendedTo as)) # | |
| SingI as => Provable (Found (AppendedTo as) :: TyFun [k] Type -> Type) Source # | |
| Defined in Data.Type.List.Sublist Methods prove :: Prove (Found (AppendedTo as)) # | |
| Auto (IsAppend ([] :: [k]) as :: TyFun [k] Type -> Type) (as :: [k]) Source # | |
| Defined in Data.Type.List.Sublist | |
| Auto (IsAppend as bs) cs => Auto (IsAppend (a2 ': as) bs :: TyFun [a1] Type -> Type) (a2 ': cs :: [a1]) Source # | |
| Defined in Data.Type.List.Sublist | |
| Show (Append as bs cs) Source # | |
type IsAppend as bs = TyPred (Append as bs) Source #
A type-level predicate that a given list is the result of appending of
 as and bs.
Since: 0.1.2.0
autoAppend :: forall as bs cs. Auto (IsAppend as bs) cs => Append as bs cs Source #
Automatically generate an Append if as, bs and cs are known
 statically.
Since: 0.1.2.0
withAppend :: Rec f as -> Rec f bs -> (forall cs. Rec f cs -> Append as bs cs -> r) -> r Source #
Given as and bs, create an Append as bs cscs
 existentially quantified
prefixToAppend :: Prefix as cs -> (forall bs. Append as bs cs -> r) -> r Source #
suffixToAppend :: Suffix bs cs -> (forall as. Append as bs cs -> r) -> r Source #
appendToPrefix :: Append as bs cs -> Prefix as cs Source #
appendToSuffix :: Append as bs cs -> Suffix bs cs Source #
splitAppend :: Append as bs cs -> (Prefix as cs, Suffix bs cs) Source #
Split an Append into a Prefix and Suffix.  Basically
 appendToPrefix and appendToSuffix at the same time.
appendShape :: Append as bs cs -> Shape [] as Source #
Get the Shape associated with an Append's prefix.
Since: 0.1.3.0
Application
splitRecIso :: (Profunctor p, Functor f) => Append as bs cs -> p (Rec g as, Rec g bs) (f (Rec g as, Rec g bs)) -> p (Rec g cs) (f (Rec g cs)) Source #
Witness an isomorphism between Rec and two parts that compose it.
Read this type signature as:
splitRecIso
    :: Append as  bs  cs
    -> Iso' (Rec f cs) (Rec f as, Rec f bs)
This can be used with the combinators from the lens library.
Witnesses
Singletons
pattern AppendWit :: forall as bs cs. (RecApplicative as, RecApplicative bs) => (as ++ bs) ~ cs => Append as bs cs Source #
A useful pattern synonym for using Append with ++ from
 Data.Singletons.Prelude.List.
As a pattern, this brings (as ++ bs) ~ cs into the context whenever
 you use it to match on an Append as bs cs
As an expression, this constructs an Append as bs cs(as ++ bs) ~ cs in the context.
Since: 0.1.2.0
appendWit :: Append as bs cs -> (as ++ bs) :~: cs Source #
Witness that Append as bs cs(as ++ bs) ~ cs, using
 ++ from Data.Singletons.Prelude.List.
Since: 0.1.2.0
unAppendWit :: (as ++ bs) ~ cs => Rec f as -> Rec f bs -> Append as bs cs Source #
The inverse of appendWit: if we know (as ++ bs) ~ cs (using ++
 from Data.Singletons.Prelude.List), we can create an Append as bs
 csSing.
Since: 0.1.2.0
Vinyl
pattern AppendWitV :: forall as bs cs. (RecApplicative as, RecApplicative bs) => (as ++ bs) ~ cs => Append as bs cs Source #
A useful pattern synonym for using Append with ++ from
 Data.Vinyl.TypeLevel.
As a pattern, this brings (as ++ bs) ~ cs into the context whenever
 you use it to match on an Append as bs cs
As an expression, this constructs an Append as bs cs(as ++ bs) ~ cs in the context.
Since: 0.1.2.0
appendWitV :: Append as bs cs -> (as ++ bs) :~: cs Source #
Witness that Append as bs cs(as ++ bs) ~ cs, using
 ++ from Data.Vinyl.TypeLevel.
Since: 0.1.2.0
implyAppendV :: IsAppend as bs --> EqualTo (as ++ bs) Source #
appendWitV stated as a Predicate implication.
Since: 0.1.2.0
unAppendWitV :: (as ++ bs) ~ cs => Rec f as -> Rec f bs -> Append as bs cs Source #
The inverse of appendWitV: if we know (as ++ bs) ~ cs (using ++
 from Data.Vinyl.TypeLevel), we can create an Append as bs csSing.
Since: 0.1.2.0
Both
pattern AppendWit' :: forall as bs cs. (RecApplicative as, RecApplicative bs) => ((as ++ bs) ~ cs, (as ++ bs) ~ cs) => Append as bs cs Source #
Combine the powers of AppendWit and AppendWitV by matching on an
 Append to witness (as ++ bs) ~ cs for both ++ from
 Data.Singletons.Prelude.List and Data.Vinyl.TypeLevel.  This also
 witnesses that (as ++ bs) ~ (as ++ bs) (for the two different ++s)
 by transitive property.
Since: 0.1.2.0
convertAppends :: Append as bs cs -> (as ++ bs) :~: (as ++ bs) Source #
Given a witness Append as bs cs++ from
 Data.Singletons.Prelude.List is the same as vinyl's ++
 Data.Vinyl.TypeLevel.
type AppendedTo as = TyPP (Append as) Source #
A parameterized predicate that you can use with select: With an
 AppendedTo asbs and get cs in return, where cs
 is the appending of as and bs.
Run it with:
selectTC:: SingI as => Sing bs ->Σ[k] (IsAppendas bs)
select for AppendedTo is pretty much just withAppend.
Since: 0.1.2.0
Interleave
data Interleave :: [k] -> [k] -> [k] -> Type where Source #
A Interleave as bs cscs is as interleaved with
 bs. It is constructed by selectively zipping items from as and bs
 together, like mergesort or riffle shuffle.
You construct an Interleave from as and bs by picking "which item" from
 as and bs to add to cs.
Some examples:
IntL (IntL (IntR (IntR IntZ))) :: Interleave '[1,2] '[3,4] '[1,2,3,4] IntR (IntR (IntL (IntL IntZ))) :: Interleave '[1,2] '[3,4] '[3,4,1,2] IntL (IntR (IntL (IntR IntZ))) :: Interleave '[1,2] '[3,4] '[1,3,2,4] IntR (IntL (IntR (IntL IntZ))) :: Interleave '[1,2] '[3,4] '[3,1,4,2]
Since: 0.1.1.0
Constructors
| IntZ :: Interleave '[] '[] '[] | |
| IntL :: Interleave as bs cs -> Interleave (a ': as) bs (a ': cs) | |
| IntR :: Interleave as bs cs -> Interleave as (b ': bs) (b ': cs) | 
Instances
| (SDecide k, SingI as, SingI bs) => Decidable (IsInterleave as bs :: TyFun [k] Type -> Type) Source # | |
| Defined in Data.Type.List.Sublist Methods decide :: Decide (IsInterleave as bs) # | |
| Auto (IsInterleave ([] :: [k]) ([] :: [k]) :: TyFun [k] Type -> Type) ([] :: [k]) Source # | |
| Defined in Data.Type.List.Sublist Methods auto :: IsInterleave [] [] @@ [] # | |
| Auto (IsInterleave as bs) cs => Auto (IsInterleave as (b ': bs) :: TyFun [a] Type -> Type) (b ': cs :: [a]) Source # | |
| Defined in Data.Type.List.Sublist Methods auto :: IsInterleave as (b ': bs) @@ (b ': cs) # | |
| Auto (IsInterleave as bs) cs => Auto (IsInterleave (a2 ': as) bs :: TyFun [a1] Type -> Type) (a2 ': cs :: [a1]) Source # | Prefers  | 
| Defined in Data.Type.List.Sublist Methods auto :: IsInterleave (a2 ': as) bs @@ (a2 ': cs) # | |
| Show (Interleave as bs cs) Source # | |
| Defined in Data.Type.List.Sublist Methods showsPrec :: Int -> Interleave as bs cs -> ShowS # show :: Interleave as bs cs -> String # showList :: [Interleave as bs cs] -> ShowS # | |
type IsInterleave as bs = TyPred (Interleave as bs) Source #
A type-level predicate that a given list is the "interleave" of as
 and bs.
Since: 0.1.2.0
autoInterleave :: forall as bs cs. Auto (IsInterleave as bs) cs => Interleave as bs cs Source #
Automatically generate an Interleave if as, bs, and cs are
 known statically.
Prefers the left side if there is an ambiguity:
IntL (IntR (IntR IntZ) :: Interleave '[1] '[1,2] '[1,1,2]
IntR (IntL (IntR IntZ) :: Interleave '[1] '[1,2] '[1,1,2]
autoInterleave '[1] '[1,2] '[1,1,2] == IntL (IntR (IntR IntZ)
Since: 0.1.2.0
interleaveRec :: Interleave as bs cs -> Rec f as -> Rec f bs -> Rec f cs Source #
unweaveRec :: Interleave as bs cs -> Rec f cs -> (Rec f as, Rec f bs) Source #
Given a Rec, disinterleave it into two Recs corresponding to an
 Interleave.
Since: 0.1.1.0
interleaveRecIso :: (Profunctor p, Functor f) => Interleave as bs cs -> p (Rec g as, Rec g bs) (f (Rec g as, Rec g bs)) -> p (Rec g cs) (f (Rec g cs)) Source #
Witness an isomorphism between Rec and two parts that interleave it.
Read this type signature as:
interleaveRecIso
    :: Interleave as  bs  cs
    -> Iso' (Rec f cs) (Rec f as, Rec f bs)
This can be used with the combinators from the lens library.
The Interleave tells how to unweave the Rec.
Since: 0.1.1.0
injectIndexL :: Interleave as bs cs -> Index as a -> Index cs a Source #
Interleave an Index on as into a full index on cs, which is as
 interleaved with bs.
Since: 0.1.1.0
injectIndexR :: Interleave as bs cs -> Index bs b -> Index cs b Source #
Interleave an Index on bs into a full index on cs, which is as
 interleaved with bs.
Since: 0.1.1.0
unweaveIndex :: Interleave as bs cs -> Index cs c -> Either (Index as c) (Index bs c) Source #
Given an index on cs, disinterleave it into either an index on as
 or on bs.
Since: 0.1.1.0
interleavedIxes :: Interleave as bs cs -> Rec (Index as :+: Index bs) cs Source #
swapInterleave :: Interleave as bs cs -> Interleave bs as cs Source #
Swap the two halves of an Interleave.
Since: 0.1.3.0
interleaveShapes :: Interleave as bs cs -> (Shape [] as, Shape [] bs, Shape [] cs) Source #
Get the Shapes associated with an Interleave.
Since: 0.1.3.0
Subset
data Subset :: [k] -> [k] -> Type where Source #
A Subset as bsas is some subset of bs, with
 items in the same order.  It is constructed by specifying
 what item to include or exclude in bs from as.  It is essentially
 Interleave, but without one of the two initial parameters.
You construct an Subset from cs by picking "which item" from
 bs to add to as.
Some examples:
SubsetNo (SubsetNo (SubsetNo SubsetNil)) :: Subset '[] '[1,2,3] SubsetYes (SubsetNo (SubsetNo SubsetNil)) :: Subset '[1] '[1,2,3] SubsetNo (SubsetNo (SubsetYes SubsetNil)) :: Subset '[3] '[1,2,3] SubsetYes (SubsetNo (SubsetYes SubsetNil)) :: Subset '[1,3] '[1,2,3] SubsetYes (SubsetYes (SubsetYes SubsetNil)) :: Subset '[1,2,3] '[1,2,3]
Since: 0.1.3.0
Constructors
| SubsetNil :: Subset '[] '[] | |
| SubsetNo :: Subset as bs -> Subset as (b ': bs) | |
| SubsetYes :: Subset as bs -> Subset (a ': as) (a ': bs) | 
Instances
| (SDecide k, SingI as) => Decidable (IsSubset as :: TyFun [k] Type -> Type) Source # | |
| Defined in Data.Type.List.Sublist | |
| Auto (IsSubset ([] :: [k]) :: TyFun [k] Type -> Type) ([] :: [k]) Source # | |
| Defined in Data.Type.List.Sublist | |
| Auto (IsSubset as) bs => Auto (IsSubset (a2 ': as) :: TyFun [a1] Type -> Type) (a2 ': bs :: [a1]) Source # | |
| Defined in Data.Type.List.Sublist | |
| Auto (IsSubset as) bs => Auto (IsSubset as :: TyFun [a] Type -> Type) (b ': bs :: [a]) Source # | |
| Defined in Data.Type.List.Sublist | |
| Show (Subset as bs) Source # | |
type IsSubset as = TyPred (Subset as) Source #
A type-level predicate that a given list is a "superset" of as, in
 correct order
Since: 0.1.2.0
autoSubset :: forall as bs. Auto (IsSubset as) bs => Subset as bs Source #
Automatically generate an Subset if as and bs are known
 statically.
subsetComplement :: Subset as cs -> (forall bs. Subset bs cs -> r) -> r Source #
as is a subset of cs; this function recovers bs, the subset of
 cs that is not as.
interleaveRToSubset :: Interleave as bs cs -> Subset bs cs Source #
Drop the left side of an Interleave, leaving only the right side.
interleaveLToSubset :: Interleave as bs cs -> Subset as cs Source #
Drop the right side of an Interleave, leaving only the left side.
subsetToInterleaveL :: Subset as cs -> (forall bs. Interleave as bs cs -> r) -> r Source #
Convert a Subset into an left Interleave, recovering the dropped
 items.
subsetToInterleaveR :: Subset bs cs -> (forall as. Interleave as bs cs -> r) -> r Source #
Convert a Subset into an right Interleave, recovering the dropped
 items.
subsetRec :: Subset as bs -> Lens' (Rec f bs) (Rec f as) Source #
A lens into a subset of a record, indicated by a Subset.
subsetIxes :: Subset as bs -> Rec (Index bs) as Source #
Get all of the indices of all the items in a Subset.
weakenSubsetIndex :: Subset as bs -> Index as a -> Index bs a Source #
Because as is a subset of bs, an index into as should also be an
 index into bs.  This performs that transformation.
This is like a version of injectIndexL or injectIndexR, for
 Subset.
strengthenSubsetIndex :: Subset as bs -> Index bs a -> Maybe (Index as a) Source #
Because as is a subset of bs, we can sometimes transform an
 index into bs into an index into as.  This performs that
 transformation.  If it succeeds, it means that the index in bs also
 exists in as; otherwise, it means that the index in bs was excluded
 from as.
Note that if the index into a was excluded from as, it doesn't
 necessarily mean that there is no a in bs --- bs could contain
 a duplicate that was included into as.  This converts into an index to
 the exact same item (positionlly) in the list, if it is possible.
This is like a version of unweaveIndex, but for Subset.