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

WIP yesod 1.2

Browse source
This commit is contained in:
Joey Hess 2013-06-02 15:57:22 -04:00
parent 92f036fcb4
commit 79fd677805
18 changed files with 94 additions and 89 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -110,13 +110,13 @@ postXMPPConfigForPairSelfR = xmppform StartXMPPPairSelfR
xmppform :: Route WebApp -> Handler RepHtml
#ifdef WITH_XMPP
xmppform next = xmppPage $ do
((result, form), enctype) <- lift $ do
((result, form), enctype) <- handlerToWidget $ do
oldcreds <- liftAnnex getXMPPCreds
runFormPost $ renderBootstrap $ xmppAForm $
creds2Form <$> oldcreds
let showform problem = $(widgetFile "configurators/xmpp")
case result of
FormSuccess f -> either (showform . Just) (lift . storecreds)
FormSuccess f -> either (showform . Just) (handlerToWidget . storecreds)
=<< liftIO (validateForm f)
_ -> showform Nothing
where
@ -171,12 +171,12 @@ data XMPPForm = XMPPForm
creds2Form :: XMPPCreds -> XMPPForm
creds2Form c = XMPPForm (xmppJID c) (xmppPassword c)
xmppAForm :: (Maybe XMPPForm) -> AForm WebApp WebApp XMPPForm
xmppAForm :: (Maybe XMPPForm) -> AForm Handler XMPPForm
xmppAForm def = XMPPForm
<$> areq jidField "Jabber address" (formJID <$> def)
<*> areq passwordField "Password" Nothing
jidField :: Field WebApp WebApp Text
jidField :: Field Handler Text
jidField = checkBool (isJust . parseJID) bad textField
where
bad :: Text