diff --git a/src/Blog.hs b/src/Blog.hs
index e22a8d9ef..f14b5df5e 100644
--- a/src/Blog.hs
+++ b/src/Blog.hs
@@ -2,7 +2,6 @@
module Blog where
---import Control.Monad(when)
import Data.Data (Data, Typeable)
import Data.List (intersperse)
import Data.Monoid (mempty)
@@ -14,6 +13,7 @@ import Text.Blaze.Html5.Attributes (action, enctype, href, name, size,
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
+import Locales
data Comment = Comment{
cauthor :: String,
@@ -36,18 +36,10 @@ data Entry = Entry{
data BlogError = NoEntries | NotFound | DBError
-data BlogLang = EN | DE deriving (Data, Typeable)
-
-instance Show BlogLang where
- show EN = "en"
- show DE = "de"
-
-repoURL = ("https://bitbucket.org/tazjin/tazblog-haskell" :: String)
-
-blogTemplate :: String -> String -> String -> String -> BlogLang -> Html -> Html
-blogTemplate title ctext1 ortext version lang body = H.docTypeHtml $ do --add body
+blogTemplate :: BlogLang -> Html -> Html
+blogTemplate lang body = H.docTypeHtml $ do --add body
H.head $ do
- H.title $ (toHtml title)
+ H.title $ (toHtml $ blogTitle lang)
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"
@@ -56,9 +48,9 @@ blogTemplate title ctext1 ortext version lang body = H.docTypeHtml $ do --add bo
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 title)
+ (toHtml $ blogTitle lang)
H.br
- H.span ! A.id "cosx" ! A.style "display:block;" $ H.b $ contactInfo "imessage:tazjin@me.com"
+ 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"
H.div ! A.class_ "myclear" $ mempty
body
@@ -68,11 +60,11 @@ blogTemplate title ctext1 ortext version lang body = H.docTypeHtml $ do --add bo
H.img ! A.src "http://getpunchd.com/img/june/idiots.png" ! A.alt ""
where
contactInfo (imu :: String) = do
- toHtml ctext1
- H.a ! A.href "mailto:hej@tazj.in" $ "Mail"
+ toHtml $ contactText lang
+ H.a ! A.href (toValue mailTo) $ "Mail"
", "
- H.a ! A.href "http://twitter.com/#!/tazjin" ! A.target "_blank" $ "Twitter"
- toHtml ortext
+ H.a ! A.href (toValue twitter) ! A.target "_blank" $ "Twitter"
+ toHtml $ orString lang
H.a ! A.href (toValue imu) ! A.target "_blank" $ "iMessage"
"."
@@ -101,13 +93,9 @@ renderEntry entry = H.div ! A.class_ "innerBox" $ do
H.div ! A.class_ "innerBoxComments" $ do
H.div ! A.name "cHead" ! A.style "font-size:large;font-weight:bold;" $ toHtml $ cHead (lang entry)
H.ul $ renderComments (comments entry) (lang entry)
- where
- cHead EN = ("Comments:" :: String)
- cHead DE = ("Kommentare:" :: String)
renderComments :: [Comment] -> BlogLang -> Html
-renderComments [] DE = H.li $ toHtml (" Keine Kommentare" :: String)
-renderComments [] EN = H.li $ toHtml (" No comments yet" :: String)
+renderComments [] lang = H.li $ toHtml $ noComments lang
renderComments comments lang = sequence_ $ map showComment comments
where
showComment :: Comment -> Html
@@ -118,20 +106,10 @@ renderComments comments lang = sequence_ $ map showComment comments
H.p ! A.class_ "tt" $ toHtml (timeString $ cdate c)
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]" t
+ showTime lang (Just t) = formatTime defaultTimeLocale (cTimeFormat lang) t
showTime _ Nothing = "[???]" -- this can not happen??
timeString = (showTime lang) . getTime
-emptyTest :: BlogLang -> Html
-emptyTest lang = H.div ! A.class_ "innerBox" $ do
- H.div ! A.class_ "innerBoxTop" $ "Test"
- H.div ! A.class_ "innerBoxMiddle" $ getTestText lang
- H.div ! A.class_ "myclear" $ mempty
- where
- getTestText DE = toHtml ("Das ist doch schonmal was." :: String)
- getTestText EN = toHtml ("This is starting to look like something." :: String)
-
showFooter :: BlogLang -> String -> Html
showFooter l v = H.div ! A.class_ "rightbox" ! A.style "text-align:right;" $ do
toHtml ("Proudly made with " :: String)
@@ -143,11 +121,6 @@ showFooter l v = H.div ! A.class_ "rightbox" ! A.style "text-align:right;" $ do
H.a ! A.href (toValue repoURL) $ toHtml $ ("Version " :: String) ++ v
preEscapedString " "
H.a ! A.href "/notice" $ toHtml $ noticeText l
- where
- noticeText :: BlogLang -> String
- noticeText EN = "site notice"
- noticeText DE = "Impressum"
-
-- Error pages
showError :: BlogError -> Html
diff --git a/src/Locales.hs b/src/Locales.hs
new file mode 100644
index 000000000..266f4e752
--- /dev/null
+++ b/src/Locales.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}
+
+module Locales where
+
+import Data.Data (Data, Typeable)
+
+{- to add a language simply define it's abbreviation and show instance then
+ - translate the appropriate strings and add CouchDB views in Server.hs -}
+
+data BlogLang = EN | DE deriving (Data, Typeable)
+
+instance Show BlogLang where
+ show EN = "en"
+ show DE = "de"
+
+version = ("2.2b" :: String)
+
+allLang = [EN, DE]
+
+blogTitle DE = "Tazjins Blog"
+blogTitle EN = "Tazjin's Blog"
+
+-- index site headline
+topText DE = "Aktuelle Einträge"
+topText EN = "Latest entries"
+
+-- contact information
+contactText DE = "Wer mich kontaktieren will: "
+contactText EN = "Get in touch with me: "
+
+orString DE = " oder "
+orString EN = " or "
+
+-- footer
+noticeText EN = "site notice"
+noticeText DE = "Impressum"
+
+-- comments
+noComments DE = " Keine Kommentare"
+noComments EN = " No comments yet"
+
+cHead DE = "Kommentare:"
+cHead EN = "Comments:"
+
+cTimeFormat DE = "[Am %d.%m.%y um %H:%M Uhr]"
+cTimeFormat EN = "[On %D at %H:%M]"
+
+-- right side text (this is inserted AS IS. Escape HTML!)
+rightText DE = "English version available here"
+rightText EN = "Deutsche Version hier verfügbar"
+
+-- static information
+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
diff --git a/src/Server.hs b/src/Server.hs
index 8b513595e..764d3c905 100644
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -18,14 +18,11 @@ import qualified Text.Blaze.Html5.Attributes as A
import Text.JSON.Generic
import Blog
+import Locales
tmpPolicy :: BodyPolicy
tmpPolicy = (defaultBodyPolicy "./tmp/" 0 1000 1000)
-
---TazBlog version
-version = ("2.2b" :: String)
-
main :: IO()
main = do
putStrLn ("TazBlog " ++ version ++ " in Haskell starting")
@@ -33,8 +30,8 @@ main = do
tazBlog :: ServerPart Response
tazBlog = do
- msum [ dir "en" $ blogHandler EN
- , dir "de" $ blogHandler DE
+ msum [ dir (show DE) $ blogHandler DE
+ , dir (show EN) $ blogHandler EN
, do nullDir
showIndex DE
, do dir " " $ nullDir
@@ -68,13 +65,9 @@ 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
+renderBlog lang body = blogTemplate lang body
-- http://tazj.in/2012/02/10.155234