UI for configuring fscks of remotes

Assistant/WebApp/Configurators/Fsck.hs

@@ -13,7 +13,6 @@ module Assistant.WebApp.Configurators.Fsck where
 import qualified Data.Map as M
 import qualified Data.Set as S
 import qualified Data.Text as T
-import qualified Text.Hamlet as Hamlet
 
 import Assistant.WebApp.Common
 import Types.ScheduledActivity
@@ -21,17 +20,19 @@ import Utility.HumanTime
 import Utility.Scheduled
 import Logs.Schedule
 import Annex.UUID
+import qualified Remote
+import Assistant.DaemonStatus
 
 {- This adds a form to the page. It does not handle posting of the form,
  - because unlike a typical yesod form that posts using the same url
  - that generated it, this form posts using one of two other routes. -}
-fsckForm :: Bool -> ScheduledActivity -> Widget
+showFsckForm :: Bool -> ScheduledActivity -> Widget
-fsckForm new activity = do
+showFsckForm new activity = do
 	u <- liftAnnex getUUID
 	let action = if new
 		then AddActivityR u
 		else ChangeActivityR u activity
-	((res, form), enctype) <- liftH $ runFormPost $ fsckForm' new activity
+	((res, form), enctype) <- liftH $ runFsckForm new activity
 	case res of
 		FormSuccess _ -> noop
 		_ -> $(widgetFile "configurators/fsck/form")
@@ -40,49 +41,73 @@ fsckForm new activity = do
  - some Annex action on it. -}
 withFsckForm :: (ScheduledActivity -> Annex ()) -> Handler ()
 withFsckForm a = do
-	((res, _form), _enctype) <- runFormPost $ fsckForm' False defaultFsck
+	((res, _form), _enctype) <- runFsckForm False defaultFsck
 	case res of
 		FormSuccess activity -> liftAnnex $ a activity
 		_ -> noop
 
-fsckForm' :: Bool -> ScheduledActivity -> Hamlet.Html -> MkMForm ScheduledActivity
+mkFsck :: UUID -> UUID -> Schedule -> Duration -> ScheduledActivity
-fsckForm' new activity@(ScheduledSelfFsck (Schedule r t) d) msg = do
+mkFsck hereu u s d
-	(durationRes, durationView) <- mreq intField "" (Just $ durationSeconds d `quot` 60 )
+	| u == hereu = ScheduledSelfFsck s d 
-	(timeRes, timeView) <- mreq (selectFieldList times) "" (Just t)
+	| otherwise = ScheduledRemoteFsck u s d
-	(recurranceRes, recurranceView) <- mreq (selectFieldList recurrances) "" (Just r)
+
-	let form = do
+runFsckForm :: Bool -> ScheduledActivity -> Handler ((FormResult ScheduledActivity, Widget), Enctype)
-		webAppFormAuthToken
+runFsckForm new activity = case activity of
-		u <- liftAnnex getUUID
+	ScheduledSelfFsck s d -> go s d =<< liftAnnex getUUID
-		$(widgetFile "configurators/fsck/formcontent")
+	ScheduledRemoteFsck ru s d -> go s d ru
-	let formresult = ScheduledSelfFsck
-		<$> (Schedule <$> recurranceRes <*> timeRes)
-		<*> (Duration <$> ((60 *) <$> durationRes))
-	return (formresult, form)
   where
-	times :: [(Text, ScheduledTime)]
+  	go (Schedule r t) d ru = do
-	times = ensurevalue t (T.pack $ fromScheduledTime t) $
+		u <- liftAnnex getUUID
-		map (\x -> (T.pack $ fromScheduledTime x, x)) $
+		repolist <- liftAssistant (getrepolist ru)
-			AnyTime : map (\h -> SpecificTime h 0) [0..23]
+		runFormPost $ \msg -> do
-	recurrances :: [(Text, Recurrance)]
+			(reposRes, reposView) <- mreq (selectFieldList repolist) "" (Just ru)
-	recurrances = ensurevalue r (T.pack $ fromRecurrance r) $
+			(durationRes, durationView) <- mreq intField "" (Just $ durationSeconds d `quot` 60 )
-		[ ("every day", Daily)
+			(timeRes, timeView) <- mreq (selectFieldList times) "" (Just t)
-		, ("every Sunday", Weekly 1)
+			(recurranceRes, recurranceView) <- mreq (selectFieldList recurrances) "" (Just r)
-		, ("every Monday", Weekly 2)
+			let form = do
-		, ("every Tuesday", Weekly 3)
+				webAppFormAuthToken
-		, ("every Wednesday", Weekly 4)
+				$(widgetFile "configurators/fsck/formcontent")
-		, ("every Thursday", Weekly 5)
+			let formresult = mkFsck
-		, ("every Friday", Weekly 6)
+				<$> pure u
-		, ("every Saturday", Weekly 7)
+				<*> reposRes
-		, ("on the 1st of the month", Monthly 1)
+				<*> (Schedule <$> recurranceRes <*> timeRes)
-		, ("mid-month", Monthly 15)
+				<*> (Duration <$> ((60 *) <$> durationRes))
-		, ("once a year", Yearly 1)
+			return (formresult, form)
-		, ("twice a year", (Divisible 6 $ Monthly 1))
+	  where
-		, ("quarterly", (Divisible 4 $ Monthly 1))
+		times :: [(Text, ScheduledTime)]
-		]
+		times = ensurevalue t (T.pack $ fromScheduledTime t) $
+			map (\x -> (T.pack $ fromScheduledTime x, x)) $
+				AnyTime : map (\h -> SpecificTime h 0) [0..23]
+		recurrances :: [(Text, Recurrance)]
+		recurrances = ensurevalue r (T.pack $ fromRecurrance r) $
+			[ ("every day", Daily)
+			, ("every Sunday", Weekly 1)
+			, ("every Monday", Weekly 2)
+			, ("every Tuesday", Weekly 3)
+			, ("every Wednesday", Weekly 4)
+			, ("every Thursday", Weekly 5)
+			, ("every Friday", Weekly 6)
+			, ("every Saturday", Weekly 7)
+			, ("monthly", Monthly 1)
+			, ("twice a month", Divisible 2 (Weekly 1))
+			, ("yearly", Yearly 1)
+			, ("twice a year", Divisible 6 (Monthly 1))
+			, ("quarterly", Divisible 4 (Monthly 1))
+			]
 	ensurevalue v desc l = case M.lookup v (M.fromList $ map (\(x,y) -> (y,x)) l) of
 		Just _ -> l
 		Nothing -> (desc, v) : l
-fsckForm' new (ScheduledRemoteFsck u s d) _msg = error "TODO"
+	getrepolist :: UUID -> Assistant [(Text, UUID)]
+	getrepolist ensureu = do
+		-- It is possible to have fsck jobs for remotes that
+		-- do not implement remoteFsck, but it's not too useful,
+		-- so omit them from the UI normally.
+		remotes <- filter (\r -> Remote.uuid r == ensureu || isJust (Remote.remoteFsck r)) . syncRemotes
+			<$> getDaemonStatus
+		u <- liftAnnex getUUID
+		let us = u : (map Remote.uuid remotes)
+		liftAnnex $ 
+			zip <$> (map T.pack <$> Remote.prettyListUUIDs us) <*> pure us
 
 defaultFsck :: ScheduledActivity
 defaultFsck = ScheduledSelfFsck (Schedule Daily AnyTime) (Duration $ 60*60)

templates/configurators/fsck.cassius

@@ -1,2 +1,4 @@
 input[type=number]
   width: 5em
+select
+  width: 10em

templates/configurators/fsck.hamlet

@@ -13,7 +13,7 @@
     <p>
       Currently scheduled checks:
       $forall check <- checks
-        ^{fsckForm False check}
+        ^{showFsckForm False check}
   <p>
     Add a check:
-    ^{fsckForm True defaultFsck}
+    ^{showFsckForm True defaultFsck}

templates/configurators/fsck/formcontent.hamlet

@@ -1,7 +1,7 @@
 #{msg}
 <p>
   <div .input-prepend .input-append>
-    Check this repository for #
+    Check ^{fvInput reposView} for #
     ^{fvInput durationView} minutes #
     ^{fvInput recurranceView} #
     starting at ^{fvInput timeView} #
@@ -13,4 +13,3 @@
         Save
       <a .btn href="@{RemoveActivityR u activity}">
         Remove
-