diff options
-rw-r--r-- | Assistant/Alert.hs | 33 | ||||
-rw-r--r-- | Assistant/Alert/Utility.hs | 2 | ||||
-rw-r--r-- | Assistant/NamedThread.hs | 2 | ||||
-rw-r--r-- | Assistant/Threads/UpgradeWatcher.hs | 23 | ||||
-rw-r--r-- | Assistant/Types/Alert.hs | 3 |
5 files changed, 38 insertions, 25 deletions
diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs index fef78c1f0..25a75eeab 100644 --- a/Assistant/Alert.hs +++ b/Assistant/Alert.hs @@ -42,6 +42,7 @@ mkAlertButton autoclose label urlrenderer route = do { buttonLabel = label , buttonUrl = url , buttonAction = if autoclose then Just close else Nothing + , buttonPrimary = True } #endif @@ -61,7 +62,7 @@ baseActivityAlert = Alert , alertIcon = Just ActivityIcon , alertCombiner = Nothing , alertName = Nothing - , alertButton = Nothing + , alertButtons = [] } warningAlert :: String -> String -> Alert @@ -77,7 +78,7 @@ warningAlert name msg = Alert , alertIcon = Just ErrorIcon , alertCombiner = Just $ dataCombiner $ \_old new -> new , alertName = Just $ WarningAlert name - , alertButton = Nothing + , alertButtons = [] } errorAlert :: String -> AlertButton -> Alert @@ -93,7 +94,7 @@ errorAlert msg button = Alert , alertIcon = Just ErrorIcon , alertCombiner = Nothing , alertName = Nothing - , alertButton = Just button + , alertButtons = [button] } activityAlert :: Maybe TenseText -> [TenseChunk] -> Alert @@ -160,7 +161,7 @@ sanityCheckFixAlert msg = Alert , alertIcon = Just ErrorIcon , alertName = Just SanityCheckFixAlert , alertCombiner = Just $ dataCombiner (++) - , alertButton = Nothing + , alertButtons = [] } where render alert = tenseWords $ alerthead : alertData alert ++ [alertfoot] @@ -172,7 +173,7 @@ fsckingAlert button mr = baseActivityAlert { alertData = case mr of Nothing -> [ UnTensed $ T.pack $ "Consistency check in progress" ] Just r -> [ UnTensed $ T.pack $ "Consistency check of " ++ Remote.name r ++ " in progress"] - , alertButton = Just button + , alertButtons = [button] } showFscking :: UrlRenderer -> Maybe Remote -> IO (Either E.SomeException a) -> Assistant a @@ -204,7 +205,7 @@ notFsckedAlert mr button = Alert ] , alertIcon = Just InfoIcon , alertPriority = High - , alertButton = Just button + , alertButtons = [button] , alertClosable = True , alertClass = Message , alertMessageRender = renderData @@ -223,7 +224,7 @@ canUpgradeAlert priority button = Alert else "An upgrade of git-annex is available." , alertIcon = Just UpgradeIcon , alertPriority = priority - , alertButton = Just button + , alertButtons = [button] , alertClosable = True , alertClass = Message , alertMessageRender = renderData @@ -234,13 +235,13 @@ canUpgradeAlert priority button = Alert , alertData = [] } -upgradeReadyAlert :: AlertButton -> Alert -upgradeReadyAlert button = Alert +upgradeReadyAlert :: [AlertButton] -> Alert +upgradeReadyAlert buttons = Alert { alertHeader = Just $ fromString "A new version of git-annex has been installed." , alertIcon = Just UpgradeIcon , alertPriority = High - , alertButton = Just button + , alertButtons = buttons , alertClosable = True , alertClass = Message , alertMessageRender = renderData @@ -267,7 +268,7 @@ pairingAlert :: AlertButton -> Alert pairingAlert button = baseActivityAlert { alertData = [ UnTensed "Pairing in progress" ] , alertPriority = High - , alertButton = Just button + , alertButtons = [button] } pairRequestReceivedAlert :: String -> AlertButton -> Alert @@ -283,7 +284,7 @@ pairRequestReceivedAlert who button = Alert , alertIcon = Just InfoIcon , alertName = Just $ PairAlert who , alertCombiner = Just $ dataCombiner $ \_old new -> new - , alertButton = Just button + , alertButtons = [button] } pairRequestAcknowledgedAlert :: String -> Maybe AlertButton -> Alert @@ -292,7 +293,7 @@ pairRequestAcknowledgedAlert who button = baseActivityAlert , alertPriority = High , alertName = Just $ PairAlert who , alertCombiner = Just $ dataCombiner $ \_old new -> new - , alertButton = button + , alertButtons = maybe [] (:[]) button } xmppNeededAlert :: AlertButton -> Alert @@ -300,7 +301,7 @@ xmppNeededAlert button = Alert { alertHeader = Just "Share with friends, and keep your devices in sync across the cloud." , alertIcon = Just TheCloud , alertPriority = High - , alertButton = Just button + , alertButtons = [button] , alertClosable = True , alertClass = Message , alertMessageRender = renderData @@ -319,7 +320,7 @@ cloudRepoNeededAlert friendname button = Alert ] , alertIcon = Just ErrorIcon , alertPriority = High - , alertButton = Just button + , alertButtons = [button] , alertClosable = True , alertClass = Message , alertMessageRender = renderData @@ -337,7 +338,7 @@ remoteRemovalAlert desc button = Alert "\" has been emptied, and can now be removed." , alertIcon = Just InfoIcon , alertPriority = High - , alertButton = Just button + , alertButtons = [button] , alertClosable = True , alertClass = Message , alertMessageRender = renderData diff --git a/Assistant/Alert/Utility.hs b/Assistant/Alert/Utility.hs index af52a4235..db2ea1925 100644 --- a/Assistant/Alert/Utility.hs +++ b/Assistant/Alert/Utility.hs @@ -87,7 +87,7 @@ makeAlertFiller success alert { alertClass = if c == Activity then c' else c , alertPriority = Filler , alertClosable = True - , alertButton = Nothing + , alertButtons = [] , alertIcon = Just $ if success then SuccessIcon else ErrorIcon } where diff --git a/Assistant/NamedThread.hs b/Assistant/NamedThread.hs index 2440c45bf..e1b3983f7 100644 --- a/Assistant/NamedThread.hs +++ b/Assistant/NamedThread.hs @@ -82,7 +82,7 @@ startNamedThread urlrenderer (NamedThread afterstartupsanitycheck name a) = do (RestartThreadR name) runAssistant d $ void $ addAlert $ (warningAlert (fromThreadName name) msg) - { alertButton = Just button } + { alertButtons = [button] } #endif namedThreadId :: NamedThread -> Assistant (Maybe ThreadId) diff --git a/Assistant/Threads/UpgradeWatcher.hs b/Assistant/Threads/UpgradeWatcher.hs index acf68a0a6..7d0da5818 100644 --- a/Assistant/Threads/UpgradeWatcher.hs +++ b/Assistant/Threads/UpgradeWatcher.hs @@ -12,6 +12,7 @@ module Assistant.Threads.UpgradeWatcher ( ) where import Assistant.Common +import Assistant.Upgrade import Utility.DirWatcher import Utility.DirWatcher.Types import Config.Files @@ -23,6 +24,8 @@ import Assistant.DaemonStatus #ifdef WITH_WEBAPP import Assistant.WebApp.Types #endif +import qualified Annex +import Types.Distribution import Control.Concurrent.MVar import Data.Tuple.Utils @@ -77,14 +80,14 @@ changedFile urlrenderer mvar program file _status -} sanityCheck :: FilePath -> Assistant Bool sanityCheck program = do - whileM (liftIO $ haswriter <||> missing) $ do + untilM (liftIO $ nowriter <&&> present) $ do debug [program, "is still being written; waiting"] liftIO $ threadDelaySeconds (Seconds 60) debug [program, "has changed, and seems to be ready to run"] liftIO $ boolSystem program [Param "version"] where - missing = not <$> doesFileExist program - haswriter = not . null + present = doesFileExist program + nowriter = null . filter (`elem` [Lsof.OpenReadWrite, Lsof.OpenWriteOnly]) . map snd3 <$> Lsof.query [program] @@ -95,9 +98,17 @@ handleUpgrade urlrenderer = do -- (For example, other associated files may be being put into -- place.) liftIO $ threadDelaySeconds (Seconds 120) + ifM (liftAnnex $ (==) AutoUpgrade . annexAutoUpgrade <$> Annex.getGitConfig) + ( do + debug ["starting automatic upgrade"] + unattendedUpgrade #ifdef WITH_WEBAPP - button <- mkAlertButton True (T.pack "Finish Upgrade") urlrenderer ConfigFinishUpgradeR - void $ addAlert (upgradeReadyAlert button) + , do + finish <- mkAlertButton True (T.pack "Finish Upgrade") urlrenderer (ConfigFinishUpgradeR False) + noask <- mkAlertButton True (T.pack "Always Upgrade Automatically") urlrenderer (ConfigFinishUpgradeR True) + void $ addAlert $ upgradeReadyAlert + [finish, noask { buttonPrimary = False }] #else - noop + , noop #endif + ) diff --git a/Assistant/Types/Alert.hs b/Assistant/Types/Alert.hs index c601c60db..4079802ec 100644 --- a/Assistant/Types/Alert.hs +++ b/Assistant/Types/Alert.hs @@ -51,7 +51,7 @@ data Alert = Alert , alertIcon :: Maybe AlertIcon , alertCombiner :: Maybe AlertCombiner , alertName :: Maybe AlertName - , alertButton :: Maybe AlertButton + , alertButtons :: [AlertButton] } data AlertIcon = ActivityIcon | SyncIcon | SuccessIcon | ErrorIcon | InfoIcon | UpgradeIcon | TheCloud @@ -75,4 +75,5 @@ data AlertButton = AlertButton { buttonLabel :: Text , buttonUrl :: Text , buttonAction :: Maybe (AlertId -> IO ()) + , buttonPrimary :: Bool } |