add webapp UI to manage unused files
This commit is contained in:
parent
9418685b5d
commit
e0bd088f08
11 changed files with 243 additions and 78 deletions
|
@ -11,20 +11,70 @@ module Assistant.WebApp.Configurators.Unused where
|
|||
|
||||
import Assistant.WebApp.Common
|
||||
import qualified Annex
|
||||
import qualified Git
|
||||
import Utility.HumanTime
|
||||
import Assistant.Unused
|
||||
import Config
|
||||
import Config.Files
|
||||
import Config.NumCopies
|
||||
import Utility.DataUnits
|
||||
import Git.Config
|
||||
import Types.Distribution
|
||||
import qualified Build.SysConfig
|
||||
import Logs.Unused
|
||||
import Utility.Tense
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Text.Hamlet as Hamlet
|
||||
|
||||
data UnusedForm = UnusedForm
|
||||
{ enableExpire :: Bool
|
||||
, expireWhen :: Integer
|
||||
}
|
||||
|
||||
unusedForm :: UnusedForm -> Hamlet.Html -> MkMForm UnusedForm
|
||||
unusedForm def msg = do
|
||||
(enableRes, enableView) <- mreq (selectFieldList enabledisable) ""
|
||||
(Just $ enableExpire def)
|
||||
(whenRes, whenView) <- mreq intField ""
|
||||
(Just $ expireWhen def)
|
||||
let form = do
|
||||
webAppFormAuthToken
|
||||
$(widgetFile "configurators/unused/form")
|
||||
return (UnusedForm <$> enableRes <*> whenRes, form)
|
||||
where
|
||||
enabledisable :: [(Text, Bool)]
|
||||
enabledisable = [("Disable expiry", False), ("Enable expiry", True)]
|
||||
|
||||
getConfigUnusedR :: Handler Html
|
||||
getConfigUnusedR = error "TODO"
|
||||
|
||||
getConfigUnusedR = postConfigUnusedR
|
||||
postConfigUnusedR :: Handler Html
|
||||
postConfigUnusedR = getConfigUnusedR
|
||||
postConfigUnusedR = page "Unused files" (Just Configuration) $ do
|
||||
current <- liftAnnex getUnused
|
||||
((res, form), enctype) <- liftH $ runFormPostNoToken $ unusedForm current
|
||||
case res of
|
||||
FormSuccess new -> liftH $ do
|
||||
liftAnnex $ storeUnused new
|
||||
redirect ConfigurationR
|
||||
_ -> do
|
||||
munuseddesc <- liftAssistant describeUnused
|
||||
ts <- liftAnnex $ dateUnusedLog ""
|
||||
mlastchecked <- case ts of
|
||||
Nothing -> pure Nothing
|
||||
Just t -> Just <$> liftIO (durationSince t)
|
||||
$(widgetFile "configurators/unused")
|
||||
|
||||
getUnused :: Annex UnusedForm
|
||||
getUnused = convert . annexExpireUnused <$> Annex.getGitConfig
|
||||
where
|
||||
convert Nothing = noexpire
|
||||
convert (Just Nothing) = noexpire
|
||||
convert (Just (Just n)) = UnusedForm True $ durationToDays n
|
||||
|
||||
-- The 7 is so that, if they enable expiry, they have to change
|
||||
-- it to get faster than a week.
|
||||
noexpire = UnusedForm False 7
|
||||
|
||||
storeUnused :: UnusedForm -> Annex ()
|
||||
storeUnused f = setConfig (annexConfig "expireunused") $
|
||||
if not (enableExpire f) || expireWhen f < 0
|
||||
then boolConfig False
|
||||
else fromDuration $ daysToDuration $ expireWhen f
|
||||
|
||||
getCleanupUnusedR :: Handler Html
|
||||
getCleanupUnusedR = do
|
||||
liftAssistant $ expireUnused Nothing
|
||||
redirect ConfigUnusedR
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue