Add simple module for users registration.

Portnov [2009-07-15 18:00:09]
Add simple module for users registration.
Filename
Framework/Forms/HTML.hs
Framework/Modules/Registration/Forms.hs
diff --git a/Framework/Forms/HTML.hs b/Framework/Forms/HTML.hs
index 3cb89ae..d2b7df1 100644
--- a/Framework/Forms/HTML.hs
+++ b/Framework/Forms/HTML.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE ExistentialQuantification, TypeFamilies, NamedFieldPuns, FlexibleContexts #-}
 module Framework.Forms.HTML
-    (Inputbox, Textarea, PasswordBox,
+    (Inputbox (..), Textarea (..), PasswordBox (..),
      inputbox, textarea, passwordbox,
      tag, tagToHtml, toHtml,
      formrow, hiddenField,
diff --git a/Framework/Modules/Registration/Forms.hs b/Framework/Modules/Registration/Forms.hs
new file mode 100644
index 0000000..2bb4800
--- /dev/null
+++ b/Framework/Modules/Registration/Forms.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE TypeFamilies #-}
+module Framework.Modules.Registration.Forms where
+
+import Framework.ORM
+import Framework.Forms.Types
+import Framework.Forms.Validators
+import Framework.Forms.Validation
+import Framework.Forms.HTML
+import Framework.Http.Vars
+
+data TwoPasswordBoxes = TwoPasswordBoxes {tpWidth :: Maybe Int}
+
+instance Widget TwoPasswordBoxes where
+    type WContent TwoPasswordBoxes = String
+
+    html (TwoPasswordBoxes w) name value = tag "div" [] [html (PasswordBox w) name value,
+                                                         html (PasswordBox w) (name++"check") value]
+
+    wRead = id
+
+twoPasswordBoxes = TwoPasswordBoxes Nothing
+
+validatePasswords :: FieldValidator
+validatePasswords rq name str =
+    if str == str'
+      then Right str
+      else Left name
+  where
+    str' = httpPostVar' rq (name++"check") ""
+
+registrationModel = emptyModel {
+    mName = "register",
+    mFields = [
+        "name" ::: StringColumn,
+        "password" ::: StringColumn ]
+    }
+
+registrationForm = Form {
+    formName = "register",
+    formModel = registrationModel,
+    fFields = [
+      Field "name" "Name" inputbox notEmpty,
+      Field "password" "Password" twoPasswordBoxes validatePasswords ]
+  }
+
+showRegistrationForm' form target = retryForm form "1" [] target
+
+showRegistrationForm target = showRegistrationForm registrationForm
ViewGit