{- Copyright (c) 2011 Robert Henderson
This source file is distributed under the terms of a BSD3-style
license, which can be found in the file LICENSE at the root of
this package. -}

-- | Extends "Data.List"
--
module Data.List.Rosso1
    (module Data.List

    ,dropEachElem
    ,extractEachElem

    ,sortAndGroupOn
    ,alistCollect

    ,zipFilter

    ) where

------------------------------------------------------
import Data.List
import Data.Function


-- | Returns a list of lists, each obtained by dropping a single
-- element of the argument.
--
-- >>> dropEachElem "abcd"
-- ["bcd","acd","abd","abc"]
--
dropEachElem :: [a] -> [[a]]
dropEachElem lst = zipWith (++) (inits lst) (tail . tails $ lst)


-- | Similar to 'dropEachElem', but each output list is paired with the
-- element that was dropped.
--
-- >>> extractEachElem "abcd"
-- [('a',"bcd"),('b',"acd"),('c',"abd"),('d',"abc")]
--
extractEachElem :: [a] -> [(a, [a])]
extractEachElem lst = zip lst (dropEachElem lst)



-- | Sorts, then groups the elements of a list, using a specified key
-- function. The sorting process is stable, i.e. elements with equal
-- keys remain in the same order.
--
-- >>> sortAndGroupOn (`mod` 3) [1..10]
-- [[3,6,9],[1,4,7,10],[2,5,8]]
--
sortAndGroupOn :: Ord b => (a -> b) -> [a] -> [[a]]
sortAndGroupOn f = groupBy ((==) `on` f) . sortBy (compare `on` f)


-- | Collects together the list of values corresponding to each unique
-- key in an association list. Entries in the output list are arranged
-- in ascending order of key. The ordering of values corresponding to
-- a given key is preserved from input to output.
--
-- >>> alistCollect [(7, 'a'), (3, 'a'), (5, 'x'), (3, 'a'), (3, 'b')]
-- [(3,"aab"),(5,"x"),(7,"a")]
--
alistCollect :: Ord k => [(k, a)] -> [(k, [a])]
alistCollect = map f . sortAndGroupOn fst
    where f grp = (fst (head grp), map snd grp)



-- | Filters a list of values according to a list of corresponding
-- boolean flags.
--
-- >>> zipFilter [False, True, False, True, True] [0..]
-- [1,3,4]
--
zipFilter :: [Bool] -> [a] -> [a]
zipFilter bs xs = map snd . filter fst $ zip bs xs



-----------------------------------------------------------
{- UNIT TESTS

*Util.List1e> dropEachElem "abcd"
["bcd","acd","abd","abc"]
*Util.List1e> extractEachElem "abcd"
[('a',"bcd"),('b',"acd"),('c',"abd"),('d',"abc")]

*Util.List1e> sortAndGroupOn (`mod` 3) [1..10]
[[3,6,9],[1,4,7,10],[2,5,8]]

*Rosso.List1e> alistCollect []
[]
*Rosso.List1e> alistCollect [(7, 'a'), (3, 'a'), (5, 'x'), (3, 'a'), (3, 'b')]
[(3,"aab"),(5,"x"),(7,"a")]
*Data.List.Rosso1> alistCollect [(7, 'c'), (3, 'b'), (7, 'a'), (3, 'a'), (7, 'd')]
[(3,"ba"),(7,"cad")]

*Rosso.List1> zipFilter [False, True, False, True, True] [0..]
[1,3,4]
*Rosso.List1> zipFilter [] []
[]
*Rosso.List1> zipFilter [False, True] [5]
[]
*Rosso.List1> zipFilter [True, False] [5]
[5]

-}