1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
|
{- 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")
|
