* localization moved to Locales.hs
This commit is contained in:
parent
a29a34d41f
commit
35a5557e17
3 changed files with 73 additions and 50 deletions
51
src/Blog.hs
51
src/Blog.hs
|
@ -2,7 +2,6 @@
|
||||||
|
|
||||||
module Blog where
|
module Blog where
|
||||||
|
|
||||||
--import Control.Monad(when)
|
|
||||||
import Data.Data (Data, Typeable)
|
import Data.Data (Data, Typeable)
|
||||||
import Data.List (intersperse)
|
import Data.List (intersperse)
|
||||||
import Data.Monoid (mempty)
|
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 as H
|
||||||
import qualified Text.Blaze.Html5.Attributes as A
|
import qualified Text.Blaze.Html5.Attributes as A
|
||||||
|
|
||||||
|
import Locales
|
||||||
|
|
||||||
data Comment = Comment{
|
data Comment = Comment{
|
||||||
cauthor :: String,
|
cauthor :: String,
|
||||||
|
@ -36,18 +36,10 @@ data Entry = Entry{
|
||||||
|
|
||||||
data BlogError = NoEntries | NotFound | DBError
|
data BlogError = NoEntries | NotFound | DBError
|
||||||
|
|
||||||
data BlogLang = EN | DE deriving (Data, Typeable)
|
blogTemplate :: BlogLang -> Html -> Html
|
||||||
|
blogTemplate lang body = H.docTypeHtml $ do --add body
|
||||||
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
|
|
||||||
H.head $ do
|
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 "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.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"
|
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_ "mainshell" $ H.div ! A.class_ "gradBox" $ do
|
||||||
H.div ! A.class_ "header" $ 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;" $
|
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.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.span ! A.id "cios" ! A.style "display:none;" $ H.b $ contactInfo "sms:tazjin@me.com"
|
||||||
H.div ! A.class_ "myclear" $ mempty
|
H.div ! A.class_ "myclear" $ mempty
|
||||||
body
|
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 ""
|
H.img ! A.src "http://getpunchd.com/img/june/idiots.png" ! A.alt ""
|
||||||
where
|
where
|
||||||
contactInfo (imu :: String) = do
|
contactInfo (imu :: String) = do
|
||||||
toHtml ctext1
|
toHtml $ contactText lang
|
||||||
H.a ! A.href "mailto:hej@tazj.in" $ "Mail"
|
H.a ! A.href (toValue mailTo) $ "Mail"
|
||||||
", "
|
", "
|
||||||
H.a ! A.href "http://twitter.com/#!/tazjin" ! A.target "_blank" $ "Twitter"
|
H.a ! A.href (toValue twitter) ! A.target "_blank" $ "Twitter"
|
||||||
toHtml ortext
|
toHtml $ orString lang
|
||||||
H.a ! A.href (toValue imu) ! A.target "_blank" $ "iMessage"
|
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.class_ "innerBoxComments" $ do
|
||||||
H.div ! A.name "cHead" ! A.style "font-size:large;font-weight:bold;" $ toHtml $ cHead (lang entry)
|
H.div ! A.name "cHead" ! A.style "font-size:large;font-weight:bold;" $ toHtml $ cHead (lang entry)
|
||||||
H.ul $ renderComments (comments entry) (lang entry)
|
H.ul $ renderComments (comments entry) (lang entry)
|
||||||
where
|
|
||||||
cHead EN = ("Comments:" :: String)
|
|
||||||
cHead DE = ("Kommentare:" :: String)
|
|
||||||
|
|
||||||
renderComments :: [Comment] -> BlogLang -> Html
|
renderComments :: [Comment] -> BlogLang -> Html
|
||||||
renderComments [] DE = H.li $ toHtml (" Keine Kommentare" :: String)
|
renderComments [] lang = H.li $ toHtml $ noComments lang
|
||||||
renderComments [] EN = H.li $ toHtml (" No comments yet" :: String)
|
|
||||||
renderComments comments lang = sequence_ $ map showComment comments
|
renderComments comments lang = sequence_ $ map showComment comments
|
||||||
where
|
where
|
||||||
showComment :: Comment -> Html
|
showComment :: Comment -> Html
|
||||||
|
@ -118,20 +106,10 @@ renderComments comments lang = sequence_ $ map showComment comments
|
||||||
H.p ! A.class_ "tt" $ toHtml (timeString $ cdate c)
|
H.p ! A.class_ "tt" $ toHtml (timeString $ cdate c)
|
||||||
getTime :: Integer -> Maybe UTCTime
|
getTime :: Integer -> Maybe UTCTime
|
||||||
getTime t = parseTime defaultTimeLocale "%s" (show t)
|
getTime t = parseTime defaultTimeLocale "%s" (show t)
|
||||||
showTime DE (Just t) = formatTime defaultTimeLocale "[Am %d.%m.%y um %H:%M Uhr]" t
|
showTime lang (Just t) = formatTime defaultTimeLocale (cTimeFormat lang) t
|
||||||
showTime EN (Just t) = formatTime defaultTimeLocale "[On %D at %H:%M]" t
|
|
||||||
showTime _ Nothing = "[???]" -- this can not happen??
|
showTime _ Nothing = "[???]" -- this can not happen??
|
||||||
timeString = (showTime lang) . getTime
|
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 :: BlogLang -> String -> Html
|
||||||
showFooter l v = H.div ! A.class_ "rightbox" ! A.style "text-align:right;" $ do
|
showFooter l v = H.div ! A.class_ "rightbox" ! A.style "text-align:right;" $ do
|
||||||
toHtml ("Proudly made with " :: String)
|
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
|
H.a ! A.href (toValue repoURL) $ toHtml $ ("Version " :: String) ++ v
|
||||||
preEscapedString " "
|
preEscapedString " "
|
||||||
H.a ! A.href "/notice" $ toHtml $ noticeText l
|
H.a ! A.href "/notice" $ toHtml $ noticeText l
|
||||||
where
|
|
||||||
noticeText :: BlogLang -> String
|
|
||||||
noticeText EN = "site notice"
|
|
||||||
noticeText DE = "Impressum"
|
|
||||||
|
|
||||||
|
|
||||||
-- Error pages
|
-- Error pages
|
||||||
showError :: BlogError -> Html
|
showError :: BlogError -> Html
|
||||||
|
|
57
src/Locales.hs
Normal file
57
src/Locales.hs
Normal file
|
@ -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"
|
|
@ -18,14 +18,11 @@ import qualified Text.Blaze.Html5.Attributes as A
|
||||||
import Text.JSON.Generic
|
import Text.JSON.Generic
|
||||||
|
|
||||||
import Blog
|
import Blog
|
||||||
|
import Locales
|
||||||
|
|
||||||
tmpPolicy :: BodyPolicy
|
tmpPolicy :: BodyPolicy
|
||||||
tmpPolicy = (defaultBodyPolicy "./tmp/" 0 1000 1000)
|
tmpPolicy = (defaultBodyPolicy "./tmp/" 0 1000 1000)
|
||||||
|
|
||||||
|
|
||||||
--TazBlog version
|
|
||||||
version = ("2.2b" :: String)
|
|
||||||
|
|
||||||
main :: IO()
|
main :: IO()
|
||||||
main = do
|
main = do
|
||||||
putStrLn ("TazBlog " ++ version ++ " in Haskell starting")
|
putStrLn ("TazBlog " ++ version ++ " in Haskell starting")
|
||||||
|
@ -33,8 +30,8 @@ main = do
|
||||||
|
|
||||||
tazBlog :: ServerPart Response
|
tazBlog :: ServerPart Response
|
||||||
tazBlog = do
|
tazBlog = do
|
||||||
msum [ dir "en" $ blogHandler EN
|
msum [ dir (show DE) $ blogHandler DE
|
||||||
, dir "de" $ blogHandler DE
|
, dir (show EN) $ blogHandler EN
|
||||||
, do nullDir
|
, do nullDir
|
||||||
showIndex DE
|
showIndex DE
|
||||||
, do dir " " $ nullDir
|
, do dir " " $ nullDir
|
||||||
|
@ -68,13 +65,9 @@ showIndex lang = do
|
||||||
entries <- getLatest lang []
|
entries <- getLatest lang []
|
||||||
ok $ toResponse $ renderBlog lang $ renderEntries entries 6 (topText lang)
|
ok $ toResponse $ renderBlog lang $ renderEntries entries 6 (topText lang)
|
||||||
where
|
where
|
||||||
topText EN = "Latest entries"
|
|
||||||
topText DE = "Aktuelle Einträge"
|
|
||||||
|
|
||||||
|
|
||||||
renderBlog :: BlogLang -> Html -> Html
|
renderBlog :: BlogLang -> Html -> Html
|
||||||
renderBlog DE body = blogTemplate "Tazjins Blog" "Wer mich kontaktieren will: " " oder " version DE body
|
renderBlog lang body = blogTemplate lang body
|
||||||
renderBlog EN body = blogTemplate "Tazjin's Blog" "Get in touch with me: " " or " version EN body
|
|
||||||
|
|
||||||
-- http://tazj.in/2012/02/10.155234
|
-- http://tazj.in/2012/02/10.155234
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue