mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* limiting amount of queries with couchDB's limit parameter

Browse source
This commit is contained in:
Vincent Ambo 2012-03-03 04:02:30 +01:00
parent 65a5443e2d
commit 7114876693
2 changed files with 6 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/Blog.hs
View file

@ -72,12 +72,12 @@ blogTemplate lang t_append body = H.docTypeHtml $ do --add body
H.a ! A.href (toValue imu) ! A.target "_blank" $ "iMessage"
"."
renderEntries :: [Entry] -> Int -> String-> Html
renderEntries entries num topText = H.div ! A.class_ "innerBox" $ do
renderEntries :: [Entry] -> String-> Html
renderEntries entries topText = H.div ! A.class_ "innerBox" $ do
H.div ! A.class_ "innerBoxTop" $ toHtml topText
H.div ! A.class_ "innerBoxMiddle" $ do
H.ul $
sequence_ $ take num $ reverse $ map showEntry entries
sequence_ $ reverse $ map showEntry entries
where
showEntry :: Entry -> Html
showEntry e = H.li $ do

6
src/Main.hs
View file

@ -64,14 +64,14 @@ tryEntry (Just entry) = toResponse $ blogTemplate eLang eTitle $ renderEntry ent
showIndex :: BlogLang -> ServerPart Response
showIndex lang = do
entries <- getLatest lang []
ok $ toResponse $ blogTemplate lang "" $ renderEntries entries 6 (topText lang)
entries <- getLatest lang [("limit", toJSON (6 :: Int)), ("descending", toJSON True)]
ok $ toResponse $ blogTemplate lang "" $ renderEntries entries (topText lang)
showMonth :: Int -> Int -> BlogLang -> ServerPart Response
showMonth y m lang = do
entries <- getLatest lang $ makeQuery startkey endkey
ok $ toResponse $ blogTemplate lang month
$ renderEntries entries (length entries) month
$ renderEntries entries month
where
month = getMonth lang y m
startkey = JSArray [toJSON y, toJSON m]