hspread 0.2 → 0.3

raw patch · 3 files changed

+42/−23 lines, 3 filesnew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Spread/Client.hs +1/−1
• Spread/Client/Message.hs +37/−17
• hspread.cabal +4/−5

@@ -3,6 +3,6 @@     ,module Spread.Client.Connection)     where import Spread.Client.Connection-import Spread.Client.Message hiding (putPadded,multicast_internal,receive_internal,KillMsg)+import Spread.Client.Message hiding (putPadded,multicast_internal,receive_internal,KillMsg(..),mkPrivateGroup)            

@@ -1,7 +1,7 @@ module Spread.Client.Message     (      OutMsg(..),InMsg(..),Message(..),Group,PrivateGroup,PrivateName,GroupId,OrderingType(..),Cause(..),groupName,mkPrivateGroup,privateName,GroupMsg(..),-     MembershipMsg(..),receive_internal,multicast_internal,mkGroup,mkPrivateName,putPadded,makeGroup,privateGroupName,KillMsg(..),RejectedMsg(..))+     MembershipMsg(..),receive_internal,multicast_internal,mkGroup,mkPrivateName,putPadded,makeGroup,KillMsg(..),RejectedMsg(..))      where import Data.ByteString (ByteString) import qualified Data.ByteString as B@@ -18,6 +18,25 @@ import System.IO (hFlush) import Spread.Constants ++runGetS bs = flip runGet (L.fromChunks [bs])+data Ask p m a = Result a | Ask p (m (Ask p m a))++instance (Functor m, Monad m) => Monad (Ask p m) where+    return = Result+    Ask i m >>= f = Ask i (fmap (>>= f) m)+    Result a >>= f = f a++runAsk' gen (Result a) = return a+runAsk' gen (Ask i m) = do foo <- gen i m+                           runAsk' gen foo+runAsk gen = runAsk' $ flip (fmap . runGet) . gen +result i = fmap Result i+ask i m = return $ Ask i m+instance Functor m => Functor (Ask p m) where+    fmap f (Result a) = Result $ f a+    fmap f (Ask i m) = Ask i (fmap (fmap f) m)+ -- | Represents the orderings as specified by the Spread toolkit. data OrderingType = Unreliable | Reliable | Fifo | Causal | Agreed | Safe deriving (Eq,Ord,Read,Show) orderingTable = fromList orderingList@@ -75,10 +94,10 @@ makeGroup = mkGroup . Ch.pack   -- | A 'PrivateGroup' identifies a connection.-newtype PrivateGroup = PrivateGroup {privateGroupName :: ByteString} deriving (Eq,Show)-mkPrivateGroup = PrivateGroup . B.take mAX_GROUP_NAME-toPrivateGroup = PrivateGroup . groupName-+type PrivateGroup = Group+mkPrivateGroup = G . B.take mAX_GROUP_NAME+toPrivateGroup = id+privateGroupName = groupName -- | Initial part of a 'PrivateGroup' name that is chosen by the client when connecting. newtype PrivateName = PrivateName {privateName :: ByteString} deriving (Eq,Show) mkPrivateName = PrivateName . B.take mAX_PRIVATE_NAME @@ -126,9 +145,9 @@                          inMsgType = itype i,                          inEndianMismatch = iendianMismatch i                        }---receive_internal :: GHC.IOBase.Handle -> Group -> IO Message-receive_internal h prvg = liftM parseRaw . Control.Monad.join $ runGetNH (mAX_GROUP_NAME + 16) h getInternal-    where getInternal :: Get (IO Raw)++receive_internal h prvg = liftM parseRaw $ runAsk (L.hGet h) $ Ask (mAX_GROUP_NAME + 16) getInternal+    where            getInternal = do srvT <- getInt                            let (dEM,maybeFlip) = if sameEndian srvT then (False,id) else (True, flip32)-- deamonEndianMismatch                            senderbs <- getGroup@@ -140,12 +159,14 @@                                getOldType :: Get Word32                                getOldType = do oldt <- maybeFlip `fmap` getInt                                                return $ rEJECT_MESS .|. oldt-                           serviceType <- fmap clearEndian $ if isSet rEJECT_MESS serviceType' -                                                               then getOldType +                           return $ do +                             serviceType <- fmap clearEndian $ if isSet rEJECT_MESS serviceType' +                                                               then Ask 4 (result getOldType)                                                                else return serviceType'-                           return $ do groups <- runGetNH (fromIntegral numGroups * mAX_GROUP_NAME) h (readGroups (fromIntegral numGroups))-                                       body <- B.hGet h (fromIntegral dataLen )-                                       return Raw { serviceType = serviceType,+                             Ask ((fromIntegral numGroups * mAX_GROUP_NAME) + (fromIntegral dataLen)) $ do +                                    groups <- readGroups (fromIntegral numGroups)+                                    body <- getByteString (fromIntegral dataLen )+                                    result . return $ Raw { serviceType = serviceType,                                                     isender = senderbs,                                                     igroups = groups,                                                     itype = if isSet mEMBERSHIP_MESS serviceType && isSet rEG_MEMB_MESS serviceType @@ -168,11 +189,10 @@                                     not (isSet rEG_MEMB_MESS t) = SelfLeave { changingGroup = isender i }                                   | otherwise = error "asMembership: unexpected message type"     where (gids,rest) = B.splitAt 12 (body i)-          gid = flip runGet (L.fromChunks [gids]) $ -                        ((\[i1,i2,i3] -> GId i1 i2 i3)) `fmap` replicateM 3 getInt'+          gid = runGetS gids $ (join . join) (liftM3 GId) getInt'           getInt' = (if daemonEndianMismatch i then flip32 else id) `fmap` getInt           getSet = fmap (map toPrivateGroup) . readGroups . fromIntegral =<< getInt' --  a set is n followed by n Groups-          cause = flip runGet (L.fromChunks [rest]) $ do+          cause = runGetS rest $ do                     numSets <- fmap fromIntegral getInt'                     byteOffsetToLocalSet <- fmap fromIntegral getInt'                     firstSet <- bytesRead@@ -230,7 +250,7 @@ multicast_internal prvg s h = maybe (return False) ((>> (hFlush h >> return True)) . L.hPut h) . sendable prvg $ s  fromPrivateGroup :: PrivateGroup -> Group-fromPrivateGroup (PrivateGroup g) = G g+fromPrivateGroup = id  sendable :: (Sendable a) => PrivateGroup -> a -> Maybe L.ByteString sendable prvg m = if numBytes > mAX_MESSAGE_LENGTH 

@@ -1,14 +1,14 @@ name:		hspread-version: 	0.2+version: 	0.3 license:	BSD3 license-file:	LICENSE author:		Andrea Vezzosi maintainer:	Andrea Vezzosi, sanzhiyan@gmail.com synopsis:	A client library for the spread toolkit-description:	+description:     hspread is a client library for the Spread toolkit.-    It is fully implemented in haskell and supports the most recent version -    of the protocol. It's intended to be used with a serialization library +    It is fully implemented in haskell and supports the most recent version+    of the protocol. It's intended to be used with a serialization library     like binary, and a separate installation of the spread deamon. build-type: 	Simple cabal-version:	>= 1.2@@ -31,4 +31,3 @@   else         build-depends: base < 3   build-depends: network, binary >= 0.3-  ghc-options: -O2