Updates in form fields validators

Portnov [2009-07-15 17:36:08]
Updates in form fields validators
Filename
Blog/Blog.hs
Blog/Models.hs
Framework/Forms/Types.hs
Framework/Forms/Validation.hs
Framework/Forms/Validators.hs
Framework/Markdown.hs
Framework/Modules/Auth/Models.hs
Framework/Modules/Formatters/Markdown.hs
Framework/Modules/TextCaptcha/FormProcessors.hs
diff --git a/Blog/Blog.hs b/Blog/Blog.hs
index 48a6da2..e53a19e 100644
--- a/Blog/Blog.hs
+++ b/Blog/Blog.hs
@@ -12,6 +12,7 @@ import Framework.Modules.TextCaptcha.FormProcessors

 import Models

+urlconf ::  URLConf
 urlconf = "blog" // "new" --> newpost
       <|> "blog" // "post" // number ~> onepost
       <|> "blog" // "edit" // number ~> editpost
diff --git a/Blog/Models.hs b/Blog/Models.hs
index ee569d2..de200d8 100644
--- a/Blog/Models.hs
+++ b/Blog/Models.hs
@@ -10,7 +10,7 @@ import Framework.Forms.Types
 import Framework.Forms.HTML
 import Framework.Forms.Validators
 import Framework.ORM
-import Framework.Markdown
+import Framework.Modules.Formatters.Markdown

 postModel = emptyModel {
     mName = "post",
@@ -39,7 +39,7 @@ postForm = Form {
     formName = "postform",
     formModel = postModel,
     fFields = [ Field "title" "" inputbox noValidate,
-                Field "body" "" textarea (notEmpty "body")]
+                Field "body" "" textarea notEmpty]
     }

 addNComments post n = setCached postModel "ncomments" IntegerColumn n
@@ -68,7 +68,7 @@ commentForm = Form {
     formName = "comment",
     formModel = commentModel,
     fFields = [ Field "author" "" inputbox noValidate,
-                Field "body" "" textarea (notEmpty "body")]
+                Field "body" "" textarea notEmpty]
     }

 -------------------------------------------------------------------------------
diff --git a/Framework/Forms/Types.hs b/Framework/Forms/Types.hs
index 32edb40..90bb1b1 100644
--- a/Framework/Forms/Types.hs
+++ b/Framework/Forms/Types.hs
@@ -51,7 +51,7 @@ data HTMLForm = HTMLForm {
 -- | Form validator takes request and returns either list of erroneus filled field or filled Model
 type FormValidator = HttpRequest -> Either [String] Model
 -- | Field validator takes field value and returns either error message or validated value
-type FieldValidator = HttpRequest -> String -> Either String String
+type FieldValidator = HttpRequest -> String -> String -> Either String String

 data FormField = forall w. (Widget w) => Field {
     fName :: String,
diff --git a/Framework/Forms/Validation.hs b/Framework/Forms/Validation.hs
index 5ab7493..9ede547 100644
--- a/Framework/Forms/Validation.hs
+++ b/Framework/Forms/Validation.hs
@@ -142,6 +142,8 @@ fromLeft :: Either t t1 -> t
 fromLeft (Left x) = x
 fromLeft _ = error "fromLeft applicable only to Left arguments!"

+apl f x y = f x y
+
 -- | Default form validation function
 defValidate :: Form
             -> String         -- ^ Form ID
@@ -152,9 +154,9 @@ defValidate form fid rq =
       else Left $ map fromLeft $ filter isLeft maybes
     where fields = map fromRight maybes
           maybes :: [Either String String]
-          maybes = zipWith ($) (map (flip fValidate rq) (fFields form)) vars
-          vars :: [String]
-          vars = formVarsValues form fid rq
+          maybes = zipWith3 apl (map (flip fValidate rq) (fFields form)) vars values
+          values = formVarsValues form fid rq
+          vars = formVarsNames form fid

 -- | List of all form fields values in request
 formVarsValues :: Form
diff --git a/Framework/Forms/Validators.hs b/Framework/Forms/Validators.hs
index 07b691b..228b321 100644
--- a/Framework/Forms/Validators.hs
+++ b/Framework/Forms/Validators.hs
@@ -1,13 +1,19 @@
 module Framework.Forms.Validators where

+import Text.Regex.PCRE
 import Framework.Forms.Types

 -- | Check that field is not empty
-notEmpty :: String -> FieldValidator
-notEmpty msg _ s = if null s
-                   then Left msg
-                   else Right s
+notEmpty :: FieldValidator
+notEmpty _ name s = if null s
+                     then Left name
+                     else Right s

 -- | Do not validate at all, consider all values are valid.
 noValidate :: FieldValidator
-noValidate _ s = Right s
+noValidate _ _ s = Right s
+
+regexp :: String -> FieldValidator
+regexp re _ name s = if s =~ ("^"++re++"$")
+                      then Right s
+                      else Left name
diff --git a/Framework/Markdown.hs b/Framework/Markdown.hs
deleted file mode 100644
index 678b50a..0000000
--- a/Framework/Markdown.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module Framework.Markdown
-    (markdown2html
-    ) where
-
-import Text.Pandoc
-import Text.Pandoc.CharacterReferences
-
-markdown2html :: String -> String
-markdown2html =
-   decodeCharacterReferences .(writeHtmlString defaultWriterOptions) . readMarkdown defaultParserState . filter (/='\r')
-
diff --git a/Framework/Modules/Auth/Models.hs b/Framework/Modules/Auth/Models.hs
index 4ccdef8..ddb93f7 100644
--- a/Framework/Modules/Auth/Models.hs
+++ b/Framework/Modules/Auth/Models.hs
@@ -23,8 +23,8 @@ username = transformString 1 id
 defaultLoginForm = Form {
     formName = "loginform",
     formModel = defaultUserModel,
-    fFields = [ Field "name" "" inputbox (notEmpty "name"),
-                Field "password" "" passwordbox (notEmpty "password") ]
+    fFields = [ Field "name" "" inputbox notEmpty,
+                Field "password" "" passwordbox notEmpty ]
     }

 onlyLogin = M.fromList [("loginform", defaultLoginForm)]
diff --git a/Framework/Modules/Formatters/Markdown.hs b/Framework/Modules/Formatters/Markdown.hs
new file mode 100644
index 0000000..225aee5
--- /dev/null
+++ b/Framework/Modules/Formatters/Markdown.hs
@@ -0,0 +1,11 @@
+module Framework.Modules.Formatters.Markdown
+    (markdown2html
+    ) where
+
+import Text.Pandoc
+import Text.Pandoc.CharacterReferences
+
+markdown2html :: String -> String
+markdown2html =
+   decodeCharacterReferences .(writeHtmlString defaultWriterOptions) . readMarkdown defaultParserState . filter (/='\r')
+
diff --git a/Framework/Modules/TextCaptcha/FormProcessors.hs b/Framework/Modules/TextCaptcha/FormProcessors.hs
index 04fc00d..c37e337 100644
--- a/Framework/Modules/TextCaptcha/FormProcessors.hs
+++ b/Framework/Modules/TextCaptcha/FormProcessors.hs
@@ -59,10 +59,10 @@ randomCaptcha = do
 isNum s = ((head s) `elem` "-0123456789") && (all isDigit (tail s))

 validateCaptcha :: FieldValidator
-validateCaptcha rq str =
+validateCaptcha rq name str =
     if (trace ("S:"++str) val) == (trace (show targetval) targetval)
       then Right str
-      else Left "TextCaptcha"
+      else Left name
   where
     val = if isNum str then read str else 9999
     targetval = evalCaptcha captcha
ViewGit