diff options
| -rw-r--r-- | src/Blog.hs | 24 | ||||
| -rw-r--r-- | src/Locales.hs | 43 | ||||
| -rw-r--r-- | src/Main.hs | 5 |
3 files changed, 43 insertions, 29 deletions
diff --git a/src/Blog.hs b/src/Blog.hs index 263060c2cb28..649329cfb3f8 100644 --- a/src/Blog.hs +++ b/src/Blog.hs @@ -44,7 +44,7 @@ blogText f = T.pack . f intersperse' :: a -> [a] -> [a] 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 H.head $ do 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 body H.div ! A.class_ "myclear" $ mempty - showFooter lang version + showFooter lang $ T.pack version H.div ! A.class_ "centerbox" $ H.img ! A.src "http://getpunchd.com/img/june/idiots.png" ! A.alt "" where - contactInfo (imu :: String) = do + contactInfo (imu :: Text) = do toHtml $ contactText lang H.a ! A.href (toValue mailTo) $ "Mail" ", " 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" "." -renderEntries :: Bool -> [Entry] -> String -> Maybe Html -> Html +renderEntries :: Bool -> [Entry] -> Text -> Maybe Html -> Html renderEntries showAll entries topText footerLinks = H.div ! A.class_ "innerBox" $ do H.div ! A.class_ "innerBoxTop" $ toHtml topText @@ -113,7 +113,7 @@ renderCommentBox lang = do H.div ! A.name "cHead" $ toHtml $ cwHead lang H.form $ do H.p $ H.label $ do - toHtml ("Name:" :: String) + toHtml ("Name:" :: Text) H.input {- <form> @@ -140,20 +140,20 @@ renderComments comments lang = sequence_ $ map showComment comments showLinks :: Maybe Int -> BlogLang -> Html showLinks (Just i) lang = H.div ! A.class_ "centerbox" $ do 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 showLinks Nothing lang = H.div ! A.class_ "centerbox" $ 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 - toHtml ("Proudly made with " :: String) + toHtml ("Proudly made with " :: Text) H.a ! A.href "http://haskell.org" $ "Haskell" - toHtml (", " :: String) + toHtml (", " :: Text) 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.a ! A.href (toValue repoURL) $ toHtml $ ("Version " :: String) ++ v + H.a ! A.href (toValue repoURL) $ toHtml $ T.concat ["Version ", v] preEscapedText " " H.a ! A.href "/notice" $ toHtml $ noticeText l diff --git a/src/Locales.hs b/src/Locales.hs index 01852cbdb0a9..f629dbe6f347 100644 --- a/src/Locales.hs +++ b/src/Locales.hs @@ -1,8 +1,10 @@ -{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} +{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings #-} module Locales where 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 - translate the appropriate strings and add CouchDB views in Server.hs -} @@ -13,7 +15,7 @@ instance Show BlogLang where show EN = "en" show DE = "de" -version = ("2.2b" :: String) +version = "2.2b" allLang = [EN, DE] @@ -21,18 +23,18 @@ if' :: Bool -> a -> a -> a if' True x _ = x if' False _ y = y -blogTitle :: BlogLang -> String -> String -blogTitle DE s = "Tazjins Blog" ++ s -blogTitle EN s = "Tazjin's Blog" ++ s +blogTitle :: BlogLang -> Text -> Text +blogTitle DE s = T.concat ["Tazjins Blog", s] +blogTitle EN s = T.concat ["Tazjin's Blog", s] -- index site headline topText DE = "Aktuelle Einträge" topText EN = "Latest entries" -getMonth :: BlogLang -> Int -> Int -> String -getMonth l y m = monthName l m ++ show y +getMonth :: BlogLang -> Int -> Int -> Text +getMonth l y m = T.append (monthName l m) $ T.pack $ show y where - monthName :: BlogLang -> Int -> String + monthName :: BlogLang -> Int -> Text monthName DE m = case m of 1 -> "Januar " 2 -> "Februar " @@ -60,46 +62,57 @@ getMonth l y m = monthName l m ++ show y 11 -> "November " 12 -> "December " +entireMonth :: BlogLang -> Text entireMonth DE = "Ganzer Monat" entireMonth EN = "Entire month" +backText :: BlogLang -> Text backText DE = "Früher" backText EN = "Earlier" +nextText :: BlogLang -> Text nextText DE = "Später" nextText EN = "Later" -- contact information +contactText :: BlogLang -> Text contactText DE = "Wer mich kontaktieren will: " contactText EN = "Get in touch with me: " -orString DE = " oder " -orString EN = " or " +orText :: BlogLang -> Text +orText DE = " oder " +orText EN = " or " -- footer +noticeText :: BlogLang -> Text noticeText EN = "site notice" noticeText DE = "Impressum" -- comments +noComments :: BlogLang -> Text noComments DE = " Keine Kommentare" noComments EN = " No comments yet" +cHead :: BlogLang -> Text cHead DE = "Kommentare:" cHead EN = "Comments:" +cwHead :: BlogLang -> Text cwHead DE = "Kommentieren:" cwHead EN = "Comment:" +cTimeFormat :: BlogLang -> String --formatTime expects a String 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 :: BlogLang -> Text 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" +repoURL :: Text = "https://bitbucket.org/tazjin/tazblog-haskell" +mailTo :: Text = "mailto:hej@tazj.in" +twitter :: Text = "http://twitter.com/#!/tazjin" +iMessage :: Text = "imessage:tazjin@me.com" +iMessage' :: Text = "sms:tazjin@me.com" diff --git a/src/Main.hs b/src/Main.hs index 89f6179237f5..c851d9a05203 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -6,7 +6,8 @@ import Control.Applicative (optional) import Control.Monad (msum) import Data.Monoid (mempty) 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 Database.CouchDB import Happstack.Server @@ -60,7 +61,7 @@ tryEntry :: Maybe Entry -> Response tryEntry Nothing = toResponse $ showError NotFound tryEntry (Just entry) = toResponse $ blogTemplate eLang eTitle $ renderEntry entry where - eTitle = ": " ++ title entry + eTitle = T.pack $ ": " ++ title entry eLang = lang entry showIndex :: BlogLang -> ServerPart Response |