1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, DeriveDataTypeable #-}
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 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)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Text.JSON.Generic
import Blog
tmpPolicy :: BodyPolicy
tmpPolicy = (defaultBodyPolicy "./tmp/" 0 1000 1000)
data BlogLang = EN | DE
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 :: String,
title :: String,
author :: String,
text :: String,
mtext :: String,
comments :: [Comment]
} deriving (Show, Data, Typeable)
instance Show BlogLang where
show EN = "en"
show DE = "de"
--TazBlog version
version = ("2.2b" :: String)
main :: IO()
main = do
putStrLn ("TazBlog " ++ version ++ " in Haskell starting")
simpleHTTP nullConf tazBlog
tazBlog :: ServerPart Response
tazBlog = do
msum [ dir "en" $ blogHandler EN
, dir "de" $ blogHandler DE
, do nullDir;
ok $ showIndex DE
, do dir " " $ nullDir;
seeOther ("https://plus.google.com/115916629925754851590" :: String) (toResponse ())
, dir "res" $ serveDirectory DisableBrowsing [] "../res"
, serveDirectory DisableBrowsing [] "../res"
]
blogHandler :: BlogLang -> ServerPart Response
blogHandler lang =
msum [ path $ \(year :: Int) -> path $ \(month :: Int) -> path $
\(day :: Int) -> path $ \(id_ :: String) -> showEntry lang year month day id_
]
showEntry :: BlogLang -> Int -> Int -> Int -> String -> ServerPart Response
showEntry EN y m d i = undefined
showEntry DE y m d i = undefined
showIndex :: BlogLang -> Response
showIndex lang = toResponse $ renderBlogHeader lang
renderBlogHeader :: BlogLang -> Html
renderBlogHeader DE = blogTemplate "Tazjins Blog" "Wer mich kontaktieren will: " " oder "
renderBlogHeader EN = blogTemplate "Tazjin's Blog" "Get in touch with me: " " or "
-- http://tazj.in/2012/02/10.155234
-- 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); } }"
latestDE = ViewMap "latestDE" latestDEView
latestEN = ViewMap "latestEN" latestENView
setupBlogViews :: IO () -- taking *reservations* DB name as parameter because we'll have multiple stores
setupBlogViews = runCouchDB' $
newView "tazblog" "entries" [latestDE, latestEN]
|
