{-# 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