Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-network-control for
openSUSE:Factory checked in at 2025-04-07 19:15:09
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-network-control (Old)
and /work/SRC/openSUSE:Factory/.ghc-network-control.new.1907 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-network-control"
Mon Apr 7 19:15:09 2025 rev:4 rq:1267452 version:0.1.6
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-network-control/ghc-network-control.changes
2025-01-28 16:41:20.727464700 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-network-control.new.1907/ghc-network-control.changes
2025-04-07 19:15:11.324379511 +0200
@@ -1,0 +2,18 @@
+Sun Mar 30 08:30:48 UTC 2025 - Peter Simons <psim...@suse.com>
+
+- Update network-control to version 0.1.6.
+ ## 0.1.6
+
+ * Allowing size 0.
+
+-------------------------------------------------------------------
+Fri Mar 28 07:03:54 UTC 2025 - Peter Simons <psim...@suse.com>
+
+- Update network-control to version 0.1.5.
+ ## 0.1.5
+
+ * New API: `lookup'` adjusts the target priority.
+ * New API: `LRUCacheRef` stuffs
+ * `insert` rebuilds PSQ when reached the limit.
+
+-------------------------------------------------------------------
Old:
----
network-control-0.1.4.tar.gz
New:
----
network-control-0.1.6.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-network-control.spec ++++++
--- /var/tmp/diff_new_pack.0jgc9v/_old 2025-04-07 19:15:11.936405199 +0200
+++ /var/tmp/diff_new_pack.0jgc9v/_new 2025-04-07 19:15:11.936405199 +0200
@@ -20,7 +20,7 @@
%global pkgver %{pkg_name}-%{version}
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.1.4
+Version: 0.1.6
Release: 0
Summary: Library to control network protocols
License: BSD-3-Clause
++++++ network-control-0.1.4.tar.gz -> network-control-0.1.6.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/network-control-0.1.4/Changelog.md
new/network-control-0.1.6/Changelog.md
--- old/network-control-0.1.4/Changelog.md 2001-09-09 03:46:40.000000000
+0200
+++ new/network-control-0.1.6/Changelog.md 2001-09-09 03:46:40.000000000
+0200
@@ -1,5 +1,15 @@
# Revision history for network-control
+## 0.1.6
+
+* Allowing size 0.
+
+## 0.1.5
+
+* New API: `lookup'` adjusts the target priority.
+* New API: `LRUCacheRef` stuffs
+* `insert` rebuilds PSQ when reached the limit.
+
## 0.1.4
* Using Integer instead of Int in LRUCache.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/network-control-0.1.4/Network/Control/LRUCache.hs
new/network-control-0.1.6/Network/Control/LRUCache.hs
--- old/network-control-0.1.4/Network/Control/LRUCache.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/network-control-0.1.6/Network/Control/LRUCache.hs 2001-09-09
03:46:40.000000000 +0200
@@ -7,46 +7,138 @@
insert,
delete,
lookup,
-) where
+ lookup',
-import Prelude hiding (lookup)
+ -- * IO
+ LRUCacheRef,
+ newLRUCacheRef,
+ cached,
+ cached',
+
+ -- * Internal
+ empty',
+) where
+import Data.IORef (IORef, atomicModifyIORef', newIORef)
+import Data.Int (Int64)
import Data.OrdPSQ (OrdPSQ)
import qualified Data.OrdPSQ as PSQ
+import Prelude hiding (lookup)
+
+----------------------------------------------------------------
-type Priority = Integer
+type Priority = Int64
-- | Sized cache based on least recently used.
data LRUCache k v = LRUCache
{ lcLimit :: Int
- , lcSize :: Int
+ -- ^ The maximum number of elements in the queue
, lcTick :: Priority
+ -- ^ The next logical time
, lcQueue :: OrdPSQ k Priority v
}
+ deriving (Eq, Show)
--- | Empty 'LRUCache'.
+----------------------------------------------------------------
+
+-- | Empty 'LRUCache'. /O(1)/
empty
:: Int
-- ^ The size of 'LRUCache'.
-> LRUCache k v
-empty lim = LRUCache lim 0 0 PSQ.empty
+empty capacity =
+ LRUCache
+ { lcLimit = capacity
+ , lcTick = 0
+ , lcQueue = PSQ.empty
+ }
--- | Inserting.
+-- | Empty 'LRUCache'. /O(1)/
+empty'
+ :: Int
+ -- ^ The size of 'LRUCache'.
+ -> Int64
+ -- ^ Counter
+ -> LRUCache k v
+empty' capacity tick =
+ LRUCache
+ { lcLimit = capacity
+ , lcTick = tick
+ , lcQueue = PSQ.empty
+ }
+
+----------------------------------------------------------------
+
+trim :: Ord k => LRUCache k v -> LRUCache k v
+trim c@LRUCache{..}
+ | lcTick == maxBound =
+ let siz = fromIntegral $ PSQ.size lcQueue
+ diff = (maxBound :: Priority) - siz
+ psq = PSQ.unsafeMapMonotonic (\_ p v -> (p - diff, v)) lcQueue
+ in LRUCache
+ { lcLimit = lcLimit
+ , lcTick = siz
+ , lcQueue = psq
+ }
+ | PSQ.size lcQueue > lcLimit = c{lcQueue = PSQ.deleteMin lcQueue}
+ | otherwise = c
+
+----------------------------------------------------------------
+
+-- | Inserting. /O(log n)/
insert :: Ord k => k -> v -> LRUCache k v -> LRUCache k v
-insert k v c@LRUCache{..}
- | lcSize == lcLimit =
- let q = PSQ.insert k lcTick v $ PSQ.deleteMin lcQueue
- in c{lcTick = lcTick + 1, lcQueue = q}
- | otherwise =
- let q = PSQ.insert k lcTick v lcQueue
- in c{lcTick = lcTick + 1, lcQueue = q, lcSize = lcSize + 1}
+insert key val c@LRUCache{..} = trim c'
+ where
+ queue = PSQ.insert key lcTick val lcQueue
+ c' = c{lcTick = lcTick + 1, lcQueue = queue}
--- | Deleting.
+----------------------------------------------------------------
+
+-- | Deleting. /O(log n)/
delete :: Ord k => k -> LRUCache k v -> LRUCache k v
-delete k c@LRUCache{..} =
- let q = PSQ.delete k lcQueue
- in c{lcQueue = q, lcSize = lcSize - 1}
+delete k c@LRUCache{..} = c{lcQueue = q}
+ where
+ q = PSQ.delete k lcQueue
+
+----------------------------------------------------------------
--- | Looking up.
+-- | Looking up. /O(log n)/
lookup :: Ord k => k -> LRUCache k v -> Maybe v
lookup k LRUCache{..} = snd <$> PSQ.lookup k lcQueue
+
+-- | Looking up and changing priority. /O(log n)/
+lookup' :: Ord k => k -> LRUCache k v -> Maybe (v, LRUCache k v)
+lookup' k c@LRUCache{..} = case PSQ.alter lookupAndBump k lcQueue of
+ (Nothing, _) -> Nothing
+ (Just v, q) ->
+ let c' = trim $ c{lcTick = lcTick + 1, lcQueue = q}
+ in Just (v, c')
+ where
+ lookupAndBump Nothing = (Nothing, Nothing)
+ -- setting its priority to lcTick
+ lookupAndBump (Just (_p, v)) = (Just v, Just (lcTick, v))
+
+----------------------------------------------------------------
+
+newtype LRUCacheRef k v = LRUCacheRef (IORef (LRUCache k v))
+
+newLRUCacheRef :: Int -> IO (LRUCacheRef k v)
+newLRUCacheRef capacity = LRUCacheRef <$> newIORef (empty capacity)
+
+cached' :: Ord k => LRUCacheRef k v -> k -> IO (Maybe v)
+cached' (LRUCacheRef ref) k = do
+ atomicModifyIORef' ref $ \c -> case lookup' k c of
+ Nothing -> (c, Nothing)
+ Just (v, c') -> (c', Just v)
+
+cached :: Ord k => LRUCacheRef k v -> k -> IO v -> IO (v, Bool)
+cached (LRUCacheRef ref) k io = do
+ lookupRes <- atomicModifyIORef' ref $ \c -> case lookup' k c of
+ Nothing -> (c, Nothing)
+ Just (v, c') -> (c', Just v)
+ case lookupRes of
+ Just v -> return (v, True)
+ Nothing -> do
+ v <- io
+ atomicModifyIORef' ref $ \c -> (insert k v c, ())
+ return (v, False)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/network-control-0.1.4/network-control.cabal
new/network-control-0.1.6/network-control.cabal
--- old/network-control-0.1.4/network-control.cabal 2001-09-09
03:46:40.000000000 +0200
+++ new/network-control-0.1.6/network-control.cabal 2001-09-09
03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
cabal-version: 3.0
name: network-control
-version: 0.1.4
+version: 0.1.6
license: BSD-3-Clause
license-file: LICENSE
maintainer: k...@iij.ad.jp
@@ -33,6 +33,7 @@
hs-source-dirs: test
other-modules:
Network.Control.FlowSpec
+ Network.Control.LRUCacheSpec
default-language: Haskell2010
default-extensions: Strict StrictData
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/network-control-0.1.4/test/Network/Control/FlowSpec.hs
new/network-control-0.1.6/test/Network/Control/FlowSpec.hs
--- old/network-control-0.1.4/test/Network/Control/FlowSpec.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/network-control-0.1.6/test/Network/Control/FlowSpec.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,11 +1,8 @@
{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans -Wno-incomplete-patterns #-}
-module Network.Control.FlowSpec where
+module Network.Control.FlowSpec (spec) where
import Data.List
import Data.Text.Lazy (unpack)
@@ -104,7 +101,7 @@
assertStep :: RxFlow -> [(Int, Step OpWithResult, RxFlow)] -> Property
assertStep _ [] = property True
assertStep oldFlow ((ix, step, newFlow) : steps) =
- (counterexample ("step #" <> show ix) check) .&. assertStep newFlow steps
+ counterexample ("step #" <> show ix) check .&. assertStep newFlow steps
where
check :: Expectation
check = case step of
@@ -141,10 +138,9 @@
newFlow `shouldSatisfy` \flow ->
rxfLimit flow > rxfConsumed flow
-- Condition (c)
- limitDelta `shouldSatisfy` \mUpd ->
- case mUpd of
- Nothing -> True
- Just upd -> upd >= rxfBufSize newFlow `div` 8
+ limitDelta `shouldSatisfy` \case
+ Nothing -> True
+ Just upd -> upd >= rxfBufSize newFlow `div` 8
Step (ReceiveWithResult isAcceptable) arg -> do
newFlow
`shouldBe` if isAcceptable
@@ -159,5 +155,6 @@
spec :: Spec
spec = do
- focus . prop "state transition graph checks out" $
- \trace -> counterexample (unpack $ pShowNoColor trace) (assertTrace
trace)
+ describe "Flow" $ do
+ prop "state transition graph checks out" $ \trace ->
+ counterexample (unpack $ pShowNoColor trace) (assertTrace trace)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/network-control-0.1.4/test/Network/Control/LRUCacheSpec.hs
new/network-control-0.1.6/test/Network/Control/LRUCacheSpec.hs
--- old/network-control-0.1.4/test/Network/Control/LRUCacheSpec.hs
1970-01-01 01:00:00.000000000 +0100
+++ new/network-control-0.1.6/test/Network/Control/LRUCacheSpec.hs
2001-09-09 03:46:40.000000000 +0200
@@ -0,0 +1,22 @@
+module Network.Control.LRUCacheSpec (spec) where
+
+import Data.Maybe
+import Network.Control
+import qualified Network.Control as LRU
+import Test.Hspec
+
+spec :: Spec
+spec = do
+ describe "LRUCache" $ do
+ it "can keep entry if looked up" $ do
+ let cache = insert 'b' "bar" $ insert 'a' "foo" $ empty 2
+ (v, cache') = fromJust $ LRU.lookup' 'a' cache
+ v `shouldBe` "foo"
+ let cache'' = insert 'c' "baz" cache'
+ fst <$> LRU.lookup' 'a' cache'' `shouldBe` Just "foo"
+ fst <$> LRU.lookup' 'b' cache'' `shouldBe` Nothing
+ fst <$> LRU.lookup' 'c' cache'' `shouldBe` Just "baz"
+ it "can rebuild PSQ when reached the limit" $ do
+ let cache = insert 'b' "bar" $ insert 'a' "foo" $ empty' 2
(maxBound - 2)
+ show cache
+ `shouldBe` "LRUCache {lcLimit = 2, lcTick = 2, lcQueue =
Winner (E 'a' 0 \"foo\") (RLoser 1 (E 'b' 1 \"bar\") Start 'a' Start) 'b'}"
