webapp: Fix bad interaction between required fields and modals.

Assistant/WebApp/Common.hs

@@ -10,8 +10,9 @@ module Assistant.WebApp.Common (module X) where
 import Assistant.Common as X
 import Assistant.WebApp as X
 import Assistant.WebApp.Page as X
+import Assistant.WebApp.Form as X
 import Assistant.WebApp.Types as X
 import Utility.Yesod as X
 
 import Data.Text as X (Text)
-
+import Yesod as X hiding (textField, passwordField, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option)

Assistant/WebApp/Configurators.hs

@@ -25,7 +25,6 @@ import qualified Git
 import Assistant.XMPP.Client
 #endif
 
-import Yesod
 import qualified Data.Map as M
 
 {- The main configuration screen. -}

Assistant/WebApp/Configurators/AWS.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP, TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
+{-# LANGUAGE CPP, FlexibleContexts, TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
 
 module Assistant.WebApp.Configurators.AWS where
 
@@ -23,7 +23,6 @@ import Types.Remote (RemoteConfig)
 import Types.StandardGroups
 import Logs.PreferredContent
 
-import Yesod
 import qualified Data.Text as T
 import qualified Data.Map as M
 
@@ -74,6 +73,15 @@ s3InputAForm = AWSInput
 		, ("Reduced redundancy (costs less)", ReducedRedundancy)
 		]
 
+textField' :: RenderMessage master FormMessage => Field sub master Text
+textField' = Field
+    { fieldParse = fieldParse textField
+    , fieldView = \theId name attrs val _isReq ->
+        [whamlet|
+<input id="#{theId}" name="#{name}" *{attrs} type="text" value="#{either id id val}">
+|]
+    }
+
 glacierInputAForm :: AForm WebApp WebApp AWSInput
 glacierInputAForm = AWSInput
 	<$> areq textField "Access Key ID" Nothing

Assistant/WebApp/Configurators/Edit.hs

@@ -25,7 +25,6 @@ import qualified Git
 import qualified Git.Command
 import qualified Git.Config
 
-import Yesod
 import qualified Data.Text as T
 import qualified Data.Map as M
 import qualified Data.Set as S

Assistant/WebApp/Configurators/Local.hs

@@ -30,7 +30,6 @@ import Types.StandardGroups
 import Logs.PreferredContent
 import Utility.UserInfo
 
-import Yesod
 import qualified Data.Text as T
 import Data.Char
 import System.Posix.Directory

Assistant/WebApp/Configurators/Pairing.hs

@@ -37,7 +37,6 @@ import Assistant.WebApp.Configurators.XMPP
 import Utility.UserInfo
 import Git
 
-import Yesod
 #ifdef WITH_PAIRING
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T

Assistant/WebApp/Configurators/Ssh.hs

@@ -19,7 +19,6 @@ import Logs.PreferredContent
 import Types.StandardGroups
 import Utility.UserInfo
 
-import Yesod
 import qualified Data.Text as T
 import qualified Data.Map as M
 import Network.Socket

Assistant/WebApp/Configurators/WebDAV.hs

@@ -22,7 +22,6 @@ import Logs.PreferredContent
 import Logs.Remote
 import Creds
 
-import Yesod
 import qualified Data.Text as T
 import qualified Data.Map as M
 

Assistant/WebApp/Configurators/XMPP.hs

@@ -23,7 +23,6 @@ import Assistant.DaemonStatus
 import Utility.SRV
 #endif
 
-import Yesod
 #ifdef WITH_XMPP
 import Network
 import Network.Protocol.XMPP

Assistant/WebApp/DashBoard.hs

@@ -22,7 +22,6 @@ import Types.Key
 import qualified Remote
 import qualified Git
 
-import Yesod
 import Text.Hamlet
 import qualified Data.Map as M
 import Control.Concurrent

Assistant/WebApp/Documentation.hs

@@ -13,8 +13,6 @@ import Assistant.WebApp.Common
 import Assistant.Install (standaloneAppBase)
 import Build.SysConfig (packageversion)
 
-import Yesod
-
 {- The full license info may be included in a file on disk that can
  - be read in and displayed. -}
 licenseFile :: IO (Maybe FilePath)

Assistant/WebApp/Form.hs

@@ -0,0 +1,35 @@
+{- git-annex assistant webapp form utilities
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE FlexibleContexts, TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
+
+module Assistant.WebApp.Form where
+
+import Yesod hiding (textField, passwordField)
+import Yesod.Form.Fields as F
+import Data.Text (Text)
+
+{- Yesod's textField sets the required attribute for required fields.
+ - We don't want this, because many of the forms used in this webapp 
+ - display a modal dialog when submitted, which interacts badly with
+ - required field handling by the browser.
+ -
+ - Required fields are still checked by Yesod.
+ -}
+textField :: RenderMessage master FormMessage => Field sub master Text
+textField = F.textField
+	{ fieldView = \theId name attrs val _isReq -> [whamlet|
+<input id="#{theId}" name="#{name}" *{attrs} type="text" value="#{either id id val}">
+|]
+	}
+
+passwordField :: RenderMessage master FormMessage => Field sub master Text
+passwordField = F.passwordField
+	{ fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
+<input id="#{theId}" name="#{name}" *{attrs} type="password" value="#{either id id val}">
+|]
+	}

debian/changelog

@@ -16,6 +16,7 @@ git-annex (3.20121128) UNRELEASED; urgency=low
   * webdav: Avoid trying to set props, avoiding incompatability with
     livedrive.com. Needs DAV version 0.3.
   * webapp: Prettify error display.
+  * webapp: Fix bad interaction between required fields and modals.
 
  -- Joey Hess <joeyh@debian.org>  Wed, 28 Nov 2012 13:31:07 -0400
 

doc/design/assistant/webapp.mdwn

@@ -8,6 +8,8 @@ The webapp is a web server that displays a shiny interface.
   This is quite likely because of how the div containing transfers is refereshed.
   If instead javascript was used to update the progress bar etc for transfers
   with json data, the buttons would work better.
+* Some forms display a modal message when submitted and also have required
+  fields. This does not interact well. 
 
 ## interface