diff --git a/Blog/Blog.hs b/Blog/Blog.hs
index da29b47..d4c728f 100644
--- a/Blog/Blog.hs
+++ b/Blog/Blog.hs
@@ -48,21 +48,18 @@ allposts = do
rq <- asks request
let getvars = _GET rq
key = "allposts" ++ (getString' getvars "page" "1")
- result <- cacheGet key
- case result of
- Just html -> return $ ok html
- Nothing -> do
- (posts,pagerHtml) <- pager 5 (countChildren postModel commentModel "dt") [] postModel
- lastComments <- querySQL' ((table commentModel) `order` (Desceding "dt") `limit` (0,10)) [] commentModel
- let code = getString' getvars "code" ""
- let message = maybe "" id $ lookup code messagecodes
- let html = render "blogposts.html" $
- M.fromList [("posts", C posts),
- ("comments", C lastComments),
- ("message", C message),
- ("pager", C pagerHtml)]
- cachePut key html
- return $ ok html
+ tryReturnFromCache key
+ (posts,pagerHtml) <- pager 5 (countChildren postModel commentModel "dt") [] postModel
+ lastComments <- querySQL' ((table commentModel) `order` (Desceding "dt") `limit` (0,10)) [] commentModel
+ let code = getString' getvars "code" ""
+ let message = maybe "" id $ lookup code messagecodes
+ let html = render "blogposts.html" $
+ M.fromList [("posts", C posts),
+ ("comments", C lastComments),
+ ("message", C message),
+ ("pager", C pagerHtml)]
+ cachePut key html
+ return $ ok html
invalidatePostsCache :: Controller ActionConfig ()
invalidatePostsCache = do
@@ -100,6 +97,7 @@ editpost sid = do
case rqMethod rq of
GET ->
do posts <- querySQL' ((table postModel) `restrict` ("id" :==: "?")) [SqlInt32 pid] postModel
+ assertC $ (length posts)==1
let post = head posts
let ptitle = post -:> "title"
let pbody = post -:> "body"
@@ -115,8 +113,7 @@ editpost sid = do
commit
invalidatePostsCache
return $ redirectG "/blog/" ["code" := "3"]
- Left e -> do cont <- returnInvalidForm postForm "1" e
- return cont
+ Left e -> returnInvalidForm postForm "1" e
onepost :: StrAction
onepost sid = do
diff --git a/Framework/API.hs b/Framework/API.hs
index e8791f1..eaa4e3a 100644
--- a/Framework/API.hs
+++ b/Framework/API.hs
@@ -4,6 +4,7 @@
module Framework.API
(ActionConfig (..),
cacheGet, cachePut, cacheUnset,
+ tryReturnFromCache,
serveHttp, serveStatic,
sessionLookup, sessionSet,
queryList, queryList', query, query',
@@ -31,7 +32,7 @@ import qualified Framework.Cache as Cache
import qualified Framework.SQL as SQL
import qualified Framework.Logger as Logger
import Framework.Models (Model)
-import Framework.Http.Response ((<+>))
+import Framework.Http.Response ((<+>),ok)
import Framework.Http.HTTPServer (serveHttp,serveStatic)
----------------------------------------------------------------------------------------------------------
@@ -52,6 +53,13 @@ cacheUnset key = do
cb <- asks cacheBackend
liftC $ Cache.cUnset cb key
+tryReturnFromCache :: String -> Controller ActionConfig ()
+tryReturnFromCache key = do
+ c <- cacheGet key
+ case c of
+ Just content -> returnNow $ ok content
+ Nothing -> return ()
+
----------------------------------------------------------------------------------------------------------
-- * Sessions API