vector-split-1.0.0.3: Combinator library for splitting vectors.
Safe HaskellSafe-Inferred
LanguageHaskell2010

Data.Vector.Split.Internal

Synopsis

Documentation

split :: Vector v a => Splitter v a -> v a -> [v a] Source #

type Splitter v a = v a -> SplitList v a Source #

splitOn :: (Vector v a, Eq a) => v a -> v a -> [v a] Source #

Split on the given sublist. Equivalent to split . dropDelims . onSublist. For example:

>>> splitOn (BV.fromList "..") (BV.fromList "a..b...c....d..")
["a","b",".c","","d",""]

In some parsing combinator frameworks this is also known as sepBy.

Note that this is the right inverse of the intercalate function from Data.List, that is,

> \xs -> (intercalate xs . splitOn xs) === id

splitOn x . intercalate x is the identity on certain lists, but it is tricky to state the precise conditions under which this holds. (For example, it is not enough to say that x does not occur in any elements of the input list. Working out why is left as an exercise for the reader.)

splitOneOf :: (Vector v a, Eq a) => v a -> v a -> [v a] Source #

Split on any of the given elements. Equivalent to split . dropDelims . oneOf. For example:

>>> splitOneOf (BV.fromList ";.,") (BV.fromList "foo,bar;baz.glurk")
["foo","bar","baz","glurk"]

splitWhen :: Vector v a => (a -> Bool) -> v a -> [v a] Source #

Split on elements satisfying the given predicate. Equivalent to split . dropDelims . whenElt. For example:

>>> splitWhen (<0) (BV.fromList [1,3,-4,5,7,-9,0,2])
[[1,3],[5,7],[0,2]]

endBy :: (Vector v a, Eq a) => v a -> v a -> [v a] Source #

Split into chunks terminated by the given subsequence. Equivalent to split . dropFinalBlank . dropDelims . onSublist. For example:

>>> endBy (BV.fromList ";") (BV.fromList "foo;bar;baz;")
["foo","bar","baz"]

Note also that the lines function from Data.List is equivalent to endBy "n".

oneOf :: (Vector v a, Eq a) => v a -> Splitter v a Source #

A splitting strategy that splits on any one of the given elements. For example: >>> split (oneOf (BV.fromList "xyz")) (BV.fromList "aazbxyzcxd") ["aa","z","b","x","","y","","z","c","x","d"]

endByOneOf :: (Vector v a, Eq a) => v a -> v a -> [v a] Source #

Split into chunks terminated by one of the given elements. Equivalent to split . dropFinalBlank . dropDelims . oneOf. For example:

>>> endByOneOf (BV.fromList ";,") (BV.fromList "foo;bar,baz;")
["foo","bar","baz"]

wordsBy :: Vector v a => (a -> Bool) -> v a -> [v a] Source #

Split into "words", with word boundaries indicated by the given predicate. Satisfies words === wordsBy isSpace; equivalent to split . dropBlanks . dropDelims . whenElt. For example:

>>> wordsBy (=='x') (BV.fromList "dogxxxcatxbirdxx")
["dog","cat","bird"]

linesBy :: Vector v a => (a -> Bool) -> v a -> [v a] Source #

Split into "lines", with line boundaries indicated by the given predicate. Satisfies lines === linesBy (=='n'); equivalent to split . dropFinalBlank . dropDelims . whenElt. For example:

>>> linesBy (=='x') (BV.fromList "dogxxxcatxbirdxx")
["dog","","","cat","bird",""]

onSublist :: (Vector v a, Eq a) => v a -> Splitter v a Source #

A splitting strategy that splits on the given list, when it is encountered as an exact subsequence. For example:

>>> split (onSublist (BV.fromList "xyz")) (BV.fromList "aazbxyzcxd")
["aazb","xyz","cxd"]

Note that splitting on the empty list is not allowed in `vector-split`. This is a major difference between split and `vector-split`. In any case nobody should use `vector-split` to do this anyway.

whenElt :: Vector v a => (a -> Bool) -> Splitter v a Source #

A splitting strategy that splits on any elements that satisfy the given predicate. For example:

>>> split (whenElt (<0)) (BV.fromList [2,4,-3,6,-9,1])
[[2,4],[-3],[6],[-9],[1]]

dropDelims :: Vector v a => SplitList v a -> SplitList v a Source #

Drop delimiters from the output (the default is to keep them). For example,

>>> split (oneOf (BV.fromList ":")) (BV.fromList "a:b:c")
["a",":","b",":","c"]
>>> split (dropDelims . oneOf (BV.fromList ":")) (BV.fromList "a:b:c")
["a","b","c"]

keepDelimsL :: Vector v a => SplitList v a -> SplitList v a Source #

Keep delimiters in the output by prepending them to adjacent chunks. For example:

>>> split (keepDelimsL . oneOf (BV.fromList "xyz")) (BV.fromList "aazbxyzcxd")
["aa","zb","x","y","zc","xd"]

keepDelimsR :: Vector v a => SplitList v a -> SplitList v a Source #

Keep delimiters in the output by appending them to adjacent chunks. For example:

>>> split (keepDelimsR . oneOf (BV.fromList "xyz")) (BV.fromList "aazbxyzcxd")
["aaz","bx","y","z","cx","d"]

condense :: Vector v a => SplitList v a -> SplitList v a Source #

Condense multiple consecutive delimiters into one. For example:

>>> split (condense . oneOf (BV.fromList "xyz")) (BV.fromList "aazbxyzcxd")
["aa","z","b","xyz","c","x","d"]
>>> split (dropDelims . oneOf (BV.fromList "xyz")) (BV.fromList "aazbxyzcxd")
["aa","b","","","c","d"]
>>> split (condense . dropDelims . oneOf (BV.fromList "xyz")) (BV.fromList "aazbxyzcxd")
["aa","b","c","d"]

FIXME this function is not fully compatible with the Data.List.Split version.

dropInitBlank :: Vector v a => SplitList v a -> SplitList v a Source #

Don't generate a blank chunk if there is a delimiter at the beginning. For example:

>>> split (oneOf (BV.fromList ":")) (BV.fromList ":a:b")
["",":","a",":","b"]
>>> split (dropInitBlank . oneOf (BV.fromList ":")) (BV.fromList ":a:b")
[":","a",":","b"]

dropInnerBlanks :: Vector v a => SplitList v a -> SplitList v a Source #

Don't generate blank chunks between consecutive delimiters. For example:

>>> split (oneOf (BV.fromList ":")) (BV.fromList "::b:::a")
["",":","",":","b",":","",":","",":","a"]
>>> split (dropInnerBlanks . oneOf (BV.fromList ":")) (BV.fromList "::b:::a")
["",":",":","b",":",":",":","a"]

dropFinalBlank :: Vector v a => SplitList v a -> SplitList v a Source #

Don't generate a blank chunk if there is a delimiter at the end. For example:

split (oneOf (BV.fromList ":")) (BV.fromList "a:b:") ["a",":","b",":",""] split (dropFinalBlank . oneOf (BV.fromList ":")) (BV.fromList "a:b:") ["a",":","b",":"]

dropBlanks :: Vector v a => SplitList v a -> SplitList v a Source #

Drop all blank chunks from the output, and condense consecutive delimiters into one. Equivalent to dropInitBlank . dropFinalBlank . condense. For example:

>>> split (oneOf (BV.fromList ":")) (BV.fromList "::b:::a")
["",":","",":","b",":","",":","",":","a"]
>>> split (dropBlanks . oneOf (BV.fromList ":")) (BV.fromList "::b:::a")
["::","b",":::","a"]

startsWith :: (Vector v a, Eq a) => v a -> Splitter v a Source #

Make a strategy that splits a list into chunks that all start with the given subsequence (except possibly the first). Equivalent to dropInitBlank . keepDelimsL . onSublist. For example:

>>> split (startsWith (BV.fromList "app")) (BV.fromList "applyapplicativeapplaudapproachapple")
["apply","applicative","applaud","approach","apple"]

startsWithOneOf :: (Vector v a, Eq a) => v a -> Splitter v a Source #

Make a strategy that splits a list into chunks that all start with one of the given elements (except possibly the first). Equivalent to dropInitBlank . keepDelimsL . oneOf. For example:

>>> split (startsWithOneOf (BV.fromList ['A'..'Z'])) (BV.fromList "ACamelCaseIdentifier")
["A","Camel","Case","Identifier"]

endsWith :: (Vector v a, Eq a) => v a -> Splitter v a Source #

Make a strategy that splits a list into chunks that all end with the given subsequence, except possibly the last. Equivalent to dropFinalBlank . keepDelimsR . onSublist. For example:

>>> split (endsWith (BV.fromList "ly")) (BV.fromList "happilyslowlygnarlylily")
["happily","slowly","gnarly","lily"]

endsWithOneOf :: (Vector v a, Eq a) => v a -> Splitter v a Source #

Make a strategy that splits a list into chunks that all end with one of the given elements, except possibly the last. Equivalent to dropFinalBlank . keepDelimsR . oneOf. For example:

>>> split (condense . endsWithOneOf (BV.fromList ".,?! ")) (BV.fromList "Hi, there!  How are you?")
["Hi, ","there!  ","How ","are ","you?"]