* 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

View file

@ -1,15 +1,15 @@
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
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 Network.CGI (liftIO)
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)
@ -23,31 +23,6 @@ tmpPolicy :: BodyPolicy
tmpPolicy = (defaultBodyPolicy "./tmp/" 0 1000 1000)
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)
data BlogLang = EN | DE deriving (Data, Typeable)
instance Show BlogLang where
show EN = "en"
show DE = "de"
--TazBlog version
version = ("2.2b" :: String)
@ -71,24 +46,44 @@ tazBlog = do
blogHandler :: BlogLang -> ServerPart Response
blogHandler lang =
msum [ path $ \(year :: Int) -> path $ \(month :: Int) -> path $ --single entry
\(day :: Int) -> path $ \(id_ :: String) -> showEntry lang year month day id_
\(day :: Int) -> path $ \(id_ :: String) -> showEntry year month day id_
, do nullDir
ok $ showIndex lang
]
showEntry :: BlogLang -> Int -> Int -> Int -> String -> ServerPart Response
showEntry EN y m d i = undefined
showEntry DE y m d i = undefined
showEntry :: Int -> Int -> Int -> String -> ServerPart Response
showEntry y m d i = do
entryJS <- liftIO $ runCouchDB' $ getDoc (db "tazblog") (doc i)
let entry = maybeDoc entryJS
ok $ tryEntry entry
tryEntry :: Maybe Entry -> Response
tryEntry Nothing = toResponse $ showError NotFound
tryEntry (Just entry) = toResponse $ renderBlog eLang $ renderEntry entry
where
eLang = lang entry
showIndex :: BlogLang -> Response
showIndex lang = toResponse $ renderBlogHeader lang
renderBlog :: BlogLang -> Html -> Html
renderBlog DE body = blogTemplate "Tazjins Blog" "Wer mich kontaktieren will: " " oder " version DE body
renderBlog EN body = blogTemplate "Tazjin's Blog" "Get in touch with me: " " or " version EN body
renderBlogHeader :: BlogLang -> Html
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
renderBlogHeader DE = blogTemplate "Tazjins Blog" "Wer mich kontaktieren will: " " oder " version DE (emptyTest DE)
renderBlogHeader EN = blogTemplate "Tazjin's Blog" "Get in touch with me: " " or " version EN (emptyTest EN)
-- http://tazj.in/2012/02/10.155234
-- CouchDB functions
maybeDoc :: Data a => Maybe (Doc, Rev, JSValue) -> Maybe a
maybeDoc (Just(_,_,v)) = Just( stripResult $ fromJSON v)
maybeDoc Nothing = Nothing
stripResult :: Result a -> a
stripResult (Ok z) = z
stripResult (Error s) = error $ "JSON error: " ++ s
-- CouchDB View Setup
latestDEView = "function(doc){ if(doc.lang == \"de\"){ emit([doc.year, doc.month, doc.day, doc.id_], doc); } }"
latestENView = "function(doc){ if(doc.lang == \"en\"){ emit([doc.year, doc.month, doc.day, doc.id_]], doc); } }"

View file

@ -26,7 +26,7 @@ type OldEntry struct {
Comments []OldComment
}
//new
//old
type Comment struct {
Author string `json:"cauthor"`
Text string `json:"ctext"`
@ -37,7 +37,7 @@ type Entry struct {
Id string `json:"_id"`
Year int `json:"year"`
Month int `json:"month"`
Day int
Day int `json:"day"`
Lang string `json:"lang"`
Title string `json:"title"`
Author string `json:"author"`
@ -100,17 +100,12 @@ func convertEntry(oEntry OldEntry, p string) Entry{
nEntry.Mtext = oEntry.Mtext
nEntry.Text = oEntry.Text
nEntry.Comments = nComments
nEntry.Lang = "de"
nEntry.Lang = "DE"
return nEntry
}
//http://tazj.in/2012/02/10.155234
func parseEntryTime(year, month, day int, ids string) string {
x := fmt.Sprintf()
}
func parseDumbTime(Year, Month, Day int, ) int64 {
func parseDumbTime(ct string) int64 {
x, err := time.Parse("[Am 02.01.2006 um 15:04 Uhr]", ct)
if err != nil {
fmt.Println(err.String())
@ -118,4 +113,4 @@ func parseDumbTime(Year, Month, Day int, ) int64 {
}
return x.Seconds()
}
}