{-# LANGUAGE FlexibleContexts #-}
module Simulation.Aivika.Trans.Vector
(Vector,
newVector,
copyVector,
vectorCount,
appendVector,
readVector,
writeVector,
vectorBinarySearch,
vectorInsert,
vectorDeleteAt,
vectorDeleteRange,
vectorDelete,
vectorDeleteBy,
vectorIndex,
vectorIndexBy,
vectorContains,
vectorContainsBy,
freezeVector) where
import Data.Array
import Control.Monad
import Simulation.Aivika.Trans.Simulation
import Simulation.Aivika.Trans.Event
import Simulation.Aivika.Trans.Ref.Base.Lazy
data Vector m a = Vector { forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef :: Ref m (Array Int (Ref m a)),
forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef :: Ref m Int,
forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCapacityRef :: Ref m Int }
newVector :: MonadRef m => Simulation m (Vector m a)
{-# INLINABLE newVector #-}
newVector :: forall (m :: * -> *) a. MonadRef m => Simulation m (Vector m a)
newVector =
do [Ref m a]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Integer
0 .. Integer
4 forall a. Num a => a -> a -> a
- Integer
1] forall a b. (a -> b) -> a -> b
$ \Integer
i -> forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. HasCallStack => a
undefined
let arr :: Array Int (Ref m a)
arr = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0, Int
4 forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Ref m a]
xs
Ref m (Array Int (Ref m a))
arrRef <- forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a b. (a -> b) -> a -> b
$! Array Int (Ref m a)
arr
Ref m Int
countRef <- forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a b. (a -> b) -> a -> b
$! Int
0
Ref m Int
capacityRef <- forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a b. (a -> b) -> a -> b
$! Int
4
forall (m :: * -> *) a. Monad m => a -> m a
return Vector { vectorArrayRef :: Ref m (Array Int (Ref m a))
vectorArrayRef = Ref m (Array Int (Ref m a))
arrRef,
vectorCountRef :: Ref m Int
vectorCountRef = Ref m Int
countRef,
vectorCapacityRef :: Ref m Int
vectorCapacityRef = Ref m Int
capacityRef }
copyVector :: MonadRef m => Vector m a -> Event m (Vector m a)
{-# INLINABLE copyVector #-}
copyVector :: forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Event m (Vector m a)
copyVector Vector m a
vector =
do Array Int (Ref m a)
arr <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef Vector m a
vector)
Int
count <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector)
[Ref m a]
xs' <-
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0 .. Int
count forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i ->
do a
x <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! Int
i)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef a
x
let arr' :: Array Int (Ref m a)
arr' = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0, Int
count forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Ref m a]
xs'
Ref m (Array Int (Ref m a))
arrRef' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a b. (a -> b) -> a -> b
$! Array Int (Ref m a)
arr'
Ref m Int
countRef' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a b. (a -> b) -> a -> b
$! Int
count
Ref m Int
capacityRef' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a b. (a -> b) -> a -> b
$! Int
count
forall (m :: * -> *) a. Monad m => a -> m a
return Vector { vectorArrayRef :: Ref m (Array Int (Ref m a))
vectorArrayRef = Ref m (Array Int (Ref m a))
arrRef',
vectorCountRef :: Ref m Int
vectorCountRef = Ref m Int
countRef',
vectorCapacityRef :: Ref m Int
vectorCapacityRef = Ref m Int
capacityRef' }
vectorEnsureCapacity :: MonadRef m => Vector m a -> Int -> Event m ()
{-# INLINABLE vectorEnsureCapacity #-}
vectorEnsureCapacity :: forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Int -> Event m ()
vectorEnsureCapacity Vector m a
vector Int
capacity =
do Int
capacity' <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCapacityRef Vector m a
vector)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
capacity' forall a. Ord a => a -> a -> Bool
< Int
capacity) forall a b. (a -> b) -> a -> b
$
do Array Int (Ref m a)
arr' <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef Vector m a
vector)
Int
count' <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector)
let capacity'' :: Int
capacity'' = forall a. Ord a => a -> a -> a
max (Int
2 forall a. Num a => a -> a -> a
* Int
capacity') Int
capacity
[Ref m a]
xs'' <-
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0 .. Int
capacity'' forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i ->
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. HasCallStack => a
undefined
let arr'' :: Array Int (Ref m a)
arr'' = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0, Int
capacity'' forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Ref m a]
xs''
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
count' forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i ->
do a
x <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Array Int (Ref m a)
arr' forall i e. Ix i => Array i e -> i -> e
! Int
i)
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Array Int (Ref m a)
arr'' forall i e. Ix i => Array i e -> i -> e
! Int
i) a
x
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef Vector m a
vector) forall a b. (a -> b) -> a -> b
$! Array Int (Ref m a)
arr''
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCapacityRef Vector m a
vector) forall a b. (a -> b) -> a -> b
$! Int
capacity''
vectorCount :: MonadRef m => Vector m a -> Event m Int
{-# INLINABLE vectorCount #-}
vectorCount :: forall (m :: * -> *) a. MonadRef m => Vector m a -> Event m Int
vectorCount Vector m a
vector = forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector)
appendVector :: MonadRef m => Vector m a -> a -> Event m ()
{-# INLINABLE appendVector #-}
appendVector :: forall (m :: * -> *) a. MonadRef m => Vector m a -> a -> Event m ()
appendVector Vector m a
vector a
item =
do Int
count <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector)
forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Int -> Event m ()
vectorEnsureCapacity Vector m a
vector (Int
count forall a. Num a => a -> a -> a
+ Int
1)
Array Int (Ref m a)
arr <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef Vector m a
vector)
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! Int
count) forall a b. (a -> b) -> a -> b
$! a
item
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector) forall a b. (a -> b) -> a -> b
$! (Int
count forall a. Num a => a -> a -> a
+ Int
1)
readVector :: MonadRef m => Vector m a -> Int -> Event m a
{-# INLINABLE readVector #-}
readVector :: forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Int -> Event m a
readVector Vector m a
vector Int
index =
do Array Int (Ref m a)
arr <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef Vector m a
vector)
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! Int
index)
writeVector :: MonadRef m => Vector m a -> Int -> a -> Event m ()
{-# INLINABLE writeVector #-}
writeVector :: forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Int -> a -> Event m ()
writeVector Vector m a
vector Int
index a
item =
do Array Int (Ref m a)
arr <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef Vector m a
vector)
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! Int
index) forall a b. (a -> b) -> a -> b
$! a
item
vectorBinarySearch' :: (MonadRef m, Ord a) => Array Int (Ref m a) -> a -> Int -> Int -> Event m Int
{-# INLINABLE vectorBinarySearch' #-}
vectorBinarySearch' :: forall (m :: * -> *) a.
(MonadRef m, Ord a) =>
Array Int (Ref m a) -> a -> Int -> Int -> Event m Int
vectorBinarySearch' Array Int (Ref m a)
arr a
item Int
left Int
right =
if Int
left forall a. Ord a => a -> a -> Bool
> Int
right
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ - (Int
right forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
- Int
1
else
do let index :: Int
index = (Int
left forall a. Num a => a -> a -> a
+ Int
right) forall a. Integral a => a -> a -> a
`div` Int
2
a
curr <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! Int
index)
if a
item forall a. Ord a => a -> a -> Bool
< a
curr
then forall (m :: * -> *) a.
(MonadRef m, Ord a) =>
Array Int (Ref m a) -> a -> Int -> Int -> Event m Int
vectorBinarySearch' Array Int (Ref m a)
arr a
item Int
left (Int
index forall a. Num a => a -> a -> a
- Int
1)
else if a
item forall a. Eq a => a -> a -> Bool
== a
curr
then forall (m :: * -> *) a. Monad m => a -> m a
return Int
index
else forall (m :: * -> *) a.
(MonadRef m, Ord a) =>
Array Int (Ref m a) -> a -> Int -> Int -> Event m Int
vectorBinarySearch' Array Int (Ref m a)
arr a
item (Int
index forall a. Num a => a -> a -> a
+ Int
1) Int
right
vectorBinarySearch :: (MonadRef m, Ord a) => Vector m a -> a -> Event m Int
{-# INLINABLE vectorBinarySearch #-}
vectorBinarySearch :: forall (m :: * -> *) a.
(MonadRef m, Ord a) =>
Vector m a -> a -> Event m Int
vectorBinarySearch Vector m a
vector a
item =
do Array Int (Ref m a)
arr <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef Vector m a
vector)
Int
count <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector)
forall (m :: * -> *) a.
(MonadRef m, Ord a) =>
Array Int (Ref m a) -> a -> Int -> Int -> Event m Int
vectorBinarySearch' Array Int (Ref m a)
arr a
item Int
0 (Int
count forall a. Num a => a -> a -> a
- Int
1)
freezeVector :: MonadRef m => Vector m a -> Event m (Array Int a)
{-# INLINABLE freezeVector #-}
freezeVector :: forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Event m (Array Int a)
freezeVector Vector m a
vector =
do Array Int (Ref m a)
arr <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef Vector m a
vector)
Int
count <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector)
[a]
xs' <-
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0 .. Int
count forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i ->
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! Int
i)
let arr' :: Array Int a
arr' = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0, Int
count forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [a]
xs'
forall (m :: * -> *) a. Monad m => a -> m a
return Array Int a
arr'
vectorInsert :: MonadRef m => Vector m a -> Int -> a -> Event m ()
{-# INLINABLE vectorInsert #-}
vectorInsert :: forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Int -> a -> Event m ()
vectorInsert Vector m a
vector Int
index a
item =
do Int
count <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
index forall a. Ord a => a -> a -> Bool
< Int
0) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"Index cannot be " forall a. [a] -> [a] -> [a]
++
[Char]
"negative: vectorInsert."
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
index forall a. Ord a => a -> a -> Bool
> Int
count) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"Index cannot be greater " forall a. [a] -> [a] -> [a]
++
[Char]
"than the count: vectorInsert."
forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Int -> Event m ()
vectorEnsureCapacity Vector m a
vector (Int
count forall a. Num a => a -> a -> a
+ Int
1)
Array Int (Ref m a)
arr <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef Vector m a
vector)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
count, Int
count forall a. Num a => a -> a -> a
- Int
1 .. Int
index forall a. Num a => a -> a -> a
+ Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i ->
do a
x <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! (Int
i forall a. Num a => a -> a -> a
- Int
1))
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! Int
i) a
x
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! Int
index) forall a b. (a -> b) -> a -> b
$! a
item
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector) forall a b. (a -> b) -> a -> b
$! (Int
count forall a. Num a => a -> a -> a
+ Int
1)
vectorDeleteAt :: MonadRef m => Vector m a -> Int -> Event m ()
{-# INLINABLE vectorDeleteAt #-}
vectorDeleteAt :: forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Int -> Event m ()
vectorDeleteAt Vector m a
vector Int
index =
do Int
count <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
index forall a. Ord a => a -> a -> Bool
< Int
0) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"Index cannot be " forall a. [a] -> [a] -> [a]
++
[Char]
"negative: vectorDeleteAt."
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
index forall a. Ord a => a -> a -> Bool
>= Int
count) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"Index must be less " forall a. [a] -> [a] -> [a]
++
[Char]
"than the count: vectorDeleteAt."
Array Int (Ref m a)
arr <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef Vector m a
vector)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
index, Int
index forall a. Num a => a -> a -> a
+ Int
1 .. Int
count forall a. Num a => a -> a -> a
- Int
2] forall a b. (a -> b) -> a -> b
$ \Int
i ->
do a
x <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! (Int
i forall a. Num a => a -> a -> a
+ Int
1))
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! Int
i) a
x
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! (Int
count forall a. Num a => a -> a -> a
- Int
1)) forall a. HasCallStack => a
undefined
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector) forall a b. (a -> b) -> a -> b
$! (Int
count forall a. Num a => a -> a -> a
- Int
1)
vectorDeleteRange :: MonadRef m
=> Vector m a
-> Int
-> Int
-> Event m ()
{-# INLINABLE vectorDeleteRange #-}
vectorDeleteRange :: forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Int -> Int -> Event m ()
vectorDeleteRange Vector m a
vector Int
index Int
len =
do Int
count <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
index forall a. Ord a => a -> a -> Bool
< Int
0) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"The first index cannot be " forall a. [a] -> [a] -> [a]
++
[Char]
"negative: vectorDeleteRange."
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
index forall a. Num a => a -> a -> a
+ Int
len forall a. Num a => a -> a -> a
- Int
1 forall a. Ord a => a -> a -> Bool
>= Int
count) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"The last index must be less " forall a. [a] -> [a] -> [a]
++
[Char]
"than the count: vectorDeleteRange."
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Ord a => a -> a -> Bool
< Int
0) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error [Char]
"Negative range length: vectorDeleteRange."
Array Int (Ref m a)
arr <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef Vector m a
vector)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
index, Int
index forall a. Num a => a -> a -> a
+ Int
1 .. (Int
count forall a. Num a => a -> a -> a
- Int
len) forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i ->
do a
x <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! (Int
i forall a. Num a => a -> a -> a
+ Int
len))
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! Int
i) a
x
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int
count forall a. Num a => a -> a -> a
- Int
len) .. Int
count forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i ->
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! Int
i) forall a. HasCallStack => a
undefined
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector) forall a b. (a -> b) -> a -> b
$! (Int
count forall a. Num a => a -> a -> a
- Int
len)
vectorIndex :: (MonadRef m, Eq a) => Vector m a -> a -> Event m Int
{-# INLINABLE vectorIndex #-}
vectorIndex :: forall (m :: * -> *) a.
(MonadRef m, Eq a) =>
Vector m a -> a -> Event m Int
vectorIndex Vector m a
vector a
item =
do Int
count <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector)
Array Int (Ref m a)
arr <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef Vector m a
vector)
let loop :: Int -> Event m Int
loop Int
index =
if Int
index forall a. Ord a => a -> a -> Bool
>= Int
count
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ -Int
1
else do a
x <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! Int
index)
if a
item forall a. Eq a => a -> a -> Bool
== a
x
then forall (m :: * -> *) a. Monad m => a -> m a
return Int
index
else Int -> Event m Int
loop forall a b. (a -> b) -> a -> b
$ Int
index forall a. Num a => a -> a -> a
+ Int
1
Int -> Event m Int
loop Int
0
vectorIndexBy :: MonadRef m => Vector m a -> (a -> Bool) -> Event m Int
{-# INLINABLE vectorIndexBy #-}
vectorIndexBy :: forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> (a -> Bool) -> Event m Int
vectorIndexBy Vector m a
vector a -> Bool
pred =
do Int
count <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m Int
vectorCountRef Vector m a
vector)
Array Int (Ref m a)
arr <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. Vector m a -> Ref m (Array Int (Ref m a))
vectorArrayRef Vector m a
vector)
let loop :: Int -> Event m Int
loop Int
index =
if Int
index forall a. Ord a => a -> a -> Bool
>= Int
count
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ -Int
1
else do a
x <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Array Int (Ref m a)
arr forall i e. Ix i => Array i e -> i -> e
! Int
index)
if a -> Bool
pred a
x
then forall (m :: * -> *) a. Monad m => a -> m a
return Int
index
else Int -> Event m Int
loop forall a b. (a -> b) -> a -> b
$ Int
index forall a. Num a => a -> a -> a
+ Int
1
Int -> Event m Int
loop Int
0
vectorDelete :: (MonadRef m, Eq a) => Vector m a -> a -> Event m Bool
{-# INLINABLE vectorDelete #-}
vectorDelete :: forall (m :: * -> *) a.
(MonadRef m, Eq a) =>
Vector m a -> a -> Event m Bool
vectorDelete Vector m a
vector a
item =
do Int
index <- forall (m :: * -> *) a.
(MonadRef m, Eq a) =>
Vector m a -> a -> Event m Int
vectorIndex Vector m a
vector a
item
if Int
index forall a. Ord a => a -> a -> Bool
>= Int
0
then do forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Int -> Event m ()
vectorDeleteAt Vector m a
vector Int
index
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
vectorDeleteBy :: MonadRef m => Vector m a -> (a -> Bool) -> Event m (Maybe a)
{-# INLINABLE vectorDeleteBy #-}
vectorDeleteBy :: forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> (a -> Bool) -> Event m (Maybe a)
vectorDeleteBy Vector m a
vector a -> Bool
pred =
do Int
index <- forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> (a -> Bool) -> Event m Int
vectorIndexBy Vector m a
vector a -> Bool
pred
if Int
index forall a. Ord a => a -> a -> Bool
>= Int
0
then do a
a <- forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Int -> Event m a
readVector Vector m a
vector Int
index
forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Int -> Event m ()
vectorDeleteAt Vector m a
vector Int
index
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
vectorContains :: (MonadRef m, Eq a) => Vector m a -> a -> Event m Bool
{-# INLINABLE vectorContains #-}
vectorContains :: forall (m :: * -> *) a.
(MonadRef m, Eq a) =>
Vector m a -> a -> Event m Bool
vectorContains Vector m a
vector a
item =
do Int
index <- forall (m :: * -> *) a.
(MonadRef m, Eq a) =>
Vector m a -> a -> Event m Int
vectorIndex Vector m a
vector a
item
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
index forall a. Ord a => a -> a -> Bool
>= Int
0)
vectorContainsBy :: MonadRef m => Vector m a -> (a -> Bool) -> Event m (Maybe a)
{-# INLINABLE vectorContainsBy #-}
vectorContainsBy :: forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> (a -> Bool) -> Event m (Maybe a)
vectorContainsBy Vector m a
vector a -> Bool
pred =
do Int
index <- forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> (a -> Bool) -> Event m Int
vectorIndexBy Vector m a
vector a -> Bool
pred
if Int
index forall a. Ord a => a -> a -> Bool
>= Int
0
then do a
a <- forall (m :: * -> *) a.
MonadRef m =>
Vector m a -> Int -> Event m a
readVector Vector m a
vector Int
index
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing