diff --git a/src/Hash2Pub/RingMap.hs b/src/Hash2Pub/RingMap.hs index 529a68b..9c7f63b 100644 --- a/src/Hash2Pub/RingMap.hs +++ b/src/Hash2Pub/RingMap.hs @@ -10,31 +10,31 @@ import Data.Maybe (fromJust, isJust, isNothing, mapMaybe) -- | Class for all types that can be identified via a EpiChord key. -- Used for restricting the types a 'RingMap' can store -class (Eq a, Show a, Bounded k, Ord k) => HasKeyID a k where +class (Eq a, Show a, Bounded k, Ord k) => HasKeyID k a where getKeyID :: a -> k -- | generic data structure for holding elements with a key and modular lookup -newtype RingMap a k = RingMap { getRingMap :: (HasKeyID a k, Bounded k, Ord k) => Map.Map k (RingEntry a k) } +newtype RingMap k a = RingMap { getRingMap :: (Bounded k, Ord k) => Map.Map k (RingEntry k a) } -instance (HasKeyID a k, Bounded k, Ord k) => Eq (RingMap a k) where +instance (Bounded k, Ord k, Eq a) => Eq (RingMap k a) where a == b = getRingMap a == getRingMap b -instance (HasKeyID a k, Bounded k, Ord k, Show k) => Show (RingMap a k) where +instance (Bounded k, Ord k, Show k, Show a) => Show (RingMap k a) where show rmap = shows "RingMap " (show $ getRingMap rmap) -- | entry of a 'RingMap' that holds a value and can also -- wrap around the lookup direction at the edges of the name space. -data RingEntry a k = KeyEntry a - | ProxyEntry (k, ProxyDirection) (Maybe (RingEntry a k)) +data RingEntry k a = KeyEntry a + | ProxyEntry (k, ProxyDirection) (Maybe (RingEntry k a)) deriving (Show, Eq) -- | as a compromise, only KeyEntry components are ordered by their key -- while ProxyEntry components should never be tried to be ordered. -instance (HasKeyID a k, Eq k, Ord a, Bounded k, Ord k) => Ord (RingEntry a k) where +instance (HasKeyID k a, Eq k, Ord a, Bounded k, Ord k) => Ord (RingEntry k a) where a `compare` b = compare (extractID a) (extractID b) where - extractID :: (HasKeyID a k, Ord a, Bounded k, Ord k) => RingEntry a k -> k + extractID :: (HasKeyID k a, Ord a, Bounded k, Ord k) => RingEntry k a -> k extractID (KeyEntry e) = getKeyID e extractID ProxyEntry{} = error "proxy entries should never appear outside of the RingMap" @@ -49,51 +49,51 @@ instance Enum ProxyDirection where fromEnum Backwards = - 1 fromEnum Forwards = 1 --- | helper function for getting the a from a RingEntry a k -extractRingEntry :: (HasKeyID a k, Bounded k, Ord k) => RingEntry a k -> Maybe a +-- | helper function for getting the a from a RingEntry k a +extractRingEntry :: (Bounded k, Ord k) => RingEntry k a -> Maybe a extractRingEntry (KeyEntry entry) = Just entry extractRingEntry (ProxyEntry _ (Just (KeyEntry entry))) = Just entry extractRingEntry _ = Nothing -- | An empty 'RingMap' needs to be initialised with 2 proxy entries, -- linking the modular name space together by connecting @minBound@ and @maxBound@ -emptyRMap :: (HasKeyID a k, Bounded k, Ord k) => RingMap a k +emptyRMap :: (Bounded k, Ord k) => RingMap k a emptyRMap = RingMap . Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))] where proxyEntry (from,to) = (from, ProxyEntry to Nothing) -- | Maybe returns the entry stored at given key -rMapLookup :: (HasKeyID a k, Bounded k, Ord k) +rMapLookup :: (Bounded k, Ord k) => k -- ^lookup key - -> RingMap a k -- ^lookup cache + -> RingMap k a -- ^lookup cache -> Maybe a rMapLookup key rmap = extractRingEntry =<< Map.lookup key (getRingMap rmap) -- | returns number of present 'KeyEntry' in a properly initialised 'RingMap' -rMapSize :: (HasKeyID a k, Integral i, Bounded k, Ord k) - => RingMap a k +rMapSize :: (Integral i, Bounded k, Ord k) + => RingMap k a -> i rMapSize rmap = fromIntegral $ Map.size innerMap - oneIfEntry rmap minBound - oneIfEntry rmap maxBound where innerMap = getRingMap rmap - oneIfEntry :: (HasKeyID a k, Integral i, Bounded k, Ord k) => RingMap a k -> k -> i + oneIfEntry :: (Integral i, Bounded k, Ord k) => RingMap k a -> k -> i oneIfEntry rmap' nid | isNothing (rMapLookup nid rmap') = 1 | otherwise = 0 -- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@ -- to simulate a modular ring -lookupWrapper :: (HasKeyID a k, Bounded k, Ord k, Num k) - => (k -> Map.Map k (RingEntry a k) -> Maybe (k, RingEntry a k)) - -> (k -> Map.Map k (RingEntry a k) -> Maybe (k, RingEntry a k)) +lookupWrapper :: (Bounded k, Ord k, Num k) + => (k -> Map.Map k (RingEntry k a) -> Maybe (k, RingEntry k a)) + -> (k -> Map.Map k (RingEntry k a) -> Maybe (k, RingEntry k a)) -> ProxyDirection -> k - -> RingMap a k - -> Maybe a + -> RingMap k a + -> Maybe (k, a) lookupWrapper f fRepeat direction key rmap = case f key $ getRingMap rmap of -- the proxy entry found holds a - Just (_, ProxyEntry _ (Just (KeyEntry entry))) -> Just entry + Just (foundKey, ProxyEntry _ (Just (KeyEntry entry))) -> Just (foundKey, entry) -- proxy entry holds another proxy entry, this should not happen Just (_, ProxyEntry _ (Just (ProxyEntry _ _))) -> Nothing -- proxy entry without own entry is a pointer on where to continue @@ -106,10 +106,10 @@ lookupWrapper f fRepeat direction key rmap = then lookupWrapper fRepeat fRepeat direction newKey rmap else Nothing -- normal entries are returned - Just (_, KeyEntry entry) -> Just entry + Just (foundKey, KeyEntry entry) -> Just (foundKey, entry) Nothing -> Nothing where - rMapNotEmpty :: (HasKeyID a k, Bounded k, Ord k) => RingMap a k -> Bool + rMapNotEmpty :: (Bounded k, Ord k) => RingMap k a -> Bool rMapNotEmpty rmap' = (Map.size (getRingMap rmap') > 2) -- there are more than the 2 ProxyEntries || isJust (rMapLookup minBound rmap') -- or one of the ProxyEntries holds a node || isJust (rMapLookup maxBound rmap') @@ -117,32 +117,34 @@ lookupWrapper f fRepeat direction key rmap = -- | find the successor node to a given key on a modular EpiChord ring. -- Note: The EpiChord definition of "successor" includes the node at the key itself, -- if existing. -rMapLookupSucc :: (HasKeyID a k, Bounded k, Ord k, Num k) +rMapLookupSucc :: (Bounded k, Ord k, Num k) => k -- ^lookup key - -> RingMap a k -- ^ring cache - -> Maybe a + -> RingMap k a -- ^ring cache + -> Maybe (k, a) rMapLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards -- | find the predecessor node to a given key on a modular EpiChord ring. -rMapLookupPred :: (HasKeyID a k, Bounded k, Ord k, Num k) +rMapLookupPred :: (Bounded k, Ord k, Num k) => k -- ^lookup key - -> RingMap a k -- ^ring cache - -> Maybe a + -> RingMap k a -- ^ring cache + -> Maybe (k, a) rMapLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards -addRMapEntryWith :: (HasKeyID a k, Bounded k, Ord k) - => (RingEntry a k -> RingEntry a k -> RingEntry a k) - -> a - -> RingMap a k - -> RingMap a k -addRMapEntryWith combineFunc entry = RingMap - . Map.insertWith combineFunc (getKeyID entry) (KeyEntry entry) +addRMapEntryWith :: (Bounded k, Ord k) + => (RingEntry k a -> RingEntry k a -> RingEntry k a) + -> k -- ^ key + -> a -- ^ value + -> RingMap k a + -> RingMap k a +addRMapEntryWith combineFunc key entry = RingMap + . Map.insertWith combineFunc key (KeyEntry entry) . getRingMap -addRMapEntry :: (HasKeyID a k, Bounded k, Ord k) - => a - -> RingMap a k - -> RingMap a k +addRMapEntry :: (Bounded k, Ord k) + => k -- ^ key + -> a -- ^ value + -> RingMap k a + -> RingMap k a addRMapEntry = addRMapEntryWith insertCombineFunction where insertCombineFunction newVal oldVal = @@ -151,30 +153,30 @@ addRMapEntry = addRMapEntryWith insertCombineFunction KeyEntry _ -> newVal -addRMapEntries :: (Foldable t, HasKeyID a k, Bounded k, Ord k) - => t a - -> RingMap a k - -> RingMap a k -addRMapEntries entries rmap = foldr' addRMapEntry rmap entries +addRMapEntries :: (Foldable t, Bounded k, Ord k) + => t (k, a) + -> RingMap k a + -> RingMap k a +addRMapEntries entries rmap = foldr' (\(k, v) rmap' -> addRMapEntry k v rmap') rmap entries -setRMapEntries :: (Foldable t, HasKeyID a k, Bounded k, Ord k) - => t a - -> RingMap a k +setRMapEntries :: (Foldable t, Bounded k, Ord k) + => t (k, a) + -> RingMap k a setRMapEntries entries = addRMapEntries entries emptyRMap -deleteRMapEntry :: (HasKeyID a k, Bounded k, Ord k) +deleteRMapEntry :: (Bounded k, Ord k) => k - -> RingMap a k - -> RingMap a k + -> RingMap k a + -> RingMap k a deleteRMapEntry nid = RingMap . Map.update modifier nid . getRingMap where modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing) modifier KeyEntry {} = Nothing -rMapToList :: (HasKeyID a k, Bounded k, Ord k) => RingMap a k -> [a] +rMapToList :: (Bounded k, Ord k) => RingMap k a -> [a] rMapToList = mapMaybe extractRingEntry . Map.elems . getRingMap -rMapFromList :: (HasKeyID a k, Bounded k, Ord k) => [a] -> RingMap a k +rMapFromList :: (Bounded k, Ord k) => [(k, a)] -> RingMap k a rMapFromList = setRMapEntries -- | takes up to i entries from a 'RingMap' by calling a getter function on a @@ -182,49 +184,52 @@ rMapFromList = setRMapEntries -- Stops once i entries have been taken or an entry has been encountered twice -- (meaning the ring has been traversed completely). -- Forms the basis for 'takeRMapSuccessors' and 'takeRMapPredecessors'. -takeRMapEntries_ :: (HasKeyID a k, Integral i, Bounded k, Ord k) - => (k -> RingMap a k -> Maybe a) - -> k - -> i - -> RingMap a k - -> [a] +takeRMapEntries_ :: (Integral i, Bounded k, Ord k) + => (k -> RingMap k a -> Maybe (k, a)) -- ^ parameterisable getter function to determine lookup direction + -> k -- ^ starting key + -> i -- ^ number of maximum values to take + -> RingMap k a + -> [a] -- ^ values taken -- TODO: might be more efficient with dlists takeRMapEntries_ getterFunc startAt num rmap = reverse $ case getterFunc startAt rmap of Nothing -> [] - Just anEntry -> takeEntriesUntil rmap getterFunc (getKeyID anEntry) (getKeyID anEntry) (num-1) [anEntry] + Just (foundKey, anEntry) -> takeEntriesUntil rmap getterFunc foundKey foundKey (num-1) [anEntry] where -- for some reason, just reusing the already-bound @rmap@ and @getterFunc@ -- variables leads to a type error, these need to be passed explicitly - takeEntriesUntil :: (HasKeyID a k, Integral i, Bounded k, Ord k) - => RingMap a k - -> (k -> RingMap a k -> Maybe a) -- getter function + takeEntriesUntil :: (Integral i, Bounded k, Ord k) + => RingMap k a + -> (k -> RingMap k a -> Maybe (k, a)) -- getter function -> k -> k -> i -> [a] -> [a] takeEntriesUntil rmap' getterFunc' havingReached previousEntry remaining takeAcc + -- length limit reached | remaining <= 0 = takeAcc - | getKeyID (fromJust $ getterFunc' previousEntry rmap') == havingReached = takeAcc - | otherwise = let (Just gotEntry) = getterFunc' previousEntry rmap' - in takeEntriesUntil rmap' getterFunc' havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc) + -- + | otherwise = case nextEntry of + Just (fKey, gotEntry) + | fKey == havingReached -> takeAcc + | otherwise -> takeEntriesUntil rmap' getterFunc' havingReached fKey (remaining - 1) (gotEntry:takeAcc) + Nothing -> takeAcc + where + nextEntry = getterFunc' previousEntry rmap' -takeRMapPredecessors :: (HasKeyID a k, Integral i, Bounded k, Ord k, Num k) + +takeRMapPredecessors :: (Integral i, Bounded k, Ord k, Num k) => k -> i - -> RingMap a k + -> RingMap k a -> [a] takeRMapPredecessors = takeRMapEntries_ rMapLookupPred -takeRMapSuccessors :: (HasKeyID a k, Integral i, Bounded k, Ord k, Num k) +takeRMapSuccessors :: (Integral i, Bounded k, Ord k, Num k) => k -> i - -> RingMap a k + -> RingMap k a -> [a] takeRMapSuccessors = takeRMapEntries_ rMapLookupSucc --- clean up cache entries: once now - entry > maxAge --- transfer difference now - entry to other node - -