diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Blog.hs | 51 | ||||
-rw-r--r-- | src/Locales.hs | 57 | ||||
-rw-r--r-- | src/Server.hs | 15 |
3 files changed, 73 insertions, 50 deletions
diff --git a/src/Blog.hs b/src/Blog.hs index e22a8d9efed8..f14b5df5ecd5 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 000000000000..266f4e752d9a --- /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 <a href=\"en\">available here</a>" +rightText EN = "Deutsche Version <a href=\"de\">hier verfügbar</a>" + +-- 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 8b513595e00c..764d3c9055aa 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 |