add syncing enabled/disabled to repo list with icon, and toggle link

The toggle link doesn't work yet.

Also lots of refactoring and type improvements

Assistant/WebApp/Configurators.hs

@@ -13,8 +13,8 @@ import Assistant.Common
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.WebApp.SideBar
-import Assistant.DaemonStatus
 import Assistant.WebApp.Configurators.Local
+import Assistant.DaemonStatus
 import Utility.Yesod
 import qualified Remote
 import qualified Types.Remote as Remote
@@ -37,71 +37,6 @@ getConfigR = ifM (inFirstRun)
 		$(widgetFile "configurators/main")
 	)
 
-{- Lists known repositories, followed by options to add more. -}
-getRepositoriesR :: Handler RepHtml
-getRepositoriesR = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Repositories"
-	repolist <- lift $ repoList False True
-	$(widgetFile "configurators/repositories")
-
-data SetupRepo =
-	EnableRepo (Route WebApp) |
-	EditRepo (Route WebApp) |
-	EnableSyncRepo (Route WebApp)
-
-needsEnabled :: SetupRepo -> Bool
-needsEnabled (EnableRepo _) = True
-needsEnabled _ = False
-
-notSyncing :: SetupRepo -> Bool
-notSyncing (EnableSyncRepo _) = True
-notSyncing _ = False
-
-setupRepoLink :: SetupRepo -> Route WebApp
-setupRepoLink (EnableRepo r) = r
-setupRepoLink (EditRepo r) = r
-setupRepoLink (EnableSyncRepo r) = r
-
-{- A numbered list of known repositories. -}
-repoList :: Bool -> Bool -> Handler [(String, String, SetupRepo)]
-repoList onlyconfigured includehere
-	| onlyconfigured = list =<< configured
-	| otherwise = list =<< (++) <$> configured <*> rest
-	where
-		configured = do
-			rs <- filter (not . Remote.readonly) . knownRemotes <$>
-				(liftIO . getDaemonStatus =<< daemonStatus <$> getYesod)
-			runAnnex [] $ do
-				u <- getUUID
-				let l = map Remote.uuid rs
-				let l' = if includehere then u : l else l
-				return $ withlinks (EditRepo . EditRepositoryR) l'
-		withlinks mklink l = zip l (map mklink l)
-		rest = runAnnex [] $ do
-			m <- readRemoteLog
-			unconfigured <- catMaybes . map (findtype m) . snd
-				<$> (trustPartition DeadTrusted $ M.keys m)
-			unsyncable <- withlinks (EnableSyncRepo . EditRepositoryR) . map Remote.uuid <$>
-				(filterM (\r -> not <$> repoSyncable (Remote.repo r))
-					=<< Remote.enabledRemoteList)
-			return $ unsyncable ++ unconfigured
-		findtype m u = case M.lookup u m of
-			Nothing -> Nothing
-			Just c -> case M.lookup "type" c of
-				Just "rsync" -> u `enableswith` EnableRsyncR
-				Just "directory" -> u `enableswith` EnableDirectoryR
-				Just "S3" -> u `enableswith` EnableS3R
-				_ -> Nothing
-		u `enableswith` r = Just (u, EnableRepo $ r u)
-		list l = runAnnex [] $ do
-			let l' = nubBy (\x y -> fst x == fst y) l
-			zip3
-				<$> pure counter
-				<*> Remote.prettyListUUIDs (map fst l')
-				<*> pure (map snd l')
-		counter = map show ([1..] :: [Int])
-
 {- An intro message, list of repositories, and nudge to make more. -}
 introDisplay :: Text -> Widget
 introDisplay ident = do
@@ -114,3 +49,93 @@ introDisplay ident = do
 	lift $ modifyWebAppState $ \s -> s { showIntro = False }
 	where
 		enough = 2
+
+{- Lists known repositories, followed by options to add more. -}
+getRepositoriesR :: Handler RepHtml
+getRepositoriesR = bootstrap (Just Config) $ do
+	sideBarDisplay
+	setTitle "Repositories"
+	repolist <- lift $ repoList False True
+	$(widgetFile "configurators/repositories")
+
+data Actions
+	= DisabledRepoActions
+		{ setupRepoLink :: Route WebApp }
+	| SyncingRepoActions
+		{ setupRepoLink :: Route WebApp
+		, syncToggleLink :: Route WebApp
+		}
+	| NotSyncingRepoActions
+		{ setupRepoLink :: Route WebApp
+		, syncToggleLink :: Route WebApp
+		}
+
+mkSyncingRepoActions :: UUID -> Actions
+mkSyncingRepoActions u = SyncingRepoActions
+	{ setupRepoLink = EditRepositoryR u
+	, syncToggleLink = DisableSyncR u
+	}
+
+mkNotSyncingRepoActions :: UUID -> Actions
+mkNotSyncingRepoActions u = NotSyncingRepoActions
+	{ setupRepoLink = EditRepositoryR u
+	, syncToggleLink = EnableSyncR u
+	}
+
+needsEnabled :: Actions -> Bool
+needsEnabled (DisabledRepoActions _) = True
+needsEnabled _ = False
+
+notSyncing :: Actions -> Bool
+notSyncing (SyncingRepoActions _ _) = False
+notSyncing _ = True
+
+{- A numbered list of known repositories,
+ - with actions that can be taken on them. -}
+repoList :: Bool -> Bool -> Handler [(String, String, Actions)]
+repoList onlyconfigured includehere
+	| onlyconfigured = list =<< configured
+	| otherwise = list =<< (++) <$> configured <*> rest
+	where
+		configured = do
+			rs <- filter (not . Remote.readonly) . knownRemotes <$>
+				(liftIO . getDaemonStatus =<< daemonStatus <$> getYesod)
+			runAnnex [] $ do
+				u <- getUUID
+				let l = map Remote.uuid rs
+				let l' = if includehere then u : l else l
+				return $ zip l' $ map mkSyncingRepoActions l'
+		rest = runAnnex [] $ do
+			m <- readRemoteLog
+			unconfigured <- catMaybes . map (findtype m) . snd
+				<$> (trustPartition DeadTrusted $ M.keys m)
+			unsyncable <- map Remote.uuid <$>
+				(filterM (\r -> not <$> repoSyncable (Remote.repo r))
+					=<< Remote.enabledRemoteList)
+			return $ zip unsyncable (map mkNotSyncingRepoActions unsyncable) ++ unconfigured
+		findtype m u = case M.lookup u m of
+			Nothing -> Nothing
+			Just c -> case M.lookup "type" c of
+				Just "rsync" -> u `enableswith` EnableRsyncR
+				Just "directory" -> u `enableswith` EnableDirectoryR
+				Just "S3" -> u `enableswith` EnableS3R
+				_ -> Nothing
+		u `enableswith` r = Just (u, DisabledRepoActions $ r u)
+		list l = runAnnex [] $ do
+			let l' = nubBy (\x y -> fst x == fst y) l
+			zip3
+				<$> pure counter
+				<*> Remote.prettyListUUIDs (map fst l')
+				<*> pure (map snd l')
+		counter = map show ([1..] :: [Int])
+
+
+getEnableSyncR :: UUID -> Handler ()
+getEnableSyncR uuid = do
+	error "TODO"
+	redirect RepositoriesR
+
+getDisableSyncR :: UUID -> Handler ()
+getDisableSyncR uuid = do
+	error "TODO"
+	redirect RepositoriesR