summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Data/CyclicBuffer.hs114
-rw-r--r--src/Data/InOrOut.hs13
-rw-r--r--src/Data/Word64RangeMap.hs193
-rw-r--r--src/Data/Word64RangeMap/Unboxed.hs195
4 files changed, 0 insertions, 515 deletions
diff --git a/src/Data/CyclicBuffer.hs b/src/Data/CyclicBuffer.hs
deleted file mode 100644
index 92b6bacc..00000000
--- a/src/Data/CyclicBuffer.hs
+++ /dev/null
@@ -1,114 +0,0 @@
1{-# LANGUAGE NamedFieldPuns #-}
2{-# LANGUAGE FlexibleContexts #-}
3module Data.CyclicBuffer {- TODO: export list -} where
4
5
6import Control.Concurrent.STM
7import Control.Monad
8import Data.Word
9import Data.Array.MArray
10import Data.Maybe
11
12data CyclicBuffer a = CyclicBuffer
13 { vwflgs :: TArray Word32 Bool -- TODO: Use TVar. TArray Word32 (TVar Bool)
14 -- This would allow updating by external code.
15 -- The TVar could be returned from dequeue
16 , pktq :: TArray Word32 (Maybe a)
17 , seqno :: TVar Word32
18 , qsize :: Word32
19 , buffend :: TVar Word32 -- on incoming, highest packet number handled + 1
20 , dropCnt :: TVar Word32
21 , totalCnt :: TVar Word32
22 }
23
24cyclicBufferViewList :: CyclicBuffer a -> STM [(Word32,a)]
25cyclicBufferViewList p = do
26 let f (n,Nothing) = Nothing
27 f (n,Just x) = Just (n,x)
28 catMaybes . map f <$> getAssocs (pktq p)
29
30getCapacity :: Applicative m => CyclicBuffer t -> m Word32
31getCapacity (CyclicBuffer { qsize }) = pure qsize
32
33getTotal :: CyclicBuffer t -> STM Word32
34getTotal (CyclicBuffer { totalCnt }) = readTVar totalCnt
35
36getDropped :: CyclicBuffer t -> STM Word32
37getDropped (CyclicBuffer { dropCnt }) = readTVar dropCnt
38
39getNextSequenceNum :: CyclicBuffer t -> STM Word32
40getNextSequenceNum (CyclicBuffer { seqno }) = readTVar seqno
41
42-- | Create a new CyclicBuffer with Overwrite on Wrap.
43new :: Word32 -- ^ Capacity of queue.
44 -> Word32 -- ^ Initial sequence number.
45 -> STM (CyclicBuffer a)
46new capacity seqstart = do
47 let cap = if capacity `mod` 2 == 0 then capacity else capacity + 1
48 q <- newArray (0,cap - 1) Nothing
49 flgs <- newArray (0,cap - 1) False
50 seqv <- newTVar seqstart
51 bufe <- newTVar 0
52 dropped <- newTVar 0
53 total <- newTVar 0
54 return CyclicBuffer
55 { vwflgs = flgs
56 , pktq = q
57 , seqno = seqv
58 , qsize = cap
59 , buffend = bufe
60 , dropCnt = dropped
61 , totalCnt = total
62 }
63
64observeOutOfBand :: CyclicBuffer a -> Word32-> STM ()
65observeOutOfBand CyclicBuffer { seqno, qsize, buffend } no = do
66 low <- readTVar seqno
67 let proj = no - low
68 -- Ignore packet if out of range.
69 when ( proj < qsize) $ do
70 modifyTVar' buffend (\be -> if be - low <= proj then no + 1 else be)
71
72
73-- | Retry until the next expected packet is enqueued. Then return it.
74dequeue :: CyclicBuffer a -> STM a
75dequeue CyclicBuffer { pktq, seqno, qsize } = do
76 i0 <- readTVar seqno
77 let i = i0 `mod` qsize
78 x <- maybe retry return =<< readArray pktq i
79 writeArray pktq i Nothing
80 modifyTVar' seqno succ
81 return x
82
83-- | Like dequeue, but just marks as viewed rather than removing
84markButNotDequeue :: CyclicBuffer a -> STM a
85markButNotDequeue CyclicBuffer { vwflgs, pktq, seqno, qsize } = do
86 i0 <- readTVar seqno
87 let i = i0 `mod` qsize
88 x <- maybe retry return =<< readArray pktq i
89 writeArray vwflgs i True
90 modifyTVar' seqno succ
91 return x
92
93-- | Enqueue a packet. If the capacity is exceeded, packets are
94-- dropped and the drop count increased accordingly.
95-- TODO: We no longer really support "out of order"
96-- So perhaps drop the num parameter
97enqueue :: CyclicBuffer a -- ^ The cyclic buffer(queue)
98 -> Word32 -- ^ Sequence number of the packet.
99 -> a -- ^ The packet.
100 -> STM ()
101enqueue CyclicBuffer{vwflgs, pktq, seqno, qsize, buffend, dropCnt, totalCnt} no x = do
102 low <- readTVar seqno
103 let proj = no - low
104 let i = no `mod` qsize
105 when (proj >= qsize) $ do
106 viewed <- readArray vwflgs i
107 when (not viewed) $
108 modifyTVar' dropCnt (+1)
109 writeArray pktq i (Just x)
110 writeArray vwflgs i False -- mark as not viewed
111 modifyTVar' totalCnt (+1)
112 writeTVar seqno (no+1)
113 modifyTVar' buffend (\be -> if be - low <= proj then no + 1 else be)
114 return ()
diff --git a/src/Data/InOrOut.hs b/src/Data/InOrOut.hs
deleted file mode 100644
index 2c14a0f9..00000000
--- a/src/Data/InOrOut.hs
+++ /dev/null
@@ -1,13 +0,0 @@
1module Data.InOrOut where
2
3
4-- | This wrapper is useful for tagging another type
5-- as being of either an In variety or an Out variety.
6--
7-- For example, incoming messages can be tagged as In
8-- and outgoing messages could be tagged as Out.
9--
10-- Another use case is tagging handles so that
11-- you only output to Out Handle and only input
12-- from In Handle.
13data InOrOut a = In a | Out a
diff --git a/src/Data/Word64RangeMap.hs b/src/Data/Word64RangeMap.hs
deleted file mode 100644
index 2e4cc8b7..00000000
--- a/src/Data/Word64RangeMap.hs
+++ /dev/null
@@ -1,193 +0,0 @@
1{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
2{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE TupleSections #-}
5-- |
6-- A Word64RangeMap is actually a sorted array of arrays
7-- but lookup is done via binary search testing the range.
8-- One way of implementing a sparse array i suppose.
9module Data.Word64RangeMap where
10
11import Data.Word
12import Data.Array.Unboxed
13import qualified Data.Array.MArray as MA
14import Data.Array.MArray (MArray(..))
15import Data.Reference
16import Debug.Trace
17import Control.Concurrent.STM
18import Data.Array.IO
19import Data.IORef
20
21type OuterIndex = Int
22type Index = Word64
23type InnerArray b = Array Index b
24
25-- | Although this type includes a parameter for index, the code assumes bounds start at 0
26-- and the index has 'Integral', and 'Num' instances.
27newtype RefArray r ma i e = RefArray (r (ma i e))
28
29-- convenient contraint kind
30type RangeArray rangeArray m b ref = (MArray rangeArray (InnerArray b) m, Reference ref m)
31-- The RangeMap type, to be used with the above constraint
32type RangeMap rangeArray b ref = RefArray ref rangeArray OuterIndex (InnerArray b)
33
34insertArrayAt :: (MA.MArray ma e m, Reference r m, Ix i, Num i, Integral i) => RefArray r ma i e -> i -> e -> m ()
35insertArrayAt (RefArray ref) pos e = do
36 ma <- readRef ref
37 (0,n) <- MA.getBounds ma -- irrefutable pattern, assume array starts at 0
38 (esBefore,esAt) <- splitAt (fromIntegral pos) <$> (getElems ma)
39 newMA <- MA.newListArray (0,n+1) (esBefore ++ [e] ++ esAt)
40 writeRef ref newMA
41
42deleteArrayAt :: (MA.MArray ma e m, Reference r m, Ix i, Num i, Integral i) => RefArray r ma i e -> i -> m ()
43deleteArrayAt (RefArray ref) pos = do
44 ma <- readRef ref
45 (0,n) <- MA.getBounds ma -- irrefutable pattern, assume array starts at 0
46 (esBefore,esAt) <- splitAt (fromIntegral pos) <$> getElems ma
47 newMA <- MA.newListArray (0,n-1) (esBefore ++ drop 1 esAt)
48 writeRef ref newMA
49
50
51-- forall (ma :: * -> * -> *) i e (r :: * -> *) (m :: * -> *).
52readRefArray :: Reference r m => RefArray r ma i e -> m (ma i e)
53readRefArray (RefArray x) = readRef x
54
55-- forall (ma :: * -> * -> *) i e (r :: * -> *) (m :: * -> *).
56writeRefArray :: Reference r m => RefArray r ma i e -> ma i e -> m ()
57writeRefArray (RefArray x) y = writeRef x y
58
59{-
60instance (Reference r m, MArray ma e m) => MArray (RefArray r ma) e m where
61 getBounds (RefArray r) = readRef r >>= Base.getBounds
62 getNumElements (RefArray r) = readRef r >>= Base.getNumElements
63 unsafeRead (RefArray r) i = readRef r >>= \x -> Base.unsafeRead x i
64 unsafeWrite (RefArray r) i e = modifyRef r (\x -> Base.unsafeWrite x i e >> return (x,()))
65-}
66
67emptySTMRangeMap :: STM (RangeMap TArray a TVar)
68emptySTMRangeMap = RefArray <$>
69 (newTVar =<<
70 newListArray (0,-1) [])
71
72-- | a sample RangeMap for easier debugging
73getX :: IO (RangeMap IOArray Word8 IORef)
74getX = RefArray <$>
75 (newIORef =<<
76 newListArray (0,2)
77 [ listArray (15,20) [15..20]
78 , listArray (100,105) [100..105]
79 , listArray (106,107) [106..107]
80 ])
81-- | a sample RangeMap for easier debugging
82getY :: IO (RangeMap IOArray Word8 IORef)
83getY = RefArray <$>
84 (newIORef =<<
85 newListArray (0,3)
86 [ listArray (0,5) [0..5]
87 , listArray (15,20) [15..20]
88 , listArray (100,105) [100..105]
89 , listArray (106,107) [106..107]
90 ])
91
92lookupArray :: RangeArray ra m b ref => Index -> RangeMap ra b ref -> m (Either OuterIndex (OuterIndex,InnerArray b))
93lookupArray i r = do
94 ra <- readRefArray r
95 (zr,nr) <- getBounds ra -- bounds of mutable range array
96 let (dr,mr) = (nr+1 - zr) `divMod` 2
97 lookupArrayHelper i r (zr+dr+mr-1) zr nr
98
99lookupArrayHelper :: RangeArray ra m b ref => Index -> RangeMap ra b ref
100 -> OuterIndex{- current position -}
101 -> OuterIndex{- smallest possible -}
102 -> OuterIndex{- largest possible -}
103 -> m (Either OuterIndex (OuterIndex,InnerArray b))
104lookupArrayHelper i r pos min max = do
105 {- trace ("lookupArrayHelper " ++ show i ++ " "
106 ++ "ra "
107 ++ show pos ++ " "
108 ++ show min ++ " "
109 ++ show max) (return ()) -}
110 ra <- readRefArray r
111 ca <- MA.readArray ra pos -- current array
112 let beforeOrAfter i (x,y) | i < x = LT
113 beforeOrAfter i (x,y) | i > y = GT
114 beforeOrAfter _ _ = EQ
115 avg a b = (a + b) `divMod` 2
116 isUnequalMod2 a b = if a `mod` 2 /= b `mod` 2 then 1 else 0
117 f a b recurse finish
118 = let (pos',r) = avg a b
119 u = isUnequalMod2 r (max - min) {- trace ("u = " ++ show t
120 ++ " min=" ++ show min
121 ++ " max=" ++ show max
122 ++ " pos'=" ++ show pos'
123 ++ " r=" ++ show r
124 ) t -}
125 in if max - min + u > 1 && pos' /= pos then recurse pos' r else finish
126 s = "beforeOrAfter " ++ show i ++ " " ++ show (bounds ca) ++ " --> "
127 checkAndReturn pos = do
128 boundsRA <- getBounds ra
129 case beforeOrAfter pos boundsRA of
130 EQ -> do
131 a <- MA.readArray ra pos
132 {- trace ("checkAndReturn " ++ show pos ++ " bounds a= " ++ show (bounds a)) (return ()) -}
133 case beforeOrAfter i (bounds a) of
134 EQ -> {- trace "EQ" $ -} return (Right (pos,a))
135 LT -> {- trace "LT" $ -} return (Left pos)
136 GT -> {- trace "GT" $ -} return (Left (pos+1))
137 LT -> {- trace "LT" $ -} return (Left pos)
138 GT -> {- trace "GT" $ -} return (Left (pos+1))
139 case beforeOrAfter i (bounds ca) of
140 GT -> {- trace (s ++ "GT") $ -} f pos max (\pos' r' -> lookupArrayHelper i r (pos'+r') pos max) (checkAndReturn (pos + 1))
141 LT -> {- trace (s ++ "LT") $ -} f min pos (\pos' r' -> lookupArrayHelper i r pos' min pos) (checkAndReturn pos)
142 EQ -> {- trace (s ++ "EQ") $ -} return (Right (pos,ca))
143
144insertWhereItGoes :: RangeArray ra m e ref => InnerArray e -> RangeMap ra e ref -> m (Either (OuterIndex, InnerArray e) ())
145insertWhereItGoes e r = do
146 let (i,j) = bounds e
147 outerArray <- readRefArray r
148 (outerZ,outerN) <- MA.getBounds outerArray
149 let inside x (low,hi) = x >= low && x <= hi -- flip inRange
150 lr <- lookupArray i r
151 case lr of
152 Left ii ->
153 trace "(insertWhereItGoes) Left ii case"
154 $if ii <= outerN -- is there a next array?
155 then do
156 y <- MA.readArray outerArray (ii)
157 let boundsy = show (bounds y)
158 insideStr = show j ++ " inside " ++ boundsy
159 outsideStr = show j ++ " outside " ++ boundsy
160 if j `inside` bounds y -- does the final bound of inserted array overlap next array?
161 then trace insideStr $ return (Left (ii,y)) -- TODO, actually could shrink y or e
162 else trace outsideStr $ Right <$> insertArrayAt r ii e
163 else Right <$> insertArrayAt r ii e
164 Right x ->
165 trace "(insertWhereItGoes) Right x case"
166 $return (Left x)
167
168lookupInRangeMap :: RangeArray ra m e ref => Index -> RangeMap ra e ref -> m (Maybe e)
169lookupInRangeMap k r = do
170 b <- lookupArray k r
171 case b of
172 Right (_,ar) -> return (Just (ar ! k))
173 Left _ -> return Nothing
174
175
176deleteRange :: RangeArray ra m e ref => (Index,Index)
177 -> RangeMap ra e ref
178 -> m (Either OuterIndex (OuterIndex,InnerArray e))
179
180deleteRange (z,n) r = do
181 result <- lookupArray z r
182 case result of
183 Left _ -> return result
184 Right (outerIndex,a) | bounds a /= (z,n) -> return (Left outerIndex)
185 Right (outerIndex,a) | bounds a == (z,n) -> do
186 outerArray <- readRefArray r
187 (zz,nn) <- getBounds outerArray
188 as <- map (\(i,e) -> (if i > outerIndex then i - 1 else i, e))
189 . filter ((/=outerIndex) . fst)
190 <$> getAssocs outerArray
191 mutAr <- MA.newListArray (zz,nn-1) (map snd as)
192 writeRefArray r mutAr
193 return result
diff --git a/src/Data/Word64RangeMap/Unboxed.hs b/src/Data/Word64RangeMap/Unboxed.hs
deleted file mode 100644
index 7faacb88..00000000
--- a/src/Data/Word64RangeMap/Unboxed.hs
+++ /dev/null
@@ -1,195 +0,0 @@
1{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
2{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE TupleSections #-}
5-- |
6-- A Word64RangeMap is actually a sorted array of arrays
7-- but lookup is done via binary search testing the range.
8-- One way of implementing a sparse array i suppose.
9module Data.Word64RangeMap.Unboxed where
10
11import Data.Word
12import Data.Array.Unboxed
13import qualified Data.Array.MArray as MA
14import Data.Array.MArray (MArray(..))
15import qualified Data.Array.Base as Base
16import Data.Reference
17import Debug.Trace
18import Control.Concurrent.STM
19import Control.Concurrent.STM.TArray
20import Data.Array.IO
21import Data.IORef
22
23type OuterIndex = Int
24type Index = Word64
25type InnerArray b = UArray Index b
26
27-- | Although this type includes a parameter for index, the code assumes bounds start at 0
28-- and the index has 'Integral', and 'Num' instances.
29newtype RefArray r ma i e = RefArray (r (ma i e))
30
31-- convenient contraint kind
32type RangeArray rangeArray m b ref = (IArray UArray b, MArray rangeArray (InnerArray b) m, Reference ref m)
33-- The RangeMap type, to be used with the above constraint
34type RangeMap rangeArray b ref = RefArray ref rangeArray OuterIndex (InnerArray b)
35
36insertArrayAt :: (MA.MArray ma e m, Reference r m, Ix i, Num i, Integral i) => RefArray r ma i e -> i -> e -> m ()
37insertArrayAt (RefArray ref) pos e = do
38 ma <- readRef ref
39 (0,n) <- MA.getBounds ma -- irrefutable pattern, assume array starts at 0
40 (esBefore,esAt) <- splitAt (fromIntegral pos) <$> (getElems ma)
41 newMA <- MA.newListArray (0,n+1) (esBefore ++ [e] ++ esAt)
42 writeRef ref newMA
43
44deleteArrayAt :: (MA.MArray ma e m, Reference r m, Ix i, Num i, Integral i) => RefArray r ma i e -> i -> m ()
45deleteArrayAt (RefArray ref) pos = do
46 ma <- readRef ref
47 (0,n) <- MA.getBounds ma -- irrefutable pattern, assume array starts at 0
48 (esBefore,esAt) <- splitAt (fromIntegral pos) <$> getElems ma
49 newMA <- MA.newListArray (0,n-1) (esBefore ++ drop 1 esAt)
50 writeRef ref newMA
51
52
53-- forall (ma :: * -> * -> *) i e (r :: * -> *) (m :: * -> *).
54readRefArray :: Reference r m => RefArray r ma i e -> m (ma i e)
55readRefArray (RefArray x) = readRef x
56
57-- forall (ma :: * -> * -> *) i e (r :: * -> *) (m :: * -> *).
58writeRefArray :: Reference r m => RefArray r ma i e -> ma i e -> m ()
59writeRefArray (RefArray x) y = writeRef x y
60
61{-
62instance (Reference r m, MArray ma e m) => MArray (RefArray r ma) e m where
63 getBounds (RefArray r) = readRef r >>= Base.getBounds
64 getNumElements (RefArray r) = readRef r >>= Base.getNumElements
65 unsafeRead (RefArray r) i = readRef r >>= \x -> Base.unsafeRead x i
66 unsafeWrite (RefArray r) i e = modifyRef r (\x -> Base.unsafeWrite x i e >> return (x,()))
67-}
68
69emptySTMRangeMap :: STM (RangeMap TArray a TVar)
70emptySTMRangeMap = RefArray <$>
71 (newTVar =<<
72 newListArray (0,-1) [])
73
74-- | a sample RangeMap for easier debugging
75getX :: IO (RangeMap IOArray Word8 IORef)
76getX = RefArray <$>
77 (newIORef =<<
78 newListArray (0,2)
79 [ listArray (15,20) [15..20]
80 , listArray (100,105) [100..105]
81 , listArray (106,107) [106..107]
82 ])
83-- | a sample RangeMap for easier debugging
84getY :: IO (RangeMap IOArray Word8 IORef)
85getY = RefArray <$>
86 (newIORef =<<
87 newListArray (0,3)
88 [ listArray (0,5) [0..5]
89 , listArray (15,20) [15..20]
90 , listArray (100,105) [100..105]
91 , listArray (106,107) [106..107]
92 ])
93
94lookupArray :: RangeArray ra m b ref => Index -> RangeMap ra b ref -> m (Either OuterIndex (OuterIndex,InnerArray b))
95lookupArray i r = do
96 ra <- readRefArray r
97 (zr,nr) <- getBounds ra -- bounds of mutable range array
98 let (dr,mr) = (nr+1 - zr) `divMod` 2
99 lookupArrayHelper i r (zr+dr+mr-1) zr nr
100
101lookupArrayHelper :: RangeArray ra m b ref => Index -> RangeMap ra b ref
102 -> OuterIndex{- current position -}
103 -> OuterIndex{- smallest possible -}
104 -> OuterIndex{- largest possible -}
105 -> m (Either OuterIndex (OuterIndex,InnerArray b))
106lookupArrayHelper i r pos min max = do
107 {- trace ("lookupArrayHelper " ++ show i ++ " "
108 ++ "ra "
109 ++ show pos ++ " "
110 ++ show min ++ " "
111 ++ show max) (return ()) -}
112 ra <- readRefArray r
113 ca <- MA.readArray ra pos -- current array
114 let beforeOrAfter i (x,y) | i < x = LT
115 beforeOrAfter i (x,y) | i > y = GT
116 beforeOrAfter _ _ = EQ
117 avg a b = (a + b) `divMod` 2
118 isUnequalMod2 a b = if a `mod` 2 /= b `mod` 2 then 1 else 0
119 f a b recurse finish
120 = let (pos',r) = avg a b
121 u = isUnequalMod2 r (max - min) {- trace ("u = " ++ show t
122 ++ " min=" ++ show min
123 ++ " max=" ++ show max
124 ++ " pos'=" ++ show pos'
125 ++ " r=" ++ show r
126 ) t -}
127 in if max - min + u > 1 && pos' /= pos then recurse pos' r else finish
128 s = "beforeOrAfter " ++ show i ++ " " ++ show (bounds ca) ++ " --> "
129 checkAndReturn pos = do
130 boundsRA <- getBounds ra
131 case beforeOrAfter pos boundsRA of
132 EQ -> do
133 a <- MA.readArray ra pos
134 {- trace ("checkAndReturn " ++ show pos ++ " bounds a= " ++ show (bounds a)) (return ()) -}
135 case beforeOrAfter i (bounds a) of
136 EQ -> {- trace "EQ" $ -} return (Right (pos,a))
137 LT -> {- trace "LT" $ -} return (Left pos)
138 GT -> {- trace "GT" $ -} return (Left (pos+1))
139 LT -> {- trace "LT" $ -} return (Left pos)
140 GT -> {- trace "GT" $ -} return (Left (pos+1))
141 case beforeOrAfter i (bounds ca) of
142 GT -> {- trace (s ++ "GT") $ -} f pos max (\pos' r' -> lookupArrayHelper i r (pos'+r') pos max) (checkAndReturn (pos + 1))
143 LT -> {- trace (s ++ "LT") $ -} f min pos (\pos' r' -> lookupArrayHelper i r pos' min pos) (checkAndReturn pos)
144 EQ -> {- trace (s ++ "EQ") $ -} return (Right (pos,ca))
145
146insertWhereItGoes :: RangeArray ra m e ref => InnerArray e -> RangeMap ra e ref -> m (Either (OuterIndex, InnerArray e) ())
147insertWhereItGoes e r = do
148 let (i,j) = bounds e
149 outerArray <- readRefArray r
150 (outerZ,outerN) <- MA.getBounds outerArray
151 let inside x (low,hi) = x >= low && x <= hi -- flip inRange
152 lr <- lookupArray i r
153 case lr of
154 Left ii ->
155 trace "(insertWhereItGoes) Left ii case"
156 $if ii <= outerN -- is there a next array?
157 then do
158 y <- MA.readArray outerArray (ii)
159 let boundsy = show (bounds y)
160 insideStr = show j ++ " inside " ++ boundsy
161 outsideStr = show j ++ " outside " ++ boundsy
162 if j `inside` bounds y -- does the final bound of inserted array overlap next array?
163 then trace insideStr $ return (Left (ii,y)) -- TODO, actually could shrink y or e
164 else trace outsideStr $ Right <$> insertArrayAt r ii e
165 else Right <$> insertArrayAt r ii e
166 Right x ->
167 trace "(insertWhereItGoes) Right x case"
168 $return (Left x)
169
170lookupInRangeMap :: RangeArray ra m e ref => Index -> RangeMap ra e ref -> m (Maybe e)
171lookupInRangeMap k r = do
172 b <- lookupArray k r
173 case b of
174 Right (_,ar) -> return (Just (ar ! k))
175 Left _ -> return Nothing
176
177
178deleteRange :: RangeArray ra m e ref => (Index,Index)
179 -> RangeMap ra e ref
180 -> m (Either OuterIndex (OuterIndex,InnerArray e))
181
182deleteRange (z,n) r = do
183 result <- lookupArray z r
184 case result of
185 Left _ -> return result
186 Right (outerIndex,a) | bounds a /= (z,n) -> return (Left outerIndex)
187 Right (outerIndex,a) | bounds a == (z,n) -> do
188 outerArray <- readRefArray r
189 (zz,nn) <- getBounds outerArray
190 as <- map (\(i,e) -> (if i > outerIndex then i - 1 else i, e))
191 . filter ((/=outerIndex) . fst)
192 <$> getAssocs outerArray
193 mutAr <- MA.newListArray (zz,nn-1) (map snd as)
194 writeRefArray r mutAr
195 return result
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 13:57:16 +0000