about summary refs log tree commit diff
path: root/src/Server.hs
diff options
context:
space:
mode:
author"Vincent Ambo ext:(%22) <tazjin@me.com>2012-02-24T04·20+0100
committer"Vincent Ambo ext:(%22) <tazjin@me.com>2012-02-24T04·20+0100
commita29a34d41f3101344b46f51a8e5dc5afecf82218 (patch)
tree14b22d61ee8884ccc093d59a2a0bd9c7cc97a87a /src/Server.hs
parent066762051abe5739e956aeb5f369c58c02703010 (diff)
* I fixed the front page
Diffstat (limited to 'src/Server.hs')
-rw-r--r--src/Server.hs35
1 files changed, 25 insertions, 10 deletions
diff --git a/src/Server.hs b/src/Server.hs
index a95b72cd7bba..8b513595e00c 100644
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -36,7 +36,7 @@ tazBlog = do
     msum [ dir "en" $ blogHandler EN
          , dir "de" $ blogHandler DE
          , do nullDir
-              ok $ showIndex DE
+              showIndex DE
          , do dir " " $ nullDir
               seeOther ("https://plus.google.com/115916629925754851590" :: String) (toResponse ())
          , dir "res" $ serveDirectory DisableBrowsing [] "../res"
@@ -48,7 +48,7 @@ blogHandler lang =
     msum [ path $ \(year :: Int) -> path $ \(month :: Int) -> path $ --single entry
                       \(day :: Int) -> path $ \(id_ :: String) -> showEntry year month day id_
          , do nullDir
-              ok $ showIndex lang
+              showIndex lang
          ]
 
 showEntry :: Int -> Int -> Int -> String -> ServerPart Response
@@ -63,20 +63,35 @@ tryEntry (Just entry) = toResponse $ renderBlog eLang $ renderEntry entry
     where
         eLang = lang entry
 
-showIndex :: BlogLang -> Response
-showIndex lang = toResponse $ renderBlogHeader lang
+showIndex :: BlogLang -> ServerPart Response
+showIndex lang = do
+    entries <- getLatest lang []
+    ok $ toResponse $ renderBlog lang $ renderEntries entries 6 (topText lang)
+  where
+    topText EN = "Latest entries"
+    topText DE = "Aktuelle Einträge"
+
 
 renderBlog :: BlogLang -> Html -> Html
 renderBlog DE body = blogTemplate "Tazjins Blog" "Wer mich kontaktieren will: " " oder " version DE body
 renderBlog EN body = blogTemplate "Tazjin's Blog" "Get in touch with me: " " or " version EN body
 
-renderBlogHeader :: BlogLang -> Html
-renderBlogHeader DE = blogTemplate "Tazjins Blog" "Wer mich kontaktieren will: " " oder " version DE (emptyTest DE)
-renderBlogHeader EN = blogTemplate "Tazjin's Blog" "Get in touch with me: " " or " version EN (emptyTest EN)
-
 -- http://tazj.in/2012/02/10.155234
 
 -- CouchDB functions
+getLatest :: BlogLang -> [(String, JSValue)] -> ServerPart [Entry]
+getLatest lang arg = do
+        queryResult <- queryDB view arg
+        let entries = map (stripResult . fromJSON . snd) queryResult
+        return entries
+    where
+        view = case lang of
+                EN -> "latestEN"
+                DE -> "latestDE"
+
+queryDB :: JSON a => String -> [(String, JSValue)] -> ServerPart [(Doc, a)]
+queryDB view arg = liftIO $ runCouchDB' $ queryView (db "tazblog") (doc "entries") (doc view) arg
+
 maybeDoc :: Data a => Maybe (Doc, Rev, JSValue) -> Maybe a
 maybeDoc (Just(_,_,v)) = Just( stripResult $ fromJSON v)
 maybeDoc Nothing = Nothing
@@ -85,8 +100,8 @@ stripResult :: Result a -> a
 stripResult (Ok z) = z
 stripResult (Error s) = error $ "JSON error: " ++ s
 -- CouchDB View Setup
-latestDEView = "function(doc){ if(doc.lang == \"DE\"){ emit([doc.year, doc.month, doc.day, doc.id_], doc); } }"
-latestENView = "function(doc){ if(doc.lang == \"EN\"){ emit([doc.year, doc.month, doc.day, doc.id_]], doc); } }"
+latestDEView = "function(doc){ if(doc.lang == 'DE'){ emit([doc.year, doc.month, doc.day, doc.id_], doc); } }"
+latestENView = "function(doc){ if(doc.lang == 'EN'){ emit([doc.year, doc.month, doc.day, doc.id_], doc); } }"
 
 latestDE = ViewMap "latestDE" latestDEView
 latestEN = ViewMap "latestEN" latestENView