Copyright | (c) Justin Le 2018 |
---|---|
License | BSD3 |
Maintainer | justin@jle.im |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
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
witnesses that 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
witnesses that 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
witnesses that 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 decide :: Decide (Found (AppendedTo as)) # | |
SingI as => Provable (Found (AppendedTo as) :: TyFun [k] Type -> Type) Source # | |
Defined in Data.Type.List.Sublist 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
with, with 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
as long as
you have 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
implies 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
given structure witnesses 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
as long as
you have 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
implies 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
given
structure witnesses 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
, prove that singleton's 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
, you can give 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] (IsAppend
as bs)
select
for AppendedTo
is pretty much just withAppend
.
Since: 0.1.2.0
Interleave
data Interleave :: [k] -> [k] -> [k] -> Type where Source #
A
witnesses that 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
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 decide :: Decide (IsInterleave as bs) # | |
Auto (IsInterleave ([] :: [k]) ([] :: [k]) :: TyFun [k] Type -> Type) ([] :: [k]) Source # | |
Defined in Data.Type.List.Sublist 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 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 auto :: IsInterleave (a2 ': as) bs @@ (a2 ': cs) # | |
Show (Interleave as bs cs) Source # | |
Defined in Data.Type.List.Sublist 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 Rec
s 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 Shape
s associated with an Interleave
.
Since: 0.1.3.0
Subset
data Subset :: [k] -> [k] -> Type where Source #
A
witnesses that 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
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
.