Proposal: Add chop function to Data.List

Christian Maeder Christian.Maeder at dfki.de
Tue Dec 14 09:28:05 CET 2010


I seem to have this function as "replaceBy":

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)

replaceBy :: ([a] -> (b, [a])) -> [a] -> [b]
replaceBy splt =
  unfoldr (\ l -> if null l then Nothing else
     Just (splt l))

Cheers Christian

Am 13.12.2010 18:17, schrieb Lennart Augustsson:
> I would like to propose the following function for inclusion in Data.List
> 
> chop :: (a -> (b, [a]) -> [a] -> [b]
> chop _ [] = []
> chop f as = b : chop f as'
>   where (b, as') = f as
> 
> It's commonly occuring recursion pattern.  Typically chop is called
> with some function that will consume an initial prefix of the list
> and produce a value and the rest of the list.
> 
> The function is clearly related to unfoldr, but I find it more
> convenient to use in a lot of cases.
> 
> Some examples
> -------------
> 
> -- From Data.List
> group :: (Eq a) => [a] -> [[a]]
> group = chop (\ xs@(x:_) -> span (==x) xs)
> 
> -- From Data.List
> words :: String -> [String]
> words = filter (not . null) . chop (span (not . isSpace) . dropWhile
> isSpace)
> 
> -- From Data.List
> lines :: String -> [String]
> lines = chop ((id *** dropNL) . span (/= '\n'))
>   where dropNL ('\n':s) = s; dropNL s = s
> 
> -- From Data.List
> tails :: [a] -> [[a]]
> tails = (++ [[]]) . chop (\ xs@(_:xs') -> (xs, xs'))
> 
> -- From Data.List
> map f = chop (\ (x:xs) -> (f x, xs))
> 
> -- Split a list into a list of list with length n.
> splitEveryN n = chop (splitAt n)
> 
> -- Simple Haskell tokenizer
> tokenize = chop (head . lex)
> 
> 
> History
> -------
> 
> I first encountered this function around 1981 when I was talking to
> Sören Holmström about this recursion pattern and he said that he
> had also observed it and he called the function chopList.
> Ever since then I've used chopList a lot, but unfortunately I always
> have to make my own definition of this common function.
> 
> 
> 
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://www.haskell.org/mailman/listinfo/libraries



More information about the Libraries mailing list