Ticket #4887: MapOps.hs

File MapOps.hs, 5.5 KB (added by ross, 5 years ago)

Example uses: defining existing operations

Line 
1-- Element-wise operations from Data.Map re-defined using Locations.
2
3module MapOps where
4
5import Data.Map (Map, empty, null,
6        Location, key, before, after, assign, clear,
7        search, index, minLocation, maxLocation)
8
9import Prelude hiding (null)
10
11-- ** Insertion
12
13insert :: Ord k => k -> a -> Map k a -> Map k a
14insert k v m = assign v (snd (search k m))
15
16insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
17insertWith f k v m = case search k m of
18        (Nothing, loc) -> assign v loc
19        (Just oldv, loc) -> assign (f v oldv) loc
20
21insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
22insertWith' f k v m = case search k m of
23        (Nothing, loc) -> assign v loc
24        (Just oldv, loc) -> flip assign loc $! f v oldv
25
26insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
27insertWithKey f k v m = case search k m of
28        (Nothing, loc) -> assign v loc
29        (Just oldv, loc) -> assign (f (key loc) v oldv) loc
30
31insertWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
32insertWithKey' f k v m = case search k m of
33        (Nothing, loc) -> assign v loc
34        (Just oldv, loc) -> flip assign loc $! f (key loc) v oldv
35
36insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
37insertLookupWithKey f k v m = case search k m of
38        (Nothing, loc) -> (Nothing, assign v loc)
39        (Just oldv, loc) -> (Just oldv, assign (f (key loc) v oldv) loc)
40
41insertLookupWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
42insertLookupWithKey' f k v m = case search k m of
43        (Nothing, loc) -> (Nothing, assign v loc)
44        (Just oldv, loc) -> v' `seq` (Just oldv, assign v' loc)
45          where v' = f (key loc) v oldv
46
47-- ** Delete/Update
48
49delete :: Ord k => k -> Map k a -> Map k a
50delete k m = clear (snd (search k m))
51
52adjust :: Ord k => (a -> a) -> k -> Map k a -> Map k a
53adjust f k m = case search k m of
54        (Nothing, _) -> m
55        (Just v, loc) -> assign (f v) loc
56
57adjustWithKey :: Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
58adjustWithKey f k m = case search k m of
59        (Nothing, _) -> m
60        (Just v, loc) -> assign (f (key loc) v) loc
61
62update :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
63update f k m = case search k m of
64        (Nothing, _) -> m
65        (Just v, loc) -> maybeAssign (f v) loc
66
67updateWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
68updateWithKey f k m = case search k m of
69        (Nothing, _) -> m
70        (Just v, loc) -> maybeAssign (f (key loc) v) loc
71
72updateLookupWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
73updateLookupWithKey f k m = case search k m of
74        (Nothing, _) -> (Nothing, m)
75        (Just v, loc) -> (Just v, maybeAssign (f (key loc) v) loc)
76
77alter :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
78alter f k m = case search k m of
79        (v, loc) -> maybeAssign (f v) loc
80
81-- * Filter
82
83split :: Ord k => k -> Map k a -> (Map k a, Map k a)
84split k m = case search k m of
85        (_, loc) -> (before loc, after loc)
86
87splitLookup :: Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
88splitLookup k m = case search k m of
89        (res, loc) -> (before loc, res, after loc)
90
91-- * Indexed
92
93updateAt :: (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
94updateAt f i m = case index i m of
95        (v, loc) -> maybeAssign (f (key loc) v) loc
96
97deleteAt :: Int -> Map k a -> Map k a
98deleteAt i m = clear (snd (index i m))
99
100-- * Min/Max
101
102deleteMin :: Map k a -> Map k a
103deleteMin m
104  | null m = empty
105  | otherwise = clear (snd (minLocation m))
106
107deleteMax :: Map k a -> Map k a
108deleteMax m
109  | null m = empty
110  | otherwise = clear (snd (maxLocation m))
111
112deleteFindMin :: Map k a -> ((k, a), Map k a)
113deleteFindMin m
114  | null m = (error "Map.deleteFindMin: empty map", m)
115  | otherwise = case minLocation m of
116        (x, loc) -> ((key loc, x), clear loc)
117
118deleteFindMax :: Map k a -> ((k, a), Map k a)
119deleteFindMax m
120  | null m = (error "Map.deleteFindMax: empty map", m)
121  | otherwise = case maxLocation m of
122        (x, loc) -> ((key loc, x), clear loc)
123
124updateMin :: (a -> Maybe a) -> Map k a -> Map k a
125updateMin f m
126  | null m = m
127  | otherwise = case minLocation m of
128        (x, loc) -> maybeAssign (f x) loc
129
130updateMax :: (a -> Maybe a) -> Map k a -> Map k a
131updateMax f m
132  | null m = m
133  | otherwise = case maxLocation m of
134        (x, loc) -> maybeAssign (f x) loc
135
136updateMinWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
137updateMinWithKey f m
138  | null m = m
139  | otherwise = case minLocation m of
140        (x, loc) -> maybeAssign (f (key loc) x) loc
141
142updateMaxWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
143updateMaxWithKey f m
144  | null m = m
145  | otherwise = case maxLocation m of
146        (x, loc) -> maybeAssign (f (key loc) x) loc
147
148minView :: Map k a -> Maybe (a, Map k a)
149minView m
150  | null m = Nothing
151  | otherwise = case minLocation m of
152        (x, loc) -> Just (x, clear loc)
153
154maxView :: Map k a -> Maybe (a, Map k a)
155maxView m
156  | null m = Nothing
157  | otherwise = case maxLocation m of
158        (x, loc) -> Just (x, clear loc)
159
160minViewWithKey :: Map k a -> Maybe ((k, a), Map k a)
161minViewWithKey m
162  | null m = Nothing
163  | otherwise = case minLocation m of
164        (x, loc) -> Just ((key loc, x), clear loc)
165
166maxViewWithKey :: Map k a -> Maybe ((k, a), Map k a)
167maxViewWithKey m
168  | null m = Nothing
169  | otherwise = case maxLocation m of
170        (x, loc) -> Just ((key loc, x), clear loc)
171
172-- utility
173
174maybeAssign :: Maybe a -> Location k a -> Map k a
175maybeAssign = maybe clear assign