* blog footer, language handling, emptyTest

res/blogstyle.css

@@ -43,6 +43,10 @@ body {
 	text-align:center;
 }
 
+.rightbox {
+	text-align:right;
+}
+
 .innerBox {
 	width: 100%;
 	margin-top: 20px;

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)
+
+{-
+</div>
+<div style=\"text-align:right;\">
+Proudly made with 
+<a href=\"http://golang.org\">Google Go</a> and without PHP, Java, Perl, MySQL and Python.
+<br>Idee zum simplen Blog von 
+<a href=\"http://blog.fefe.de\" target=\"_blank\">Fefe</a>
+<br>Version 2.1.3&nbsp;
+<a href=\"/impressum\">Impressum</a>
+</div>
+</div>
+</div>
+<div class=\"centerbox\"><img src=\"http://getpunchd.com/img/june/idiots.png\" alt=\"\"></div>
+</body>
+</html>"
+
+-}
+
+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"
-            "."
+            "."
+
+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 "&nbsp;"
+    H.a ! A.href "/notice" $ toHtml $ noticeText l
+  where
+    noticeText :: String -> String
+    noticeText "en" = "site notice"
+    noticeText "de" = "Impressum"

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]