0 | module Data.List.Map
  1 |
  2 | import Data.List
  3 | import Data.List.Set
  4 | import Data.SortedMap
  5 |
  6 | %default total
  7 |
  8 | public export
  9 | record ListMap k v where
 10 |   constructor MkListMap
 11 |   {auto eq : Eq k}
 12 |   kvList : List (k, v)
 13 |
 14 | export
 15 | empty : Eq k => ListMap k v
 16 | empty = MkListMap empty
 17 |
 18 | export
 19 | lookup : k -> ListMap k v -> Maybe v
 20 | lookup k (MkListMap kv) = lookup k kv
 21 |
 22 | public export %inline
 23 | lookup' : ListMap k v -> k -> Maybe v
 24 | lookup' = flip lookup
 25 |
 26 | export
 27 | insert : k -> v -> ListMap k v -> ListMap k v
 28 | insert k v (MkListMap kv) = MkListMap $ (k, v) :: kv
 29 |
 30 | ||| Inserts a key value pair into a map and merges duplicated values
 31 | ||| with the given function.
 32 | export
 33 | insertWith : (v -> v -> v) -> k -> v -> ListMap k v -> ListMap k v
 34 | insertWith f k v xs =
 35 |   case lookup k xs of
 36 |     Just x  => insert k (f v x) xs
 37 |     Nothing => insert k v xs
 38 |
 39 | public export %inline
 40 | insert' : ListMap k v -> (k, v) -> ListMap k v
 41 | insert' = flip $ uncurry insert
 42 |
 43 | export
 44 | insertFrom : Foldable f => f (k, v) -> ListMap k v -> ListMap k v
 45 | insertFrom = flip $ foldl insert'
 46 |
 47 | public export %inline
 48 | insertFrom' : Foldable f => ListMap k v -> f (k, v) -> ListMap k v
 49 | insertFrom' = flip insertFrom
 50 |
 51 | ||| Inserts any foldable of a key value pair into a map and merges duplicated
 52 | ||| values with the given function.
 53 | export
 54 | insertFromWith : Foldable f => (v -> v -> v) -> f (k, v) -> ListMap k v -> ListMap k v
 55 | insertFromWith f = flip $ foldl $ flip $ uncurry $ insertWith f
 56 |
 57 | export
 58 | singleton : Eq k => k -> v -> ListMap k v
 59 | singleton = MkListMap .: curry singleton
 60 |
 61 | ||| Updates existing value, if it is present, and does nothing otherwise
 62 | |||
 63 | ||| The current implementation performs up to two traversals of the original map
 64 | export
 65 | updateExisting : (v -> v) -> k -> ListMap k v -> ListMap k v
 66 | updateExisting f k m = case lookup k m of
 67 |   Just v  => insert k (f v) m
 68 |   Nothing => m
 69 |
 70 | public export %inline
 71 | updateExisting' : ListMap k v -> (v -> v) -> k -> ListMap k v
 72 | updateExisting' m f x = updateExisting f x m
 73 |
 74 | public export %inline
 75 | fromList : Eq k => List (k, v) -> ListMap k v
 76 | fromList = MkListMap
 77 |
 78 | ||| Returns the keys from the underlying list of key–value pairs
 79 | ||| without removing duplicates or normalising the order.
 80 | public export %inline
 81 | rawKeys : ListMap k v -> List k
 82 | rawKeys = map fst . kvList
 83 |
 84 | ||| Returns the values from the underlying list of key–value pairs
 85 | ||| in their original order, without any normalisation.
 86 | public export %inline
 87 | rawValues : ListMap k v -> List v
 88 | rawValues = map snd . kvList
 89 |
 90 | export
 91 | normalise : ListMap k v -> ListMap k v
 92 | normalise (MkListMap kv) = MkListMap $ nubBy ((==) `on` fst) kv
 93 |
 94 | ||| Gets the keys of the map.
 95 | export
 96 | keys : ListMap k v -> List k
 97 | keys = rawKeys . normalise
 98 |
 99 | export
100 | keySet : ListMap k v -> ListSet k
101 | keySet m = MkListSet @{m.eq} $ rawKeys m
102 |
103 | ||| Gets the values of the map. Could contain duplicates.
104 | public export %inline
105 | values : ListMap k v -> List v
106 | values = rawValues . normalise
107 |
108 | export
109 | implementation Functor (ListMap k) where
110 |   map f (MkListMap kv) = MkListMap $ map (map f) kv
111 |
112 | export
113 | mapWithKey : (k -> a -> b) -> ListMap k a -> ListMap k b
114 | mapWithKey f = (\(MkListMap vs) => MkListMap $ vs <&> \(k, v) => (k, f k v)) . normalise
115 |
116 | export %inline
117 | mapWithKey' : ListMap k a -> (k -> a -> b) -> ListMap k b
118 | mapWithKey' = flip mapWithKey
119 |
120 | ||| Merge two maps. When encountering duplicate keys, using a function to combine the values.
121 | ||| Uses the ordering of the first map given.
122 | export
123 | mergeWith : (v -> v -> v) -> ListMap k v -> ListMap k v -> ListMap k v
124 | mergeWith f x y = insertFrom inserted x where
125 |   inserted : List (k, v)
126 |   inserted = do
127 |     (k, v) <- kvList y
128 |     let v' = (maybe id f $ lookup k x) v
129 |     pure (k, v')
130 |
131 | ||| Merge two maps using the Semigroup (and by extension, Monoid) operation.
132 | ||| Uses mergeWith internally, so the ordering of the left map is kept.
133 | export
134 | merge : Semigroup v => ListMap k v -> ListMap k v -> ListMap k v
135 | merge = mergeWith (<+>)
136 |
137 | ||| Left-biased merge, also keeps the equality specified by the left map.
138 | export
139 | mergeLeft : ListMap k v -> ListMap k v -> ListMap k v
140 | mergeLeft (MkListMap @{eq} x) (MkListMap y) = MkListMap @{eq} $ x ++ y
141 |
142 | public export %inline
143 | toSortedMap : Ord k => ListMap k v -> SortedMap k v
144 | toSortedMap = fromList . kvList
145 |
146 | export
147 | Foldable (ListMap k) where
148 |   foldr f init = foldr f init . values
149 |   foldl f init = foldl f init . values
150 |   null $ MkListMap vs = null vs
151 |   foldlM f init = foldlM f init . values
152 |   toList = values
153 |
154 | export
155 | Traversable (ListMap k) where
156 |   traverse f $ MkListMap vs = MkListMap <$> traverse (traverse f) vs
157 |
158 | export
159 | Semigroup v => Semigroup (ListMap k v) where
160 |   (<+>) = merge
161 |
162 | ||| For `neutral <+> y`, y is rebuilt in `Eq k`, so this is not a "strict" Monoid.
163 | ||| However, semantically, it should be equal.
164 | export
165 | (Ord k, Semigroup v) => Monoid (ListMap k v) where
166 |   neutral = empty
167 |
168 | export
169 | (Show k, Show v) => Show (ListMap k v) where
170 |    show m = "fromList " ++ show (kvList m)
171 |