about summary refs log tree commit diff
path: root/src/Server.hs
blob: aa41a2173d6ea6ba9218f8e833e11fdc1c9f9900 (plain) (blame)
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]