mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

Assistant monad, stage 2.5

Browse source 
Converted several threads to run in the monad.

Added a lot of useful combinators for working with the monad.

Now the monad includes the name of the thread.

Some debugging messages are disabled pending converting other threads.
This commit is contained in:
Joey Hess 2012-10-29 02:21:04 -04:00
parent 4e765327ca
commit 4dbdc2b666
29 changed files with 299 additions and 280 deletions
Download patch file Download diff file Expand all files Collapse all files

40
Assistant/Monad.hs
View file

@ -13,7 +13,12 @@ module Assistant.Monad (
newAssistantData,
runAssistant,
getAssistant,
liftAnnex
liftAnnex,
(<~>),
(<<~),
daemonStatus,
asIO,
asIO2,
) where
import "mtl" Control.Monad.Reader
@ -43,8 +48,9 @@ instance MonadBase IO Assistant where
liftBase = Assistant . liftBase
data AssistantData = AssistantData
{ threadState :: ThreadState
, daemonStatus :: DaemonStatusHandle
{ threadName :: String
, threadState :: ThreadState
, daemonStatusHandle :: DaemonStatusHandle
, scanRemoteMap :: ScanRemoteMap
, transferQueue :: TransferQueue
, transferSlots :: TransferSlots
@ -57,7 +63,8 @@ data AssistantData = AssistantData
newAssistantData :: ThreadState -> DaemonStatusHandle -> IO AssistantData
newAssistantData st dstatus = AssistantData
<$> pure st
<$> pure "main"
<*> pure st
<*> pure dstatus
<*> newScanRemoteMap
<*> newTransferQueue
@ -81,3 +88,28 @@ liftAnnex :: Annex a -> Assistant a
liftAnnex a = do
st <- reader threadState
liftIO $ runThreadState st a
{- Runs an IO action, passing it an IO action that runs an Assistant action. -}
(<~>) :: (IO a -> IO b) -> Assistant a -> Assistant b
io <~> a = do
d <- reader id
liftIO $ io $ runAssistant a d
{- Creates an IO action that will run an Assistant action when run. -}
asIO :: (a -> Assistant b) -> Assistant (a -> IO b)
asIO a = do
d <- reader id
return $ \v -> runAssistant (a v) d
{- Creates an IO action that will run an Assistant action when run. -}
asIO2 :: (a -> b -> Assistant c) -> Assistant (a -> b -> IO c)
asIO2 a = do
d <- reader id
return $ \v1 v2 -> runAssistant (a v1 v2) d
{- Runs an IO action on a selected field of the AssistantData. -}
(<<~) :: (a -> IO b) -> (AssistantData -> a) -> Assistant b
io <<~ v = reader v >>= liftIO . io
daemonStatus :: Assistant DaemonStatus
daemonStatus = getDaemonStatus <<~ daemonStatusHandle