module ExtArray where
import IOExts
import Array
import List

updIOArray         :: Ix ix => IOArray ix elt -> ix -> (elt -> elt) -> IO ()
updIOArray arr i f = readIOArray arr i >>= (writeIOArray arr i . f)


type ExtArray elt = IORef (ExtArrayI elt) 
   --in newExtArray,boundsExtArray,readExtArray,writeExtArray,clearExtArray,nextExtEntry,
   --   updExtArray

data ExtArrayI elt = 
 ExtArray {sizeExt :: Int,nextExt :: Int,freeExts :: [Int],
           extArrays :: [(Int,IOArray Int (Maybe elt))]}

newExtArray          :: Int -> IO (ExtArray elt)
newExtArray max = do
 newIORef $ ExtArray max 0 [] []

boundsExtArray       :: ExtArray elt -> IO (Int,Int)
boundsExtArray ext = do
 (ExtArray {nextExt = ix}) <- readIORef ext
 return (0,ix)

readExtArray         :: ExtArray elt -> Int -> IO (Maybe elt)
readExtArray extV ix = do
 (ExtArray {freeExts = frees,sizeExt = s,extArrays = arrs}) <- readIORef extV
 let (div,mod) = ix `divMod` s
 case lookup div arrs of
  Just arr -> readIOArray arr mod 
  _ -> return Nothing

findSafe :: [a] -> Int -> Maybe a
findSafe xs n = if length xs < n + 1 then Nothing else Just $ xs !! n

writeExtArray        :: ExtArray elt -> Int -> elt -> IO ()
writeExtArray extV ix elt = do
 ext@(ExtArray {sizeExt = s,extArrays = arrs}) <- readIORef extV
 let (div,mod) = ix `divMod` s
 case lookup div arrs of
  Nothing -> do ioarr <- newIOArray (0,s) Nothing
                writeIOArray ioarr mod (Just elt)
                writeIORef extV (ext {extArrays = insertBy comp (div,ioarr) arrs})
  Just arr -> writeIOArray arr mod (Just elt)
 where comp (a,_) (b,_) = a `compare` b

updExtArray :: ExtArray elt -> Int -> (elt -> elt) -> IO ()
updExtArray extV ix f = do
 ext@(ExtArray {sizeExt = s,extArrays = arrs}) <- readIORef extV
 let (div,mod) = ix `divMod` s
 case lookup div arrs of
  Nothing -> return ()
  Just arr -> do
   eltMb <- readIOArray arr mod
   case eltMb of
    Just elt -> writeIOArray arr mod (Just $ f elt)
    Nothing -> return ()
 where comp (a,_) (b,_) = a `compare` b

clearExtArray :: ExtArray elt -> Int -> IO ()
clearExtArray extV ix = do
 ext@(ExtArray {sizeExt = s,extArrays = arrs,freeExts = frees}) <- readIORef extV
 let (div,mod) = ix `divMod` s
 case lookup div arrs of
  Nothing -> return ()
  Just arr -> do writeIOArray arr mod Nothing
                 writeIORef extV $ ext {freeExts = ix:frees}

nextExtEntry :: ExtArray elt -> IO Int
nextExtEntry extV = do
 ext@(ExtArray {nextExt = n,freeExts = frees}) <- readIORef extV
 let (n',ext') = case frees of [] -> (n,ext {nextExt = n + 1})
                               (x:xs) -> (x,ext {freeExts = xs})
 writeIORef extV $ ext'
 return n'