module Utils where

import IOExts
import MArray
import Monad(ap,when,liftM2,liftM)
import Maybe(listToMaybe)
import Random
import List(partition,groupBy,sortBy)
import Concurrent

infixl 1 #, <#

type Mutable = IORef 
new       = newIORef
readRef   = readIORef
writeRef  = writeIORef
f # m     = fmap f m
mf <# mx  = mf `ap` mx

findM p [] = return Nothing
findM p (x:xs) = do
  b <- p x
  if b then return (Just x) else findM p xs

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

collectBySnd x =
    map pick .
    groupBy eqSnd .
    sortBy cmpSnd $ x
  where
    pick xys@((_,y):_) = ({-sort $-} map fst xys,y)
    pick _ = error "groupBy bug: it returned an []"


collectByFst x = map swap . collectBySnd . map swap $ x

onSnd f (_,y1) (_,y2) = f y1 y2
cmpSnd x = onSnd compare x
eqSnd x = onSnd (==) x
     


findFilter :: (a -> Bool) -> [a] -> Maybe (a,[a])
findFilter p [] = Nothing
findFilter p (x:xs)
  | p x       = return (x,xs)
  | otherwise = do
    (y,ys) <- findFilter p xs
    return (y,x:ys)

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


instance (Num a, Num b) => Num (a,b) where
  (x,y) + (a,b) = (x + a, y + b)
  (x,y) * (a,b) = (x * a, y * b)
  negate (x,y)  = (-x,-y)

  signum      (x,y) = (signum x,      signum y)
  abs         (x,y) = (abs x,         abs y)

  fromInteger x = undefined


parse :: Read a => String -> Maybe a
parse = listToMaybe . map fst . reads


compareBy f x y = compare (f x) (f y)


partitionM p [] = return ([],[])
partitionM p (x:xs) = do b <- p x 
                         (ys,ns) <- partitionM p xs 
                         return $ 
                          if b then (x:ys,ns) else (ys,x:ns)

whenM :: Monad m => m Bool -> m () -> m ()
whenM p m = do b <- p
               if b then m else return ()

unlessM :: Monad m => m Bool -> m () -> m ()
unlessM = whenM . notM
            
while :: Monad m => m Bool -> m () -> m ()
while p m = whenM p (m >> while p m)

m `untilM` p = m >> unlessM p (m `untilM` p)

repeatM m = whenM m (repeatM m)

ifM p t e = do b <- p 
               if b then t else e

andM :: Monad m => m Bool -> m Bool -> m Bool
andM p q = ifM p q (return False)

notM p = liftM not p

updArray a p f = writeArray a p . f =<< readArray a p


partitionFst xs = let (as,bs) = partition fst xs in (map snd as, map snd bs)


o `get` f     = readRef (f o)
(o `set` f) x = writeRef (f o) x
(o `upd` f) g = let r = f o in writeRef r . g =<< readRef r


spacesTo_ = foldr f ""
  where
  f ' ' xs  = '_' : xs
  f x xs    = x : xs



instance (Random a, Random b) => Random (a,b) where
  random g = let (x,g1) = random g
                 (y,g2) = random g1
             in ((x,y),g2)
  randomR ((x1,y1),(x2,y2)) g = 
    let (x,g1) = randomR (x1,x2) g
        (y,g2) = randomR (y1,y2) g1
    in ((x,y),g2)


comment prt msg = prt ("# " ++ msg)


-- take from channel
-- bool indicates if we should wait if not enough are pressent    
takeC chan _ 0        = return []
takeC chan wait n = 
  do empty <- isEmptyChan chan
     if empty && not wait
       then return []
        else do p <- readChan chan
                ps <- takeC chan wait (n-1)
                return (p:ps)

allM p []     = return True
allM p (m:ms) = p m `andM` allM p ms


linesBy      :: (a -> Bool) -> [a] -> [[a]]
linesBy p [] = []
linesBy p s  = let (l,s') = break p s
              in l : case s' of 
                       []      -> []
                       (_:s'') -> linesBy p s''