split remaining assistant types

1 files changed, 3 insertions, 92 deletions

diff --git a/Assistant/Common.hs b/Assistant/Common.hs
index e65564a17..0be536250 100644
--- a/Assistant/Common.hs
+++ b/Assistant/Common.hs
@@ -1,102 +1,13 @@
-{- Common infrastructure for the git-annex assistant threads.
+{- Common infrastructure for the git-annex assistant.
  -
  - Copyright 2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Assistant.Common (
-	module X,
-	ThreadName,
-	NamedThread(..),
-	runNamedThread,
-	debug,
-	addAlert,
-	removeAlert,
-	alertWhile,
-	alertWhile',
-	alertDuring,
-) where
+module Assistant.Common (module X) where
 
 import Common.Annex as X
 import Assistant.Monad as X
 import Assistant.Types.DaemonStatus as X
-import Assistant.Alert
-import Assistant.DaemonStatus
-
-import System.Log.Logger
-import qualified Control.Exception as E
-import qualified Data.Map as M
-
-type ThreadName = String
-data NamedThread = NamedThread ThreadName (Assistant ())
-
-debug :: [String] -> Assistant ()
-debug ws = do
-	name <- getAssistant threadName
-	liftIO $ debugM name $ unwords $ (name ++ ":") : ws
-
-runNamedThread :: NamedThread -> Assistant ()
-runNamedThread (NamedThread name a) = do
-	d <- getAssistant id
-	liftIO . go $ d { threadName = name }
-  where
-	go d = do
-		r <- E.try (runAssistant a d) :: IO (Either E.SomeException ())
-		case r of
-			Right _ -> noop
-			Left e -> do
-				let msg = unwords [name, "crashed:", show e]
-				hPutStrLn stderr msg
-				-- TODO click to restart
-				void $ addAlert (daemonStatusHandle d) $
-					warningAlert name msg
-
-{- Returns the alert's identifier, which can be used to remove it. -}
-addAlert :: DaemonStatusHandle -> Alert -> IO AlertId
-addAlert dstatus alert = notifyAlert dstatus `after` modifyDaemonStatus dstatus go
-	where
-		go s = (s { lastAlertId = i, alertMap = m }, i)
-			where
-				i = nextAlertId $ lastAlertId s
-				m = mergeAlert i alert (alertMap s)
-
-removeAlert :: DaemonStatusHandle -> AlertId -> IO ()
-removeAlert dstatus i = updateAlert dstatus i (const Nothing)
-
-updateAlert :: DaemonStatusHandle -> AlertId -> (Alert -> Maybe Alert) -> IO ()
-updateAlert dstatus i a = updateAlertMap dstatus $ \m -> M.update a i m
-
-updateAlertMap :: DaemonStatusHandle -> (AlertMap -> AlertMap) -> IO ()
-updateAlertMap dstatus a = notifyAlert dstatus `after` modifyDaemonStatus_ dstatus go
-	where
-		go s = s { alertMap = a (alertMap s) }
-
-{- Displays an alert while performing an activity that returns True on
- - success.
- -
- - The alert is left visible afterwards, as filler.
- - Old filler is pruned, to prevent the map growing too large. -}
-alertWhile :: Alert -> Assistant Bool -> Assistant Bool
-alertWhile alert a = alertWhile' alert $ do
-	r <- a
-	return (r, r)
-
-{- Like alertWhile, but allows the activity to return a value too. -}
-alertWhile' :: Alert -> Assistant (Bool, a) -> Assistant a
-alertWhile' alert a = do
-	let alert' = alert { alertClass = Activity }
-	dstatus <- getAssistant daemonStatusHandle
-	i <- liftIO $ addAlert dstatus alert'
-	(ok, r) <- a
-	liftIO $ updateAlertMap dstatus $
-		mergeAlert i $ makeAlertFiller ok alert'
-	return r
-
-{- Displays an alert while performing an activity, then removes it. -}
-alertDuring :: Alert -> Assistant a -> Assistant a
-alertDuring alert a = do
-	let alert' = alert { alertClass = Activity }
-	dstatus <- getAssistant daemonStatusHandle
-	i <- liftIO $ addAlert dstatus alert'
-	liftIO (removeAlert dstatus i) `after` a
+import Assistant.Types.NamedThread as X