7ed8e87a34
(eg, on removable drives) gcrypt remotes are not yet handled. This commit was sponsored by Sören Brunk.
35 lines
1.1 KiB
Haskell
35 lines
1.1 KiB
Haskell
{- git-annex assistant repository repair
|
|
-
|
|
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
|
|
|
|
module Assistant.WebApp.Repair where
|
|
|
|
import Assistant.WebApp.Common
|
|
import Assistant.WebApp.RepoList
|
|
import Remote (prettyUUID, remoteFromUUID)
|
|
import Annex.UUID (getUUID)
|
|
import Assistant.Repair
|
|
|
|
getRepairRepositoryR :: UUID -> Handler Html
|
|
getRepairRepositoryR = postRepairRepositoryR
|
|
postRepairRepositoryR :: UUID -> Handler Html
|
|
postRepairRepositoryR u = page "Repair repository" Nothing $ do
|
|
repodesc <- liftAnnex $ prettyUUID u
|
|
repairingmainrepo <- (==) u <$> liftAnnex getUUID
|
|
$(widgetFile "control/repairrepository")
|
|
|
|
getRepairRepositoryRunR :: UUID -> Handler Html
|
|
getRepairRepositoryRunR = postRepairRepositoryRunR
|
|
postRepairRepositoryRunR :: UUID -> Handler Html
|
|
postRepairRepositoryRunR u = do
|
|
r <- liftAnnex $ remoteFromUUID u
|
|
void $ liftAssistant $ runRepair u r True
|
|
page "Repair repository" Nothing $ do
|
|
let repolist = repoListDisplay $
|
|
mainRepoSelector { nudgeAddMore = True }
|
|
$(widgetFile "control/repairrepository/done")
|