--              Copyright (c) 1996 - 2004 Tim Barbour.

--	$Id$	
module Utils (
       noDups, remDups, dropFields, dropGiven, takes, passHead, passLast, slideWith, 
       isSublist, sameLength, shorter, longer, takeLen, dropLen,
       splitLen, bisect, unconcat, ensureHasLeading, ensureHasTrailing, justs,
       maybeToBool, maybesToBools, enumerateTrue, enumerateSuch, section, unmerge, merge,
       interleave
       ) where
import List

noDups :: Ord a => [a] -> Bool
noDups = all not . slideWith (==) . sort

remDups :: Ord a => [a] -> [a]
remDups = map head . group . sort	

-- an interesting problem
-- maybe do it by having a sort that returns the re-ordering by list index that would sort the list
-- then it is easy to write an unsort. Maybe use a FiniteMap
-- remDupsStable :: [a] -> [a]

-- remove unwanted fields from a line
dropFields :: [Int] -> String -> String
dropFields fs = unwords . (dropGiven fs) . words

-- remove unwanted elements from a list
dropGiven :: [Int] -> [a] -> [a]
-- dropGiven es xs = concat ((passFirst (map tail)) spans) where   -- would be more efficient than line below
dropGiven es xs = concat ((passLast (map init)) spans) where
   spans = takes (slideWith (flip (-)) bounds) xs
   bounds = sort (-1 : length xs : es)

-- generalisation of take
takes :: [Int] -> [a] -> [[a]]
takes [] _ = []
takes (n:ns) xs = as : takes ns bs where
   (as, bs) = splitAt n xs

-- modify list processing function so it passes
-- the head element through unchanged
passHead :: ([a] -> [a]) -> ([a] -> [a])
passHead f = \xs -> head xs : f (tail xs)

-- modify list processing function so it passes
-- the last element through unchanged
passLast :: ([a] -> [a]) -> ([a] -> [a])
passLast f = \xs -> f (init xs) ++ [last xs]

-- slide the given function along a list
slideWith :: (a -> a -> b) -> [a] -> [b]
slideWith _ []         = []
slideWith _ [_]        = []
slideWith f (a1:a2:as) = f a1 a2 : slideWith f (a2:as)

isPrefix :: Eq a => [a] -> [a] -> Bool
isPrefix []     []    = True
isPrefix []     (_:_) = True
isPrefix (_:_)  []    = False
isPrefix (x:xs) (y:ys) | x == y = isPrefix xs ys
isPrefix (_:_)  (_:_)           = False

-- performance is quadratic in the worst case. Boyer-Moore would be better
isSublist :: Eq a => [a] -> [a] -> Bool
isSublist [] _          = True
isSublist _  []         = False
isSublist xs ys@(_:ys') = isPrefix xs ys || isSublist xs ys'

sameLength :: [a] -> [b] -> Bool
sameLength []     []     = True
sameLength (_:_)  []     = False
sameLength []     (_:_)  = False
sameLength (_:xs) (_:ys) = sameLength xs ys

shorter :: [a] -> [b] -> Bool
shorter []     []     = False
shorter (_:_)  []     = False
shorter []     (_:_)  = True
shorter (_:xs) (_:ys) = shorter xs ys

longer :: [a] -> [b] -> Bool
longer = flip shorter

takeLen :: [a] -> [b] -> [b]
takeLen []     []      =  []
takeLen []     (_:_)   =  []
takeLen (_:_)  []      =  []
takeLen (_:ls) (x:xs)  =  x : takeLen ls xs

dropLen :: [a] -> [b] -> [b]
dropLen []     []     = []
dropLen []     xs     = xs
dropLen (_:_)  []     = []
dropLen (_:ls) (_:xs) = dropLen ls xs

splitLen :: [a] -> [b] -> ([b],[b])
splitLen []     []     = ([],[])
splitLen []     xs     = ([],xs)
splitLen (_:_)  []     = ([],[])
splitLen (_:ls) (x:xs) = (x:xs',xs'') where (xs',xs'') = splitLen ls xs

bisect :: [a] -> ([a],[a])
bisect xs = splitAt (length xs `div` 2) xs

unconcat :: [[a]] -> [b] -> [[b]]
unconcat xss ys = map fst (scanl splitOne ([], ys) xss) where
                     splitOne (_, zs) ts = splitLen ts zs

ensureHasLeading :: Eq a => a -> [a] -> [a]
ensureHasLeading x xs@(y : _) | y == x = xs
ensureHasLeading x xs@(_    )          = x : xs

ensureHasTrailing :: Eq a => a -> [a] -> [a]
ensureHasTrailing x = reverse . ensureHasLeading x . reverse

justs :: [Maybe a] -> [a]
justs = concat . map (maybe [] (: []))

maybeToBool :: Maybe a -> Bool
maybeToBool = maybe False (const True)

maybesToBools :: [Maybe a] -> [Bool]
maybesToBools = map maybeToBool

enumerateSuch :: (a -> Bool) -> [a] -> [Int]
enumerateSuch p = map fst . filter (p . snd) . zip [0..]

enumerateTrue :: [Bool] -> [Int]
enumerateTrue = enumerateSuch id

-- + need precondition that length xs `mod` n == 0
groupsOf :: Int -> [a] -> [[a]]
groupsOf _ [] = []
groupsOf n xs@(_:_) = let (as, bs) = splitAt n xs in as : groupsOf n bs

-- + need precondition that length xs `mod` n == 0
section :: Int -> [a] -> [[a]]
section n xs = takes ((take n . repeat) (length xs `div` n)) xs

unmerge :: Int -> [a] -> [[a]]
unmerge n = transpose . groupsOf n

merge :: [[a]] -> [a]
merge = concat . transpose

interleave :: Int -> [a] -> [a]
interleave n = merge . section n