Assistant monad, stage 2.5
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:
parent
4e765327ca
commit
4dbdc2b666
29 changed files with 299 additions and 280 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue