further relax constrains on RingMap

key now needs to be explicitly given at insert, instead of
deriving it from the value. This makes it possible to store values where
a key cannot be extracted from (HasKeyID)

contributes to #62, #32, #41

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
+data RingEntry k a = KeyEntry a
-    | ProxyEntry (k, ProxyDirection) (Maybe (RingEntry a k))
+    | 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
+-- | helper function for getting the a from a RingEntry k a
-extractRingEntry :: (HasKeyID a k, Bounded k, Ord k) => RingEntry a k -> Maybe 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)
+rMapSize :: (Integral i, Bounded k, Ord k)
-         => RingMap a 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)
+lookupWrapper :: (Bounded k, Ord k, Num k)
-              => (k -> Map.Map k (RingEntry a k) -> Maybe (k, RingEntry a k))
+              => (k -> Map.Map k (RingEntry k a) -> Maybe (k, RingEntry k a))
-              -> (k -> Map.Map k (RingEntry a k) -> Maybe (k, RingEntry a k))
+              -> (k -> Map.Map k (RingEntry k a) -> Maybe (k, RingEntry k a))
               -> ProxyDirection
               -> k
-              -> RingMap a k
+              -> RingMap k a
-              -> Maybe 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
+               -> RingMap k a       -- ^ring cache
-               -> Maybe a
+               -> 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
+               -> RingMap k a        -- ^ring cache
-               -> Maybe a
+               -> Maybe (k, a)
 rMapLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards
 
-addRMapEntryWith :: (HasKeyID a k, Bounded k, Ord k)
+addRMapEntryWith :: (Bounded k, Ord k)
-                 => (RingEntry a k -> RingEntry a k -> RingEntry a k)
+                 => (RingEntry k a -> RingEntry k a -> RingEntry k a)
-                 -> a
+                 -> k   -- ^ key
-                 -> RingMap a k
+                 -> a   -- ^ value
-                 -> RingMap a k
+                 -> RingMap k a
-addRMapEntryWith combineFunc entry = RingMap
+                 -> RingMap k a
-    . Map.insertWith combineFunc (getKeyID entry) (KeyEntry entry)
+addRMapEntryWith combineFunc key entry = RingMap
+    . Map.insertWith combineFunc key (KeyEntry entry)
     . getRingMap
 
-addRMapEntry :: (HasKeyID a k, Bounded k, Ord k)
+addRMapEntry :: (Bounded k, Ord k)
-             => a
+             => k   -- ^ key
-             -> RingMap a k
+             -> a   -- ^ value
-             -> RingMap a k
+             -> 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)
+addRMapEntries :: (Foldable t, Bounded k, Ord k)
-               => t a
+               => t (k, a)
-               -> RingMap a k
+               -> RingMap k a
-               -> RingMap a k
+               -> RingMap k a
-addRMapEntries entries rmap = foldr' addRMapEntry rmap entries
+addRMapEntries entries rmap = foldr' (\(k, v) rmap' -> addRMapEntry k v rmap') rmap entries
 
-setRMapEntries :: (Foldable t, HasKeyID a k, Bounded k, Ord k)
+setRMapEntries :: (Foldable t, Bounded k, Ord k)
-               => t a
+               => t (k, a)
-               -> RingMap a k
+               -> 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 k a
-                -> RingMap a k
+                -> 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)
+takeRMapEntries_ :: (Integral i, Bounded k, Ord k)
-                 => (k -> RingMap a k -> Maybe a)
+                 => (k -> RingMap k a -> Maybe (k, a))   -- ^ parameterisable getter function to determine lookup direction
-                 -> k
+                 -> k   -- ^ starting key
-                 -> i
+                 -> i   -- ^ number of maximum values to take
-                 -> RingMap a k
+                 -> RingMap k a
-                 -> [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)
+    takeEntriesUntil :: (Integral i, Bounded k, Ord k)
-                     => RingMap a k
+                     => RingMap k a
-                     -> (k -> RingMap a k -> Maybe a) -- getter function
+                     -> (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'
+      | otherwise = case nextEntry of
-                    in takeEntriesUntil rmap' getterFunc' havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc)
+                      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
-
-