Copyright | (c) Andrey Mulik 2019 |
---|---|
License | BSD-style |
Maintainer | work.a.mulik@gmail.com |
Portability | non-portable (GHC extensions) |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
SDP.Linear is a module that provides several convenient interfaces for working with various linear data structures.
Synopsis
- module SDP.Nullable
- module SDP.Index
- module SDP.Sort
- module SDP.Zip
- class (Index i, Estimate b) => Bordered b i | b -> i where
- type Bordered1 l i e = Bordered (l e) i
- type Bordered2 l i e = Bordered (l i e) i
- class Nullable l => Linear l e | l -> e where
- uncons :: l -> (e, l)
- uncons' :: l -> Maybe (e, l)
- toHead :: e -> l -> l
- head :: l -> e
- tail :: l -> l
- unsnoc :: l -> (l, e)
- unsnoc' :: l -> Maybe (l, e)
- toLast :: l -> e -> l
- init :: l -> l
- last :: l -> e
- single :: e -> l
- (++) :: l -> l -> l
- replicate :: Int -> e -> l
- fromList :: [e] -> l
- fromListN :: Int -> [e] -> l
- listR :: l -> [e]
- listL :: l -> [e]
- fromFoldable :: Foldable f => f e -> l
- (!^) :: l -> Int -> e
- write :: l -> Int -> e -> l
- concat :: Foldable f => f l -> l
- concatMap :: Foldable f => (a -> l) -> f a -> l
- intersperse :: e -> l -> l
- filter :: (e -> Bool) -> l -> l
- except :: (e -> Bool) -> l -> l
- partition :: (e -> Bool) -> l -> (l, l)
- partitions :: Foldable f => f (e -> Bool) -> l -> [l]
- select :: (e -> Maybe a) -> l -> [a]
- select' :: (t e ~ l, Linear1 t a) => (e -> Maybe a) -> l -> t a
- extract :: (e -> Maybe a) -> l -> ([a], l)
- extract' :: (t e ~ l, Linear1 t a) => (e -> Maybe a) -> l -> (t a, l)
- selects :: Foldable f => f (e -> Maybe a) -> l -> ([[a]], l)
- selects' :: (Foldable f, t e ~ l, Linear1 t a) => f (e -> Maybe a) -> l -> ([t a], l)
- isSubseqOf :: Eq e => l -> l -> Bool
- reverse :: l -> l
- force :: l -> l
- subsequences :: l -> [l]
- iterate :: Int -> (e -> e) -> e -> l
- nub :: Eq e => l -> l
- nubBy :: Equal e -> l -> l
- ofoldr :: (Int -> e -> b -> b) -> b -> l -> b
- ofoldl :: (Int -> b -> e -> b) -> b -> l -> b
- ofoldr' :: (Int -> e -> b -> b) -> b -> l -> b
- ofoldl' :: (Int -> b -> e -> b) -> b -> l -> b
- o_foldr :: (e -> b -> b) -> b -> l -> b
- o_foldl :: (b -> e -> b) -> b -> l -> b
- o_foldr' :: (e -> b -> b) -> b -> l -> b
- o_foldl' :: (b -> e -> b) -> b -> l -> b
- type Linear1 l e = Linear (l e) e
- class Linear s e => Split s e | s -> e where
- take :: Int -> s -> s
- drop :: Int -> s -> s
- keep :: Int -> s -> s
- sans :: Int -> s -> s
- save :: Int -> s -> s
- skip :: Int -> s -> s
- split :: Int -> s -> (s, s)
- divide :: Int -> s -> (s, s)
- splits :: Foldable f => f Int -> s -> [s]
- divides :: Foldable f => f Int -> s -> [s]
- parts :: Foldable f => f Int -> s -> [s]
- chunks :: Int -> s -> [s]
- splitBy :: (e -> Bool) -> s -> (s, s)
- divideBy :: (e -> Bool) -> s -> (s, s)
- splitsBy :: (e -> Bool) -> s -> [s]
- splitsOn :: Eq e => s -> s -> [s]
- replaceBy :: Eq e => s -> s -> s -> s
- removeAll :: Eq e => s -> s -> s
- combo :: Equal e -> s -> Int
- justifyL :: Int -> e -> s -> s
- justifyR :: Int -> e -> s -> s
- each :: Int -> s -> s
- eachFrom :: Int -> Int -> s -> s
- isPrefixOf :: Eq e => s -> s -> Bool
- isSuffixOf :: Eq e => s -> s -> Bool
- isInfixOf :: Eq e => s -> s -> Bool
- prefix :: (e -> Bool) -> s -> Int
- suffix :: (e -> Bool) -> s -> Int
- infixes :: Eq e => s -> s -> [Int]
- dropSide :: (e -> Bool) -> s -> s
- takeWhile :: (e -> Bool) -> s -> s
- dropWhile :: (e -> Bool) -> s -> s
- takeEnd :: (e -> Bool) -> s -> s
- dropEnd :: (e -> Bool) -> s -> s
- spanl :: (e -> Bool) -> s -> (s, s)
- breakl :: (e -> Bool) -> s -> (s, s)
- spanr :: (e -> Bool) -> s -> (s, s)
- breakr :: (e -> Bool) -> s -> (s, s)
- selectWhile :: (e -> Maybe a) -> s -> [a]
- selectEnd :: (e -> Maybe a) -> s -> [a]
- extractWhile :: (e -> Maybe a) -> s -> ([a], s)
- extractEnd :: (e -> Maybe a) -> s -> (s, [a])
- selectWhile' :: (t e ~ l, Split1 t a) => (e -> Maybe a) -> s -> t a
- selectEnd' :: (t e ~ l, Split1 t a) => (e -> Maybe a) -> s -> t a
- extractWhile' :: (t e ~ l, Split1 t a) => (e -> Maybe a) -> s -> (t a, s)
- extractEnd' :: (t e ~ l, Split1 t a) => (e -> Maybe a) -> s -> (s, t a)
- type Split1 s e = Split (s e) e
- pattern (:>) :: Linear l e => e -> l -> l
- pattern (:<) :: Linear l e => l -> e -> l
- pattern Z :: Nullable e => e
- intercalate :: (Foldable f, Linear1 f l, Linear l e) => l -> f l -> l
- tails :: Linear l e => l -> [l]
- inits :: Linear l e => l -> [l]
- ascending :: (Split s e, Sort s e, Ord e) => s -> [Int] -> Bool
- stripPrefix :: (Split s e, Bordered s i, Eq e) => s -> s -> s
- stripSuffix :: (Split s e, Bordered s i, Eq e) => s -> s -> s
- stripPrefix' :: (Split s e, Bordered s i, Eq e) => s -> s -> Maybe s
- stripSuffix' :: (Split s e, Bordered s i, Eq e) => s -> s -> Maybe s
Exports
module SDP.Nullable
module SDP.Index
module SDP.Sort
module SDP.Zip
Bordered class
class (Index i, Estimate b) => Bordered b i | b -> i where Source #
Class of bordered data structures.
bounds :: b -> (i, i) Source #
Returns the exact upper
and lower
bounds of given structure. If the
structure doesn't have explicitly defined boundaries (list, for example),
use the
.defaultBounds
. sizeOf
Returns lower bound of structure
Returns upper bound of structure
Returns actual size of structure.
sizesOf :: b -> [Int] Source #
Returns actual sizes of structure.
indexIn :: b -> i -> Bool Source #
Checks if an index falls within the boundaries of the structure.
Returns index range list.
indexOf :: b -> Int -> i Source #
Returns index by offset in structure.
offsetOf :: b -> i -> Int Source #
Returns index offset in structure bounds.
Instances
Linear class
Linear is a class for linear (list-like) data structures which supports
- creation:
single
,replicate
,fromFoldable
,fromList
,fromListN
- deconstruction:
head
,tail
,init
,last
,uncons
,unsnoc
- construction, concatenation:
toHead
,toLast
,++
,concat
,concatMap
- left- and right-side view:
listL
,listR
- filtering, separation and selection:
filter
,except
,partition
,partitions
,select
,select'
,extract
,extract'
,selects
andselects'
Select and extract are needed to combine filtering and mapping, simplifying lambdas and case-expressions in complex cases.
select' (p ?+ f) == fmap f . filter p select' (p ?- f) == fmap f . except p
fmap (\ (OneOfCons x y z) -> x + y * z) . filter (\ es -> case es of {(OneOfCons _ _ _) -> True; _ -> False})
is just
select (\ es -> case es of {(OneOfCons x y z) -> Just (x + y * z); _ -> Nothing})
The code is greatly simplified if there are more than one such constructor or any additional conditions.
class Nullable l => Linear l e | l -> e where Source #
Class of list-like data structures.
uncons :: l -> (e, l) Source #
uncons' :: l -> Maybe (e, l) Source #
toHead :: e -> l -> l Source #
Prepends element to line, constructor for :>
pattern.
Returns first element of line, may fail.
Returns line except first, may fail.
unsnoc :: l -> (l, e) Source #
unsnoc' :: l -> Maybe (l, e) Source #
toLast :: l -> e -> l Source #
Appends element to line, constructor for :<
pattern.
Returns line except last
element, may fail.
Returns last element, may fail.
Just singleton.
(++) :: l -> l -> l infixr 5 Source #
Concatenation of two lines.
replicate :: Int -> e -> l Source #
replicate n e
returns a line of n
repetitions of the element e
.
Creates line from list.
fromListN :: Int -> [e] -> l Source #
Create finite line from (possibly infinite) list.
Right to left view of line.
Left to right view of line, same to toList
.
fromFoldable :: Foldable f => f e -> l Source #
Generalized fromList
.
(!^) :: l -> Int -> e infixl 9 Source #
Returns the element of a sequence by offset, may be completely unsafe. This is an optimistic read function and shouldn't perform checks for efficiency reasons.
If you need safety, use (!) or (!?). The generalization of this function by index type (.!).
es !^ i = listL es !! i
write :: l -> Int -> e -> l Source #
write es n e
writes value e
in position n
(offset), returns new
structure. If n
is out of range, returns equal structure (es
or copy).
concat :: Foldable f => f l -> l Source #
Generalized concat.
concatMap :: Foldable f => (a -> l) -> f a -> l Source #
Generalized concatMap.
intersperse :: e -> l -> l Source #
Generalized intersperse.
filter :: (e -> Bool) -> l -> l infix 8 Source #
Generalized filter.
except :: (e -> Bool) -> l -> l infix 8 Source #
Inverted filter.
partition :: (e -> Bool) -> l -> (l, l) Source #
Generalization of partition.
partitions :: Foldable f => f (e -> Bool) -> l -> [l] Source #
Generalization of partition, that select sublines by predicates.
select :: (e -> Maybe a) -> l -> [a] Source #
select f es
is selective map of es
elements to new list.
select' :: (t e ~ l, Linear1 t a) => (e -> Maybe a) -> l -> t a Source #
select' f es
is selective map of es
elements to new line.
extract :: (e -> Maybe a) -> l -> ([a], l) Source #
extract f es
returns a selective map of es
elements to new list and
the remaining elements of the line.
extract' :: (t e ~ l, Linear1 t a) => (e -> Maybe a) -> l -> (t a, l) Source #
extract' f es
returns a selective map of es
elements to new line and
the remaining elements of the line.
selects :: Foldable f => f (e -> Maybe a) -> l -> ([[a]], l) Source #
selects fs es
sequentially applies the functions from fs
to the
remainder of es
, returns a list of selections and the remainder of the
last selection.
selects' :: (Foldable f, t e ~ l, Linear1 t a) => f (e -> Maybe a) -> l -> ([t a], l) Source #
selects' fs es
sequentially applies the functions from fs
to the
remainder of es
, returns a line of selections and the remainder of the
last selection.
isSubseqOf :: Eq e => l -> l -> Bool Source #
The isSubseqOf xs ys
checks if all the elements of the xs
occur,
in order, in the ys
. The elements don't have to occur consecutively.
Generalized reverse.
Create new line, equal to given.
subsequences :: l -> [l] Source #
Generalized subsequences.
iterate :: Int -> (e -> e) -> e -> l Source #
iterate n f x
returns sequence of n
applications of f
to x
.
Note that iterate
returns finite sequence, instead Prelude prototype.
nub :: Eq e => l -> l Source #
Same as nubBy (
.==
)
nubBy :: Equal e -> l -> l Source #
Generalization of nubBy.
ofoldr :: (Int -> e -> b -> b) -> b -> l -> b Source #
ofoldr
is right fold with offset.
ofoldl :: (Int -> b -> e -> b) -> b -> l -> b Source #
ofoldl
is left fold with offset.
ofoldr' :: (Int -> e -> b -> b) -> b -> l -> b Source #
ofoldl' :: (Int -> b -> e -> b) -> b -> l -> b Source #
o_foldr :: (e -> b -> b) -> b -> l -> b Source #
o_foldl :: (b -> e -> b) -> b -> l -> b Source #
Instances
Linear [e] e Source # | |
Defined in SDP.Linear uncons :: [e] -> (e, [e]) Source # uncons' :: [e] -> Maybe (e, [e]) Source # toHead :: e -> [e] -> [e] Source # unsnoc :: [e] -> ([e], e) Source # unsnoc' :: [e] -> Maybe ([e], e) Source # toLast :: [e] -> e -> [e] Source # (++) :: [e] -> [e] -> [e] Source # replicate :: Int -> e -> [e] Source # fromList :: [e] -> [e] Source # fromListN :: Int -> [e] -> [e] Source # fromFoldable :: Foldable f => f e -> [e] Source # (!^) :: [e] -> Int -> e Source # write :: [e] -> Int -> e -> [e] Source # concat :: Foldable f => f [e] -> [e] Source # concatMap :: Foldable f => (a -> [e]) -> f a -> [e] Source # intersperse :: e -> [e] -> [e] Source # filter :: (e -> Bool) -> [e] -> [e] Source # except :: (e -> Bool) -> [e] -> [e] Source # partition :: (e -> Bool) -> [e] -> ([e], [e]) Source # partitions :: Foldable f => f (e -> Bool) -> [e] -> [[e]] Source # select :: (e -> Maybe a) -> [e] -> [a] Source # select' :: (t e ~ [e], Linear1 t a) => (e -> Maybe a) -> [e] -> t a Source # extract :: (e -> Maybe a) -> [e] -> ([a], [e]) Source # extract' :: (t e ~ [e], Linear1 t a) => (e -> Maybe a) -> [e] -> (t a, [e]) Source # selects :: Foldable f => f (e -> Maybe a) -> [e] -> ([[a]], [e]) Source # selects' :: (Foldable f, t e ~ [e], Linear1 t a) => f (e -> Maybe a) -> [e] -> ([t a], [e]) Source # isSubseqOf :: [e] -> [e] -> Bool Source # reverse :: [e] -> [e] Source # subsequences :: [e] -> [[e]] Source # iterate :: Int -> (e -> e) -> e -> [e] Source # nubBy :: Equal e -> [e] -> [e] Source # ofoldr :: (Int -> e -> b -> b) -> b -> [e] -> b Source # ofoldl :: (Int -> b -> e -> b) -> b -> [e] -> b Source # ofoldr' :: (Int -> e -> b -> b) -> b -> [e] -> b Source # ofoldl' :: (Int -> b -> e -> b) -> b -> [e] -> b Source # o_foldr :: (e -> b -> b) -> b -> [e] -> b Source # o_foldl :: (b -> e -> b) -> b -> [e] -> b Source # | |
Unboxed e => Linear (SBytes# e) e Source # | |
Defined in SDP.Prim.SBytes uncons :: SBytes# e -> (e, SBytes# e) Source # uncons' :: SBytes# e -> Maybe (e, SBytes# e) Source # toHead :: e -> SBytes# e -> SBytes# e Source # head :: SBytes# e -> e Source # tail :: SBytes# e -> SBytes# e Source # unsnoc :: SBytes# e -> (SBytes# e, e) Source # unsnoc' :: SBytes# e -> Maybe (SBytes# e, e) Source # toLast :: SBytes# e -> e -> SBytes# e Source # init :: SBytes# e -> SBytes# e Source # last :: SBytes# e -> e Source # single :: e -> SBytes# e Source # (++) :: SBytes# e -> SBytes# e -> SBytes# e Source # replicate :: Int -> e -> SBytes# e Source # fromList :: [e] -> SBytes# e Source # fromListN :: Int -> [e] -> SBytes# e Source # listR :: SBytes# e -> [e] Source # listL :: SBytes# e -> [e] Source # fromFoldable :: Foldable f => f e -> SBytes# e Source # (!^) :: SBytes# e -> Int -> e Source # write :: SBytes# e -> Int -> e -> SBytes# e Source # concat :: Foldable f => f (SBytes# e) -> SBytes# e Source # concatMap :: Foldable f => (a -> SBytes# e) -> f a -> SBytes# e Source # intersperse :: e -> SBytes# e -> SBytes# e Source # filter :: (e -> Bool) -> SBytes# e -> SBytes# e Source # except :: (e -> Bool) -> SBytes# e -> SBytes# e Source # partition :: (e -> Bool) -> SBytes# e -> (SBytes# e, SBytes# e) Source # partitions :: Foldable f => f (e -> Bool) -> SBytes# e -> [SBytes# e] Source # select :: (e -> Maybe a) -> SBytes# e -> [a] Source # select' :: (t e ~ SBytes# e, Linear1 t a) => (e -> Maybe a) -> SBytes# e -> t a Source # extract :: (e -> Maybe a) -> SBytes# e -> ([a], SBytes# e) Source # extract' :: (t e ~ SBytes# e, Linear1 t a) => (e -> Maybe a) -> SBytes# e -> (t a, SBytes# e) Source # selects :: Foldable f => f (e -> Maybe a) -> SBytes# e -> ([[a]], SBytes# e) Source # selects' :: (Foldable f, t e ~ SBytes# e, Linear1 t a) => f (e -> Maybe a) -> SBytes# e -> ([t a], SBytes# e) Source # isSubseqOf :: SBytes# e -> SBytes# e -> Bool Source # reverse :: SBytes# e -> SBytes# e Source # force :: SBytes# e -> SBytes# e Source # subsequences :: SBytes# e -> [SBytes# e] Source # iterate :: Int -> (e -> e) -> e -> SBytes# e Source # nub :: SBytes# e -> SBytes# e Source # nubBy :: Equal e -> SBytes# e -> SBytes# e Source # ofoldr :: (Int -> e -> b -> b) -> b -> SBytes# e -> b Source # ofoldl :: (Int -> b -> e -> b) -> b -> SBytes# e -> b Source # ofoldr' :: (Int -> e -> b -> b) -> b -> SBytes# e -> b Source # ofoldl' :: (Int -> b -> e -> b) -> b -> SBytes# e -> b Source # o_foldr :: (e -> b -> b) -> b -> SBytes# e -> b Source # o_foldl :: (b -> e -> b) -> b -> SBytes# e -> b Source # | |
Linear (SArray# e) e Source # | |
Defined in SDP.Prim.SArray uncons :: SArray# e -> (e, SArray# e) Source # uncons' :: SArray# e -> Maybe (e, SArray# e) Source # toHead :: e -> SArray# e -> SArray# e Source # head :: SArray# e -> e Source # tail :: SArray# e -> SArray# e Source # unsnoc :: SArray# e -> (SArray# e, e) Source # unsnoc' :: SArray# e -> Maybe (SArray# e, e) Source # toLast :: SArray# e -> e -> SArray# e Source # init :: SArray# e -> SArray# e Source # last :: SArray# e -> e Source # single :: e -> SArray# e Source # (++) :: SArray# e -> SArray# e -> SArray# e Source # replicate :: Int -> e -> SArray# e Source # fromList :: [e] -> SArray# e Source # fromListN :: Int -> [e] -> SArray# e Source # listR :: SArray# e -> [e] Source # listL :: SArray# e -> [e] Source # fromFoldable :: Foldable f => f e -> SArray# e Source # (!^) :: SArray# e -> Int -> e Source # write :: SArray# e -> Int -> e -> SArray# e Source # concat :: Foldable f => f (SArray# e) -> SArray# e Source # concatMap :: Foldable f => (a -> SArray# e) -> f a -> SArray# e Source # intersperse :: e -> SArray# e -> SArray# e Source # filter :: (e -> Bool) -> SArray# e -> SArray# e Source # except :: (e -> Bool) -> SArray# e -> SArray# e Source # partition :: (e -> Bool) -> SArray# e -> (SArray# e, SArray# e) Source # partitions :: Foldable f => f (e -> Bool) -> SArray# e -> [SArray# e] Source # select :: (e -> Maybe a) -> SArray# e -> [a] Source # select' :: (t e ~ SArray# e, Linear1 t a) => (e -> Maybe a) -> SArray# e -> t a Source # extract :: (e -> Maybe a) -> SArray# e -> ([a], SArray# e) Source # extract' :: (t e ~ SArray# e, Linear1 t a) => (e -> Maybe a) -> SArray# e -> (t a, SArray# e) Source # selects :: Foldable f => f (e -> Maybe a) -> SArray# e -> ([[a]], SArray# e) Source # selects' :: (Foldable f, t e ~ SArray# e, Linear1 t a) => f (e -> Maybe a) -> SArray# e -> ([t a], SArray# e) Source # isSubseqOf :: SArray# e -> SArray# e -> Bool Source # reverse :: SArray# e -> SArray# e Source # force :: SArray# e -> SArray# e Source # subsequences :: SArray# e -> [SArray# e] Source # iterate :: Int -> (e -> e) -> e -> SArray# e Source # nub :: SArray# e -> SArray# e Source # nubBy :: Equal e -> SArray# e -> SArray# e Source # ofoldr :: (Int -> e -> b -> b) -> b -> SArray# e -> b Source # ofoldl :: (Int -> b -> e -> b) -> b -> SArray# e -> b Source # ofoldr' :: (Int -> e -> b -> b) -> b -> SArray# e -> b Source # ofoldl' :: (Int -> b -> e -> b) -> b -> SArray# e -> b Source # o_foldr :: (e -> b -> b) -> b -> SArray# e -> b Source # o_foldl :: (b -> e -> b) -> b -> SArray# e -> b Source # | |
(Bordered1 rep Int e, Linear1 rep e) => Linear (AnyChunks rep e) e Source # | |
Defined in SDP.Templates.AnyChunks uncons :: AnyChunks rep e -> (e, AnyChunks rep e) Source # uncons' :: AnyChunks rep e -> Maybe (e, AnyChunks rep e) Source # toHead :: e -> AnyChunks rep e -> AnyChunks rep e Source # head :: AnyChunks rep e -> e Source # tail :: AnyChunks rep e -> AnyChunks rep e Source # unsnoc :: AnyChunks rep e -> (AnyChunks rep e, e) Source # unsnoc' :: AnyChunks rep e -> Maybe (AnyChunks rep e, e) Source # toLast :: AnyChunks rep e -> e -> AnyChunks rep e Source # init :: AnyChunks rep e -> AnyChunks rep e Source # last :: AnyChunks rep e -> e Source # single :: e -> AnyChunks rep e Source # (++) :: AnyChunks rep e -> AnyChunks rep e -> AnyChunks rep e Source # replicate :: Int -> e -> AnyChunks rep e Source # fromList :: [e] -> AnyChunks rep e Source # fromListN :: Int -> [e] -> AnyChunks rep e Source # listR :: AnyChunks rep e -> [e] Source # listL :: AnyChunks rep e -> [e] Source # fromFoldable :: Foldable f => f e -> AnyChunks rep e Source # (!^) :: AnyChunks rep e -> Int -> e Source # write :: AnyChunks rep e -> Int -> e -> AnyChunks rep e Source # concat :: Foldable f => f (AnyChunks rep e) -> AnyChunks rep e Source # concatMap :: Foldable f => (a -> AnyChunks rep e) -> f a -> AnyChunks rep e Source # intersperse :: e -> AnyChunks rep e -> AnyChunks rep e Source # filter :: (e -> Bool) -> AnyChunks rep e -> AnyChunks rep e Source # except :: (e -> Bool) -> AnyChunks rep e -> AnyChunks rep e Source # partition :: (e -> Bool) -> AnyChunks rep e -> (AnyChunks rep e, AnyChunks rep e) Source # partitions :: Foldable f => f (e -> Bool) -> AnyChunks rep e -> [AnyChunks rep e] Source # select :: (e -> Maybe a) -> AnyChunks rep e -> [a] Source # select' :: (t e ~ AnyChunks rep e, Linear1 t a) => (e -> Maybe a) -> AnyChunks rep e -> t a Source # extract :: (e -> Maybe a) -> AnyChunks rep e -> ([a], AnyChunks rep e) Source # extract' :: (t e ~ AnyChunks rep e, Linear1 t a) => (e -> Maybe a) -> AnyChunks rep e -> (t a, AnyChunks rep e) Source # selects :: Foldable f => f (e -> Maybe a) -> AnyChunks rep e -> ([[a]], AnyChunks rep e) Source # selects' :: (Foldable f, t e ~ AnyChunks rep e, Linear1 t a) => f (e -> Maybe a) -> AnyChunks rep e -> ([t a], AnyChunks rep e) Source # isSubseqOf :: AnyChunks rep e -> AnyChunks rep e -> Bool Source # reverse :: AnyChunks rep e -> AnyChunks rep e Source # force :: AnyChunks rep e -> AnyChunks rep e Source # subsequences :: AnyChunks rep e -> [AnyChunks rep e] Source # iterate :: Int -> (e -> e) -> e -> AnyChunks rep e Source # nub :: AnyChunks rep e -> AnyChunks rep e Source # nubBy :: Equal e -> AnyChunks rep e -> AnyChunks rep e Source # ofoldr :: (Int -> e -> b -> b) -> b -> AnyChunks rep e -> b Source # ofoldl :: (Int -> b -> e -> b) -> b -> AnyChunks rep e -> b Source # ofoldr' :: (Int -> e -> b -> b) -> b -> AnyChunks rep e -> b Source # ofoldl' :: (Int -> b -> e -> b) -> b -> AnyChunks rep e -> b Source # o_foldr :: (e -> b -> b) -> b -> AnyChunks rep e -> b Source # o_foldl :: (b -> e -> b) -> b -> AnyChunks rep e -> b Source # o_foldr' :: (e -> b -> b) -> b -> AnyChunks rep e -> b Source # o_foldl' :: (b -> e -> b) -> b -> AnyChunks rep e -> b Source # | |
(Index i, Linear1 rep e, Bordered1 rep Int e) => Linear (AnyBorder rep i e) e Source # | |
Defined in SDP.Templates.AnyBorder uncons :: AnyBorder rep i e -> (e, AnyBorder rep i e) Source # uncons' :: AnyBorder rep i e -> Maybe (e, AnyBorder rep i e) Source # toHead :: e -> AnyBorder rep i e -> AnyBorder rep i e Source # head :: AnyBorder rep i e -> e Source # tail :: AnyBorder rep i e -> AnyBorder rep i e Source # unsnoc :: AnyBorder rep i e -> (AnyBorder rep i e, e) Source # unsnoc' :: AnyBorder rep i e -> Maybe (AnyBorder rep i e, e) Source # toLast :: AnyBorder rep i e -> e -> AnyBorder rep i e Source # init :: AnyBorder rep i e -> AnyBorder rep i e Source # last :: AnyBorder rep i e -> e Source # single :: e -> AnyBorder rep i e Source # (++) :: AnyBorder rep i e -> AnyBorder rep i e -> AnyBorder rep i e Source # replicate :: Int -> e -> AnyBorder rep i e Source # fromList :: [e] -> AnyBorder rep i e Source # fromListN :: Int -> [e] -> AnyBorder rep i e Source # listR :: AnyBorder rep i e -> [e] Source # listL :: AnyBorder rep i e -> [e] Source # fromFoldable :: Foldable f => f e -> AnyBorder rep i e Source # (!^) :: AnyBorder rep i e -> Int -> e Source # write :: AnyBorder rep i e -> Int -> e -> AnyBorder rep i e Source # concat :: Foldable f => f (AnyBorder rep i e) -> AnyBorder rep i e Source # concatMap :: Foldable f => (a -> AnyBorder rep i e) -> f a -> AnyBorder rep i e Source # intersperse :: e -> AnyBorder rep i e -> AnyBorder rep i e Source # filter :: (e -> Bool) -> AnyBorder rep i e -> AnyBorder rep i e Source # except :: (e -> Bool) -> AnyBorder rep i e -> AnyBorder rep i e Source # partition :: (e -> Bool) -> AnyBorder rep i e -> (AnyBorder rep i e, AnyBorder rep i e) Source # partitions :: Foldable f => f (e -> Bool) -> AnyBorder rep i e -> [AnyBorder rep i e] Source # select :: (e -> Maybe a) -> AnyBorder rep i e -> [a] Source # select' :: (t e ~ AnyBorder rep i e, Linear1 t a) => (e -> Maybe a) -> AnyBorder rep i e -> t a Source # extract :: (e -> Maybe a) -> AnyBorder rep i e -> ([a], AnyBorder rep i e) Source # extract' :: (t e ~ AnyBorder rep i e, Linear1 t a) => (e -> Maybe a) -> AnyBorder rep i e -> (t a, AnyBorder rep i e) Source # selects :: Foldable f => f (e -> Maybe a) -> AnyBorder rep i e -> ([[a]], AnyBorder rep i e) Source # selects' :: (Foldable f, t e ~ AnyBorder rep i e, Linear1 t a) => f (e -> Maybe a) -> AnyBorder rep i e -> ([t a], AnyBorder rep i e) Source # isSubseqOf :: AnyBorder rep i e -> AnyBorder rep i e -> Bool Source # reverse :: AnyBorder rep i e -> AnyBorder rep i e Source # force :: AnyBorder rep i e -> AnyBorder rep i e Source # subsequences :: AnyBorder rep i e -> [AnyBorder rep i e] Source # iterate :: Int -> (e -> e) -> e -> AnyBorder rep i e Source # nub :: AnyBorder rep i e -> AnyBorder rep i e Source # nubBy :: Equal e -> AnyBorder rep i e -> AnyBorder rep i e Source # ofoldr :: (Int -> e -> b -> b) -> b -> AnyBorder rep i e -> b Source # ofoldl :: (Int -> b -> e -> b) -> b -> AnyBorder rep i e -> b Source # ofoldr' :: (Int -> e -> b -> b) -> b -> AnyBorder rep i e -> b Source # ofoldl' :: (Int -> b -> e -> b) -> b -> AnyBorder rep i e -> b Source # o_foldr :: (e -> b -> b) -> b -> AnyBorder rep i e -> b Source # o_foldl :: (b -> e -> b) -> b -> AnyBorder rep i e -> b Source # o_foldr' :: (e -> b -> b) -> b -> AnyBorder rep i e -> b Source # o_foldl' :: (b -> e -> b) -> b -> AnyBorder rep i e -> b Source # |
Split class
Split is class of structures that may be splitted by
- length:
take
,drop
,split
,splits
,keep
,sans
,divide
,divides
,parts
,chunks
- content:
splitBy
,divideBy
,splitsBy
,splitsOn
- predicate:
takeWhile
,dropWhile
,spanl
,breakl
(left to right),takeEnd
,dropEnd
,spanr
,breakr
(right to left) - selector:
selectWhile
,selectEnd
,extractWhile
,extractEnd
,selectWhile'
,selectEnd'
,extractWhile'
,extractEnd'
,replaceBy
,removeAll
,each
,eachFrom
.
Also Split provides some usefil predicates: isPrefixOf
, isInfixOf
,
isSuffixOf
, prefix
, suffix
, infixes
, combo
.
class Linear s e => Split s e | s -> e where Source #
Split - class of splittable data structures.
take :: Int -> s -> s Source #
take n es
takes first n
elements of es
.
drop :: Int -> s -> s Source #
drop n es
drops first n
elements of es
.
keep :: Int -> s -> s Source #
keep n es
takes last n
elements of es
.
sans :: Int -> s -> s Source #
sans n es
drops last n
elements of es
.
save :: Int -> s -> s Source #
save n es
takes first n
elements of es
if n > 0
and last -n
elements otherwise.
skip :: Int -> s -> s Source #
skip n es
drops first n
elements of es
if n > 0
and last -n
elements otherwise.
split :: Int -> s -> (s, s) Source #
split n es
is same to (take n es, drop n es)
.
divide :: Int -> s -> (s, s) Source #
divide n es
is same to (sans n es, keep n es)
.
splits :: Foldable f => f Int -> s -> [s] Source #
Splits line into sequences of given sizes (left to right).
splits [5, 3, 12] ['a'..'z'] = ["abcde","fgh","ijklmnopqrst","uvwxyz"]
divides :: Foldable f => f Int -> s -> [s] Source #
Splits line into sequences of given sizes (right to left).
divides [5,3,12] ['a'..'z'] == ["abcdef","ghijk","lmn","opqrstuvwxyz"]
parts :: Foldable f => f Int -> s -> [s] Source #
Splits structures into parts by given offsets.
parts [0,5,6,12,26] ['a'..'z'] = ["","abcde","f","ghijkl","mnopqrstuvwxyz",""] -- if previous offset is equal or greater, subline is empty and next begins from previous: parts [0, 5, 4, 12, 26] ['a' .. 'z'] = ["","abcde","","fghijklm","nopqrstuvwxyz",""]
chunks :: Int -> s -> [s] Source #
Splits structures into chunks of size n
and the rest.
chunks x [] = [] -- forall x chunks 0 es = [] -- forall es
chunks 3 [1 .. 10] == [[1,2,3],[4,5,6],[7,8,9],[10]]
splitBy :: (e -> Bool) -> s -> (s, s) Source #
Split line by first (left) separation element. If there is no such
element, splitBy es = (es, Z)
.
splitBy (== '.') "foo" == ("foo","") splitBy (== '.') "foo." == ("foo","") splitBy (== '.') ".foo" == ("","foo") splitBy (== '.') "foo.bar" == ("foo","bar") splitBy (== '.') "foo.bar.baz" == ("foo","bar.baz")
divideBy :: (e -> Bool) -> s -> (s, s) Source #
Split line by last (right) separation element. If there is no such
element, divide es = (Z, es)
.
divideBy (== '.') "foo" == ("","foo") divideBy (== '.') ".foo" == ("","foo") divideBy (== '.') "foo." == ("foo","") divideBy (== '.') "foo.bar" == ("foo","bar") divideBy (== '.') "foo.bar.baz" == ("foo.bar","baz")
splitsBy :: (e -> Bool) -> s -> [s] Source #
Splits line by separation elements.
splitsOn :: Eq e => s -> s -> [s] Source #
splitsOn sub line
splits line
by sub
.
splitsOn "fo" "foobar bazfoobar1" == ["","obar baz","obar1"]
replaceBy :: Eq e => s -> s -> s -> s Source #
replaceBy sub new line
replace every non-overlapping occurrence of sub
in line
with new
.
replaceBy "foo" "bar" "foobafoorbaz" == "barbabarrbaz"
removeAll :: Eq e => s -> s -> s Source #
Removes every non-overlapping occurrence of sub
with Z
.
removeAll = concat ... splitsOn (`replaceBy` Z) = removeAll
combo :: Equal e -> s -> Int Source #
combo f es
returns the length of the es
subsequence (left to tight)
whose elements are in order f
.
combo (<) [] == 0 combo (<) [1] == 1 combo (<) [7, 4, 12] == 1 combo (<) [1, 7, 3, 12] == 2
justifyL :: Int -> e -> s -> s Source #
justifyL n e es
appends e
elements if the es
is shorter than n
,
takes n
elements if longer.
justifyR :: Int -> e -> s -> s Source #
justifyR n e es
prepends e
elements if the es
is shorter than n
,
takes n
elements if longer.
each :: Int -> s -> s Source #
each n es
returns each nth element of structure.
If n == 1
, returns es
.
If n < 1
, returns Z
.
eachFrom :: Int -> Int -> s -> s Source #
eachFrom o n es
returns each nth element of structure, beginning from o.
eachFrom o n = each n . drop o
eachFrom 0 2 [1 .. 20] == [2, 4 .. 20] eachFrom 1 2 [1 .. 20] == [3, 5 .. 19]
isPrefixOf :: Eq e => s -> s -> Bool Source #
isPrefixOf checks whether the first line is the beginning of the second
isSuffixOf :: Eq e => s -> s -> Bool Source #
isSuffixOf checks whether the first line is the ending of the second
isInfixOf :: Eq e => s -> s -> Bool Source #
isInfixOf checks whether the first line is the substring of the second
prefix :: (e -> Bool) -> s -> Int Source #
prefix gives length of init, satisfying preducate.
suffix :: (e -> Bool) -> s -> Int Source #
suffix gives length of tail, satisfying predicate.
infixes :: Eq e => s -> s -> [Int] Source #
infixes inf es
returns a list of inf
positions in es
, without
intersections.
"" `infixes` es = [] "abba" `infixes` "baababba" == [4] "abab" `infixes` "baababab" == [2] "aaaa" `infixes` "aaaaaaaa" == [0, 4]
dropSide :: (e -> Bool) -> s -> s Source #
dropSide f = dropWhile f . dropEnd f
.
takeWhile :: (e -> Bool) -> s -> s Source #
Takes the longest init by predicate.
dropWhile :: (e -> Bool) -> s -> s Source #
Drops the longest init by predicate.
takeEnd :: (e -> Bool) -> s -> s Source #
Takes the longest suffix by predicate.
dropEnd :: (e -> Bool) -> s -> s Source #
Drops the longest prefix by predicate.
spanl :: (e -> Bool) -> s -> (s, s) Source #
Left-side span.
breakl :: (e -> Bool) -> s -> (s, s) Source #
Left-side break.
spanr :: (e -> Bool) -> s -> (s, s) Source #
Right-side span.
breakr :: (e -> Bool) -> s -> (s, s) Source #
Right-side break.
selectWhile :: (e -> Maybe a) -> s -> [a] Source #
selectWhile f es
selects results of applying f
to es
(left to right)
untill first fail.
selectEnd :: (e -> Maybe a) -> s -> [a] Source #
selectEnd f es
selects results of applying f
to es
(right to left)
untill first fail.
extractWhile :: (e -> Maybe a) -> s -> ([a], s) Source #
extractWhile f es
selects results of applying f
to es
(left to
right) untill first fail. Returns selected results and rest of line.
extractEnd :: (e -> Maybe a) -> s -> (s, [a]) Source #
extractEnd f es
selects results of applying f
to es
(right to left)
untill first fail. Returns rest of line and selected results.
selectWhile' :: (t e ~ l, Split1 t a) => (e -> Maybe a) -> s -> t a Source #
selectWhile'
is selectWhile
version for generalized structures.
selectEnd' :: (t e ~ l, Split1 t a) => (e -> Maybe a) -> s -> t a Source #
selectEnd'
is selectEnd
version for generalized structures.
extractWhile' :: (t e ~ l, Split1 t a) => (e -> Maybe a) -> s -> (t a, s) Source #
extractWhile'
is extractWhile
version for generalized structures.
extractEnd' :: (t e ~ l, Split1 t a) => (e -> Maybe a) -> s -> (s, t a) Source #
extractEnd'
is extractEnd
version for generalized structures.
Instances
Patterns
SDP.Linear also provides three overloaded patterns: Z
, (:>
) and (:<
).
Related functions
intercalate :: (Foldable f, Linear1 f l, Linear l e) => l -> f l -> l Source #
intercalate is generalization of intercalate
ascending :: (Split s e, Sort s e, Ord e) => s -> [Int] -> Bool Source #
ascending es lens
checks if the subsequences of es
of lengths lens
is
sorted.
stripPrefix :: (Split s e, Bordered s i, Eq e) => s -> s -> s Source #
stripPrefix sub line
strips prefix sub
of line
(if any).
stripSuffix :: (Split s e, Bordered s i, Eq e) => s -> s -> s Source #
stripSuffix sub line
strips suffix sub
of line
(if any).