--------------------------------------------------------------------
-- |
-- Module    : Data.List.Grouping
-- Copyright : (c) Brandon Simmons
-- License   : BSD3
--
-- Maintainer:  Brandon Simmons <brandon.m.simmons@gmail.com>
-- Stability :  experimental
-- Portability: portable
--
-- Provides functions for the awkward task of dividing a list into 
-- sub-lists, based on some predicate function, or based on some integer
-- offset (e.g. dividing a list into lists of three elements each.
--
-- We could abstract out some common patterns, but I want the code to 
-- be copy-and-pasteable. I'm hoping that this module can eventually
-- contain the most efficient implementation possible of these functions,
-- and would appreciate any suggestions or patches. Please also send
-- any suggestions for other useful list-grouping functions.
--
-- Please send me any requests, bugs, or improvements to this module!
--
--------------------------------------------------------------------

module Data.List.Grouping (
       
       -- * Grouping by integer offsets:
         splitEvery
       , splitWith
       , splitWithDrop

       -- * Grouping by predicate:
       , breakBefore
       , breakAfter
       , breakDrop
     
     ) where 




-- | partitions list into sub-lists of length given by the Int:
splitEvery :: Int -> [a] -> [[a]]
splitEvery _ [] = []
splitEvery n xs = as : splitEvery n bs 
     where (as,bs) = splitAt n xs




-- | partitions list into lengths corresponding the list of Ints supplied.
-- if we run out of lengths, the remaining tail is returned as last element.
splitWith :: [Int] -> [a] -> [[a]]
splitWith _  [] = []
splitWith [] xs = [xs] 
splitWith (n:ns) xs = as : splitWith ns bs
     where (as,bs) = splitAt n xs




-- | same as 'splitWith' but we drop the end of our list should we run out of
-- integer lengths.
splitWithDrop :: [Int] -> [a] -> [[a]]
splitWithDrop _  [] = []
splitWithDrop [] _  = [] 
splitWithDrop (n:ns) xs = as : splitWithDrop ns bs
     where (as,bs) = splitAt n xs




-- | partitions list before every element matching predicate:
breakBefore :: (a -> Bool) -> [a] -> [[a]]
breakBefore _ []     = []
breakBefore p (x:xs) = (x:as) : breakBefore p bs
     where (as,bs) = break p xs



-- | partitions list after every element matching predicate:
breakAfter :: (a -> Bool) -> [a] -> [[a]]
breakAfter _ [] =  []
breakAfter p xss@(x:xs)
    | p x        =  [x] : breakAfter p xs
    | otherwise  =  case breakAfter p xs of
                         []      -> [xss]
                         (ys:zs) -> (x:ys) : zs



-- | partitions the list at the points matching predicate, dropping those
-- elements that match.
breakDrop :: (a -> Bool) -> [a] -> [[a]]
breakDrop p = next . break p . dropWhile p 
    where next ([], _) = []
          next (as,bs) = as : breakDrop p bs