Add simple module for users registration.
Add simple module for users registration.
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