From 0f0d874aa7bc194b48a47c29fab06513d093d306 Mon Sep 17 00:00:00 2001
From: "\"Vincent Ambo ext:(%22)" <tazjin@me.com>
Date: Fri, 24 Feb 2012 17:01:36 +0100
Subject: [PATCH] * entries by month

---
 src/Locales.hs | 40 ++++++++++++++++++++++++++++++++++++++++
 src/Server.hs  | 30 +++++++++++++++++++++++++-----
 2 files changed, 65 insertions(+), 5 deletions(-)

diff --git a/src/Locales.hs b/src/Locales.hs
index 266f4e752..fb9435195 100644
--- a/src/Locales.hs
+++ b/src/Locales.hs
@@ -24,6 +24,46 @@ blogTitle EN = "Tazjin's Blog"
 topText DE = "Aktuelle Einträge"
 topText EN = "Latest entries"
 
+getMonth :: BlogLang -> Int -> Int -> String
+getMonth l y m = monthName l m ++ show y
+  where
+    monthName :: BlogLang -> Int -> String
+    monthName DE m = case m of 
+                    1 -> "Januar "
+                    2 -> "Februar "
+                    3 -> "März "
+                    4 -> "April "
+                    5 -> "Mai "
+                    6 -> "Juni "
+                    7 -> "Juli "
+                    8 -> "August "
+                    9 -> "September "
+                    10 -> "Oktober "
+                    11 -> "November"
+                    12 -> "Dezember"
+    monthName EN m = case m of
+                    1 -> "January "
+                    2 -> "February "
+                    3 -> "March "
+                    4 -> "April "
+                    5 -> "May "
+                    6 -> "June "
+                    7 -> "July "
+                    8 -> "August "
+                    9 -> "September "
+                    10 -> "October "
+                    11 -> "November "
+                    12 -> "December "
+
+entireMonth DE = "Ganzer Monat"
+entireMonth EN = "Entire month"
+
+prevMonth DE = "Früher"
+prevMonth EN = "Earlier"
+
+nextMonth DE = "Später"
+nextMonth EN = "Later"
+
 -- contact information
 contactText DE = "Wer mich kontaktieren will: "
 contactText EN = "Get in touch with me: "
diff --git a/src/Server.hs b/src/Server.hs
index 764d3c905..b50de2deb 100644
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -44,6 +44,10 @@ blogHandler :: BlogLang -> ServerPart Response
 blogHandler lang = 
     msum [ path $ \(year :: Int) -> path $ \(month :: Int) -> path $ --single entry
                       \(day :: Int) -> path $ \(id_ :: String) -> showEntry year month day id_
+         , path $ \(year :: Int) -> path $ \(month :: Int) -> path $ 
+                      \(day :: Int) -> showDay year month day lang
+         , path $ \(year :: Int ) -> path $ \(month :: Int) -> showMonth year month lang
+         , path $ \(year :: Int ) -> showYear year lang
          , do nullDir
               showIndex lang
          ]
@@ -56,18 +60,29 @@ showEntry y m d i = do
 
 tryEntry :: Maybe Entry -> Response
 tryEntry Nothing = toResponse $ showError NotFound
-tryEntry (Just entry) = toResponse $ renderBlog eLang $ renderEntry entry
+tryEntry (Just entry) = toResponse $ blogTemplate eLang $ renderEntry entry
     where
         eLang = lang entry
 
 showIndex :: BlogLang -> ServerPart Response
 showIndex lang = do
     entries <- getLatest lang []
-    ok $ toResponse $ renderBlog lang $ renderEntries entries 6 (topText lang)
-  where
+    ok $ toResponse $ blogTemplate lang $ renderEntries entries 6 (topText lang)
+
+showDay :: Int -> Int -> Int -> BlogLang -> ServerPart Response
+showDay y m d lang = undefined
+
+showMonth :: Int -> Int -> BlogLang -> ServerPart Response
+showMonth y m lang = do
+    entries <- getLatest lang $ makeQuery startkey endkey
+    ok $ toResponse $ blogTemplate lang $ renderEntries entries (length entries) $ getMonth lang y  m
+  where
+    startkey = JSArray [toJSON y, toJSON m]
+    endkey = JSArray [toJSON y, toJSON m, JSObject (toJSObject [] )]
+
+showYear :: Int -> BlogLang -> ServerPart Response
+showYear y lang = undefined
 
-renderBlog :: BlogLang -> Html -> Html
-renderBlog lang body = blogTemplate lang body
 
 -- http://tazj.in/2012/02/10.155234
 
@@ -82,6 +97,10 @@ getLatest lang arg = do
                 EN -> "latestEN"
                 DE -> "latestDE"
 
+makeQuery :: JSON a => a -> a -> [(String, JSValue)]
+makeQuery qsk qek = [("startkey", (showJSON qsk))
+                    ,("endkey", (showJSON qek))]
+
 queryDB :: JSON a => String -> [(String, JSValue)] -> ServerPart [(Doc, a)]
 queryDB view arg = liftIO $ runCouchDB' $ queryView (db "tazblog") (doc "entries") (doc view) arg
 
@@ -92,6 +111,7 @@ maybeDoc Nothing = Nothing
 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); } }"