import Data.Default in Common
This commit is contained in:
parent
0fd5f257d0
commit
e8c376e0ad
19 changed files with 48 additions and 54 deletions
|
@ -144,13 +144,13 @@ setRepoConfig uuid mremote oldc newc = do
|
|||
legalName = makeLegalName . T.unpack . repoName
|
||||
|
||||
editRepositoryAForm :: Maybe Remote -> RepoConfig -> MkAForm RepoConfig
|
||||
editRepositoryAForm mremote def = RepoConfig
|
||||
editRepositoryAForm mremote d = RepoConfig
|
||||
<$> areq (if ishere then readonlyTextField else textField)
|
||||
(bfs "Name") (Just $ repoName def)
|
||||
<*> aopt textField (bfs "Description") (Just $ repoDescription def)
|
||||
<*> areq (selectFieldList groups `withNote` help) (bfs "Repository group") (Just $ repoGroup def)
|
||||
(bfs "Name") (Just $ repoName d)
|
||||
<*> aopt textField (bfs "Description") (Just $ repoDescription d)
|
||||
<*> areq (selectFieldList groups `withNote` help) (bfs "Repository group") (Just $ repoGroup d)
|
||||
<*> associateddirectory
|
||||
<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def)
|
||||
<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable d)
|
||||
where
|
||||
ishere = isNothing mremote
|
||||
isspecial = fromMaybe False $
|
||||
|
@ -163,14 +163,14 @@ editRepositoryAForm mremote def = RepoConfig
|
|||
| isspecial = const True
|
||||
| otherwise = not . specialRemoteOnly
|
||||
customgroups :: [(Text, RepoGroup)]
|
||||
customgroups = case repoGroup def of
|
||||
customgroups = case repoGroup d of
|
||||
RepoGroupCustom s -> [(T.pack s, RepoGroupCustom s)]
|
||||
_ -> []
|
||||
help = [whamlet|<a href="@{RepoGroupR}">What's this?</a>|]
|
||||
|
||||
associateddirectory = case repoAssociatedDirectory def of
|
||||
associateddirectory = case repoAssociatedDirectory d of
|
||||
Nothing -> aopt hiddenField "" Nothing
|
||||
Just d -> aopt textField (bfs "Associated directory") (Just $ Just d)
|
||||
Just dir -> aopt textField (bfs "Associated directory") (Just $ Just dir)
|
||||
|
||||
getEditRepositoryR :: RepoId -> Handler Html
|
||||
getEditRepositoryR = postEditRepositoryR
|
||||
|
|
|
@ -167,8 +167,8 @@ getFsckPreferences = FsckPreferences
|
|||
<$> (annexFsckNudge <$> Annex.getGitConfig)
|
||||
|
||||
fsckPreferencesAForm :: FsckPreferences -> MkAForm FsckPreferences
|
||||
fsckPreferencesAForm def = FsckPreferences
|
||||
<$> areq (checkBoxField `withNote` nudgenote) "Reminders" (Just $ enableFsckNudge def)
|
||||
fsckPreferencesAForm d = FsckPreferences
|
||||
<$> areq (checkBoxField `withNote` nudgenote) "Reminders" (Just $ enableFsckNudge d)
|
||||
where
|
||||
nudgenote = [whamlet|Remind me when using repositories that lack consistency checks.|]
|
||||
|
||||
|
|
|
@ -34,17 +34,17 @@ data PrefsForm = PrefsForm
|
|||
}
|
||||
|
||||
prefsAForm :: PrefsForm -> MkAForm PrefsForm
|
||||
prefsAForm def = PrefsForm
|
||||
prefsAForm d = PrefsForm
|
||||
<$> areq (storageField `withNote` diskreservenote)
|
||||
(bfs "Disk reserve") (Just $ diskReserve def)
|
||||
(bfs "Disk reserve") (Just $ diskReserve d)
|
||||
<*> areq (positiveIntField `withNote` numcopiesnote)
|
||||
(bfs "Number of copies") (Just $ numCopies def)
|
||||
(bfs "Number of copies") (Just $ numCopies d)
|
||||
<*> areq (checkBoxField `withNote` autostartnote)
|
||||
"Auto start" (Just $ autoStart def)
|
||||
"Auto start" (Just $ autoStart d)
|
||||
<*> areq (selectFieldList autoUpgradeChoices)
|
||||
(bfs autoUpgradeLabel) (Just $ autoUpgrade def)
|
||||
(bfs autoUpgradeLabel) (Just $ autoUpgrade d)
|
||||
<*> areq (checkBoxField `withNote` debugnote)
|
||||
"Enable debug logging" (Just $ debugEnabled def)
|
||||
"Enable debug logging" (Just $ debugEnabled d)
|
||||
where
|
||||
diskreservenote = [whamlet|<br>Avoid downloading files from other repositories when there is too little free disk space.|]
|
||||
numcopiesnote = [whamlet|<br>Only drop a file after verifying that other repositories contain this many copies.|]
|
||||
|
|
|
@ -91,15 +91,15 @@ sshInputAForm :: Field Handler Text -> SshInput -> AForm Handler SshInput
|
|||
#else
|
||||
sshInputAForm :: Field WebApp WebApp Text -> SshInput -> AForm WebApp WebApp SshInput
|
||||
#endif
|
||||
sshInputAForm hostnamefield def = normalize <$> gen
|
||||
sshInputAForm hostnamefield d = normalize <$> gen
|
||||
where
|
||||
gen = SshInput
|
||||
<$> aopt check_hostname (bfs "Host name") (Just $ inputHostname def)
|
||||
<*> aopt check_username (bfs "User name") (Just $ inputUsername def)
|
||||
<*> areq (selectFieldList authmethods) (bfs "Authenticate with") (Just $ inputAuthMethod def)
|
||||
<$> aopt check_hostname (bfs "Host name") (Just $ inputHostname d)
|
||||
<*> aopt check_username (bfs "User name") (Just $ inputUsername d)
|
||||
<*> areq (selectFieldList authmethods) (bfs "Authenticate with") (Just $ inputAuthMethod d)
|
||||
<*> aopt passwordField (bfs "Password") Nothing
|
||||
<*> aopt textField (bfs "Directory") (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory def)
|
||||
<*> areq intField (bfs "Port") (Just $ inputPort def)
|
||||
<*> aopt textField (bfs "Directory") (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory d)
|
||||
<*> areq intField (bfs "Port") (Just $ inputPort d)
|
||||
|
||||
authmethods :: [(Text, AuthMethod)]
|
||||
authmethods =
|
||||
|
@ -133,10 +133,10 @@ sshInputAForm hostnamefield def = normalize <$> gen
|
|||
|
||||
-- The directory is implicitly in home, so remove any leading ~/
|
||||
normalize i = i { inputDirectory = normalizedir <$> inputDirectory i }
|
||||
normalizedir d
|
||||
| "~/" `T.isPrefixOf` d = T.drop 2 d
|
||||
| "/~/" `T.isPrefixOf` d = T.drop 3 d
|
||||
| otherwise = d
|
||||
normalizedir dir
|
||||
| "~/" `T.isPrefixOf` dir = T.drop 2 dir
|
||||
| "/~/" `T.isPrefixOf` dir = T.drop 3 dir
|
||||
| otherwise = dir
|
||||
|
||||
data ServerStatus
|
||||
= UntestedServer
|
||||
|
|
|
@ -26,11 +26,11 @@ data UnusedForm = UnusedForm
|
|||
}
|
||||
|
||||
unusedForm :: UnusedForm -> Hamlet.Html -> MkMForm UnusedForm
|
||||
unusedForm def msg = do
|
||||
unusedForm d msg = do
|
||||
(enableRes, enableView) <- mreq (selectFieldList enabledisable) (bfs "")
|
||||
(Just $ enableExpire def)
|
||||
(Just $ enableExpire d)
|
||||
(whenRes, whenView) <- mreq intField (bfs "")
|
||||
(Just $ expireWhen def)
|
||||
(Just $ expireWhen d)
|
||||
let form = do
|
||||
webAppFormAuthToken
|
||||
$(widgetFile "configurators/unused/form")
|
||||
|
|
|
@ -161,8 +161,8 @@ creds2Form :: XMPPCreds -> XMPPForm
|
|||
creds2Form c = XMPPForm (xmppJID c) (xmppPassword c)
|
||||
|
||||
xmppAForm :: (Maybe XMPPForm) -> MkAForm XMPPForm
|
||||
xmppAForm def = XMPPForm
|
||||
<$> areq jidField (bfs "Jabber address") (formJID <$> def)
|
||||
xmppAForm d = XMPPForm
|
||||
<$> areq jidField (bfs "Jabber address") (formJID <$> d)
|
||||
<*> areq passwordField (bfs "Password") Nothing
|
||||
|
||||
jidField :: MkField Text
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue