This repository was archived by the owner on Feb 7, 2024. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 13
Expand file tree
/
Copy pathQMap.hs
More file actions
57 lines (43 loc) · 1.97 KB
/
QMap.hs
File metadata and controls
57 lines (43 loc) · 1.97 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module NStack.Module.QMap where
import Data.Aeson
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid ((<>))
import Data.Serialize (Serialize)
import GHC.Generics (Generic)
import NStack.Module.Name (ModuleRef)
import NStack.Module.Types (Qualified(..))
import NStack.Module.Types.Aeson ()
{-
Qualified Map datatype - store values under Qualified Keys, with a simplified interface
for querying and working with them.
-}
newtype QMap k v = QMap {
inner :: Map ModuleRef (Map k v)
} deriving (Show, Functor, Generic, ToJSON, FromJSON, Eq, Ord)
instance (Serialize k, Serialize v, Ord k) => Serialize (QMap k v)
-- QMap monoid is left-biased like Map
-- This could probably be more performant if we took into account
-- the actual internal structure of the map
instance Ord k => Monoid (QMap k v) where
(QMap inner) `mappend` b =
foldl (flip $ uncurry insert) b elements
where elements = do (mod', map') <- Map.toList inner
(k, v) <- Map.toList map'
return (Qualified mod' k, v)
mempty = QMap mempty
lookup :: Ord k => Qualified k -> QMap k v -> Maybe v
lookup (Qualified mod' k) (QMap inner) = Map.lookup mod' inner >>= Map.lookup k
insert :: Ord k => Qualified k -> v -> QMap k v -> QMap k v
insert (Qualified mod' k) v (QMap inner) = QMap $ Map.insertWith f mod' (Map.singleton k v) inner
where f new old = new <> old
-- Overrides previous members
overrideModule :: Ord k => ModuleRef -> Map k v -> QMap k v -> QMap k v
overrideModule mod' members (QMap inner) = QMap $ Map.insert mod' members inner
flatten :: Ord k => QMap k v -> Map (Qualified k) v
flatten (QMap inner) = Map.foldMapWithKey (\mod' m -> Map.mapKeys (Qualified mod') m) inner
mapKeys :: Ord k2 => (k1 -> k2) -> QMap k1 v -> QMap k2 v
mapKeys f (QMap inner) = QMap $ Map.mapKeys f <$> inner
filter :: (v -> Bool) -> QMap k v -> QMap k v
filter p (QMap inner) = QMap $ Map.filter p <$> inner