about summary refs log tree commit diff
path: root/src
diff options
context:
space:
mode:
authorVincent Ambo <viam@humac.com>2012-03-02T08·12+0100
committerVincent Ambo <viam@humac.com>2012-03-02T08·12+0100
commitda8833bf343ddb0083cc14ef616eddd442896af5 (patch)
tree39b3f953c859499544330ac80de5a6574f08ecae /src
parentfed422f8724f9e0bfa7d6749721f2586803212a7 (diff)
* changes D:
Diffstat (limited to 'src')
-rw-r--r--src/Blog.hs14
-rw-r--r--src/Locales.hs13
-rw-r--r--src/Main.hs (renamed from src/Server.hs)20
3 files changed, 30 insertions, 17 deletions
diff --git a/src/Blog.hs b/src/Blog.hs
index f14b5df5ecd5..61c8bc3f029d 100644
--- a/src/Blog.hs
+++ b/src/Blog.hs
@@ -36,10 +36,14 @@ data Entry = Entry{
 
 data BlogError = NoEntries | NotFound | DBError
 
-blogTemplate :: BlogLang -> Html -> Html
-blogTemplate lang body = H.docTypeHtml $ do --add body
+
+intersperse' :: a -> [a] -> [a]
+intersperse' sep l = sep : intersperse sep l
+
+blogTemplate :: BlogLang -> String -> Html -> Html
+blogTemplate lang t_append body = H.docTypeHtml $ do --add body
     H.head $ do
-        H.title $ (toHtml $ blogTitle lang)
+        H.title $ (toHtml $ blogTitle lang t_append)
         H.link ! A.rel "alternate" ! A.type_ "application/rss+xml" ! A.title "RSS-Feed" ! A.href "/rss"
         H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "/res/blogstyle.css" ! A.media "all"
         H.meta ! A.httpEquiv "content-type" ! A.content "text/html;charset=UTF-8"
@@ -48,7 +52,7 @@ blogTemplate lang body = H.docTypeHtml $ do --add body
         H.div ! A.class_ "mainshell" $ H.div ! A.class_ "gradBox" $ do
             H.div ! A.class_ "header" $ do
                 H.a ! A.href "/" ! A.style "text-decoration:none;color:black;font-size:x-large;font-weight:bold;" $
-                        (toHtml $ blogTitle lang)
+                        toHtml $ blogTitle lang ""
                 H.br
                 H.span ! A.id "cosx" ! A.style "display:block;" $ H.b $ contactInfo iMessage
                -- H.span ! A.id "cios" ! A.style "display:none;" $ H.b $ contactInfo "sms:tazjin@me.com"
@@ -79,7 +83,7 @@ renderEntries entries num topText = H.div ! A.class_ "innerBox" $ do
         showEntry e = H.li $ do 
             entryLink e
             preEscapedString $ " " ++ (text e) ++ "<br>&nbsp;</br>"
-        entryLink e = H.a ! A.href (toValue $ concat $ intersperse "/" $ linkElems e) $
+        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]
 
diff --git a/src/Locales.hs b/src/Locales.hs
index fb9435195987..c3d11bc887af 100644
--- a/src/Locales.hs
+++ b/src/Locales.hs
@@ -4,7 +4,7 @@ module Locales where
 
 import           Data.Data (Data, Typeable)
 
-{- to add a language simply define it's abbreviation and show instance then
+{- to add a language simply define its abbreviation and Show instance then
  - translate the appropriate strings and add CouchDB views in Server.hs -}
 
 data BlogLang = EN | DE deriving (Data, Typeable)
@@ -17,8 +17,9 @@ version = ("2.2b" :: String)
 
 allLang = [EN, DE]
 
-blogTitle DE = "Tazjins Blog"
-blogTitle EN = "Tazjin's Blog"
+blogTitle :: BlogLang -> String -> String
+blogTitle DE s = "Tazjins Blog" ++ s
+blogTitle EN s = "Tazjin's Blog" ++ s
 
 -- index site headline
 topText DE = "Aktuelle Einträge"
@@ -39,8 +40,8 @@ getMonth l y m = monthName l m ++ show y
                     8 -> "August "
                     9 -> "September "
                     10 -> "Oktober "
-                    11 -> "November"
-                    12 -> "Dezember"
+                    11 -> "November "
+                    12 -> "Dezember "
     monthName EN m = case m of
                     1 -> "January "
                     2 -> "February "
@@ -94,4 +95,4 @@ repoURL = "https://bitbucket.org/tazjin/tazblog-haskell"
 mailTo  = "mailto:hej@tazj.in"
 twitter = "http://twitter.com/#!/tazjin"
 iMessage = "imessage:tazjin@me.com"
-iMessage' = "sms:tazjin@me.com"
\ No newline at end of file
+iMessage' = "sms:tazjin@me.com"
diff --git a/src/Server.hs b/src/Main.hs
index b50de2debcd9..27dfc621bd04 100644
--- a/src/Server.hs
+++ b/src/Main.hs
@@ -60,14 +60,15 @@ showEntry y m d i = do
 
 tryEntry :: Maybe Entry -> Response
 tryEntry Nothing = toResponse $ showError NotFound
-tryEntry (Just entry) = toResponse $ blogTemplate eLang $ renderEntry entry
+tryEntry (Just entry) = toResponse $ blogTemplate eLang eTitle $ renderEntry entry
     where
+        eTitle = ": " ++ title entry
         eLang = lang entry
 
 showIndex :: BlogLang -> ServerPart Response
 showIndex lang = do
     entries <- getLatest lang []
-    ok $ toResponse $ blogTemplate lang $ renderEntries entries 6 (topText lang)
+    ok $ toResponse $ blogTemplate lang "" $ renderEntries entries 6 (topText lang)
 
 showDay :: Int -> Int -> Int -> BlogLang -> ServerPart Response
 showDay y m d lang = undefined
@@ -75,8 +76,10 @@ 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
+    ok $ toResponse $ blogTemplate lang month 
+        $ renderEntries entries (length entries) month
   where
+    month = getMonth lang y  m
     startkey = JSArray [toJSON y, toJSON m]
     endkey = JSArray [toJSON y, toJSON m, JSObject (toJSObject [] )]
 
@@ -113,12 +116,17 @@ 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); } }"
+countDEView  = "function(doc){ if(doc.lang == 'DE'){ emit([doc.year, doc.month, doc.day, doc._id], 1); } }"
+countENView  = "function(doc){ if(doc.lang == 'EN'){ emit([doc.year, doc.month, doc.day, doc._id], 1); } }"
+countReduce = "function(keys, values, rereduce) { return sum(values); }"
 
 latestDE = ViewMap "latestDE" latestDEView
 latestEN = ViewMap "latestEN" latestENView
+countDE  = ViewMapReduce "countDE" countDEView countReduce
+countEN  = ViewMapReduce "countEN" countENView countReduce
 
 setupBlogViews :: IO ()
 setupBlogViews = runCouchDB' $ 
-    newView "tazblog" "entries" [latestDE, latestEN]
+    newView "tazblog" "entries" [latestDE, latestEN, countDE, countEN]