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

annex.autoupgrade added to webapp prefs page

Browse source
This commit is contained in:
Joey Hess 2013-11-22 16:21:04 -04:00
parent 5cf8a2ffcd
commit f8a3dd9c3d
1 changed files with 17 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

17
Assistant/WebApp/Configurators/Preferences.hs
View file

@ -19,6 +19,8 @@ import Config
import Config.Files import Config.Files
import Utility.DataUnits import Utility.DataUnits
import Git.Config import Git.Config
import Types.Distribution
import qualified Build.SysConfig
import qualified Data.Text as T import qualified Data.Text as T
@ -26,6 +28,7 @@ data PrefsForm = PrefsForm
{ diskReserve :: Text { diskReserve :: Text
, numCopies :: Int , numCopies :: Int
, autoStart :: Bool , autoStart :: Bool
, autoUpgrade :: AutoUpgrade
, debugEnabled :: Bool , debugEnabled :: Bool
} }
@ -37,6 +40,8 @@ prefsAForm def = PrefsForm
"Number of copies" (Just $ numCopies def) "Number of copies" (Just $ numCopies def)
<*> areq (checkBoxField `withNote` autostartnote) <*> areq (checkBoxField `withNote` autostartnote)
"Auto start" (Just $ autoStart def) "Auto start" (Just $ autoStart def)
<*> areq (selectFieldList autoUpgradeChoices)
autoUpgradeLabel (Just $ autoUpgrade def)
<*> areq (checkBoxField `withNote` debugnote) <*> areq (checkBoxField `withNote` debugnote)
"Enable debug logging" (Just $ debugEnabled def) "Enable debug logging" (Just $ debugEnabled def)
where where
@ -45,6 +50,16 @@ prefsAForm def = PrefsForm
debugnote = [whamlet|<a href="@{LogR}">View Log</a>|] debugnote = [whamlet|<a href="@{LogR}">View Log</a>|]
autostartnote = [whamlet|Start the git-annex assistant at boot or on login.|] autostartnote = [whamlet|Start the git-annex assistant at boot or on login.|]
autoUpgradeChoices :: [(Text, AutoUpgrade)]
autoUpgradeChoices =
[ ("ask me", AskUpgrade)
, ("enabled", AutoUpgrade)
, ("disabled", NoAutoUpgrade)
]
autoUpgradeLabel
| isJust Build.SysConfig.upgradelocation = "Auto upgrade"
| otherwise = "Auto restart on upgrade"
positiveIntField = check isPositive intField positiveIntField = check isPositive intField
where where
isPositive i isPositive i
@ -68,12 +83,14 @@ getPrefs = PrefsForm
<$> (T.pack . roughSize storageUnits False . annexDiskReserve <$> Annex.getGitConfig) <$> (T.pack . roughSize storageUnits False . annexDiskReserve <$> Annex.getGitConfig)
<*> (annexNumCopies <$> Annex.getGitConfig) <*> (annexNumCopies <$> Annex.getGitConfig)
<*> inAutoStartFile <*> inAutoStartFile
<*> (annexAutoUpgrade <$> Annex.getGitConfig)
<*> (annexDebug <$> Annex.getGitConfig) <*> (annexDebug <$> Annex.getGitConfig)
storePrefs :: PrefsForm -> Annex () storePrefs :: PrefsForm -> Annex ()
storePrefs p = do storePrefs p = do
setConfig (annexConfig "diskreserve") (T.unpack $ diskReserve p) setConfig (annexConfig "diskreserve") (T.unpack $ diskReserve p)
setConfig (annexConfig "numcopies") (show $ numCopies p) setConfig (annexConfig "numcopies") (show $ numCopies p)
setConfig (annexConfig "autoupgrade") (fromAutoUpgrade $ autoUpgrade p)
unlessM ((==) <$> pure (autoStart p) <*> inAutoStartFile) $ do unlessM ((==) <$> pure (autoStart p) <*> inAutoStartFile) $ do
here <- fromRepo Git.repoPath here <- fromRepo Git.repoPath
liftIO $ if autoStart p liftIO $ if autoStart p