* displaying blog entries

* changed convertDB for BlogLang JSON representation
This commit is contained in:
"Vincent Ambo ext:(%22) 2012-02-23 13:20:29 +01:00
parent 47dbfe900e
commit a4119e1cfd
3 changed files with 91 additions and 71 deletions

View file

@ -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