moved ThreadedMonad to Types

Assistant.hs

@@ -118,8 +118,8 @@
 module Assistant where
 
 import Assistant.Common
-import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
+import Assistant.Types.ThreadedMonad
 import Assistant.Threads.DaemonStatus
 import Assistant.Threads.Watcher
 import Assistant.Threads.Committer

Assistant/Monad.hs

@@ -26,7 +26,7 @@ import "mtl" Control.Monad.Reader
 import Control.Monad.Base (liftBase, MonadBase)
 
 import Common.Annex
-import Assistant.ThreadedMonad
+import Assistant.Types.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.ScanRemotes
 import Assistant.TransferQueue
@@ -112,6 +112,7 @@ asIO2 a = do
 (<<~) :: (a -> IO b) -> (AssistantData -> a) -> Assistant b
 io <<~ v = reader v >>= liftIO . io
 
+withAssistant :: (AssistantData -> a) -> (a -> IO b) -> Assistant b
 withAssistant v io = io <<~ v
 
 daemonStatus :: Assistant DaemonStatus

Assistant/Threads/WebApp.hs

@@ -27,7 +27,7 @@ import Assistant.WebApp.Configurators.S3
 import Assistant.WebApp.Configurators.XMPP
 import Assistant.WebApp.Documentation
 import Assistant.WebApp.OtherRepos
-import Assistant.ThreadedMonad
+import Assistant.Types.ThreadedMonad
 import Utility.WebApp
 import Utility.FileMode
 import Utility.TempFile

Assistant/Types/ThreadedMonad.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Assistant.ThreadedMonad where
+module Assistant.Types.ThreadedMonad where
 
 import Common.Annex
 import qualified Annex

Assistant/WebApp.hs

@@ -11,7 +11,6 @@ module Assistant.WebApp where
 
 import Assistant.WebApp.Types
 import Assistant.Common
-import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Utility.NotificationBroadcaster
 import Utility.Yesod
@@ -99,10 +98,8 @@ modifyWebAppState a = go =<< webAppState <$> getYesod
 runAnnex :: forall sub a. a -> Annex a -> GHandler sub WebApp a
 runAnnex fallback a = ifM (noAnnex <$> getYesod)
 	( return fallback
-	, go =<< getAssistantY threadState
+	, runAssistantY $ liftAnnex a
 	)
-	where
-		go st = liftIO $ runThreadState st a
 
 waitNotifier :: forall sub. (DaemonStatus -> NotificationBroadcaster) -> NotificationId -> GHandler sub WebApp ()
 waitNotifier selector nid = do

Assistant/WebApp/Configurators/S3.hs

@@ -15,7 +15,6 @@ import Assistant.Sync
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.WebApp.SideBar
-import Assistant.ThreadedMonad
 import Utility.Yesod
 import qualified Remote.S3 as S3
 import Logs.Remote
@@ -116,11 +115,9 @@ getEnableS3R uuid = s3Configurator $ do
 
 makeS3Remote :: S3Creds -> String -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
 makeS3Remote (S3Creds ak sk) name setup config = do
-	d <- getAssistantY id
-	let st = threadState d
 	remotename <- runAnnex name $ fromRepo $ uniqueRemoteName name 0
 	liftIO $ S3.s3SetCredsEnv ( T.unpack ak, T.unpack sk)
-	r <- liftIO $ runThreadState st $ addRemote $ do
+	r <- runAssistantY $ liftAnnex $ addRemote $ do
 		makeSpecialRemote name S3.remote config
 		return remotename
 	setup r

Assistant/WebApp/Utility.hs

@@ -11,7 +11,6 @@ import Assistant.Common
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.DaemonStatus
-import Assistant.ThreadedMonad
 import Assistant.TransferQueue
 import Assistant.TransferSlots
 import Assistant.Sync
@@ -38,8 +37,7 @@ changeSyncable (Just r) False = do
 	changeSyncFlag r False
 	d <- getAssistantY id
 	let dstatus = daemonStatusHandle d
-	let st = threadState d
-	liftIO $ runThreadState st $ updateSyncRemotes dstatus
+	runAssistantY $ liftAnnex $ updateSyncRemotes dstatus
 	{- Stop all transfers to or from this remote.
 	 - XXX Can't stop any ongoing scan, or git syncs. -}
 	void $ liftIO $ dequeueTransfers (transferQueue d) dstatus tofrom