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}">
+|]
+	}