now builds with both yesod 1.2 and 1.1

This commit is contained in:
Joey Hess 2013-06-03 16:33:05 -04:00
parent 31753bad46
commit 1198b5444d
14 changed files with 103 additions and 35 deletions

View file

@ -63,7 +63,7 @@ data AWSCreds = AWSCreds Text Text
extractCreds :: AWSInput -> AWSCreds
extractCreds i = AWSCreds (accessKeyID i) (secretAccessKey i)
s3InputAForm :: Maybe CredPair -> AForm Handler AWSInput
s3InputAForm :: Maybe CredPair -> MkAForm AWSInput
s3InputAForm defcreds = AWSInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> secretAccessKeyField (T.pack . snd <$> defcreds)
@ -78,7 +78,7 @@ s3InputAForm defcreds = AWSInput
, ("Reduced redundancy (costs less)", ReducedRedundancy)
]
glacierInputAForm :: Maybe CredPair -> AForm Handler AWSInput
glacierInputAForm :: Maybe CredPair -> MkAForm AWSInput
glacierInputAForm defcreds = AWSInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> secretAccessKeyField (T.pack . snd <$> defcreds)
@ -87,15 +87,15 @@ glacierInputAForm defcreds = AWSInput
<*> areq textField "Repository name" (Just "glacier")
<*> enableEncryptionField
awsCredsAForm :: Maybe CredPair -> AForm Handler AWSCreds
awsCredsAForm :: Maybe CredPair -> MkAForm AWSCreds
awsCredsAForm defcreds = AWSCreds
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> secretAccessKeyField (T.pack . snd <$> defcreds)
accessKeyIDField :: Widget -> Maybe Text -> AForm Handler Text
accessKeyIDField :: Widget -> Maybe Text -> MkAForm Text
accessKeyIDField help def = areq (textField `withNote` help) "Access Key ID" def
accessKeyIDFieldWithHelp :: Maybe Text -> AForm Handler Text
accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text
accessKeyIDFieldWithHelp def = accessKeyIDField help def
where
help = [whamlet|
@ -103,10 +103,10 @@ accessKeyIDFieldWithHelp def = accessKeyIDField help def
Get Amazon access keys
|]
secretAccessKeyField :: Maybe Text -> AForm Handler Text
secretAccessKeyField :: Maybe Text -> MkAForm Text
secretAccessKeyField def = areq passwordField "Secret Access Key" def
datacenterField :: AWS.Service -> AForm Handler Text
datacenterField :: AWS.Service -> MkAForm Text
datacenterField service = areq (selectFieldList list) "Datacenter" defregion
where
list = M.toList $ AWS.regionMap service

View file

@ -107,7 +107,7 @@ deleteCurrentRepository = dangerPage $ do
data SanityVerifier = SanityVerifier T.Text
deriving (Eq)
sanityVerifierAForm :: SanityVerifier -> AForm Handler SanityVerifier
sanityVerifierAForm :: SanityVerifier -> MkAForm SanityVerifier
sanityVerifierAForm template = SanityVerifier
<$> areq checksanity "Confirm deletion?" Nothing
where

View file

@ -132,7 +132,7 @@ setRepoConfig uuid mremote oldc newc = do
legalName = makeLegalName . T.unpack . repoName
editRepositoryAForm :: RepoConfig -> AForm Handler RepoConfig
editRepositoryAForm :: RepoConfig -> MkAForm RepoConfig
editRepositoryAForm def = RepoConfig
<$> areq textField "Name" (Just $ repoName def)
<*> aopt textField "Description" (Just $ repoDescription def)

View file

@ -79,7 +79,7 @@ showMediaType MediaVideo = "videos & movies"
showMediaType MediaAudio = "audio & music"
showMediaType MediaOmitted = "other"
iaInputAForm :: Maybe CredPair -> AForm Handler IAInput
iaInputAForm :: Maybe CredPair -> MkAForm IAInput
iaInputAForm defcreds = IAInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> AWS.secretAccessKeyField (T.pack . snd <$> defcreds)
@ -99,7 +99,7 @@ itemNameHelp = [whamlet|
will be uploaded to your Internet Archive item.
|]
iaCredsAForm :: Maybe CredPair -> AForm Handler AWS.AWSCreds
iaCredsAForm :: Maybe CredPair -> MkAForm AWS.AWSCreds
iaCredsAForm defcreds = AWS.AWSCreds
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> AWS.secretAccessKeyField (T.pack . snd <$> defcreds)
@ -110,7 +110,7 @@ previouslyUsedIACreds = previouslyUsedCredPair AWS.creds S3.remote $
AWS.isIARemoteConfig . Remote.config
#endif
accessKeyIDFieldWithHelp :: Maybe Text -> AForm Handler Text
accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text
accessKeyIDFieldWithHelp def = AWS.accessKeyIDField help def
where
help = [whamlet|

View file

@ -46,7 +46,11 @@ data RepositoryPath = RepositoryPath Text
-
- Validates that the path entered is not empty, and is a safe value
- to use as a repository. -}
#if MIN_VERSION_yesod(1,2,0)
repositoryPathField :: forall (m :: * -> *). (MonadIO m, HandlerSite m ~ WebApp) => Bool -> Field m Text
#else
repositoryPathField :: forall sub. Bool -> Field sub WebApp Text
#endif
repositoryPathField autofocus = Field
#if ! MIN_VERSION_yesod_form(1,2,0)
{ fieldParse = parse
@ -119,7 +123,7 @@ defaultRepositoryPath firstrun = do
)
legit d = not <$> doesFileExist (d </> "git-annex")
newRepositoryForm :: FilePath -> Html -> Form RepositoryPath
newRepositoryForm :: FilePath -> Html -> MkMForm RepositoryPath
newRepositoryForm defpath msg = do
(pathRes, pathView) <- mreq (repositoryPathField True) ""
(Just $ T.pack $ addTrailingPathSeparator defpath)
@ -185,7 +189,7 @@ getCombineRepositoryR (FilePathAndUUID newrepopath newrepouuid) = do
where
remotename = takeFileName newrepopath
selectDriveForm :: [RemovableDrive] -> Html -> Form RemovableDrive
selectDriveForm :: [RemovableDrive] -> Html -> MkMForm RemovableDrive
selectDriveForm drives = renderBootstrap $ RemovableDrive
<$> pure Nothing
<*> areq (selectFieldList pairs) "Select drive:" Nothing

View file

@ -29,7 +29,7 @@ data PrefsForm = PrefsForm
, debugEnabled :: Bool
}
prefsAForm :: PrefsForm -> AForm Handler PrefsForm
prefsAForm :: PrefsForm -> MkAForm PrefsForm
prefsAForm def = PrefsForm
<$> areq (storageField `withNote` diskreservenote)
"Disk reserve" (Just $ diskReserve def)

View file

@ -5,7 +5,7 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes, FlexibleContexts #-}
{-# LANGUAGE CPP #-}
module Assistant.WebApp.Configurators.Ssh where
@ -58,7 +58,11 @@ mkSshInput s = SshInput
, inputPort = sshPort s
}
#if MIN_VERSION_yesod(1,2,0)
sshInputAForm :: Field Handler Text -> SshInput -> AForm Handler SshInput
#else
sshInputAForm :: Field WebApp WebApp Text -> SshInput -> AForm WebApp WebApp SshInput
#endif
sshInputAForm hostnamefield def = SshInput
<$> aopt check_hostname "Host name" (Just $ inputHostname def)
<*> aopt check_username "User name" (Just $ inputUsername def)

View file

@ -43,7 +43,7 @@ data WebDAVInput = WebDAVInput
toCredPair :: WebDAVInput -> CredPair
toCredPair input = (T.unpack $ user input, T.unpack $ password input)
boxComAForm :: Maybe CredPair -> AForm Handler WebDAVInput
boxComAForm :: Maybe CredPair -> MkAForm WebDAVInput
boxComAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds)
<*> areq passwordField "Box.com Password" (T.pack . snd <$> defcreds)
@ -51,7 +51,7 @@ boxComAForm defcreds = WebDAVInput
<*> areq textField "Directory" (Just "annex")
<*> enableEncryptionField
webDAVCredsAForm :: Maybe CredPair -> AForm Handler WebDAVInput
webDAVCredsAForm :: Maybe CredPair -> MkAForm WebDAVInput
webDAVCredsAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds)
<*> areq passwordField "Password" (T.pack . snd <$> defcreds)

View file

@ -5,7 +5,7 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings #-}
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, FlexibleContexts #-}
{-# LANGUAGE CPP #-}
module Assistant.WebApp.Configurators.XMPP where
@ -171,12 +171,12 @@ data XMPPForm = XMPPForm
creds2Form :: XMPPCreds -> XMPPForm
creds2Form c = XMPPForm (xmppJID c) (xmppPassword c)
xmppAForm :: (Maybe XMPPForm) -> AForm Handler XMPPForm
xmppAForm :: (Maybe XMPPForm) -> MkAForm XMPPForm
xmppAForm def = XMPPForm
<$> areq jidField "Jabber address" (formJID <$> def)
<*> areq passwordField "Password" Nothing
jidField :: Field Handler Text
jidField :: MkField Text
jidField = checkBool (isJust . parseJID) bad textField
where
bad :: Text