From 2fa129e7e3107dee64d855df4260dbc9f2188a83 Mon Sep 17 00:00:00 2001 From: "\"Vincent Ambo ext:(%22)" Date: Thu, 23 Feb 2012 03:30:14 +0100 Subject: [PATCH] * blog footer, language handling, emptyTest --- res/.DS_Store | Bin 6148 -> 6148 bytes res/blogstyle.css | 4 +++ src/.DS_Store | Bin 6148 -> 6148 bytes src/Blog.hs | 76 +++++++++++++++++++++++++++++++++------ src/Server.hs | 89 ++++++++++++++++++++++++---------------------- 5 files changed, 116 insertions(+), 53 deletions(-) diff --git a/res/.DS_Store b/res/.DS_Store index 5008ddfcf53c02e82d7eee2e57c38e5672ef89f6..6bbb484b850da3484c984a10b23ce00417a02e87 100644 GIT binary patch literal 6148 zcmeHK%}&BV5dIc9fW*kbgU24dNa7nb1WmZA51@b`NuflFKes-H59I^+Hu%l#hHOC+ zPsW&;X6D=O&dlz7ZMt0muDcpt0Brybs$i{2^Nq;3=#JDvj|@7^F-HeOEV1loJKomu z7a5Re*Tg+Wm|=?O`Q^hwmJc{8uf`SiY^}l;aKeZMuM7`3M}ZtGKKDnqr^HY6ma0&(*oyC%xh|w=fp3 zXob4gYLr&`9#wiA)+gL_xzbnM(k?jXzWU8a)CK>+DuxTYeZN zCJC4ZEIo3B;(RF4hq`dYa6X*VisYkQMfH6>I z;K1LuW&gk2fBvrq*_|<94E!qwT)lVG>$0S9!ql$=M>2VXnhHl05m96-c as>1$68pJeU>5)AY`w>tY%oqc|%D@+%^MH^5 delta 70 zcmZoMXfc=|#>AjHu~2NHo+1YW5HK<@2yDK{Y{s(r0dp1eW_AvK4xj>{$am(+{342+ UKzW7)kiy9(Jj$D6L{=~Z06bFCpNHeX6N|J4*+~V35Wmy delta 25 dcmZoMXfc@ZgzY~VZ2Tz3KCyv)Gdss$egM7R4T1mw diff --git a/src/Blog.hs b/src/Blog.hs index 2a62bb768..983bae236 100644 --- a/src/Blog.hs +++ b/src/Blog.hs @@ -1,33 +1,89 @@ {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} + module Blog where +import Data.Monoid (mempty) import Text.Blaze (toValue, preEscapedString) import Text.Blaze.Html5 (Html, (!), a, form, input, p, toHtml, label) import Text.Blaze.Html5.Attributes (action, enctype, href, name, size, type_, value) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A -blogTemplate :: String -> String -> String -> Html -blogTemplate t h o = H.docTypeHtml $ do + + + +repoURL = ("" :: String) + +{- + +
+Proudly made with +Google Go and without PHP, Java, Perl, MySQL and Python. +
Idee zum simplen Blog von +Fefe +
Version 2.1.3  +Impressum +
+ + +
\"\"
+ +" + +-} + +blogTemplate :: String -> String -> String -> String -> String -> Html -- -> Html +blogTemplate title ctext1 ortext lang version = H.docTypeHtml $ do --add body H.head $ do - H.title $ (toHtml t) + H.title $ (toHtml title) 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" -{- H.style ! A.type_ "text/css" ! A.title "iOS iMessage" ! A.media "screen and (max-device-width: 1024px)" $ "#cosx{display:none;} #cios{display:block;}" -} + --H.style ! A.type_ "text/css" ! A.title "iOS iMessage" ! A.media "screen and (max-device-width: 1024px)" $ "#cosx{display:none;}" H.body $ do - H.div ! A.class_ "mainshell" $ H.div ! A.class_ "gradBox" $ H.div ! A.class_ "header" $ do + 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 t) + (toHtml title) H.br H.span ! A.id "cosx" ! A.style "display:block;" $ H.b $ contactInfo "imessage:tazjin@me.com" - 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 + emptyTest lang + showFooter lang version + H.div ! A.class_ "centerbox" $ + H.img ! A.src "http://getpunchd.com/img/june/idiots.png" ! A.alt "" where contactInfo (imu :: String) = do - toHtml h + toHtml ctext1 H.a ! A.href "mailto:hej@tazj.in" $ "Mail" ", " H.a ! A.href "http://twitter.com/#!/tazjin" ! A.target "_blank" $ "Twitter" - toHtml o + toHtml ortext H.a ! A.href (toValue imu) ! A.target "_blank" $ "iMessage" - "." \ No newline at end of file + "." + +emptyTest :: String -> 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 :: String -> String -> Html +showFooter l v = H.div ! A.class_ "rightbox" ! A.style "text-align:right;" $ do + toHtml ("Proudly made with " :: String) + H.a ! A.href "http://haskell.org" $ "Haskell" + toHtml (", " :: String) + H.a ! A.href "http://couchdb.apache.org/" $ "CouchDB" + toHtml (" and without PHP, Java, Perl, MySQL and Python." :: String) + H.br + H.a ! A.href (toValue repoURL) $ toHtml $ ("Version " :: String) ++ v + preEscapedString " " + H.a ! A.href "/notice" $ toHtml $ noticeText l + where + noticeText :: String -> String + noticeText "en" = "site notice" + noticeText "de" = "Impressum" diff --git a/src/Server.hs b/src/Server.hs index aa41a2173..eefc9b1e7 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -2,76 +2,79 @@ module Main where -import Control.Monad (msum, mzero) -import Data.Data (Data, Typeable) -import Data.Monoid (mempty) -import Data.ByteString.Char8 (ByteString) -import Data.Text hiding (map, length, zip, head) -import Data.Time -import Database.CouchDB -import Happstack.Server +import Control.Monad (msum, mzero) +import Data.Data (Data, Typeable) +import Data.Monoid (mempty) +import Data.ByteString.Char8 (ByteString) +import Data.Text hiding (map, length, zip, head) +import Data.Time +import Database.CouchDB +import Happstack.Server import Text.Blaze (toValue, preEscapedString) import Text.Blaze.Html5 (Html, (!), a, form, input, p, toHtml, label) import Text.Blaze.Html5.Attributes (action, enctype, href, name, size, type_, value) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A -import Text.JSON.Generic +import Text.JSON.Generic -import Blog +import Blog tmpPolicy :: BodyPolicy tmpPolicy = (defaultBodyPolicy "./tmp/" 0 1000 1000) -data BlogLang = EN | DE data Comment = Comment{ - cauthor :: String, - ctext :: String, - cdate :: Integer + cauthor :: String, + ctext :: String, + cdate :: Integer } deriving (Show, Data, Typeable) data Entry = Entry{ - _id :: String, - year :: Int, - month :: Int, - day :: Int, - lang :: String, - title :: String, - author :: String, - text :: String, - mtext :: String, - comments :: [Comment] + _id :: String, + year :: Int, + month :: Int, + day :: Int, + lang :: BlogLang, + title :: String, + author :: String, + text :: String, + mtext :: String, + comments :: [Comment] } deriving (Show, Data, Typeable) +data BlogLang = EN | DE deriving (Data, Typeable) + instance Show BlogLang where - show EN = "en" - show DE = "de" + show EN = "en" + show DE = "de" --TazBlog version version = ("2.2b" :: String) main :: IO() main = do - putStrLn ("TazBlog " ++ version ++ " in Haskell starting") - simpleHTTP nullConf tazBlog + putStrLn ("TazBlog " ++ version ++ " in Haskell starting") + simpleHTTP nullConf tazBlog tazBlog :: ServerPart Response tazBlog = do - msum [ dir "en" $ blogHandler EN - , dir "de" $ blogHandler DE - , do nullDir; - ok $ showIndex DE - , do dir " " $ nullDir; - seeOther ("https://plus.google.com/115916629925754851590" :: String) (toResponse ()) - , dir "res" $ serveDirectory DisableBrowsing [] "../res" - , serveDirectory DisableBrowsing [] "../res" - ] + msum [ dir "en" $ blogHandler EN + , dir "de" $ blogHandler DE + , do nullDir + ok $ showIndex DE + , do dir " " $ nullDir + seeOther ("https://plus.google.com/115916629925754851590" :: String) (toResponse ()) + , dir "res" $ serveDirectory DisableBrowsing [] "../res" + , serveDirectory DisableBrowsing [] "../res" + ] blogHandler :: BlogLang -> ServerPart Response blogHandler lang = - msum [ path $ \(year :: Int) -> path $ \(month :: Int) -> path $ - \(day :: Int) -> path $ \(id_ :: String) -> showEntry lang year month day id_ - ] + msum [ path $ \(year :: Int) -> path $ \(month :: Int) -> path $ --single entry + \(day :: Int) -> path $ \(id_ :: String) -> showEntry lang year month day id_ + , do nullDir + ok $ showIndex lang + ] showEntry :: BlogLang -> Int -> Int -> Int -> String -> ServerPart Response showEntry EN y m d i = undefined @@ -81,8 +84,8 @@ showIndex :: BlogLang -> Response showIndex lang = toResponse $ renderBlogHeader lang renderBlogHeader :: BlogLang -> Html -renderBlogHeader DE = blogTemplate "Tazjins Blog" "Wer mich kontaktieren will: " " oder " -renderBlogHeader EN = blogTemplate "Tazjin's Blog" "Get in touch with me: " " or " +renderBlogHeader DE = blogTemplate "Tazjins Blog" "Wer mich kontaktieren will: " " oder " "de" version +renderBlogHeader EN = blogTemplate "Tazjin's Blog" "Get in touch with me: " " or " "en" version -- http://tazj.in/2012/02/10.155234 @@ -93,6 +96,6 @@ latestENView = "function(doc){ if(doc.lang == \"en\"){ emit([doc.year, doc.month latestDE = ViewMap "latestDE" latestDEView latestEN = ViewMap "latestEN" latestENView -setupBlogViews :: IO () -- taking *reservations* DB name as parameter because we'll have multiple stores +setupBlogViews :: IO () setupBlogViews = runCouchDB' $ newView "tazblog" "entries" [latestDE, latestEN]