-- | Useful List operations, part of the "Useful" module.
module Useful.List where

import Useful.General
import Data.List

-- | Takes a list item and splits a list around it, removing the item.
--
-- > $ explodeI "Hello there people" ' '
-- > ["Hello","there","people"]
explodeI :: Eq a => [a] -> a -> [[a]]
explodeI xs m = rmEmptyList (explode' xs m)

-- explode' :: Eq a => [a] -> a -> [[a]]
explode' [] m = []
explode' xs m = [takeWhile (!=m) xs] ++ explode' (tail' (dropWhile (!=m) xs)) m
	where
	tail' [] = []
	tail' (x:xs) = xs

-- | Alias of explodeI
splitI :: Eq a => [a] -> a -> [[a]]
splitI = explodeI
	
	
-- | Take a list item and concatinates each element of it around another given item.
--
-- > $implodeI "askjdnaskd" '!'
-- > "a!s!k!j!d!n!a!s!k!d"
implodeI :: Eq a => [a] -> a -> [a]
implodeI (x:xs) y
	|xs == [] = [x]
	|otherwise = (x : [y]) ++ (implodeI xs y)

-- | alias of implodeI
joinI :: Eq a => [a] -> a -> [a]
joinI = implodeI


-- | Takes a two lists and explodes the first into a new list, around the second. Removing the second list where it occurs.
--
-- THIS NEEDS FIXING
explode :: Eq a => [a] -> [a] -> [[a]]
explode x y = explode'' x y 0 0

-- explode'' :: Eq a => [a] -> [a] -> Int -> Int -> [[a]]
explode'' x y buff count
	|x == y  = []
	|x == [] = []
	|y == [] = [x]
	|buff == len y = (takeBefore buff (fst splut)) : ( explode'' (snd splut) y 0 0) -- If the buffer is full (match found). Then split and remove match from fst, cons onto the explode'' of the second part.
	|((x !! count) ? y) = explode'' x y (((x !! count) ?! y )+1) (count+1) -- is x !! count in y? If so then find at which position and explode'' with that +1 as the new buffer.
	|otherwise = explode'' x y 0 (count+1) -- otherwise increment the counter.
		where splut = (splitAt count x)

-- | alias of explode
split :: Eq a => [a] -> [a] -> [[a]]
split = explode


-- | Takes a list of lists and an extra list and concatinates the list of lists with the second list inbetween. When used with the empty list mimics concat
--
-- > $ implode ["helloasdad","asd hello","hello"] "!!"
-- > "helloasdad!!asd hello!!hello"
implode :: Eq a => [[a]] -> [a] -> [a]
implode x [] = concat x
implode (x:xs) y
	|xs == [] = x
	|otherwise = (x ++ y) ++ (implode xs y)

-- | Alias of implode
join :: Eq a => [[a]] -> [a] -> [a]
join = implode


-- | takes n number of items from the front of a list
--
-- > $ takeFor 5 "Hello there people"
-- > "Hello"
takeFor :: Eq a => Int -> [a] -> [a]
takeFor n x = takeFor' n x 0

takeFor' n (x:xs) c
	|xs == [] = x: []
	|c == n = []
	|otherwise = x : takeFor' n xs (c+1)

	
-- | drops n number of items from the front of a list
--
-- > $ dropFor 5 "Hello there people"
-- > " there people"
dropFor :: Eq a => Int -> [a] -> [a]
dropFor n x = dropFor' n x 0

dropFor' n (x:xs) c
	|(xs == []) && (c <= n) = []
	|(xs == []) && (c > n) = (x:xs)
	|c < n = [] ++ dropFor' n xs (c+1)
	|otherwise = x : dropFor' n xs (c+1)

	
-- | takes a number of items from a list before it reaches the index n
-- 
-- > $ takeBefore 5 "Hello there people"
-- > "Hello there p"
takeBefore :: Eq a => Int -> [a] -> [a]
takeBefore n x = takeFor' (len x - n) x 0


-- | drops a number of items from a list before it reaches the index n
--
-- > $ dropBefore 5 "Hello there people"
-- > "eople"
dropBefore :: Eq a => Int -> [a] -> [a]
dropBefore n x = dropFor' (len x - n) x 0


-- | In a list of lists this removes any occurances of the empty list. Can also be used to remove occurances of the empty string.
rmEmptyList :: Eq a =>  [[a]] -> [[a]]
rmEmptyList [] = []
rmEmptyList (x:xs)
	|x == [] = rmEmptyList xs
	|otherwise = x:(rmEmptyList xs)


-- | maps a function in depth N to the given list. map3, map4, map5 are also defined.
--
-- > $ map2 (*2) [[1,2,3,4],[1,1,1,2]]
-- > [[2,4,6,8],[2,2,2,4]]
map2 :: (a -> b) -> [[a]] -> [[b]]
map2 f x = map (map f) x
map3 f x = map (map (map f)) x
map4 f x = map (map (map (map f))) x
map5 f x = map (map (map (map (map f)))) x

-- | Replaces any occuranses of the second list, with the third list, in the first list.
--
-- > $ replace "why hello hello there" "hello" "bonjour"
-- > "why bonjour bonjour there"
replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace s [] x = s
replace [] _ _ = []
replace s find repl
    |take (length find) s == find = repl ++ (replace (drop (length find) s) find repl)
    |otherwise = [head s] ++ (replace (tail s) find repl)
	

-- | Takes a list of items and returns a list with each element in it's own single list.
--
-- > $ each "hello"
-- > ["h","e","l","l","o"]
each :: [a] -> [[a]]
each x = f x
	where
	f :: [a] -> [[a]]
	f [] = []
	f (x:xs) = [x] : f xs