finished pushing Assistant monad into all relevant files

All temporary and old functions are removed.

Assistant/WebApp/Configurators.hs

@@ -102,7 +102,7 @@ repoList onlyconfigured includehere
 	where
 		configured = do
 			rs <- filter (not . Remote.readonly) . syncRemotes
-				<$> runAssistantY getDaemonStatus
+				<$> liftAssistant getDaemonStatus
 			runAnnex [] $ do
 				u <- getUUID
 				let l = map Remote.uuid rs

Assistant/WebApp/Configurators/Edit.hs

@@ -77,7 +77,7 @@ setRepoConfig uuid mremote oldc newc = do
 				, Param name
 				]
 			void $ Remote.remoteListRefresh
-		runAssistantY updateSyncRemotes
+		liftAssistant updateSyncRemotes
 
 editRepositoryAForm :: RepoConfig -> AForm WebApp WebApp RepoConfig
 editRepositoryAForm def = RepoConfig

Assistant/WebApp/Configurators/Pairing.hs

@@ -87,17 +87,15 @@ getInprogressPairR _ = noPairing
  -}
 startPairing :: PairStage -> IO () -> (AlertButton -> Alert) -> Maybe UUID -> Text -> Secret -> Widget
 startPairing stage oncancel alert muuid displaysecret secret = do
-	dstatus <- lift $ getAssistantY daemonStatusHandle
 	urlrender <- lift getUrlRender
 	reldir <- fromJust . relDir <$> lift getYesod
 
-	sendrequests <- lift $ runAssistantY $ asIO2 $ mksendrequests urlrender
-
+	sendrequests <- lift $ liftAssistant $ asIO2 $ mksendrequests urlrender
 	{- Generating a ssh key pair can take a while, so do it in the
 	 - background. -}
-	void $ liftIO $ forkIO $ do
-		keypair <- genSshKeyPair
-		pairdata <- PairData
+	thread <- lift $ liftAssistant $ asIO $ do
+		keypair <- liftIO $ genSshKeyPair
+		pairdata <- liftIO $ PairData
 			<$> getHostname
 			<*> myUserName
 			<*> pure reldir
@@ -105,7 +103,8 @@ startPairing stage oncancel alert muuid displaysecret secret = do
 			<*> (maybe genUUID return muuid)
 		let sender = multicastPairMsg Nothing secret pairdata
 		let pip = PairingInProgress secret Nothing keypair pairdata stage
-		startSending dstatus pip stage $ sendrequests sender
+		startSending pip stage $ sendrequests sender
+	void $ liftIO $ forkIO thread
 
 	lift $ redirect $ InprogressPairR $ toSecretReminder displaysecret
 	where

Assistant/WebApp/Configurators/S3.hs

@@ -117,9 +117,9 @@ makeS3Remote :: S3Creds -> String -> (Remote -> Handler ()) -> RemoteConfig -> H
 makeS3Remote (S3Creds ak sk) name setup config = do
 	remotename <- runAnnex name $ fromRepo $ uniqueRemoteName name 0
 	liftIO $ S3.s3SetCredsEnv ( T.unpack ak, T.unpack sk)
-	r <- runAssistantY $ liftAnnex $ addRemote $ do
+	r <- liftAssistant $ liftAnnex $ addRemote $ do
 		makeSpecialRemote name S3.remote config
 		return remotename
 	setup r
-	runAssistantY $ syncNewRemote r
+	liftAssistant $ syncNewRemote r
 	redirect $ EditNewCloudRepositoryR $ Remote.uuid r

Assistant/WebApp/Configurators/Ssh.hs

@@ -283,7 +283,7 @@ makeSsh' rsync setup sshdata keypair =
 
 makeSshRepo :: Bool -> (Remote -> Handler ()) -> SshData -> Handler RepHtml
 makeSshRepo forcersync setup sshdata = do
-	r <- runAssistantY $ makeSshRemote forcersync sshdata
+	r <- liftAssistant $ makeSshRemote forcersync sshdata
 	setup r
 	redirect $ EditNewCloudRepositoryR $ Remote.uuid r
 

Assistant/WebApp/Configurators/XMPP.hs

@@ -35,8 +35,8 @@ import qualified Data.Text as T
 xmppNeeded :: Handler ()
 xmppNeeded = whenM (isNothing <$> runAnnex Nothing getXMPPCreds) $ do
 	urlrender <- getUrlRender
-	void $ runAssistantY $ do
-		close <- asIO removeAlert
+	void $ liftAssistant $ do
+		close <- asIO1 removeAlert
 		addAlert $ xmppNeededAlert $ AlertButton
 			{ buttonLabel = "Configure a Jabber account"
 			, buttonUrl = urlrender XMPPR
@@ -60,7 +60,7 @@ getXMPPR = xmppPage $ do
 	where
 		storecreds creds = do
 			void $ runAnnex undefined $ setXMPPCreds creds
-			runAssistantY notifyRestart
+			liftAssistant notifyRestart
 			redirect ConfigR
 #else
 getXMPPR = xmppPage $

Assistant/WebApp/DashBoard.hs

@@ -37,9 +37,8 @@ import Control.Concurrent
 transfersDisplay :: Bool -> Widget
 transfersDisplay warnNoScript = do
 	webapp <- lift getYesod
-	d <- lift $ getAssistantY id
 	current <- lift $ M.toList <$> getCurrentTransfers
-	queued <- liftIO $ getTransferQueue $ transferQueue d
+	queued <- lift $ liftAssistant getTransferQueue
 	autoUpdate ident NotifierTransfersR (10 :: Int) (10 :: Int)
 	let transfers = simplifyTransfers $ current ++ queued
 	if null transfers

Assistant/WebApp/SideBar.hs

@@ -28,7 +28,7 @@ sideBarDisplay = do
 	let content = do
 		{- Add newest alerts to the sidebar. -}
 		alertpairs <- lift $ M.toList . alertMap
-			<$> runAssistantY getDaemonStatus
+			<$> liftAssistant getDaemonStatus
 		mapM_ renderalert $
 			take displayAlerts $ reverse $ sortAlertPairs alertpairs
 	let ident = "sidebar"
@@ -73,12 +73,12 @@ getSideBarR nid = do
 
 {- Called by the client to close an alert. -}
 getCloseAlert :: AlertId -> Handler ()
-getCloseAlert = runAssistantY . removeAlert
+getCloseAlert = liftAssistant . removeAlert
 
 {- When an alert with a button is clicked on, the button takes us here. -}
 getClickAlert :: AlertId -> Handler ()
 getClickAlert i = do
-	m <- alertMap <$> runAssistantY getDaemonStatus
+	m <- alertMap <$> liftAssistant getDaemonStatus
 	case M.lookup i m of
 		Just (Alert { alertButton = Just b }) -> do
 			{- Spawn a thread to run the action while redirecting. -}

Assistant/WebApp/Utility.hs

@@ -36,15 +36,13 @@ changeSyncable (Just r) True = do
 	syncRemote r
 changeSyncable (Just r) False = do
 	changeSyncFlag r False
-	d <- getAssistantY id
-	let dstatus = daemonStatusHandle d
-	runAssistantY $ updateSyncRemotes
+	liftAssistant $ updateSyncRemotes
 	{- 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
+	void $ liftAssistant $ dequeueTransfers tofrom
 	mapM_ (cancelTransfer False) =<<
 		filter tofrom . M.keys <$>
-			runAssistantY (currentTransfers <$> getDaemonStatus)
+			liftAssistant (currentTransfers <$> getDaemonStatus)
 	where
 		tofrom t = transferUUID t == Remote.uuid r
 
@@ -60,24 +58,21 @@ changeSyncFlag r enabled = runAnnex undefined $ do
 
 {- Start syncing remote, using a background thread. -}
 syncRemote :: Remote -> Handler ()
-syncRemote = runAssistantY . syncNewRemote
+syncRemote = liftAssistant . syncNewRemote
 
 pauseTransfer :: Transfer -> Handler ()
 pauseTransfer = cancelTransfer True
 
 cancelTransfer :: Bool -> Transfer -> Handler ()
 cancelTransfer pause t = do
-	tq <- getAssistantY transferQueue
 	m <- getCurrentTransfers
-	dstatus <- getAssistantY daemonStatusHandle
-	unless pause $ liftIO $
+	unless pause $
 		{- remove queued transfer -}
-		void $ dequeueTransfers tq dstatus $
-			equivilantTransfer t
+		void $ liftAssistant $ dequeueTransfers $ equivilantTransfer t
 	{- stop running transfer -}
 	maybe noop stop (M.lookup t m)
 	where
-		stop info = runAssistantY $ do
+		stop info = liftAssistant $ do
 			{- When there's a thread associated with the
 			 - transfer, it's signaled first, to avoid it
 			 - displaying any alert about the transfer having
@@ -107,18 +102,16 @@ startTransfer t = do
 	where
 		go info = maybe (start info) resume $ transferTid info
 		startqueued = do
-			dstatus <- getAssistantY daemonStatusHandle
-			q <- getAssistantY transferQueue
-			is <- liftIO $ map snd <$> getMatchingTransfers q dstatus (== t)
+			is <- liftAssistant $ map snd <$> getMatchingTransfers (== t)
 			maybe noop start $ headMaybe is
 		resume tid = do
-			runAssistantY $ alterTransferInfo t $
+			liftAssistant $ alterTransferInfo t $
 				\i -> i { transferPaused = False }
 			liftIO $ throwTo tid ResumeTransfer
-		start info = runAssistantY $ do
+		start info = liftAssistant $ do
 			program <- liftIO readProgramFile
 			inImmediateTransferSlot $
 				Transferrer.startTransfer program t info
 
 getCurrentTransfers :: Handler TransferMap
-getCurrentTransfers = currentTransfers <$> runAssistantY getDaemonStatus
+getCurrentTransfers = currentTransfers <$> liftAssistant getDaemonStatus