make liftAnnex and liftAssistant polymorphic, like liftIO

2 files changed, 11 insertions, 5 deletions

diff --git a/Assistant/Monad.hs b/Assistant/Monad.hs
index 140b9f582..e046c9666 100644
--- a/Assistant/Monad.hs
+++ b/Assistant/Monad.hs
@@ -13,6 +13,7 @@ module Assistant.Monad (
 	newAssistantData,
 	runAssistant,
 	getAssistant,
+	LiftAnnex,
 	liftAnnex,
 	(<~>),
 	(<<~),
@@ -90,13 +91,18 @@ runAssistant d a = runReaderT (mkAssistant a) d
 getAssistant :: (AssistantData -> a) -> Assistant a
 getAssistant = reader
 
+{- Using a type class for lifting into the annex monad allows
+ - easily lifting to it from multiple different monads. -}
+class LiftAnnex m where
+	liftAnnex :: Annex a -> m a
+
 {- Runs an action in the git-annex monad. Note that the same monad state
  - is shared amoung all assistant threads, so only one of these can run at
  - a time. Therefore, long-duration actions should be avoided. -}
-liftAnnex :: Annex a -> Assistant a
-liftAnnex a = do
-	st <- reader threadState
-	liftIO $ runThreadState st a
+instance LiftAnnex Assistant where
+	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
diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs
index 69a886c4a..66c6e7227 100644
--- a/Assistant/Threads/XMPPClient.hs
+++ b/Assistant/Threads/XMPPClient.hs
@@ -19,7 +19,7 @@ import Assistant.DaemonStatus
 import qualified Remote
 import Utility.ThreadScheduler
 import Assistant.WebApp (UrlRenderer, renderUrl)
-import Assistant.WebApp.Types
+import Assistant.WebApp.Types hiding (liftAssistant)
 import Assistant.Alert
 import Assistant.Pairing
 import Assistant.XMPP.Git