{-# LANGUAGE UndecidableInstances, RankNTypes, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances#-}
module Control.Monad.Array.Class where

import qualified Control.Monad.State.Lazy as LazyS
import qualified Control.Monad.State.Strict as StrictS
import Control.Monad.Reader
import Control.Monad.List
import qualified Control.Monad.Writer.Lazy as LazyW
import qualified Control.Monad.Writer.Strict as StrictW
import Control.Monad.Maybe
import Data.Monoid
import Control.Monad(Monad(return), mapM, when)
import Prelude hiding (getContents)

-- | Type class abstraction for a monad with access to an underlying mutable array indexed by 'Int's.  Minimal implementation: 'readAt' or 'unsafeReadAt', 'writeAt' or 'unsafeWriteAt', 'getSize', 'resize' or 'ensureSize'.
class Monad m => MonadArray e m | m -> e where
	{-# INLINE readAt #-}
	{-# INLINE unsafeReadAt #-}
	{-# INLINE writeAt #-}
	{-# INLINE unsafeWriteAt #-}
	{-# INLINE replaceAt #-}
	{-# INLINE getContents #-}
	{-# INLINE getSize #-}
	{-# INLINE resize #-}
	{-# INLINE ensureSize #-}
	readAt :: Int -> m e
	unsafeReadAt :: Int -> m e
	writeAt :: Int -> e -> m ()
	unsafeWriteAt :: Int -> e -> m ()
	replaceAt :: Int -> e -> m e
	getContents :: m [e]
	getSize :: m Int
	resize :: Int -> m ()
	ensureSize :: Int -> m ()
	readAt i = 	do	n <- getSize
				if i >= 0 && i < n then unsafeReadAt i else fail "Index out of bounds"
	unsafeReadAt = 	readAt
	writeAt i x = 	do	n <- getSize
				if i >= 0 && i < n then unsafeWriteAt i x else fail "Index out of bounds"
	unsafeWriteAt = writeAt
	getContents =	do	n <- getSize
				mapM readAt [0..n-1]
	ensureSize n =	do	m <- getSize
				when (m < n) (resize n)
	resize = ensureSize
	replaceAt i x = do	y <- readAt i
				writeAt i x
				return y

instance MonadArray e m => MonadArray e (LazyS.StateT s m) where
	readAt = lift . readAt
	unsafeReadAt = lift . unsafeReadAt
	writeAt i x = lift (writeAt i x)
	unsafeWriteAt i x = lift (unsafeWriteAt i x)
	replaceAt i x = lift (replaceAt i x)
	getContents = lift getContents
	getSize = lift getSize
	resize = lift . resize
	ensureSize = lift . ensureSize

instance MonadArray e m => MonadArray e (StrictS.StateT s m) where
	readAt = lift . readAt
	unsafeReadAt = lift . unsafeReadAt
	writeAt i x = lift (writeAt i x)
	unsafeWriteAt i x = lift (unsafeWriteAt i x)
	replaceAt i x = lift (replaceAt i x)
	getContents = lift getContents
	getSize = lift getSize
	resize = lift . resize
	ensureSize = lift . ensureSize

instance MonadArray e m => MonadArray e (ReaderT r m) where
	readAt = lift . readAt
	unsafeReadAt = lift . unsafeReadAt
	writeAt i x = lift (writeAt i x)
	unsafeWriteAt i x = lift (unsafeWriteAt i x)
	replaceAt i x = lift (replaceAt i x)
	getContents = lift getContents
	getSize = lift getSize
	resize = lift . resize
	ensureSize = lift . ensureSize

instance (Monoid w, MonadArray e m) => MonadArray e (StrictW.WriterT w m) where
	readAt = lift . readAt
	unsafeReadAt = lift . unsafeReadAt
	writeAt i x = lift (writeAt i x)
	unsafeWriteAt i x = lift (unsafeWriteAt i x)
	replaceAt i x = lift (replaceAt i x)
	getContents = lift getContents
	getSize = lift getSize
	resize = lift . resize
	ensureSize = lift . ensureSize

instance (Monoid w, MonadArray e m) => MonadArray e (LazyW.WriterT w m) where
	readAt = lift . readAt
	unsafeReadAt = lift . unsafeReadAt
	writeAt i x = lift (writeAt i x)
	unsafeWriteAt i x = lift (unsafeWriteAt i x)
	replaceAt i x = lift (replaceAt i x)
	getContents = lift getContents
	getSize = lift getSize
	resize = lift . resize
	ensureSize = lift . ensureSize

instance MonadArray e m => MonadArray e (MaybeT m) where
	readAt = lift . readAt
	unsafeReadAt = lift . unsafeReadAt
	writeAt i x = lift (writeAt i x)
	unsafeWriteAt i x = lift (unsafeWriteAt i x)
	replaceAt i x = lift (replaceAt i x)
	getContents = lift getContents
	getSize = lift getSize
	resize = lift . resize
	ensureSize = lift . ensureSize

instance MonadArray e m => MonadArray e (ListT m) where
	readAt = lift . readAt
	unsafeReadAt = lift . unsafeReadAt
	writeAt i x = lift (writeAt i x)
	unsafeWriteAt i x = lift (unsafeWriteAt i x)
	replaceAt i x = lift (replaceAt i x)
	getContents = lift getContents
	getSize = lift getSize
	resize = lift . resize
	ensureSize = lift . ensureSize