* I fixed the front page

src/Blog.hs

@@ -4,6 +4,7 @@ module Blog where
 
 --import           Control.Monad(when)
 import           Data.Data (Data, Typeable)
+import           Data.List (intersperse)
 import           Data.Monoid (mempty)
 import           Data.Time
 import           System.Locale (defaultTimeLocale)
@@ -61,6 +62,7 @@ blogTemplate title ctext1 ortext version lang body = H.docTypeHtml $ do --add bo
                -- H.span ! A.id "cios" ! A.style "display:none;" $ H.b $ contactInfo "sms:tazjin@me.com"
             H.div ! A.class_ "myclear" $ mempty
             body
+            H.div ! A.class_ "myclear" $ mempty
             showFooter lang version
         H.div ! A.class_ "centerbox" $
             H.img ! A.src "http://getpunchd.com/img/june/idiots.png" ! A.alt ""
@@ -74,6 +76,21 @@ blogTemplate title ctext1 ortext version lang body = H.docTypeHtml $ do --add bo
             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
+    H.div ! A.class_ "innerBoxTop" $ toHtml topText
+    H.div ! A.class_ "innerBoxMiddle" $ do
+        H.ul $ 
+            sequence_ $ take num $ reverse $ map showEntry entries
+    where
+        showEntry :: Entry -> Html
+        showEntry e = H.li $ do 
+            entryLink e
+            preEscapedString $ " " ++ (text e) ++ "<br>&nbsp;</br>"
+        entryLink e = H.a ! A.href (toValue $ concat $ intersperse "/" $ linkElems e) $
+                        toHtml ("[" ++ show(length $ comments e) ++ "]")
+        linkElems e = [show(lang e), show(year e), show(month e), show(day e), _id e]
+
 renderEntry :: Entry -> Html
 renderEntry entry = H.div ! A.class_ "innerBox" $ do
     H.div ! A.class_ "innerBoxTop" $ toHtml $ title entry
@@ -102,12 +119,10 @@ renderComments comments lang = sequence_ $ map showComment comments
         getTime :: Integer -> Maybe UTCTime
         getTime t = parseTime defaultTimeLocale "%s" (show t)
         showTime DE (Just t) = formatTime defaultTimeLocale "[Am %d.%m.%y um %H:%M Uhr]" t
-        showTime EN (Just t) = formatTime defaultTimeLocale "[On %D at %H:%M Uhr]" t
+        showTime EN (Just t) = formatTime defaultTimeLocale "[On %D at %H:%M]" t
         showTime _ Nothing = "[???]" -- this can not happen??
         timeString = (showTime lang) . getTime
 
---[Am %d.%m.%y um %H:%M Uhr]
-
 emptyTest :: BlogLang -> Html
 emptyTest lang = H.div ! A.class_ "innerBox" $ do
     H.div ! A.class_ "innerBoxTop" $ "Test"

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