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

bootstrap3 forms

Browse source
This commit is contained in:
Sören Brunk 2014-04-18 02:07:09 +02:00
parent d2b42c30ad
commit 00c1cd0db1
35 changed files with 176 additions and 132 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
Assistant/WebApp/Configurators/AWS.hs
View file

@ -68,8 +68,8 @@ s3InputAForm defcreds = AWSInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds) <$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> secretAccessKeyField (T.pack . snd <$> defcreds) <*> secretAccessKeyField (T.pack . snd <$> defcreds)
<*> datacenterField AWS.S3 <*> datacenterField AWS.S3
<*> areq (selectFieldList storageclasses) "Storage class" (Just StandardRedundancy) <*> areq (selectFieldList storageclasses) (bfs "Storage class") (Just StandardRedundancy)
<*> areq textField "Repository name" (Just "S3") <*> areq textField (bfs "Repository name") (Just "S3")
<*> enableEncryptionField <*> enableEncryptionField
where where
storageclasses :: [(Text, StorageClass)] storageclasses :: [(Text, StorageClass)]
@ -84,7 +84,7 @@ glacierInputAForm defcreds = AWSInput
<*> secretAccessKeyField (T.pack . snd <$> defcreds) <*> secretAccessKeyField (T.pack . snd <$> defcreds)
<*> datacenterField AWS.Glacier <*> datacenterField AWS.Glacier
<*> pure StandardRedundancy <*> pure StandardRedundancy
<*> areq textField "Repository name" (Just "glacier") <*> areq textField (bfs "Repository name") (Just "glacier")
<*> enableEncryptionField <*> enableEncryptionField
awsCredsAForm :: Maybe CredPair -> MkAForm AWSCreds awsCredsAForm :: Maybe CredPair -> MkAForm AWSCreds
@ -93,7 +93,7 @@ awsCredsAForm defcreds = AWSCreds
<*> secretAccessKeyField (T.pack . snd <$> defcreds) <*> secretAccessKeyField (T.pack . snd <$> defcreds)
accessKeyIDField :: Widget -> Maybe Text -> MkAForm Text accessKeyIDField :: Widget -> Maybe Text -> MkAForm Text
accessKeyIDField help = areq (textField `withNote` help) "Access Key ID" accessKeyIDField help = areq (textField `withNote` help) (bfs "Access Key ID")
accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text
accessKeyIDFieldWithHelp = accessKeyIDField help accessKeyIDFieldWithHelp = accessKeyIDField help
@ -104,10 +104,10 @@ accessKeyIDFieldWithHelp = accessKeyIDField help
|] |]
secretAccessKeyField :: Maybe Text -> MkAForm Text secretAccessKeyField :: Maybe Text -> MkAForm Text
secretAccessKeyField = areq passwordField "Secret Access Key" secretAccessKeyField = areq passwordField (bfs "Secret Access Key")
datacenterField :: AWS.Service -> MkAForm Text datacenterField :: AWS.Service -> MkAForm Text
datacenterField service = areq (selectFieldList list) "Datacenter" defregion datacenterField service = areq (selectFieldList list) (bfs "Datacenter") defregion
where where
list = M.toList $ AWS.regionMap service list = M.toList $ AWS.regionMap service
defregion = Just $ AWS.defaultRegion service defregion = Just $ AWS.defaultRegion service
@ -120,7 +120,7 @@ postAddS3R :: Handler Html
postAddS3R = awsConfigurator $ do postAddS3R = awsConfigurator $ do
defcreds <- liftAnnex previouslyUsedAWSCreds defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ s3InputAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ s3InputAForm defcreds
case result of case result of
FormSuccess input -> liftH $ do FormSuccess input -> liftH $ do
let name = T.unpack $ repoName input let name = T.unpack $ repoName input
@ -143,7 +143,7 @@ postAddGlacierR :: Handler Html
postAddGlacierR = glacierConfigurator $ do postAddGlacierR = glacierConfigurator $ do
defcreds <- liftAnnex previouslyUsedAWSCreds defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ glacierInputAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ glacierInputAForm defcreds
case result of case result of
FormSuccess input -> liftH $ do FormSuccess input -> liftH $ do
let name = T.unpack $ repoName input let name = T.unpack $ repoName input
@ -186,7 +186,7 @@ enableAWSRemote :: RemoteType -> UUID -> Widget
enableAWSRemote remotetype uuid = do enableAWSRemote remotetype uuid = do
defcreds <- liftAnnex previouslyUsedAWSCreds defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ awsCredsAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ awsCredsAForm defcreds
case result of case result of
FormSuccess creds -> liftH $ do FormSuccess creds -> liftH $ do
m <- liftAnnex readRemoteLog m <- liftAnnex readRemoteLog

6
Assistant/WebApp/Configurators/Delete.hs
View file

@ -89,8 +89,8 @@ deleteCurrentRepository = dangerPage $ do
havegitremotes <- haveremotes syncGitRemotes havegitremotes <- haveremotes syncGitRemotes
havedataremotes <- haveremotes syncDataRemotes havedataremotes <- haveremotes syncDataRemotes
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ sanityVerifierAForm $ runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
SanityVerifier magicphrase sanityVerifierAForm $ SanityVerifier magicphrase
case result of case result of
FormSuccess _ -> liftH $ do FormSuccess _ -> liftH $ do
dir <- liftAnnex $ fromRepo Git.repoPath dir <- liftAnnex $ fromRepo Git.repoPath
@ -122,7 +122,7 @@ data SanityVerifier = SanityVerifier T.Text
sanityVerifierAForm :: SanityVerifier -> MkAForm SanityVerifier sanityVerifierAForm :: SanityVerifier -> MkAForm SanityVerifier
sanityVerifierAForm template = SanityVerifier sanityVerifierAForm template = SanityVerifier
<$> areq checksanity "Confirm deletion?" Nothing <$> areq checksanity (bfs "Confirm deletion?") Nothing
where where
checksanity = checkBool (\input -> SanityVerifier input == template) checksanity = checkBool (\input -> SanityVerifier input == template)
insane textField insane textField

10
Assistant/WebApp/Configurators/Edit.hs
View file

@ -142,9 +142,9 @@ setRepoConfig uuid mremote oldc newc = do
editRepositoryAForm :: Maybe Remote -> RepoConfig -> MkAForm RepoConfig editRepositoryAForm :: Maybe Remote -> RepoConfig -> MkAForm RepoConfig
editRepositoryAForm mremote def = RepoConfig editRepositoryAForm mremote def = RepoConfig
<$> areq (if ishere then readonlyTextField else textField) <$> areq (if ishere then readonlyTextField else textField)
"Name" (Just $ repoName def) (bfs "Name") (Just $ repoName def)
<*> aopt textField "Description" (Just $ repoDescription def) <*> aopt textField (bfs "Description") (Just $ repoDescription def)
<*> areq (selectFieldList groups `withNote` help) "Repository group" (Just $ repoGroup def) <*> areq (selectFieldList groups `withNote` help) (bfs "Repository group") (Just $ repoGroup def)
<*> associateddirectory <*> associateddirectory
<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def) <*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def)
where where
@ -166,7 +166,7 @@ editRepositoryAForm mremote def = RepoConfig
associateddirectory = case repoAssociatedDirectory def of associateddirectory = case repoAssociatedDirectory def of
Nothing -> aopt hiddenField "" Nothing Nothing -> aopt hiddenField "" Nothing
Just d -> aopt textField "Associated directory" (Just $ Just d) Just d -> aopt textField (bfs "Associated directory") (Just $ Just d)
getEditRepositoryR :: RepoId -> Handler Html getEditRepositoryR :: RepoId -> Handler Html
getEditRepositoryR = postEditRepositoryR getEditRepositoryR = postEditRepositoryR
@ -195,7 +195,7 @@ editForm new (RepoUUID uuid) = page "Edit repository" (Just Configuration) $ do
curr <- liftAnnex $ getRepoConfig uuid mremote curr <- liftAnnex $ getRepoConfig uuid mremote
liftAnnex $ checkAssociatedDirectory curr mremote liftAnnex $ checkAssociatedDirectory curr mremote
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ editRepositoryAForm mremote curr runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ editRepositoryAForm mremote curr
case result of case result of
FormSuccess input -> liftH $ do FormSuccess input -> liftH $ do
setRepoConfig uuid mremote curr input setRepoConfig uuid mremote curr input

11
Assistant/WebApp/Configurators/Fsck.hs
View file

@ -64,10 +64,10 @@ runFsckForm new activity = case activity of
u <- liftAnnex getUUID u <- liftAnnex getUUID
repolist <- liftAssistant (getrepolist ru) repolist <- liftAssistant (getrepolist ru)
runFormPostNoToken $ \msg -> do runFormPostNoToken $ \msg -> do
(reposRes, reposView) <- mreq (selectFieldList repolist) "" (Just ru) (reposRes, reposView) <- mreq (selectFieldList repolist) (bfs "") (Just ru)
(durationRes, durationView) <- mreq intField "" (Just $ durationSeconds d `quot` 60 ) (durationRes, durationView) <- mreq intField (bfs "") (Just $ durationSeconds d `quot` 60 )
(timeRes, timeView) <- mreq (selectFieldList times) "" (Just t) (timeRes, timeView) <- mreq (selectFieldList times) (bfs "") (Just t)
(recurranceRes, recurranceView) <- mreq (selectFieldList recurrances) "" (Just r) (recurranceRes, recurranceView) <- mreq (selectFieldList recurrances) (bfs "") (Just r)
let form = do let form = do
webAppFormAuthToken webAppFormAuthToken
$(widgetFile "configurators/fsck/formcontent") $(widgetFile "configurators/fsck/formcontent")
@ -175,7 +175,8 @@ fsckPreferencesAForm def = FsckPreferences
runFsckPreferencesForm :: Handler ((FormResult FsckPreferences, Widget), Enctype) runFsckPreferencesForm :: Handler ((FormResult FsckPreferences, Widget), Enctype)
runFsckPreferencesForm = do runFsckPreferencesForm = do
prefs <- liftAnnex getFsckPreferences prefs <- liftAnnex getFsckPreferences
runFormPostNoToken $ renderBootstrap $ fsckPreferencesAForm prefs runFormPostNoToken $ renderBootstrap3 formLayout $ fsckPreferencesAForm prefs
where formLayout = BootstrapHorizontalForm (ColSm 0) (ColSm 2) (ColSm 0) (ColSm 10)
showFsckPreferencesForm :: Widget showFsckPreferencesForm :: Widget
showFsckPreferencesForm = do showFsckPreferencesForm = do

8
Assistant/WebApp/Configurators/IA.hs
View file

@ -83,8 +83,8 @@ iaInputAForm :: Maybe CredPair -> MkAForm IAInput
iaInputAForm defcreds = IAInput iaInputAForm defcreds = IAInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds) <$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> AWS.secretAccessKeyField (T.pack . snd <$> defcreds) <*> AWS.secretAccessKeyField (T.pack . snd <$> defcreds)
<*> areq (selectFieldList mediatypes) "Media Type" (Just MediaOmitted) <*> areq (selectFieldList mediatypes) (bfs "Media Type") (Just MediaOmitted)
<*> areq (textField `withExpandableNote` ("Help", itemNameHelp)) "Item Name" Nothing <*> areq (textField `withExpandableNote` ("Help", itemNameHelp)) (bfs "Item Name") Nothing
where where
mediatypes :: [(Text, MediaType)] mediatypes :: [(Text, MediaType)]
mediatypes = map (\t -> (T.pack $ showMediaType t, t)) [minBound..] mediatypes = map (\t -> (T.pack $ showMediaType t, t)) [minBound..]
@ -126,7 +126,7 @@ postAddIAR :: Handler Html
postAddIAR = iaConfigurator $ do postAddIAR = iaConfigurator $ do
defcreds <- liftAnnex previouslyUsedIACreds defcreds <- liftAnnex previouslyUsedIACreds
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ iaInputAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ iaInputAForm defcreds
case result of case result of
FormSuccess input -> liftH $ do FormSuccess input -> liftH $ do
let name = escapeBucket $ T.unpack $ itemName input let name = escapeBucket $ T.unpack $ itemName input
@ -165,7 +165,7 @@ enableIARemote :: UUID -> Widget
enableIARemote uuid = do enableIARemote uuid = do
defcreds <- liftAnnex previouslyUsedIACreds defcreds <- liftAnnex previouslyUsedIACreds
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ iaCredsAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ iaCredsAForm defcreds
case result of case result of
FormSuccess creds -> liftH $ do FormSuccess creds -> liftH $ do
m <- liftAnnex readRemoteLog m <- liftAnnex readRemoteLog

8
Assistant/WebApp/Configurators/Local.hs
View file

@ -143,7 +143,7 @@ defaultRepositoryPath firstrun = do
newRepositoryForm :: FilePath -> Hamlet.Html -> MkMForm RepositoryPath newRepositoryForm :: FilePath -> Hamlet.Html -> MkMForm RepositoryPath
newRepositoryForm defpath msg = do newRepositoryForm defpath msg = do
(pathRes, pathView) <- mreq (repositoryPathField True) "" (pathRes, pathView) <- mreq (repositoryPathField True) (bfs "")
(Just $ T.pack $ addTrailingPathSeparator defpath) (Just $ T.pack $ addTrailingPathSeparator defpath)
let (err, errmsg) = case pathRes of let (err, errmsg) = case pathRes of
FormMissing -> (False, "") FormMissing -> (False, "")
@ -217,10 +217,10 @@ getCombineRepositoryR newrepopath newrepouuid = do
remotename = takeFileName newrepopath remotename = takeFileName newrepopath
selectDriveForm :: [RemovableDrive] -> Hamlet.Html -> MkMForm RemovableDrive selectDriveForm :: [RemovableDrive] -> Hamlet.Html -> MkMForm RemovableDrive
selectDriveForm drives = renderBootstrap $ RemovableDrive selectDriveForm drives = renderBootstrap3 bootstrapFormLayout $ RemovableDrive
<$> pure Nothing <$> pure Nothing
<*> areq (selectFieldList pairs `withNote` onlywritable) "Select drive:" Nothing <*> areq (selectFieldList pairs `withNote` onlywritable) (bfs "Select drive:") Nothing
<*> areq textField "Use this directory on the drive:" <*> areq textField (bfs "Use this directory on the drive:")
(Just $ T.pack gitAnnexAssistantDefaultDir) (Just $ T.pack gitAnnexAssistantDefaultDir)
where where
pairs = zip (map describe drives) (map mountPoint drives) pairs = zip (map describe drives) (map mountPoint drives)

4
Assistant/WebApp/Configurators/Pairing.hs
View file

@ -265,8 +265,8 @@ data InputSecret = InputSecret { secretText :: Maybe Text }
promptSecret :: Maybe PairMsg -> (Text -> Secret -> Widget) -> Handler Html promptSecret :: Maybe PairMsg -> (Text -> Secret -> Widget) -> Handler Html
promptSecret msg cont = pairPage $ do promptSecret msg cont = pairPage $ do
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
InputSecret <$> aopt textField "Secret phrase" Nothing InputSecret <$> aopt textField (bfs "Secret phrase") Nothing
case result of case result of
FormSuccess v -> do FormSuccess v -> do
let rawsecret = fromMaybe "" $ secretText v let rawsecret = fromMaybe "" $ secretText v

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

@ -36,13 +36,13 @@ data PrefsForm = PrefsForm
prefsAForm :: PrefsForm -> MkAForm PrefsForm prefsAForm :: PrefsForm -> MkAForm PrefsForm
prefsAForm def = PrefsForm prefsAForm def = PrefsForm
<$> areq (storageField `withNote` diskreservenote) <$> areq (storageField `withNote` diskreservenote)
"Disk reserve" (Just $ diskReserve def) (bfs "Disk reserve") (Just $ diskReserve def)
<*> areq (positiveIntField `withNote` numcopiesnote) <*> areq (positiveIntField `withNote` numcopiesnote)
"Number of copies" (Just $ numCopies def) (bfs "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) <*> areq (selectFieldList autoUpgradeChoices)
autoUpgradeLabel (Just $ autoUpgrade def) (bfs 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
@ -109,7 +109,7 @@ postPreferencesR :: Handler Html
postPreferencesR = page "Preferences" (Just Configuration) $ do postPreferencesR = page "Preferences" (Just Configuration) $ do
((result, form), enctype) <- liftH $ do ((result, form), enctype) <- liftH $ do
current <- liftAnnex getPrefs current <- liftAnnex getPrefs
runFormPostNoToken $ renderBootstrap $ prefsAForm current runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ prefsAForm current
case result of case result of
FormSuccess new -> liftH $ do FormSuccess new -> liftH $ do
liftAnnex $ storePrefs new liftAnnex $ storePrefs new

14
Assistant/WebApp/Configurators/Ssh.hs
View file

@ -76,10 +76,10 @@ sshInputAForm :: Field Handler Text -> SshInput -> AForm Handler SshInput
sshInputAForm :: Field WebApp WebApp Text -> SshInput -> AForm WebApp WebApp SshInput sshInputAForm :: Field WebApp WebApp Text -> SshInput -> AForm WebApp WebApp SshInput
#endif #endif
sshInputAForm hostnamefield def = SshInput sshInputAForm hostnamefield def = SshInput
<$> aopt check_hostname "Host name" (Just $ inputHostname def) <$> aopt check_hostname (bfs "Host name") (Just $ inputHostname def)
<*> aopt check_username "User name" (Just $ inputUsername def) <*> aopt check_username (bfs "User name") (Just $ inputUsername def)
<*> aopt textField "Directory" (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory def) <*> aopt textField (bfs "Directory") (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory def)
<*> areq intField "Port" (Just $ inputPort def) <*> areq intField (bfs "Port") (Just $ inputPort def)
where where
check_username = checkBool (all (`notElem` "/:@ \t") . T.unpack) check_username = checkBool (all (`notElem` "/:@ \t") . T.unpack)
bad_username textField bad_username textField
@ -121,7 +121,7 @@ postAddSshR :: Handler Html
postAddSshR = sshConfigurator $ do postAddSshR = sshConfigurator $ do
username <- liftIO $ T.pack <$> myUserName username <- liftIO $ T.pack <$> myUserName
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ sshInputAForm textField $ runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ sshInputAForm textField $
SshInput Nothing (Just username) Nothing 22 SshInput Nothing (Just username) Nothing 22
case result of case result of
FormSuccess sshinput -> do FormSuccess sshinput -> do
@ -173,7 +173,7 @@ enableSpecialSshRemote getsshinput rsyncnetsetup genericsetup u = do
case (mkSshInput . unmangle <$> getsshinput m, M.lookup "name" m) of case (mkSshInput . unmangle <$> getsshinput m, M.lookup "name" m) of
(Just sshinput, Just reponame) -> sshConfigurator $ do (Just sshinput, Just reponame) -> sshConfigurator $ do
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ sshInputAForm textField sshinput runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ sshInputAForm textField sshinput
case result of case result of
FormSuccess sshinput' FormSuccess sshinput'
| isRsyncNet (inputHostname sshinput') -> | isRsyncNet (inputHostname sshinput') ->
@ -450,7 +450,7 @@ getAddRsyncNetR = postAddRsyncNetR
postAddRsyncNetR :: Handler Html postAddRsyncNetR :: Handler Html
postAddRsyncNetR = do postAddRsyncNetR = do
((result, form), enctype) <- runFormPostNoToken $ ((result, form), enctype) <- runFormPostNoToken $
renderBootstrap $ sshInputAForm hostnamefield $ renderBootstrap3 bootstrapFormLayout $ sshInputAForm hostnamefield $
SshInput Nothing Nothing Nothing 22 SshInput Nothing Nothing Nothing 22
let showform status = inpage $ let showform status = inpage $
$(widgetFile "configurators/rsync.net/add") $(widgetFile "configurators/rsync.net/add")

4
Assistant/WebApp/Configurators/Unused.hs
View file

@ -27,9 +27,9 @@ data UnusedForm = UnusedForm
unusedForm :: UnusedForm -> Hamlet.Html -> MkMForm UnusedForm unusedForm :: UnusedForm -> Hamlet.Html -> MkMForm UnusedForm
unusedForm def msg = do unusedForm def msg = do
(enableRes, enableView) <- mreq (selectFieldList enabledisable) "" (enableRes, enableView) <- mreq (selectFieldList enabledisable) (bfs "")
(Just $ enableExpire def) (Just $ enableExpire def)
(whenRes, whenView) <- mreq intField "" (whenRes, whenView) <- mreq intField (bfs "")
(Just $ expireWhen def) (Just $ expireWhen def)
let form = do let form = do
webAppFormAuthToken webAppFormAuthToken

18
Assistant/WebApp/Configurators/WebDAV.hs
View file

@ -45,16 +45,16 @@ toCredPair input = (T.unpack $ user input, T.unpack $ password input)
boxComAForm :: Maybe CredPair -> MkAForm WebDAVInput boxComAForm :: Maybe CredPair -> MkAForm WebDAVInput
boxComAForm defcreds = WebDAVInput boxComAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds) <$> areq textField (bfs "Username or Email") (T.pack . fst <$> defcreds)
<*> areq passwordField "Box.com Password" (T.pack . snd <$> defcreds) <*> areq passwordField (bfs "Box.com Password") (T.pack . snd <$> defcreds)
<*> areq checkBoxField "Share this account with other devices and friends?" (Just True) <*> areq checkBoxField (bfs "Share this account with other devices and friends?") (Just True)
<*> areq textField "Directory" (Just "annex") <*> areq textField (bfs "Directory") (Just "annex")
<*> enableEncryptionField <*> enableEncryptionField
webDAVCredsAForm :: Maybe CredPair -> MkAForm WebDAVInput webDAVCredsAForm :: Maybe CredPair -> MkAForm WebDAVInput
webDAVCredsAForm defcreds = WebDAVInput webDAVCredsAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds) <$> areq textField (bfs "Username or Email") (T.pack . fst <$> defcreds)
<*> areq passwordField "Password" (T.pack . snd <$> defcreds) <*> areq passwordField (bfs "Password") (T.pack . snd <$> defcreds)
<*> pure False <*> pure False
<*> pure T.empty <*> pure T.empty
<*> pure NoEncryption -- not used! <*> pure NoEncryption -- not used!
@ -66,7 +66,8 @@ postAddBoxComR :: Handler Html
postAddBoxComR = boxConfigurator $ do postAddBoxComR = boxConfigurator $ do
defcreds <- liftAnnex $ previouslyUsedWebDAVCreds "box.com" defcreds <- liftAnnex $ previouslyUsedWebDAVCreds "box.com"
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ boxComAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout
$ boxComAForm defcreds
case result of case result of
FormSuccess input -> liftH $ FormSuccess input -> liftH $
makeWebDavRemote initSpecialRemote "box.com" (toCredPair input) $ M.fromList makeWebDavRemote initSpecialRemote "box.com" (toCredPair input) $ M.fromList
@ -109,7 +110,8 @@ postEnableWebDAVR uuid = do
maybe (pure Nothing) previouslyUsedWebDAVCreds $ maybe (pure Nothing) previouslyUsedWebDAVCreds $
urlHost url urlHost url
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ webDAVCredsAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
webDAVCredsAForm defcreds
case result of case result of
FormSuccess input -> liftH $ FormSuccess input -> liftH $
makeWebDavRemote enableSpecialRemote name (toCredPair input) M.empty makeWebDavRemote enableSpecialRemote name (toCredPair input) M.empty

6
Assistant/WebApp/Configurators/XMPP.hs
View file

@ -99,7 +99,7 @@ xmppform :: Route WebApp -> Handler Html
xmppform next = xmppPage $ do xmppform next = xmppPage $ do
((result, form), enctype) <- liftH $ do ((result, form), enctype) <- liftH $ do
oldcreds <- liftAnnex getXMPPCreds oldcreds <- liftAnnex getXMPPCreds
runFormPostNoToken $ renderBootstrap $ xmppAForm $ runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ xmppAForm $
creds2Form <$> oldcreds creds2Form <$> oldcreds
let showform problem = $(widgetFile "configurators/xmpp") let showform problem = $(widgetFile "configurators/xmpp")
case result of case result of
@ -162,8 +162,8 @@ creds2Form c = XMPPForm (xmppJID c) (xmppPassword c)
xmppAForm :: (Maybe XMPPForm) -> MkAForm XMPPForm xmppAForm :: (Maybe XMPPForm) -> MkAForm XMPPForm
xmppAForm def = XMPPForm xmppAForm def = XMPPForm
<$> areq jidField "Jabber address" (formJID <$> def) <$> areq jidField (bfs "Jabber address") (formJID <$> def)
<*> areq passwordField "Password" Nothing <*> areq passwordField (bfs "Password") Nothing
jidField :: MkField Text jidField :: MkField Text
jidField = checkBool (isJust . parseJID) bad textField jidField = checkBool (isJust . parseJID) bad textField

21
Assistant/WebApp/Form.hs
View file

@ -17,6 +17,8 @@ import Assistant.Gpg
import Yesod hiding (textField, passwordField) import Yesod hiding (textField, passwordField)
import Yesod.Form.Fields as F import Yesod.Form.Fields as F
import Yesod.Form.Bootstrap3 hiding (bfs)
import Data.String (IsString (..))
import Data.Text (Text) import Data.Text (Text)
{- Yesod's textField sets the required attribute for required fields. {- Yesod's textField sets the required attribute for required fields.
@ -80,10 +82,27 @@ enableEncryptionField :: (RenderMessage site FormMessage) => AForm (HandlerT sit
#else #else
enableEncryptionField :: RenderMessage master FormMessage => AForm sub master EnableEncryption enableEncryptionField :: RenderMessage master FormMessage => AForm sub master EnableEncryption
#endif #endif
enableEncryptionField = areq (selectFieldList choices) "Encryption" (Just SharedEncryption) enableEncryptionField = areq (selectFieldList choices) (bfs "Encryption") (Just SharedEncryption)
where where
choices :: [(Text, EnableEncryption)] choices :: [(Text, EnableEncryption)]
choices = choices =
[ ("Encrypt all data", SharedEncryption) [ ("Encrypt all data", SharedEncryption)
, ("Disable encryption", NoEncryption) , ("Disable encryption", NoEncryption)
] ]
{- Defines the layout used by the Bootstrap3 form helper -}
bootstrapFormLayout :: BootstrapFormLayout
bootstrapFormLayout = BootstrapHorizontalForm (ColSm 0) (ColSm 2) (ColSm 0) (ColSm 5)
{- Adds the form-control class used by Bootstrap3 for layout to a field
- This is the same as Yesod.Form.Bootstrap3.bfs except it takes just a Text
- parameter as I couldn't get the original bfs to compile due to type ambiguities.
-}
bfs :: Text -> FieldSettings master
bfs msg = FieldSettings
{ fsLabel = SomeMessage msg
, fsName = Nothing
, fsId = Nothing
, fsAttrs = [("class", "form-control")]
, fsTooltip = Nothing
}

1
Utility/Yesod.hs
View file

@ -25,6 +25,7 @@ module Utility.Yesod
#if MIN_VERSION_yesod(1,2,0) #if MIN_VERSION_yesod(1,2,0)
import Yesod as Y import Yesod as Y
import Yesod.Form.Bootstrap3 as Y hiding (bfs)
#else #else
import Yesod as Y hiding (Html) import Yesod as Y hiding (Html)
#endif #endif

7
templates/configurators/addbox.com.hamlet
View file

@ -12,9 +12,10 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <div .col-sm-offset-2>
Add repository <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Add repository
<div .modal .fade #workingmodal> <div .modal .fade #workingmodal>
<div .modal-header> <div .modal-header>
<h3> <h3>

10
templates/configurators/adddrive.hamlet
View file

@ -22,10 +22,12 @@
<a .btn .btn-primary href="@{AddDriveR}"> <a .btn .btn-primary href="@{AddDriveR}">
Rescan for removable drives Rescan for removable drives
$else $else
<form method="post" enctype=#{enctype}> <form method="post" enctype=#{enctype} .form-horizontal>
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<button .btn .btn-primary type=submit>Use this drive</button> # <div .form-group>
<a .btn .btn-default href="@{AddDriveR}"> <div .col-sm-offset-2>
Rescan for removable drives <button .btn .btn-primary type=submit>Use this drive</button> #
<a .btn .btn-default href="@{AddDriveR}">
Rescan for removable drives

7
templates/configurators/addglacier.hamlet
View file

@ -20,9 +20,10 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <div .col-sm-offset-2>
Add Glacier repository <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Add Glacier repository
<div .modal .fade #workingmodal> <div .modal .fade #workingmodal>
<div .modal-header> <div .modal-header>
<h3> <h3>

7
templates/configurators/addia.hamlet
View file

@ -20,9 +20,10 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <div .col-sm-offset-2>
Add Internet Archive item <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Add Internet Archive item
<div .modal .fade #workingmodal> <div .modal .fade #workingmodal>
<div .modal-header> <div .modal-header>
<h3> <h3>

7
templates/configurators/adds3.hamlet
View file

@ -16,9 +16,10 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <div .col-sm-offset-2>
Add S3 repository <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Add S3 repository
<div .modal .fade #workingmodal> <div .modal .fade #workingmodal>
<div .modal-header> <div .modal-header>
<h3> <h3>

2
templates/configurators/delete/currentrepository.hamlet
View file

@ -27,7 +27,7 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .col-md-2>
<button .btn .btn-danger type=submit> <button .btn .btn-danger type=submit>
<span .glyphicon .glyphicon-warning-sign></span> Delete this repository # <span .glyphicon .glyphicon-warning-sign></span> Delete this repository #
<a .btn .btn-default href="@{DashboardR}"> <a .btn .btn-default href="@{DashboardR}">

11
templates/configurators/edit/repository.hamlet
View file

@ -20,11 +20,12 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit> <div .col-sm-offset-2>
Save Changes # <button .btn .btn-primary type=submit>
<a .btn .btn-default href="@{DashboardR}"> Save Changes #
Cancel # <a .btn .btn-default href="@{DashboardR}">
Cancel #
$if new $if new
<p> <p>
In a hurry? Feel free to skip this step! You can always come back # In a hurry? Feel free to skip this step! You can always come back #

7
templates/configurators/enableaws.hamlet
View file

@ -18,9 +18,10 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <div .col-sm-offset-2>
Enable Amazon repository <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Enable Amazon repository
<div .modal .fade #workingmodal> <div .modal .fade #workingmodal>
<div .modal-header> <div .modal-header>
<h3> <h3>

7
templates/configurators/enableia.hamlet
View file

@ -10,9 +10,10 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <div .col-sm-offset-2>
Enable Internet Archive repository <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Enable Internet Archive repository
<div .modal .fade #workingmodal> <div .modal .fade #workingmodal>
<div .modal-header> <div .modal-header>
<h3> <h3>

7
templates/configurators/enablewebdav.hamlet
View file

@ -10,9 +10,10 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <div .col-sm-offset-2>
Enable repository <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Enable repository
<div .modal .fade #workingmodal> <div .modal .fade #workingmodal>
<div .modal-header> <div .modal-header>
<h3> <h3>

2
templates/configurators/fsck.cassius
View file

@ -1,4 +1,4 @@
input[type=number] .form-inline input[type=number]
width: 5em width: 5em
select select
width: 10em width: 10em

22
templates/configurators/fsck/formcontent.hamlet
View file

@ -1,15 +1,17 @@
#{msg} #{msg}
<p> <p>
<div .input-group> <div .form-group>
Check ^{fvInput reposView} for # Check ^{fvInput reposView} for #
<div .form-group>
^{fvInput durationView} minutes # ^{fvInput durationView} minutes #
<div .form-group>
^{fvInput recurranceView} # ^{fvInput recurranceView} #
starting at ^{fvInput timeView} # starting at ^{fvInput timeView} #
$if new $if new
<button type=submit .btn .btn-primary> <button type=submit .btn .btn-primary>
Add Add
$else $else
<button type=submit .btn .btn-default> <button type=submit .btn .btn-default>
Save Save
<a .btn .btn-default href="@{RemoveActivityR u activity}"> <a .btn .btn-default href="@{RemoveActivityR u activity}">
Remove Remove

7
templates/configurators/fsck/preferencesform.hamlet
View file

@ -1,6 +1,7 @@
<div .well> <div .well>
<form method="post" .form-horizontal action=@{ConfigFsckPreferencesR} enctype=#{enctype}> <form method="post" .form-horizontal action=@{ConfigFsckPreferencesR} enctype=#{enctype}>
^{form} ^{form}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit> <div .col-sm-offset-2>
Save <button .btn .btn-primary type=submit>
Save

14
templates/configurators/newrepository/form.hamlet
View file

@ -1,11 +1,13 @@
#{msg} #{msg}
<p> <p>
<div .input-group> <div .form-group>
<span .input-group-addon> <div .input-group>
<span .glyphicon .glyphicon-folder-open></span> <span .input-group-addon>
^{fvInput pathView} <span .glyphicon .glyphicon-folder-open></span>
<button type=submit .btn .btn-primary> ^{fvInput pathView}
Make Repository <span .input-group-btn>
<button type=submit .btn .btn-primary>
Make Repository
$if err $if err
<div .alert .alert-danger> <div .alert .alert-danger>
#{errmsg} #{errmsg}

13
templates/configurators/pairing/local/prompt.hamlet
View file

@ -30,12 +30,13 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit> <div .col-sm-offset-2>
$if start <button .btn .btn-primary type=submit>
Start pairing $if start
$else Start pairing
Finish pairing $else
Finish pairing
<div .alert .alert-info> <div .alert .alert-info>
$if start $if start
<p> <p>

11
templates/configurators/preferences.hamlet
View file

@ -6,8 +6,9 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit> <div .col-sm-offset-2>
Save Preferences <button .btn .btn-primary type=submit>
<a .btn .btn-default href="@{ConfigurationR}"> Save Preferences
Cancel <a .btn .btn-default href="@{ConfigurationR}">
Cancel

7
templates/configurators/rsync.net/add.hamlet
View file

@ -26,9 +26,10 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit onclick="$('#setupmodal').modal('show');"> <div .col-sm-offset-2>
Use this rsync.net repository <button .btn .btn-primary type=submit onclick="$('#setupmodal').modal('show');">
Use this rsync.net repository
<div .modal .fade #setupmodal> <div .modal .fade #setupmodal>
<div .modal-header> <div .modal-header>
<h3> <h3>

7
templates/configurators/ssh/add.hamlet
View file

@ -17,7 +17,8 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit onclick="$('#testmodal').modal('show');"> <div .col-sm-offset-2>
Check this server <button .btn .btn-primary type=submit onclick="$('#testmodal').modal('show');">
Check this server
^{sshTestModal} ^{sshTestModal}

7
templates/configurators/ssh/enable.hamlet
View file

@ -8,9 +8,10 @@
<p> <p>
<form method="post" .form-horizontal enctype=#{enctype}> <form method="post" .form-horizontal enctype=#{enctype}>
<fieldset> <fieldset>
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit onclick="$('#testmodal').modal('show');"> <div .col-sm-offset-2>
Check this server <button .btn .btn-primary type=submit onclick="$('#testmodal').modal('show');">
Check this server
$case status $case status
$of UnusableServer msg $of UnusableServer msg
<div .alert .alert-danger> <div .alert .alert-danger>

2
templates/configurators/unused/form.hamlet
View file

@ -1,6 +1,6 @@
#{msg} #{msg}
<p> <p>
<div .input-group> <div .form-group>
^{fvInput enableView} after ^{fvInput whenView} days.&nbsp; ^{fvInput enableView} after ^{fvInput whenView} days.&nbsp;
<button type=submit .btn .btn-default > <button type=submit .btn .btn-default >
Save Changes Save Changes

7
templates/configurators/xmpp.hamlet
View file

@ -22,9 +22,10 @@
<fieldset> <fieldset>
^{form} ^{form}
^{webAppFormAuthToken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-group>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <div .col-sm-offset-2>
Use this account <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Use this account
<a .btn .btn-default href="@{DisconnectXMPPR}"> <a .btn .btn-default href="@{DisconnectXMPPR}">
Stop using this account Stop using this account
<div .modal .fade #workingmodal> <div .modal .fade #workingmodal>