* displaying blog entries

* changed convertDB for BlogLang JSON representation

1 files changed, 58 insertions, 28 deletions

diff --git a/src/Blog.hs b/src/Blog.hs
index 983bae2366bb..bb74cbb16bef 100644
--- a/src/Blog.hs
+++ b/src/Blog.hs
@@ -1,7 +1,9 @@
-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, DeriveDataTypeable #-}
 
 module Blog where
 
+--import           Control.Monad(when)
+import           Data.Data (Data, Typeable)
 import           Data.Monoid (mempty)
 import           Text.Blaze (toValue, preEscapedString)
 import           Text.Blaze.Html5 (Html, (!), a, form, input, p, toHtml, label)
@@ -10,30 +12,37 @@ import qualified Text.Blaze.Html5 as H
 import qualified Text.Blaze.Html5.Attributes as A
 
 
+data Comment = Comment{
+    cauthor :: String,
+    ctext   :: String,
+    cdate   :: Integer
+} deriving (Show, Data, Typeable)
 
+data Entry = Entry{
+    _id      :: String,
+    year     :: Int,
+    month    :: Int,
+    day      :: Int,
+    lang     :: BlogLang,
+    title    :: String,
+    author   :: String,
+    text     :: String,
+    mtext    :: String,
+    comments :: [Comment]
+} deriving (Show, Data, Typeable)
 
-repoURL = ("" :: String)
+data BlogError = NoEntries | NotFound | DBError
 
-{-
-</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>"
+data BlogLang = EN | DE deriving (Data, Typeable)
 
--}
+instance Show BlogLang where
+    show EN = "en"
+    show DE = "de"
 
-blogTemplate :: String -> String -> String -> String -> String -> Html -- -> Html
-blogTemplate title ctext1 ortext lang version = H.docTypeHtml $ do --add body
+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.title $ (toHtml title)
         H.link ! A.rel "alternate" ! A.type_ "application/rss+xml" ! A.title "RSS-Feed" ! A.href "/rss"
@@ -49,7 +58,7 @@ blogTemplate title ctext1 ortext lang version = H.docTypeHtml $ do --add body
                 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.div ! A.class_ "myclear" $ mempty
-            emptyTest lang
+            body
             showFooter lang version
         H.div ! A.class_ "centerbox" $
             H.img ! A.src "http://getpunchd.com/img/june/idiots.png" ! A.alt ""
@@ -63,16 +72,32 @@ blogTemplate title ctext1 ortext lang version = H.docTypeHtml $ do --add body
             H.a ! A.href (toValue imu) ! A.target "_blank" $ "iMessage"
             "."
 
-emptyTest :: String -> Html
+renderEntry :: Entry -> Html
+renderEntry entry = H.div ! A.class_ "innerBox" $ do
+    H.div ! A.class_ "innerBoxTop" $ toHtml $ title entry
+    H.div ! A.class_ "innerBoxMiddle" $ do
+        H.article $ H.ul $ H.li $ do
+            preEscapedString $ text entry
+            preEscapedString $ mtext entry
+        H.div ! A.class_ "innerBoxComments" $ do
+            H.div ! A.name "cHead" ! A.style "font-size:large;font-weight:bold;" $ toHtml cHead
+            H.ul $ H.li $ toHtml noC
+    where
+        getTexts :: BlogLang -> (String, String)
+        getTexts EN = ("Comments:", " No comments yet")
+        getTexts DE = ("Kommentare:", " Keine Kommentare")
+        (cHead,noC) = getTexts (lang entry)
+
+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)
+    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 :: BlogLang -> 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"
@@ -84,6 +109,11 @@ showFooter l v = H.div ! A.class_ "rightbox" ! A.style "text-align:right;" $ do
     preEscapedString "&nbsp;"
     H.a ! A.href "/notice" $ toHtml $ noticeText l
   where
-    noticeText :: String -> String
-    noticeText "en" = "site notice"
-    noticeText "de" = "Impressum"
+    noticeText :: BlogLang -> String
+    noticeText EN = "site notice"
+    noticeText DE = "Impressum"
+
+
+-- Error pages
+showError :: BlogError -> Html
+showError _ = undefined