diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Blog.hs | 14 | ||||
| -rw-r--r-- | src/Locales.hs | 13 | ||||
| -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> </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] |