Proposal for Data.List.splitBy
Christian Maeder
Christian.Maeder at dfki.de
Tue Feb 10 05:31:31 EST 2009
Marcus D. Gabriel wrote:
> By the way, out or curiosity, how would you generalize your current
> function replace?
I would define:
replaceBy :: ([a] -> ([b], [a])) -> [a] -> [b]
replaceBy splt l = case l of
[] -> []
_ -> let (ft, rt) = splt l in
ft ++ replaceBy splt rt
The first argument is a kind of splitting function that expects a
non-empty input list to cut of a first part and change this part to the
a replacement list of type [b]. The second part must be the rest of the
input to be processed.
The original replace function can then be defined via:
replace :: Eq a => [a] -> a -> [a] -> [a]
replace sl@(_ : _) r = replaceBy $ \ l@(hd : tl) ->
case stripPrefix sl l of
Nothing -> ([hd], tl)
Just rt -> ([r], rt)
Other replacements are also possible, i.e.
replaceDelim :: ([a] -> ([a], [a])) -> [a] -> [Either [a] a]
replaceDelim splt = replaceBy $ \ l@(hd : tl) ->
let (ft, rt) = splt l in
if null ft then ([Right hd], tl) else ([Left ft], rt)
For replaceDelim consider an input function like "span isSpace". A
sequence of spaces is grouped to a "Left String", whereas other
characters become "Right". The resulting list is suitable for my
original splitBy function yielding a list of type "[[Either [a] a]]".
This result can be further flattened to [[a]] (by the function
flatEitherSplits below).
splitByDelim :: ([a] -> ([a], [a])) -> [a] -> [[a]]
splitByDelim split =
flatEitherSplits
. splitBy (either (const True) (const False))
. replaceDelim split
As a concrete example consider:
splitBySpaces :: String -> [String]
splitBySpaces = splitByDelim (span isSpace)
splitBySpaces "ab c def"
== ["ab"," ","c"," ","def"]
For the sake of completeness I add the definition of flatEitherSplits
that exploits the result structure of splitBy and uses auxiliary functions:
flatRight :: [Either [a] a] -> [a]
flatRight = map (either (error "flatRight") id)
flatEither :: [Either [a] a] -> [[a]]
flatEither (Left d : rt) = d : [flatRight rt]
flatEitherSplits :: [[Either [a] a]] -> [[a]]
flatEitherSplits (h : tl) =
flatRight h : concatMap flatEither tl
Cheers Christian
P.S.
>> For the general case take my unintercalate below:
>>
>> splitOnAList sl = intercalate [sl] . map (: []) . unintercalate sl
By the way, this can be expressed simpler:
splitOnAList sl = intersperse sl . unintercalate sl
More information about the Libraries
mailing list