diff --git a/Blog/Config.hs b/Blog/Config.hs deleted file mode 100644 index b779189..0000000 --- a/Blog/Config.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Config where - -import System.IO -import Framework.Types - -params = HP { portNumber = 8080, - docdir = "static", --- dbDriver = "sqlite3", - dbDriver = "psql", --- dbPath = "blog.db", - dbPath = "host=rtfm-server password=31415", --- cacheDriver = "memcached", --- cachePath = "rtfm-server:11211", --- cacheDriver = "fake", - cacheDriver = "filesystem", - cachePath = "tmp/", - sessionsDriver = "files", - sessionsPath = "tmp/sessions/" --- plugins = [] - } - diff --git a/Framework/Config.hs b/Framework/Config.hs index 932aa98..814acc7 100644 --- a/Framework/Config.hs +++ b/Framework/Config.hs @@ -35,7 +35,7 @@ readConfig name sc = do Right cp -> do return $ HP { portNumber = get' cp "network" "port" 80, - docdir = get' cp "static" "staticdir" "static", + docdir = get' cp "static" "staticdir" "/var/www", dbDriver = get' cp "database" "backend" "psql", dbPath = get' cp "database" "path" "", cacheDriver = get' cp "cache" "backend" "fake", diff --git a/Framework/Forms/Validation.hs b/Framework/Forms/Validation.hs index b87a8fe..c472074 100644 --- a/Framework/Forms/Validation.hs +++ b/Framework/Forms/Validation.hs @@ -48,7 +48,18 @@ refillFormG mfun errfields form fid hidden pairs action = HTMLForm vFields hFiel name = formName form mangle (n,v) = (mfun name fid n, v) +-- | Generate a \"to-edit\" form (as "createform", but mark erroneus fields and +-- fill with previous values +refillForm :: [String] -- ^ List of erroneus filled fields names + -> Form -- ^ A form to generate + -> String -- ^ Form ID + -> [(String, String)] -- ^ Hidden values + -> [(String, String)] -- ^ (name,value) pairs (already filled) + -> String -- ^ Form's target url + -> HTMLForm refillForm = refillFormG mangleName + +refillFormU :: [String]-> Form-> String-> [(String, String)]-> [(String, String)]-> String-> HTMLForm refillFormU = refillFormG (\x y z -> z) -- | Generate a form, maybe filled with already-entered data @@ -83,12 +94,17 @@ retryEditForm conf form fid defvals hidden action = do then return (formToHtml $ refillFormU [] form fid hidden defvals action, "") else return (formToHtml $ refillForm (words err) form fid hidden filledVals action, err) -returnInvalidForm :: ActionConfig -> Form -> String -> [String] -> IO HttpResponse +returnInvalidForm :: ActionConfig + -> Form + -> String -- ^ Form ID + -> [String] -- ^ List of erroneus filled fields + -> IO HttpResponse returnInvalidForm conf form fid errs = do sessionSet conf "filled" values return $ redirectG (myUrl $ request conf) ["invalid" := (unwords errs)] where values = tail $ urlencode $ map packParam vars vars = formVars form fid (request conf) + isRight :: Either t1 t -> Bool isRight (Right _) = True isRight _ = False @@ -104,7 +120,10 @@ fromLeft :: Either t t1 -> t fromLeft (Left x) = x fromLeft _ = error "fromLeft applicable only to Left arguments!" -defValidate :: Form -> String -> FormValidator +-- | Default form validation function +defValidate :: Form + -> String -- ^ Form ID + -> FormValidator defValidate form fid rq = if all isRight maybes then Right $ record (formModel form) $ map D.toSql fields @@ -134,7 +153,10 @@ noValidate s = Right s ---------------------------------------------------------------------------------------------------- -getAnyForm :: M.Map String Form -> HttpRequest -> (Either [String] Model, String, String) +-- | Get any present form from HttpRequest +getAnyForm :: M.Map String Form -- ^ Map of all forms with their names + -> HttpRequest + -> (Either [String] Model, String, String) -- ^ (Errors|Model, form name, form ID) getAnyForm mm rq = case form of Nothing -> (Left [], "","") Just form' -> (defValidate form' fid rq, formname, fid) @@ -142,7 +164,11 @@ getAnyForm mm rq = case form of form = M.lookup formname mm fid = httpPostVar' rq "formid" "" -getForm :: M.Map String Form -> HttpRequest -> String -> (Either [String] Model, String) +-- | Get specified form from HttpRequest +getForm :: M.Map String Form -- ^ Map of all forms + -> HttpRequest + -> String -- ^ Form name + -> (Either [String] Model, String) -- ^ (Errors|Model, form ID) getForm mm rq name = if name==formname then (e,fid) else (Left [], "")