fix type constraints after RingMap refactor
This commit is contained in:
parent
1ff540fd68
commit
9a20a60222
|
|
@ -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
|
||||
| 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)
|
||||
|
||||
takeRMapPredecessors :: (HasKeyID a, Integral i)
|
||||
=> NodeID
|
||||
-- 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
|
||||
-> RingMap a
|
||||
-> [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 rmap' getterFunc' havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc)
|
||||
|
||||
takeRMapPredecessors :: (HasKeyID a, Integral i, Bounded k, Ord k, Num k)
|
||||
=> k
|
||||
-> i
|
||||
-> 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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue