This commit is contained in:
Joey Hess 2012-11-08 14:06:43 -04:00
parent 0238e4ba07
commit 08916ef695
4 changed files with 10 additions and 10 deletions

View file

@ -105,7 +105,7 @@
- BranchChanged (STM SampleVar) - BranchChanged (STM SampleVar)
- Changes to the git-annex branch are indicated by updating this - Changes to the git-annex branch are indicated by updating this
- SampleVar. - SampleVar.
- NetMessagerControl (STM TChan, SampleVar) - NetMessager (STM TChan, SampleVar)
- Used to feed messages to the built-in XMPP client, and - Used to feed messages to the built-in XMPP client, and
- signal it when it needs to restart due to configuration or - signal it when it needs to restart due to configuration or
- networking changes. - networking changes.

View file

@ -61,7 +61,7 @@ data AssistantData = AssistantData
, changeChan :: ChangeChan , changeChan :: ChangeChan
, branchChangeHandle :: BranchChangeHandle , branchChangeHandle :: BranchChangeHandle
, buddyList :: BuddyList , buddyList :: BuddyList
, netMessagerControl :: NetMessagerControl , netMessager :: NetMessager
} }
newAssistantData :: ThreadState -> DaemonStatusHandle -> IO AssistantData newAssistantData :: ThreadState -> DaemonStatusHandle -> IO AssistantData
@ -77,7 +77,7 @@ newAssistantData st dstatus = AssistantData
<*> newChangeChan <*> newChangeChan
<*> newBranchChangeHandle <*> newBranchChangeHandle
<*> newBuddyList <*> newBuddyList
<*> newNetMessagerControl <*> newNetMessager
runAssistant :: AssistantData -> Assistant a -> IO a runAssistant :: AssistantData -> Assistant a -> IO a
runAssistant d a = runReaderT (mkAssistant a) d runAssistant d a = runReaderT (mkAssistant a) d

View file

@ -15,14 +15,14 @@ import Control.Concurrent.MSampleVar
sendNetMessage :: NetMessage -> Assistant () sendNetMessage :: NetMessage -> Assistant ()
sendNetMessage m = sendNetMessage m =
(atomically . flip writeTChan m) <<~ (netMessages . netMessagerControl) (atomically . flip writeTChan m) <<~ (netMessages . netMessager)
waitNetMessage :: Assistant (NetMessage) waitNetMessage :: Assistant (NetMessage)
waitNetMessage = (atomically . readTChan) <<~ (netMessages . netMessagerControl) waitNetMessage = (atomically . readTChan) <<~ (netMessages . netMessager)
notifyNetMessagerRestart :: Assistant () notifyNetMessagerRestart :: Assistant ()
notifyNetMessagerRestart = notifyNetMessagerRestart =
flip writeSV () <<~ (netMessagerRestart . netMessagerControl) flip writeSV () <<~ (netMessagerRestart . netMessager)
waitNetMessagerRestart :: Assistant () waitNetMessagerRestart :: Assistant ()
waitNetMessagerRestart = readSV <<~ (netMessagerRestart . netMessagerControl) waitNetMessagerRestart = readSV <<~ (netMessagerRestart . netMessager)

View file

@ -39,12 +39,12 @@ data NetMessage
{- Something used to identify a specific client to send the message to. -} {- Something used to identify a specific client to send the message to. -}
type ClientID = Text type ClientID = Text
data NetMessagerControl = NetMessagerControl data NetMessager = NetMessager
{ netMessages :: TChan (NetMessage) { netMessages :: TChan (NetMessage)
, netMessagerRestart :: MSampleVar () , netMessagerRestart :: MSampleVar ()
} }
newNetMessagerControl :: IO NetMessagerControl newNetMessager :: IO NetMessager
newNetMessagerControl = NetMessagerControl newNetMessager = NetMessager
<$> atomically newTChan <$> atomically newTChan
<*> newEmptySV <*> newEmptySV