module Util where
import Sort(sortLe)
import List(sort, group, groupBy, union, partition)
import NameSupply

import Trace
import IOUtil(progArgs)

infixl 3 #

(#) :: Monad m => m (a -> b) -> m a -> m b
f # m = do
   f' <- f
   m' <- m
   return (f' m')

(##) :: Functor m => (a -> b) -> m a -> m b
(##) = fmap

doTrace = elem "-debug" progArgs
doTrace2 = length (filter (== "-debug") progArgs) > 1
doFull = elem "-full" progArgs

tracex s x = if doTrace then traces s x else x
tracex2 s x = if doTrace2 then traces s x else x

traces s x = if s==s then trace s x else undefined


splitBy :: [a->Bool] -> [a] -> [[a]]
splitBy [] _ = []
splitBy (p:ps) xs = let (xs', xs'') = span p xs in xs' : splitBy ps xs''

remDup :: (Eq a) => [a] -> [a]
remDup (x:xxs@(x':_)) = if x==x' then remDup xxs else x:remDup xxs
remDup xs = xs

unzipWith :: (a -> (b,c)) -> [a] -> ([b], [c])
unzipWith f l = unzip (map f l)

unzipWith2 :: (a -> b -> (c, d)) -> [a] -> [b] -> ([c], [d])
unzipWith2 f l1 l2 = unzip (zipWith f l1 l2)

findSame :: (Ord a) => [a] -> [[a]]
findSame = filter ((>1) . length) . group . sort

findSameLe :: (a->a->Bool) -> [a] -> [[a]]
findSameLe le = filter ((>1) . length) . groupBy eq . sortLe le
	where eq x y = le x y && le y x		-- inefficient

-- this is awfully slow!
findSameEq :: (a->a->Bool) -> [a] -> [[a]]
findSameEq eq [] = []
findSameEq eq (x:xs) =
	case partition (eq x) xs of
	    ([], ns) -> findSameEq eq ns
	    (es, ns) -> (x:es) : findSameEq eq ns 

--mapFst f xys = [(f x, y) | (x,y)<-xys]

--mapSnd f xys = [(x, f y) | (x,y)<-xys]

unwordsWith d [] = ""
unwordsWith d [x] = x
unwordsWith d (x:xs) = x++d++unwordsWith d xs

checkEither :: [Either a b] -> Either [a] [b]
checkEither xs = f xs [] []
	where f [] [] rs = Right (reverse rs)
	      f [] ls _  = Left  (reverse ls)
	      f (Left l :xs) ls rs = f xs (l:ls) rs
	      f (Right r:xs) ls rs = f xs ls (r:rs)

joinByFst :: (Ord a) => [(a, b)] -> [(a, [b])]
joinByFst = map (\ xys@((x,_):_) -> (x, map snd xys)) . groupBy (\ (x,_) (y,_) -> x==y) . sortLe (\ (x,_) (y,_) -> x<=y)

joinByFstLe :: (a->a->Bool) -> [(a, b)] -> [(a, [b])]
joinByFstLe le = map (\ xys@((x,_):_) -> (x, map snd xys)) . groupBy (\ (x,_) (y,_) -> not (le x y)) . sortLe (\ (x,_) (y,_) -> le x y)

swap (x,y) = (y,x)

assert True msg v = v
assert False msg v = error ("assertion failed: "++msg)

listListNameSupply ns = map listNameSupply (listNameSupply ns)

type AList a b = [(a, b)]

firstJust :: [Maybe a] -> Maybe a
firstJust [] = Nothing
firstJust (j@(Just _):_) = j
firstJust (_:ms) = firstJust ms

breakAt x xs =
	case span (/= x) xs of
	    (ys,_:zs) -> (ys,zs)
	    p -> p

mapThd f xyzs = [(x, y, f z) | (x, y, z) <- xyzs]

concatUnzipMap f zs = 
	let (xss, yss) = unzip (map f zs)
	in  (concat xss, concat yss)

unions l = foldr union [] l

unJust (Just x) = x


rTake n = reverse . take n . reverse
rDrop n = reverse . drop n . reverse

mDefault s Nothing = s
mDefault s (Just x) = x

apFst f (x, y) = (f x, y)

apSnd f (x, y) = (x, f y)

fst3 (x,_,_) = x
snd3 (_,x,_) = x
thd  (_,_,x) = x

boolCompress [] _  = []
boolCompress _  [] = []
boolCompress (True:bs) (x:xs) = x : boolCompress bs xs
boolCompress (False:bs) (x:xs) = boolCompress bs xs

anySame :: (Ord a) => [a] -> Bool
anySame = same . sort
	where same (x:xs@(x':_)) = x == x' || same xs
	      same _ = False

allSame :: (Eq a) => [a] -> Bool
allSame [] = True
allSame (x:xs) = all (==x) xs

mkSet :: (Ord a) => [a] -> [a]
mkSet l = remDup (sort l)

findDup [] = []
findDup (x:xs) =
    case filter (== x) xs of
    [] -> findDup xs
    xs' -> x:xs'

assoc :: (Eq a) => [(a,b)] -> a -> b
assoc xys x =
    case lookup x xys of
    Just y -> y
    Nothing -> error "assoc"

sortFst xs = sortLe (\(x,_) (y,_) -> x <= y) xs

sortGroup :: (a->a->Bool) -> [a] -> [[a]]
sortGroup le = groupBy (\x y-> le x y && le y x) . sortLe le