diff --git a/Blog/Blog b/Blog/Blog
index 7a08d03..f942038 100755
Binary files a/Blog/Blog and b/Blog/Blog differ
diff --git a/Blog/Blog.hs b/Blog/Blog.hs
index a7c17c1..0d85401 100644
--- a/Blog/Blog.hs
+++ b/Blog/Blog.hs
@@ -28,7 +28,7 @@ urlconf = "blog" // "new" --> newpost
allposts :: HttpAction
allposts hp rq = withConfig hp rq $ \conf -> do
- (posts,pagerHtml) <- pager conf 5 (table "posts") [] postModel
+ (posts,pagerHtml) <- pager conf 5 (table postModel) [] postModel
-- print posts
let code = httpGetVar' rq "code" ""
let message = maybe "" id $ lookup code messagecodes
@@ -47,9 +47,7 @@ newpost hp rq = withConfig hp rq $ \conf -> do
case d of
Right post -> let ptitle = post -:> "title"
pbody = post -:> "body"
- in do queryListSQL conf
- ((table "posts") `onlyFields` ["dt","title","body"] `insertQ` ["current_timestamp","?","?"])
- [ptitle, pbody]
+ in do queryListSQL conf (insertM postModel) [ptitle, pbody]
commit conf
return $ redirectG "/blog/" ["code" =: "1"]
Left e -> returnInvalidForm conf postForm "1" e
@@ -59,7 +57,7 @@ editpost :: StrAction
editpost hp rq sid = Just $ withConfig hp rq $ \conf -> do
case reqMethod rq of
"GET" ->
- do posts <- querySQL' conf ((table "posts") `restrict` ("id" :==: "?")) [SqlInt32 pid] postModel
+ do posts <- querySQL' conf ((table postModel) `restrict` ("id" :==: "?")) [SqlInt32 pid] postModel
let post = head posts
let ptitle = post -:> "title"
let pbody = post -:> "body"
@@ -71,9 +69,7 @@ editpost hp rq sid = Just $ withConfig hp rq $ \conf -> do
case d of
Right post -> let ptitle = post -:> "title"
pbody = post -:> "body"
- in do queryListSQL conf
- (updateQ ((table "posts") `onlyFields` ["dt","title","body"]) ("id" :==: sid) ["current_timestamp","?","?"])
- [ptitle, pbody]
+ in do queryListSQL conf (updateM postModel ("id":==:sid)) [ptitle, pbody]
commit conf
return $ redirectG "/blog/" ["code" =: "3"]
Left e -> do cont <- returnInvalidForm conf postForm "1" e
@@ -86,8 +82,8 @@ onepost hp rq sid = Just $ withConfig hp rq $ \conf -> do
(form,err) <- retryForm conf commentForm "1" [] url
case reqMethod rq of
"GET" -> do
- post <- querySQL' conf ((table "posts") `restrict` ("id" :==: "?")) [SqlInt32 pid] postModel
- comments <- querySQL' conf ((table "comments") `restrict` ("pid" :==: "?") `order` (Asceding "dt")) [SqlInt32 pid] commentModel
+ post <- querySQL' conf ((table postModel) `restrict` ("id" :==: "?")) [SqlInt32 pid] postModel
+ comments <- querySQL' conf ((table commentModel) `restrict` ("pid" :==: "?") `order` (Asceding "dt")) [SqlInt32 pid] commentModel
let code = httpGetVar' rq "code" ""
let message = maybe "" id $ lookup code messagecodes
return $ renderToResponse "onepost.html" [("post", C (head post)),
@@ -101,9 +97,7 @@ onepost hp rq sid = Just $ withConfig hp rq $ \conf -> do
do print $ mFields comment
let cAuthor = comment -:> "author"
let cBody = comment -:> "body"
- queryListSQL conf
- ((table "comments") `onlyFields` ["pid","dt","author","body"] `insertQ` ["?","current_timestamp","?","?"])
- [SqlInt32 pid, cAuthor, cBody]
+ queryListSQL conf (insertM commentModel) [SqlInt32 pid, cAuthor, cBody]
commit conf
return $ redirectG url ["code" =: "2"]
Left e -> returnInvalidForm conf commentForm "1" e
diff --git a/Framework/SQL.hs b/Framework/SQL.hs
index 62f1c0e..3979eb0 100644
--- a/Framework/SQL.hs
+++ b/Framework/SQL.hs
@@ -10,6 +10,7 @@ module Framework.SQL
restrict,
limit,
countChildren,
+ insertM,updateM,
-- insertQ, updateQ,
aggregate, count
) where
@@ -152,7 +153,7 @@ table m = tableR (mTable m)
insertM m = InsertQuery (mTable m) (map fieldName insfields) temps
where insfields = filter notid $ mFields m
- notid s = not ("id" `isSuffixOf` (fieldName s))
+ notid s = not ("id" == (fieldName s))
temps = map (\f -> if (fieldType f)==CurrentDateColumn
then "current_timestamp"
else "?") insfields