diff options
author | Joey Hess <joey@kitenet.net> | 2012-11-10 12:18:00 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-11-10 12:18:00 -0400 |
commit | 275dbbc0086fd895ae8593f9d37798b57cf51d0f (patch) | |
tree | 02721777ae92591531908f54bb0c02e7050b2681 /Assistant/Types | |
parent | b5b2eb90a83cb2720b21701a523b8a8dcc992215 (diff) |
separate data type for push stages
This improves type safety.
Diffstat (limited to 'Assistant/Types')
-rw-r--r-- | Assistant/Types/NetMessager.hs | 48 |
1 files changed, 21 insertions, 27 deletions
diff --git a/Assistant/Types/NetMessager.hs b/Assistant/Types/NetMessager.hs index d2195f53c..091d12815 100644 --- a/Assistant/Types/NetMessager.hs +++ b/Assistant/Types/NetMessager.hs @@ -25,39 +25,36 @@ data NetMessage -- notification about a stage in the pairing process, -- involving a client, and a UUID. | PairingNotification PairStage ClientID UUID + -- used for git push over the network messager + | Pushing ClientID PushStage + deriving (Show, Eq, Ord) + +{- Something used to identify the client, or clients to send the message to. -} +type ClientID = Text + +data PushStage -- indicates that we have data to push over the out of band network - | CanPush ClientID + = CanPush -- request that a git push be sent over the out of band network - | PushRequest ClientID + | PushRequest -- indicates that a push is starting - | StartingPush ClientID + | StartingPush -- a chunk of output of git receive-pack - | ReceivePackOutput ClientID ByteString + | ReceivePackOutput ByteString -- a chuck of output of git send-pack - | SendPackOutput ClientID ByteString + | SendPackOutput ByteString -- sent when git receive-pack exits, with its exit code - | ReceivePackDone ClientID ExitCode + | ReceivePackDone ExitCode deriving (Show, Eq, Ord) -{- Something used to identify the client, or clients to send the message to. -} -type ClientID = Text - -getClientID :: NetMessage -> Maybe ClientID -getClientID (NotifyPush _) = Nothing -getClientID QueryPresence = Nothing -getClientID (PairingNotification _ cid _) = Just cid -getClientID (CanPush cid) = Just cid -getClientID (PushRequest cid) = Just cid -getClientID (StartingPush cid) = Just cid -getClientID (ReceivePackOutput cid _) = Just cid -getClientID (SendPackOutput cid _) = Just cid -getClientID (ReceivePackDone cid _) = Just cid +data PushRunning = NoPushRunning | SendPushRunning ClientID | ReceivePushRunning ClientID + deriving (Eq) -isPushInitiationMessage :: NetMessage -> Bool -isPushInitiationMessage (CanPush _) = True -isPushInitiationMessage (PushRequest _) = True -isPushInitiationMessage (StartingPush _) = True -isPushInitiationMessage _ = False +isPushInitiation :: PushStage -> Bool +isPushInitiation CanPush = True +isPushInitiation PushRequest = True +isPushInitiation StartingPush = True +isPushInitiation _ = False data NetMessager = NetMessager -- outgoing messages @@ -72,9 +69,6 @@ data NetMessager = NetMessager , netMessagerRestart :: MSampleVar () } -data PushRunning = NoPushRunning | SendPushRunning ClientID | ReceivePushRunning ClientID - deriving (Eq) - newNetMessager :: IO NetMessager newNetMessager = NetMessager <$> atomically newTChan |