From 86cb3faf51a2b6cce41b07e72b09c8c0c3194302 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 29 Oct 2012 19:07:10 -0400
Subject: [PATCH] moved ThreadedMonad to Types

---
 Assistant.hs                           | 2 +-
 Assistant/Monad.hs                     | 3 ++-
 Assistant/Threads/WebApp.hs            | 2 +-
 Assistant/{ => Types}/ThreadedMonad.hs | 2 +-
 Assistant/WebApp.hs                    | 5 +----
 Assistant/WebApp/Configurators/S3.hs   | 5 +----
 Assistant/WebApp/Utility.hs            | 4 +---
 7 files changed, 8 insertions(+), 15 deletions(-)
 rename Assistant/{ => Types}/ThreadedMonad.hs (95%)

diff --git a/Assistant.hs b/Assistant.hs
index a8cc0b62e0..3ef7c9a119 100644
--- a/Assistant.hs
+++ b/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
diff --git a/Assistant/Monad.hs b/Assistant/Monad.hs
index 1f8ccacbe3..c13d3a372d 100644
--- a/Assistant/Monad.hs
+++ b/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
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 126c78166c..be9a9a16f9 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/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
diff --git a/Assistant/ThreadedMonad.hs b/Assistant/Types/ThreadedMonad.hs
similarity index 95%
rename from Assistant/ThreadedMonad.hs
rename to Assistant/Types/ThreadedMonad.hs
index 7b915e12c8..1a2aa7eb7f 100644
--- a/Assistant/ThreadedMonad.hs
+++ b/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
diff --git a/Assistant/WebApp.hs b/Assistant/WebApp.hs
index 4de574e107..fe9844fcce 100644
--- a/Assistant/WebApp.hs
+++ b/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
diff --git a/Assistant/WebApp/Configurators/S3.hs b/Assistant/WebApp/Configurators/S3.hs
index 1b6696888e..9913ac0c20 100644
--- a/Assistant/WebApp/Configurators/S3.hs
+++ b/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
diff --git a/Assistant/WebApp/Utility.hs b/Assistant/WebApp/Utility.hs
index ffbe934db6..b49d7e0c2e 100644
--- a/Assistant/WebApp/Utility.hs
+++ b/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