* displaying blog entries
* changed convertDB for BlogLang JSON representation
This commit is contained in:
parent
47dbfe900e
commit
a4119e1cfd
3 changed files with 91 additions and 71 deletions
86
src/Blog.hs
86
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
|
||||
|
|
|
@ -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); } }"
|
||||
|
|
|
@ -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()
|
||||
}
|
||||
}
|
Loading…
Reference in a new issue