Updates in form fields validators
Updates in form fields validators
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