{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving, UndecidableInstances #-}
module LineStorage where

import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Maybe
import Data.Array.IO
import Control.Monad
import Data.Array.Unboxed
import Data.IORef
import Foreign.StablePtr

newtype StorageList e = ListStorage [e] deriving (Show) -- e = Storage or Word
type StorageMap = IntMap
type StorageArray = IOArray Int
newtype StorageGrowableArray e = SGA (IORef (UArray Int e)) 
--deriving instance Show (IORef (UArray Int e)) => Show (StorageGrowableArray e)

class LineStorage s where
  add :: (s e) -> e -> (s e)
  get :: (s e) -> Int -> e
  set :: (s e) -> Int -> e -> (s e)
  len :: (s e) -> Int
  
instance LineStorage StorageList where
  add (ListStorage s) e = ListStorage (s ++ [e])
  get (ListStorage s) i = s !! i
  set (ListStorage s) i e 
    | i >= l || i < 0 = error "Index out of bounds"
    | otherwise = ListStorage $ (take i s) ++ [e] ++ (drop (i+1) s)
      where l = len (ListStorage s)
  len (ListStorage s) = length s

instance LineStorage StorageMap where
  add m e = IntMap.insert (len m) e m
  get m i = x
    where Just x = IntMap.lookup i m
  set m i e = IntMap.insert i e m
  len m = IntMap.size m

class SortableMutableLineStorage s m where
  ini_ :: IArray UArray e => Int -> [e] -> m (s e)
  --add_ :: (s e) -> e -> m (s e)
  get_ :: IArray UArray e => (s e) -> Int -> m e
  set_ :: IArray UArray e => (s e) -> Int -> e -> m ()
  len_ :: IArray UArray e => (s e) -> m Int
  --sort_ :: IArray UArray e => (s e) -> ([e] -> [e]) -> m ()
  --list :: (Show e, IArray UArray e) => (s (StablePtr e)) -> m String
instance SortableMutableLineStorage StorageArray IO where
  ini_ i e = newListArray (1, i) e
  {-add_ a e = do oldElems <- getElems a
                oldBounds <- getBounds a
                let oldLen = snd oldBounds
                a <- newListArray (1, oldLen + 1) oldElems
                writeArray a (oldLen+1) e
                return a-}
  get_ a i = readArray a i
  set_ a i e = writeArray a i e
  len_ a = liftM snd $ getBounds a
  
class ExpandableMutableLineStorage s m where
  add_ :: IArray UArray e => (s e) -> e -> m ()

instance ExpandableMutableLineStorage StorageGrowableArray IO where
  add_ (SGA r) e = 
    do a <- readIORef r
       let els = elems a
           new = listArray (1, (length els) + 1) (els ++ [e])
       writeIORef r new

instance SortableMutableLineStorage StorageGrowableArray IO where
  ini_ i e = do
    --ptrs <- mapM newStablePtr 
    r <- newIORef $ listArray (1, i) e
    return $ SGA r
  get_ (SGA r) i = 
    do a <- readIORef r
       return $ a ! i
  set_ (SGA r) i e =
    do a <- readIORef r
       writeIORef r $ a // [(i, e)]
  len_ (SGA r) =
    do a <- readIORef r
       let ins = indices a
       return $ length ins
  {-sort_ (SGA r) f =
    do a <- readIORef r
       let els = elems a
           new = listArray (1, length els) $ f els
       writeIORef r new-}
--instance Show (StorageGrowableArray e) where

class SortingIterator s m where
  next :: IArray UArray e => (s e) -> e -> e
  hasNext :: IArray UArray e => (s e) -> e -> Bool
  setElem :: IArray UArray e => (s e) -> e -> m ()

--instance SortingIterator StorageGrowableArray State where