* changes D:
This commit is contained in:
Vincent Ambo
parent
fed422f872
commit
da8833bf34
3 changed files with 30 additions and 17 deletions
14
src/Blog.hs
14
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]
|
||||
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
iMessage' = "sms:tazjin@me.com"
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
Loading…
Reference in a new issue