mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

streamline deletion process and improve UI

Browse source
This commit is contained in:
Joey Hess 2013-04-03 20:54:53 -04:00
parent eb2b9f9f3a
commit 37d7da4de8
8 changed files with 49 additions and 62 deletions
Download patch file Download diff file Expand all files Collapse all files

24
Assistant/WebApp/Configurators/Delete.hs
View file

@ -27,33 +27,33 @@ import System.IO.HVFS (SystemFS(..))
import qualified Data.Text as T
import qualified Data.Map as M
getDisableRepositoryR :: UUID -> Handler RepHtml
getDisableRepositoryR uuid = do
void $ liftAssistant $ disableRemote uuid
redirect DashboardR
getDeleteRepositoryR :: UUID -> Handler RepHtml
getDeleteRepositoryR uuid = go =<< liftAnnex (Remote.remoteFromUUID uuid)
where
go Nothing = redirect DeleteCurrentRepositoryR
go (Just r) = deletionPage $ do
reponame <- liftAnnex $ Remote.prettyUUID uuid
$(widgetFile "configurators/delete/choose")
$(widgetFile "configurators/delete/start")
getDeleteRepositoryFromListR :: UUID -> Handler RepHtml
getDeleteRepositoryFromListR uuid = do
void $ liftAssistant $ removeRemote uuid
redirect DashboardR
getStartDeleteRepositoryContentsR :: UUID -> Handler RepHtml
getStartDeleteRepositoryContentsR uuid = deletionPage $ do
getStartDeleteRepositoryR :: UUID -> Handler RepHtml
getStartDeleteRepositoryR uuid = do
remote <- fromMaybe (error "unknown remote")
<$> liftAnnex (Remote.remoteFromUUID uuid)
liftAnnex $ do
trustSet uuid UnTrusted
setStandardGroup uuid UnwantedGroup
liftAssistant $ addScanRemotes True [remote]
redirect DashboardR
reponame <- liftAnnex $ Remote.prettyUUID uuid
$(widgetFile "configurators/delete/started")
getFinishDeleteRepositoryR :: UUID -> Handler RepHtml
getFinishDeleteRepositoryR uuid = deletionPage $ do
void $ liftAssistant $ removeRemote uuid
getFinishedDeletingRepositoryContentsR :: UUID -> Handler RepHtml
getFinishedDeletingRepositoryContentsR uuid = deletionPage $ do
reponame <- liftAnnex $ Remote.prettyUUID uuid
{- If it's not listed in the remote log, it must be a git repo. -}
gitrepo <- liftAnnex $ M.notMember uuid <$> readRemoteLog

13
Assistant/WebApp/routes
View file

@ -43,12 +43,6 @@
/config/repository/add/cloud/glacier AddGlacierR GET POST
/config/repository/add/cloud/box.com AddBoxComR GET POST
/config/repository/delete/choose/#UUID DeleteRepositoryR GET
/config/repository/delete/fromlist/#UUID DeleteRepositoryFromListR GET
/config/repository/delete/contents/start/#UUID StartDeleteRepositoryContentsR GET
/config/repository/delete/contents/finish/#UUID FinishedDeletingRepositoryContentsR GET
/config/repository/delete/here DeleteCurrentRepositoryR GET POST
/config/repository/pair/local/start StartLocalPairR GET POST
/config/repository/pair/local/running/#SecretReminder RunningLocalPairR GET
/config/repository/pair/local/finish/#PairMsg FinishLocalPairR GET POST
@ -69,6 +63,13 @@
/config/repository/reorder RepositoriesReorderR GET
/config/repository/disable/#UUID DisableRepositoryR GET
/config/repository/delete/confirm/#UUID DeleteRepositoryR GET
/config/repository/delete/start/#UUID StartDeleteRepositoryR GET
/config/repository/delete/finish/#UUID FinishDeleteRepositoryR GET
/config/repository/delete/here DeleteCurrentRepositoryR GET POST
/transfers/#NotificationId TransfersR GET
/notifier/transfers NotifierTransfersR GET