{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module      : Control.Concurrent.Classy.STM.
-- Copyright   : (c) 2016 Michael Walker
-- License     : MIT
-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
-- Stability   : stable
-- Portability : FlexibleInstances, MultiParamTypeClasses
--
-- TArrays: transactional arrays, for use in STM-like monads.
--
-- __Deviations:__ @TArray@ as defined here does not have an @Eq@
-- instance, this is because the @MonadSTM@ @TVar@ type does not have
-- an @Eq@ constraint.
module Control.Concurrent.Classy.STM.TArray (TArray) where

import           Data.Array              (Array, bounds)
import           Data.Array.Base         (IArray(numElements), MArray(..),
                                          arrEleBottom, listArray, unsafeAt)
import           Data.Ix                 (rangeSize)

import           Control.Monad.STM.Class

-- | @TArray@ is a transactional array, supporting the usual 'MArray'
-- interface for mutable arrays.
--
-- It is currently implemented as @Array ix (TVar stm e)@, but it may
-- be replaced by a more efficient implementation in the future (the
-- interface will remain the same, however).
--
-- @since 1.0.0.0
newtype TArray stm i e = TArray (Array i (TVar stm e))

-- | @since 1.0.0.0
instance MonadSTM stm => MArray (TArray stm) e stm where
  getBounds :: forall i. Ix i => TArray stm i e -> stm (i, i)
getBounds (TArray Array i (TVar stm e)
a) = (i, i) -> stm (i, i)
forall a. a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array i (TVar stm e) -> (i, i)
forall i e. Array i e -> (i, i)
bounds Array i (TVar stm e)
a)

  newArray :: forall i. Ix i => (i, i) -> e -> stm (TArray stm i e)
newArray (i, i)
b e
e =
    Array i (TVar stm e) -> TArray stm i e
forall (stm :: * -> *) i e. Array i (TVar stm e) -> TArray stm i e
TArray (Array i (TVar stm e) -> TArray stm i e)
-> ([TVar stm e] -> Array i (TVar stm e))
-> [TVar stm e]
-> TArray stm i e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, i) -> [TVar stm e] -> Array i (TVar stm e)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i, i)
b ([TVar stm e] -> TArray stm i e)
-> stm [TVar stm e] -> stm (TArray stm i e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> stm (TVar stm e) -> stm [TVar stm e]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
rep ((i, i) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (i, i)
b) (e -> stm (TVar stm e)
forall a. a -> stm (TVar stm a)
forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar e
e)

  newArray_ :: forall i. Ix i => (i, i) -> stm (TArray stm i e)
newArray_ (i, i)
b = (i, i) -> e -> stm (TArray stm i e)
forall i. Ix i => (i, i) -> e -> stm (TArray stm i e)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (i, i)
b e
forall a. a
arrEleBottom

  unsafeRead :: forall i. Ix i => TArray stm i e -> Int -> stm e
unsafeRead  (TArray Array i (TVar stm e)
a) = TVar stm e -> stm e
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar  (TVar stm e -> stm e) -> (Int -> TVar stm e) -> Int -> stm e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array i (TVar stm e) -> Int -> TVar stm e
forall i. Ix i => Array i (TVar stm e) -> Int -> TVar stm e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt Array i (TVar stm e)
a
  unsafeWrite :: forall i. Ix i => TArray stm i e -> Int -> e -> stm ()
unsafeWrite (TArray Array i (TVar stm e)
a) = TVar stm e -> e -> stm ()
forall a. TVar stm a -> a -> stm ()
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar (TVar stm e -> e -> stm ())
-> (Int -> TVar stm e) -> Int -> e -> stm ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array i (TVar stm e) -> Int -> TVar stm e
forall i. Ix i => Array i (TVar stm e) -> Int -> TVar stm e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt Array i (TVar stm e)
a

  getNumElements :: forall i. Ix i => TArray stm i e -> stm Int
getNumElements (TArray Array i (TVar stm e)
a) = Int -> stm Int
forall a. a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array i (TVar stm e) -> Int
forall i. Ix i => Array i (TVar stm e) -> Int
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> Int
numElements Array i (TVar stm e)
a)

-- | Like 'replicateM' but uses an accumulator to prevent stack overflows.
-- Unlike 'replicateM' the returned list is in reversed order.  This
-- doesn't matter though since this function is only used to create
-- arrays with identical elements.
rep :: Monad m => Int -> m a -> m [a]
rep :: forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
rep Int
n m a
m = Int -> [a] -> m [a]
forall {t}. (Eq t, Num t) => t -> [a] -> m [a]
go Int
n [] where
  go :: t -> [a] -> m [a]
go t
0 [a]
xs = [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
xs
  go t
i [a]
xs = do
    a
x <- m a
m
    t -> [a] -> m [a]
go (t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1) (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)