maurice/snix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* Pagination (finally!)

Browse source 
* slight CSS change
This commit is contained in:
Vincent Ambo 2012-03-03 16:39:15 +01:00
parent 485e271475
commit 96093c9009
4 changed files with 43 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

21
src/Main.hs
View file

@ -2,10 +2,11 @@
module Main where
import Control.Monad (msum, mzero)
import Control.Applicative (optional)
import Control.Monad (msum)
import Data.Monoid (mempty)
import Data.ByteString.Char8 (ByteString)
import Data.Text hiding (map, length, zip, head)
import Data.Text hiding (map, length, zip, head, drop)
import Data.Time
import Database.CouchDB
import Happstack.Server
@ -64,14 +65,20 @@ tryEntry (Just entry) = toResponse $ blogTemplate eLang eTitle $ renderEntry ent
showIndex :: BlogLang -> ServerPart Response
showIndex lang = do
entries <- getLatest lang [("limit", toJSON (7 :: Int)), ("descending", toJSON True)]
ok $ toResponse $ blogTemplate lang "" $ renderEntries entries (topText lang)
entries <- getLatest lang [("descending", showJSON True)]
(page :: Maybe Int) <- optional $ lookRead "page"
ok $ toResponse $ blogTemplate lang "" $
renderEntries False (eDrop page entries) (topText lang) (Just $ showLinks page lang)
where
eDrop :: Maybe Int -> [a] -> [a]
eDrop (Just i) = drop ((i-1) * 6)
eDrop Nothing = drop 0
showMonth :: Int -> Int -> BlogLang -> ServerPart Response
showMonth y m lang = do
entries <- getLatest lang $ makeQuery startkey endkey
entries <- getLatest lang $ ("descending", showJSON True) : makeQuery startkey endkey
ok $ toResponse $ blogTemplate lang month
$ renderEntries entries month
$ renderEntries True entries month Nothing
where
month = getMonth lang y m
startkey = JSArray [toJSON y, toJSON m]