metro 0.1.0.4 → 0.1.0.5

raw patch · 4 files changed

+28/−116 lines, 4 filesdep +hashmap-iodep −unordered-containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hashmap-io

Dependencies removed: unordered-containers

API changes (from Hackage documentation)

Files

• metro.cabal +3/−4
• src/Metro/IOHashMap.hs +0/−86
• src/Metro/Node.hs +13/−13
• src/Metro/Server.hs +12/−13

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: cff32aadbb54ab06abb8cf6fdb73517cd18298a9730b7018798ee65d56321d11+-- hash: 091d5108d142d16f7ceef8cc4670d202f181d28a52188b006c87fab5ec895f24  name:           metro-version:        0.1.0.4+version:        0.1.0.5 synopsis:       A simple tcp and udp socket server framework description:    Please see the README on GitHub at <https://github.com/Lupino/metro#readme> category:       Network,Framework@@ -32,7 +32,6 @@       Metro       Metro.Class       Metro.Conn-      Metro.IOHashMap       Metro.Lock       Metro.Node       Metro.Server@@ -49,10 +48,10 @@     , binary     , bytestring     , hashable+    , hashmap-io     , hslogger     , mtl     , transformers     , unix-time     , unliftio-    , unordered-containers   default-language: Haskell2010

@@ -1,86 +0,0 @@-module Metro.IOHashMap-  ( IOHashMap-  , newIOHashMap-  , insert-  , delete-  , lookup-  , update-  , adjust-  , alter-  , null-  , size-  , member-  , keys-  , elems-  , clear-  , toList--  , insertSTM-  , lookupSTM-  , foldrWithKeySTM-  , deleteSTM-  ) where--import           Data.Hashable-import           Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HM-import           Prelude             hiding (lookup, null)-import           UnliftIO            (MonadIO (..), STM, TVar, atomically,-                                      modifyTVar', newTVarIO, readTVar,-                                      readTVarIO)--newtype IOHashMap a b = IOHashMap (TVar (HashMap a b))--newIOHashMap :: MonadIO m => m (IOHashMap a b)-newIOHashMap = IOHashMap <$> newTVarIO HM.empty--insert :: (Eq a, Hashable a, MonadIO m) => IOHashMap a b -> a -> b -> m ()-insert (IOHashMap h) k v = atomically . modifyTVar' h $ HM.insert k v--delete :: (Eq a, Hashable a, MonadIO m) => IOHashMap a b -> a -> m ()-delete (IOHashMap h) k = atomically . modifyTVar' h $ HM.delete k--lookup :: (Eq a, Hashable a, MonadIO m) => IOHashMap a b -> a -> m (Maybe b)-lookup (IOHashMap h) k = HM.lookup k <$> readTVarIO h--adjust :: (Eq a, Hashable a, MonadIO m) => IOHashMap a b -> (b -> b) -> a -> m ()-adjust (IOHashMap h) f k = atomically . modifyTVar' h $ HM.adjust f k--update :: (Eq a, Hashable a, MonadIO m) => IOHashMap a b -> (b -> Maybe b) -> a -> m ()-update (IOHashMap h) f k = atomically . modifyTVar' h $ HM.update f k--alter :: (Eq a, Hashable a, MonadIO m) => IOHashMap a b -> (Maybe b -> Maybe b) -> a -> m ()-alter (IOHashMap h) f k = atomically . modifyTVar' h $ HM.alter f k--null :: MonadIO m => IOHashMap a b -> m Bool-null (IOHashMap h) = HM.null <$> readTVarIO h--size :: MonadIO m => IOHashMap a b -> m Int-size (IOHashMap h) = HM.size <$> readTVarIO h--member :: (Eq a, Hashable a, MonadIO m) => IOHashMap a b -> a -> m Bool-member (IOHashMap h) k = HM.member k <$> readTVarIO h--keys :: MonadIO m => IOHashMap a b -> m [a]-keys (IOHashMap h) = HM.keys <$> readTVarIO h--elems :: MonadIO m => IOHashMap a b -> m [b]-elems (IOHashMap h) = HM.elems <$> readTVarIO h--clear :: MonadIO m => IOHashMap a b -> m ()-clear (IOHashMap h) = atomically . modifyTVar' h $ const HM.empty--toList :: MonadIO m => IOHashMap a b -> m [(a, b)]-toList (IOHashMap h) = HM.toList <$> readTVarIO h--insertSTM :: (Eq a, Hashable a) => IOHashMap a b -> a -> b -> STM ()-insertSTM (IOHashMap h) k v = modifyTVar' h $ HM.insert k v--lookupSTM :: (Eq a, Hashable a) => IOHashMap a b -> a -> STM (Maybe b)-lookupSTM (IOHashMap h) k = HM.lookup k <$> readTVar h--foldrWithKeySTM :: IOHashMap a b -> (a -> b -> c -> c) -> c -> STM c-foldrWithKeySTM (IOHashMap h) f acc = HM.foldrWithKey f acc <$> readTVar h--deleteSTM :: (Eq a, Hashable a) => IOHashMap a b -> a -> STM ()-deleteSTM (IOHashMap h) k = modifyTVar' h $ HM.delete k

@@ -49,12 +49,15 @@   , getSessionSize1   ) where -import           Control.Monad              (forM, forever, mzero, void, when)+import           Control.Monad              (forM, forever, void, when)+import           Control.Monad.Cont         (callCC, runContT) import           Control.Monad.Reader.Class (MonadReader (ask), asks) import           Control.Monad.Trans.Class  (MonadTrans (..))-import           Control.Monad.Trans.Maybe  (runMaybeT) import           Control.Monad.Trans.Reader (ReaderT (..), runReaderT) import           Data.Hashable+import           Data.IOHashMap             (IOHashMap)+import qualified Data.IOHashMap             as HM (delete, elems, empty, insert,+                                                   lookup, size) import           Data.Int                   (Int64) import           Data.Maybe                 (fromMaybe, isJust) import           Metro.Class                (GetPacketId, RecvPacket,@@ -62,9 +65,6 @@                                              getPacketId) import           Metro.Conn                 (ConnEnv, ConnT, FromConn (..),                                              close, receive, runConnT)-import           Metro.IOHashMap            (IOHashMap, newIOHashMap)-import qualified Metro.IOHashMap            as HM (delete, elems, insert,-                                                   lookup, size) import           Metro.Session              (SessionEnv (sessionId), SessionT,                                              feed, isTimeout, runSessionT) import qualified Metro.Session              as S (newSessionEnv, receive, send)@@ -132,7 +132,7 @@ initEnv uEnv nodeId sessionGen = do   nodeStatus  <- newTVarIO True   nodeSession <- newTVarIO Nothing-  sessionList <- newIOHashMap+  sessionList <- HM.empty   nodeTimer   <- newTVarIO =<< getEpochTime   onNodeLeave <- newTVarIO Nothing   sessTimeout <- newTVarIO 300@@ -200,7 +200,7 @@         Just _  -> do           state <- readTVar nodeStatus           when state retrySTM-    Multi -> HM.insert sessionList sid sEnv+    Multi -> HM.insert sid sEnv sessionList   return sEnv  nextSessionId :: MonadIO m => NodeT u nid k rpkt tp m k@@ -211,7 +211,7 @@   NodeEnv{..} <- ask   case nodeMode of     Single -> atomically $ writeTVar nodeSession Nothing-    Multi  -> HM.delete sessionList mid+    Multi  -> HM.delete mid sessionList  busy :: MonadIO m => NodeT u nid k rpkt tp m Bool busy = do@@ -255,7 +255,7 @@   NodeEnv{..} <- ask   v <- case nodeMode of          Single -> readTVarIO nodeSession-         Multi  -> HM.lookup sessionList $ getPacketId rpkt+         Multi  -> HM.lookup (getPacketId rpkt) sessionList   case v of     Just aEnv ->       runSessionT_ aEnv $ feed $ Just rpkt@@ -266,7 +266,7 @@       when (sessionMode == MultiAction) $         case nodeMode of           Single -> atomically $ writeTVar nodeSession $ Just sEnv-          Multi  -> HM.insert sessionList sid sEnv+          Multi  -> HM.insert sid sEnv sessionList       bracket (return sid) removeSession $ \_ ->         runSessionT_ sEnv sessionHandler @@ -280,10 +280,10 @@   => (rpkt -> m Bool) -> SessionT u nid k rpkt tp m () -> NodeT u nid k rpkt tp m () startNodeT_ preprocess sessionHandler = do   sess <- runCheckSessionState-  void . runMaybeT . forever $ do+  (`runContT` pure) $ callCC $ \exit -> forever $ do     alive <- lift nodeState     if alive then lift $ tryMainLoop preprocess sessionHandler-             else mzero+             else exit ()    cancel sess   doFeedError@@ -356,7 +356,7 @@             to <- isTimeout             when to $ do               feed Nothing-              HM.delete sessList (sessionId sessEnv)+              HM.delete (sessionId sessEnv) sessList  getSessionSize :: MonadIO m => NodeEnv u nid k rpkt -> m Int getSessionSize NodeEnv {..} = HM.size sessionList

@@ -31,22 +31,21 @@   , handleConn   ) where -import           Control.Monad              (forM_, forever, mzero, unless,-                                             void, when)+import           Control.Monad              (forM_, forever, unless, void, when)+import           Control.Monad.Cont         (callCC, runContT) import           Control.Monad.Reader.Class (MonadReader (ask), asks) import           Control.Monad.Trans.Class  (MonadTrans, lift)-import           Control.Monad.Trans.Maybe  (runMaybeT) import           Control.Monad.Trans.Reader (ReaderT (..), runReaderT) import           Data.Either                (isLeft) import           Data.Hashable+import           Data.IOHashMap             (IOHashMap)+import qualified Data.IOHashMap             as HM (delete, elems, empty)+import qualified Data.IOHashMap.STM         as HMS (insert, lookup) import           Data.Int                   (Int64) import           Metro.Class                (GetPacketId, RecvPacket,                                              Servable (..), Transport,                                              TransportConfig) import           Metro.Conn                 hiding (close)-import           Metro.IOHashMap            (IOHashMap, newIOHashMap)-import qualified Metro.IOHashMap            as HM (delete, elems, insertSTM,-                                                   lookupSTM) import           Metro.Node                 (NodeEnv1, NodeMode (..),                                              SessionMode (..), getNodeId,                                              getTimer, initEnv1, runNodeT1,@@ -104,7 +103,7 @@ initServerEnv sc gen mapTransport prepare = do   serveServ   <- newServer sc   serveState  <- newTVarIO True-  nodeEnvList <- newIOHashMap+  nodeEnvList <- HM.empty   onNodeLeave <- newTVarIO Nothing   keepalive   <- newTVarIO 0   defSessTout <- newTVarIO 300@@ -149,11 +148,11 @@   name <- asks serveName   liftIO $ infoM "Metro.Server" $ name ++ "Server started"   state <- asks serveState-  void . runMaybeT . forever $ do+  (`runContT` pure) $ callCC $ \exit -> forever $ do     e <- lift $ tryServeOnce preprocess sess-    when (isLeft e) mzero+    when (isLeft e) $ exit ()     alive <- readTVarIO state-    unless alive mzero+    unless alive $ exit ()   liftIO $ infoM "Metro.Server" $ name ++ "Server closed"  tryServeOnce@@ -218,8 +217,8 @@       . Node.setDefaultSessionTimeout defSessTout) connEnv uEnv nid gen      env1 <- atomically $ do-      v <- HM.lookupSTM nodeEnvList nid-      HM.insertSTM nodeEnvList nid env0+      v <- HMS.lookup nid nodeEnvList+      HMS.insert nid env0 nodeEnvList       pure v      mapM_ (`runNodeT1` stopNodeT) env1@@ -280,7 +279,7 @@               when (now > expiredAt) $ do                 nid <- getNodeId                 stopNodeT-                HM.delete ref nid+                HM.delete nid ref  serverEnv :: Monad m => ServerT serv u nid k rpkt tp m (ServerEnv serv u nid k rpkt tp) serverEnv = ask