* TEXT EVERYWHERE, WHERE MY STRINGS AT?

This commit is contained in:
"Vincent Ambo ext:(%22) 2012-03-06 19:39:54 +01:00
parent d4fa02deed
commit 8c90ebdb49
3 changed files with 43 additions and 29 deletions

View file

@ -44,7 +44,7 @@ blogText f = T.pack . f
intersperse' :: a -> [a] -> [a] intersperse' :: a -> [a] -> [a]
intersperse' sep l = sep : intersperse sep l intersperse' sep l = sep : intersperse sep l
blogTemplate :: BlogLang -> String -> Html -> Html blogTemplate :: BlogLang -> Text -> Html -> Html
blogTemplate lang t_append body = H.docTypeHtml $ do --add body blogTemplate lang t_append body = H.docTypeHtml $ do --add body
H.head $ do H.head $ do
H.title $ (toHtml $ blogTitle lang t_append) H.title $ (toHtml $ blogTitle lang t_append)
@ -63,20 +63,20 @@ blogTemplate lang t_append body = H.docTypeHtml $ do --add body
H.div ! A.class_ "myclear" $ mempty H.div ! A.class_ "myclear" $ mempty
body body
H.div ! A.class_ "myclear" $ mempty H.div ! A.class_ "myclear" $ mempty
showFooter lang version showFooter lang $ T.pack version
H.div ! A.class_ "centerbox" $ H.div ! A.class_ "centerbox" $
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 :: Text) = do
toHtml $ contactText lang toHtml $ contactText lang
H.a ! A.href (toValue mailTo) $ "Mail" H.a ! A.href (toValue mailTo) $ "Mail"
", " ", "
H.a ! A.href (toValue twitter) ! A.target "_blank" $ "Twitter" H.a ! A.href (toValue twitter) ! A.target "_blank" $ "Twitter"
toHtml $ orString lang toHtml $ orText lang
H.a ! A.href (toValue imu) ! A.target "_blank" $ "iMessage" H.a ! A.href (toValue imu) ! A.target "_blank" $ "iMessage"
"." "."
renderEntries :: Bool -> [Entry] -> String -> Maybe Html -> Html renderEntries :: Bool -> [Entry] -> Text -> Maybe Html -> Html
renderEntries showAll entries topText footerLinks = renderEntries showAll entries topText footerLinks =
H.div ! A.class_ "innerBox" $ do H.div ! A.class_ "innerBox" $ do
H.div ! A.class_ "innerBoxTop" $ toHtml topText H.div ! A.class_ "innerBoxTop" $ toHtml topText
@ -113,7 +113,7 @@ renderCommentBox lang = do
H.div ! A.name "cHead" $ toHtml $ cwHead lang H.div ! A.name "cHead" $ toHtml $ cwHead lang
H.form $ do H.form $ do
H.p $ H.label $ do H.p $ H.label $ do
toHtml ("Name:" :: String) toHtml ("Name:" :: Text)
H.input H.input
{- {-
<form> <form>
@ -140,20 +140,20 @@ renderComments comments lang = sequence_ $ map showComment comments
showLinks :: Maybe Int -> BlogLang -> Html showLinks :: Maybe Int -> BlogLang -> Html
showLinks (Just i) lang = H.div ! A.class_ "centerbox" $ do showLinks (Just i) lang = H.div ! A.class_ "centerbox" $ do
H.a ! A.href (toValue $ "/?page=" ++ show (i+1)) $ toHtml $ backText lang H.a ! A.href (toValue $ "/?page=" ++ show (i+1)) $ toHtml $ backText lang
toHtml (" -- " :: String) toHtml (" -- " :: Text)
H.a ! A.href (toValue $ "/?page=" ++ show (i-1)) $ toHtml $ nextText lang H.a ! A.href (toValue $ "/?page=" ++ show (i-1)) $ toHtml $ nextText lang
showLinks Nothing lang = H.div ! A.class_ "centerbox" $ showLinks Nothing lang = H.div ! A.class_ "centerbox" $
H.a ! A.href "/?page=2" $ toHtml $ backText lang H.a ! A.href "/?page=2" $ toHtml $ backText lang
showFooter :: BlogLang -> String -> Html showFooter :: BlogLang -> Text -> 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 " :: Text)
H.a ! A.href "http://haskell.org" $ "Haskell" H.a ! A.href "http://haskell.org" $ "Haskell"
toHtml (", " :: String) toHtml (", " :: Text)
H.a ! A.href "http://couchdb.apache.org/" $ "CouchDB" H.a ! A.href "http://couchdb.apache.org/" $ "CouchDB"
toHtml (" and without PHP, Java, Perl, MySQL and Python." :: String) toHtml (" and without PHP, Java, Perl, MySQL and Python." :: Text)
H.br H.br
H.a ! A.href (toValue repoURL) $ toHtml $ ("Version " :: String) ++ v H.a ! A.href (toValue repoURL) $ toHtml $ T.concat ["Version ", v]
preEscapedText "&nbsp;" preEscapedText "&nbsp;"
H.a ! A.href "/notice" $ toHtml $ noticeText l H.a ! A.href "/notice" $ toHtml $ noticeText l

View file

@ -1,8 +1,10 @@
{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings #-}
module Locales where module Locales where
import Data.Data (Data, Typeable) import Data.Data (Data, Typeable)
import Data.Text (Text)
import qualified Data.Text as T
{- to add a language simply define its 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 -} - translate the appropriate strings and add CouchDB views in Server.hs -}
@ -13,7 +15,7 @@ instance Show BlogLang where
show EN = "en" show EN = "en"
show DE = "de" show DE = "de"
version = ("2.2b" :: String) version = "2.2b"
allLang = [EN, DE] allLang = [EN, DE]
@ -21,18 +23,18 @@ if' :: Bool -> a -> a -> a
if' True x _ = x if' True x _ = x
if' False _ y = y if' False _ y = y
blogTitle :: BlogLang -> String -> String blogTitle :: BlogLang -> Text -> Text
blogTitle DE s = "Tazjins Blog" ++ s blogTitle DE s = T.concat ["Tazjins Blog", s]
blogTitle EN s = "Tazjin's Blog" ++ s blogTitle EN s = T.concat ["Tazjin's Blog", s]
-- index site headline -- index site headline
topText DE = "Aktuelle Einträge" topText DE = "Aktuelle Einträge"
topText EN = "Latest entries" topText EN = "Latest entries"
getMonth :: BlogLang -> Int -> Int -> String getMonth :: BlogLang -> Int -> Int -> Text
getMonth l y m = monthName l m ++ show y getMonth l y m = T.append (monthName l m) $ T.pack $ show y
where where
monthName :: BlogLang -> Int -> String monthName :: BlogLang -> Int -> Text
monthName DE m = case m of monthName DE m = case m of
1 -> "Januar " 1 -> "Januar "
2 -> "Februar " 2 -> "Februar "
@ -60,46 +62,57 @@ getMonth l y m = monthName l m ++ show y
11 -> "November " 11 -> "November "
12 -> "December " 12 -> "December "
entireMonth :: BlogLang -> Text
entireMonth DE = "Ganzer Monat" entireMonth DE = "Ganzer Monat"
entireMonth EN = "Entire month" entireMonth EN = "Entire month"
backText :: BlogLang -> Text
backText DE = "Früher" backText DE = "Früher"
backText EN = "Earlier" backText EN = "Earlier"
nextText :: BlogLang -> Text
nextText DE = "Später" nextText DE = "Später"
nextText EN = "Later" nextText EN = "Later"
-- contact information -- contact information
contactText :: BlogLang -> Text
contactText DE = "Wer mich kontaktieren will: " contactText DE = "Wer mich kontaktieren will: "
contactText EN = "Get in touch with me: " contactText EN = "Get in touch with me: "
orString DE = " oder " orText :: BlogLang -> Text
orString EN = " or " orText DE = " oder "
orText EN = " or "
-- footer -- footer
noticeText :: BlogLang -> Text
noticeText EN = "site notice" noticeText EN = "site notice"
noticeText DE = "Impressum" noticeText DE = "Impressum"
-- comments -- comments
noComments :: BlogLang -> Text
noComments DE = " Keine Kommentare" noComments DE = " Keine Kommentare"
noComments EN = " No comments yet" noComments EN = " No comments yet"
cHead :: BlogLang -> Text
cHead DE = "Kommentare:" cHead DE = "Kommentare:"
cHead EN = "Comments:" cHead EN = "Comments:"
cwHead :: BlogLang -> Text
cwHead DE = "Kommentieren:" cwHead DE = "Kommentieren:"
cwHead EN = "Comment:" cwHead EN = "Comment:"
cTimeFormat :: BlogLang -> String --formatTime expects a String
cTimeFormat DE = "[Am %d.%m.%y um %H:%M Uhr]" cTimeFormat DE = "[Am %d.%m.%y um %H:%M Uhr]"
cTimeFormat EN = "[On %D at %H:%M]" cTimeFormat EN = "[On %D at %H:%M]"
-- right side text (this is inserted AS IS. Escape HTML!) -- right side text (this is inserted AS IS. Escape HTML!)
rightText :: BlogLang -> Text
rightText DE = "English version <a href=\"en\">available here</a>" rightText DE = "English version <a href=\"en\">available here</a>"
rightText EN = "Deutsche Version <a href=\"de\">hier verf&uuml;gbar</a>" rightText EN = "Deutsche Version <a href=\"de\">hier verf&uuml;gbar</a>"
-- static information -- static information
repoURL = "https://bitbucket.org/tazjin/tazblog-haskell" repoURL :: Text = "https://bitbucket.org/tazjin/tazblog-haskell"
mailTo = "mailto:hej@tazj.in" mailTo :: Text = "mailto:hej@tazj.in"
twitter = "http://twitter.com/#!/tazjin" twitter :: Text = "http://twitter.com/#!/tazjin"
iMessage = "imessage:tazjin@me.com" iMessage :: Text = "imessage:tazjin@me.com"
iMessage' = "sms:tazjin@me.com" iMessage' :: Text = "sms:tazjin@me.com"

View file

@ -6,7 +6,8 @@ import Control.Applicative (optional)
import Control.Monad (msum) import Control.Monad (msum)
import Data.Monoid (mempty) import Data.Monoid (mempty)
import Data.ByteString.Char8 (ByteString) import Data.ByteString.Char8 (ByteString)
import Data.Text hiding (map, length, zip, head, drop) import Data.Text (Text)
import qualified Data.Text as T
import Data.Time import Data.Time
import Database.CouchDB import Database.CouchDB
import Happstack.Server import Happstack.Server
@ -60,7 +61,7 @@ tryEntry :: Maybe Entry -> Response
tryEntry Nothing = toResponse $ showError NotFound tryEntry Nothing = toResponse $ showError NotFound
tryEntry (Just entry) = toResponse $ blogTemplate eLang eTitle $ renderEntry entry tryEntry (Just entry) = toResponse $ blogTemplate eLang eTitle $ renderEntry entry
where where
eTitle = ": " ++ title entry eTitle = T.pack $ ": " ++ title entry
eLang = lang entry eLang = lang entry
showIndex :: BlogLang -> ServerPart Response showIndex :: BlogLang -> ServerPart Response