From 9a20a602224dffa141b161e07307fc27b7875604 Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Sat, 25 Jul 2020 22:56:56 +0200 Subject: [PATCH] fix type constraints after RingMap refactor --- src/Hash2Pub/RingMap.hs | 148 ++++++++++++++++++++++------------------ 1 file changed, 82 insertions(+), 66 deletions(-) diff --git a/src/Hash2Pub/RingMap.hs b/src/Hash2Pub/RingMap.hs index 75698d6..46aec5f 100644 --- a/src/Hash2Pub/RingMap.hs +++ b/src/Hash2Pub/RingMap.hs @@ -1,33 +1,39 @@ +{-# LANGUAGE RankNTypes #-} + module Hash2Pub.RingMap where +import Data.Foldable (foldr') +import qualified Data.Map.Strict as Map +import Data.Maybe (fromJust, isJust, isNothing, mapMaybe) + -- | Class for all types that can be identified via an EpiChord key. -- Used for restricting the types a 'RingMap' can store class (Eq a, Show a) => HasKeyID a where - getKeyID :: a -> NodeID + getKeyID :: (Bounded k, Ord k) => a -> k -- | generic data structure for holding elements with a key and modular lookup -newtype RingMap a = RingMap { getRingMap :: HasKeyID a => Map.Map NodeID (RingEntry a) } +newtype RingMap a k = RingMap { getRingMap :: (HasKeyID a, Bounded k, Ord k) => Map.Map k (RingEntry a k) } -instance (HasKeyID a) => Eq (RingMap a) where +instance (HasKeyID a, Bounded k, Ord k) => Eq (RingMap a k) where a == b = getRingMap a == getRingMap b -instance (HasKeyID a) => Show (RingMap a) where +instance (HasKeyID a, Bounded k, Ord k, Show k) => Show (RingMap a k) 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 = KeyEntry a - | ProxyEntry (NodeID, ProxyDirection) (Maybe (RingEntry a)) +data RingEntry a k = KeyEntry a + | ProxyEntry (k, ProxyDirection) (Maybe (RingEntry a k)) deriving (Show, Eq) --- --- | as a compromise, only KeyEntry components are ordered by their NodeID +-- | as a compromise, only KeyEntry components are ordered by their key -- while ProxyEntry components should never be tried to be ordered. -instance (HasKeyID a, Eq a) => Ord (RingEntry a) where +instance (HasKeyID a, Eq k, Ord a, Bounded k, Ord k) => Ord (RingEntry a k) where a `compare` b = compare (extractID a) (extractID b) where + extractID :: (HasKeyID a, Ord a, Bounded k, Ord k) => RingEntry a k -> k extractID (KeyEntry e) = getKeyID e extractID ProxyEntry{} = error "proxy entries should never appear outside of the RingMap" @@ -42,46 +48,46 @@ instance Enum ProxyDirection where fromEnum Backwards = - 1 fromEnum Forwards = 1 --- | helper function for getting the a from a RingEntry a -extractRingEntry :: HasKeyID a => RingEntry a -> Maybe a +-- | helper function for getting the a from a RingEntry a k +extractRingEntry :: (HasKeyID a, Bounded k, Ord k) => RingEntry a k -> 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 => RingMap a +emptyRMap :: (HasKeyID a, Bounded k, Ord k) => RingMap a k 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 - => NodeID -- ^lookup key - -> RingMap a -- ^lookup cache +rMapLookup :: (HasKeyID a, Bounded k, Ord k) + => k -- ^lookup key + -> RingMap a k -- ^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, Integral i) - => RingMap a +rMapSize :: (HasKeyID a, Integral i, Bounded k, Ord k) + => RingMap a k -> i -rMapSize rmap = fromIntegral $ Map.size innerMap - oneIfEntry minBound - oneIfEntry maxBound +rMapSize rmap = fromIntegral $ Map.size innerMap - oneIfEntry rmap minBound - oneIfEntry rmap maxBound where innerMap = getRingMap rmap - oneIfEntry :: Integral i => NodeID -> i - oneIfEntry nid - | isNothing (rMapLookup nid rmap) = 1 + oneIfEntry :: (HasKeyID a, Integral i, Bounded k, Ord k) => RingMap a k -> 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 - => (NodeID -> Map.Map NodeID (RingEntry a) -> Maybe (NodeID, RingEntry a)) - -> (NodeID -> Map.Map NodeID (RingEntry a) -> Maybe (NodeID, RingEntry a)) +lookupWrapper :: (HasKeyID a, 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)) -> ProxyDirection - -> NodeID - -> RingMap a + -> k + -> RingMap a k -> Maybe a lookupWrapper f fRepeat direction key rmap = case f key $ getRingMap rmap of @@ -102,7 +108,7 @@ lookupWrapper f fRepeat direction key rmap = Just (_, KeyEntry entry) -> Just entry Nothing -> Nothing where - rMapNotEmpty :: (HasKeyID a) => RingMap a -> Bool + rMapNotEmpty :: (HasKeyID a, Bounded k, Ord k) => RingMap a k -> 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') @@ -110,32 +116,32 @@ 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 - => NodeID -- ^lookup key - -> RingMap a -- ^ring cache +rMapLookupSucc :: (HasKeyID a, Bounded k, Ord k, Num k) + => k -- ^lookup key + -> RingMap a k -- ^ring cache -> Maybe a rMapLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards -- | find the predecessor node to a given key on a modular EpiChord ring. -rMapLookupPred :: HasKeyID a - => NodeID -- ^lookup key - -> RingMap a -- ^ring cache +rMapLookupPred :: (HasKeyID a, Bounded k, Ord k, Num k) + => k -- ^lookup key + -> RingMap a k -- ^ring cache -> Maybe a rMapLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards -addRMapEntryWith :: HasKeyID a - => (RingEntry a -> RingEntry a -> RingEntry a) +addRMapEntryWith :: (HasKeyID a, Bounded k, Ord k) + => (RingEntry a k -> RingEntry a k -> RingEntry a k) -> a - -> RingMap a - -> RingMap a + -> RingMap a k + -> RingMap a k addRMapEntryWith combineFunc entry = RingMap . Map.insertWith combineFunc (getKeyID entry) (KeyEntry entry) . getRingMap -addRMapEntry :: HasKeyID a +addRMapEntry :: (HasKeyID a, Bounded k, Ord k) => a - -> RingMap a - -> RingMap a + -> RingMap a k + -> RingMap a k addRMapEntry = addRMapEntryWith insertCombineFunction where insertCombineFunction newVal oldVal = @@ -144,30 +150,30 @@ addRMapEntry = addRMapEntryWith insertCombineFunction KeyEntry _ -> newVal -addRMapEntries :: (Foldable t, HasKeyID a) +addRMapEntries :: (Foldable t, HasKeyID a, Bounded k, Ord k) => t a - -> RingMap a - -> RingMap a + -> RingMap a k + -> RingMap a k addRMapEntries entries rmap = foldr' addRMapEntry rmap entries -setRMapEntries :: (Foldable t, HasKeyID a) +setRMapEntries :: (Foldable t, HasKeyID a, Bounded k, Ord k) => t a - -> RingMap a + -> RingMap a k setRMapEntries entries = addRMapEntries entries emptyRMap -deleteRMapEntry :: (HasKeyID a) - => NodeID - -> RingMap a - -> RingMap a +deleteRMapEntry :: (HasKeyID a, Bounded k, Ord k) + => k + -> RingMap a k + -> RingMap a k deleteRMapEntry nid = RingMap . Map.update modifier nid . getRingMap where modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing) modifier KeyEntry {} = Nothing -rMapToList :: (HasKeyID a) => RingMap a -> [a] +rMapToList :: (HasKeyID a, Bounded k, Ord k) => RingMap a k -> [a] rMapToList = mapMaybe extractRingEntry . Map.elems . getRingMap -rMapFromList :: (HasKeyID a) => [a] -> RingMap a +rMapFromList :: (HasKeyID a, Bounded k, Ord k) => [a] -> RingMap a k rMapFromList = setRMapEntries -- | takes up to i entries from a 'RingMap' by calling a getter function on a @@ -175,35 +181,45 @@ 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, Integral i) - => (NodeID -> RingMap a -> Maybe a) - -> NodeID +takeRMapEntries_ :: (HasKeyID a, Integral i, Bounded k, Ord k) + => (k -> RingMap a k -> Maybe a) + -> k -> i - -> RingMap a + -> RingMap a k -> [a] -- TODO: might be more efficient with dlists takeRMapEntries_ getterFunc startAt num rmap = reverse $ case getterFunc startAt rmap of Nothing -> [] - Just anEntry -> takeEntriesUntil (getKeyID anEntry) (getKeyID anEntry) (num-1) [anEntry] + Just anEntry -> takeEntriesUntil rmap getterFunc (getKeyID anEntry) (getKeyID anEntry) (num-1) [anEntry] where - takeEntriesUntil havingReached previousEntry remaining takeAcc + -- 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, Integral i, Bounded k, Ord k) + => RingMap a k + -> (k -> RingMap a k -> Maybe a) -- getter function + -> k + -> k + -> i + -> [a] + -> [a] + takeEntriesUntil rmap' getterFunc' havingReached previousEntry remaining takeAcc | remaining <= 0 = takeAcc - | getKeyID (fromJust $ getterFunc previousEntry rmap) == havingReached = takeAcc - | otherwise = let (Just gotEntry) = getterFunc previousEntry rmap - in takeEntriesUntil havingReached (getKeyID gotEntry) (remaining-1) (gotEntry: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) -takeRMapPredecessors :: (HasKeyID a, Integral i) - => NodeID +takeRMapPredecessors :: (HasKeyID a, Integral i, Bounded k, Ord k, Num k) + => k -> i - -> RingMap a + -> RingMap a k -> [a] takeRMapPredecessors = takeRMapEntries_ rMapLookupPred -takeRMapSuccessors :: (HasKeyID a, Integral i) - => NodeID +takeRMapSuccessors :: (HasKeyID a, Integral i, Bounded k, Ord k, Num k) + => k -> i - -> RingMap a + -> RingMap a k -> [a] takeRMapSuccessors = takeRMapEntries_ rMapLookupSucc