diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 21 |
1 files changed, 14 insertions, 7 deletions
diff --git a/src/Main.hs b/src/Main.hs index debf02e3cc18..89f6179237f5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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] |