diff options
Diffstat (limited to 'src/Blog.hs')
| -rw-r--r-- | src/Blog.hs | 86 |
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 -<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 " " 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 |