about summary refs log tree commit diff
path: root/src/Server.hs
diff options
context:
space:
mode:
author"Vincent Ambo ext:(%22) <tazjin@me.com>2012-02-23T02·30+0100
committer"Vincent Ambo ext:(%22) <tazjin@me.com>2012-02-23T02·30+0100
commit2fa129e7e3107dee64d855df4260dbc9f2188a83 (patch)
treed5a88ae23c496d12d27e91cd15347276197fd6de /src/Server.hs
parent47c8d9a96d8532931c4415230e9385470062d907 (diff)
* blog footer, language handling, emptyTest
Diffstat (limited to 'src/Server.hs')
-rw-r--r--src/Server.hs89
1 files changed, 46 insertions, 43 deletions
diff --git a/src/Server.hs b/src/Server.hs
index aa41a2173d6e..eefc9b1e7ad8 100644
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -2,76 +2,79 @@
 
 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           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           Text.JSON.Generic
 
-import			 Blog
+import           Blog
 
 tmpPolicy :: BodyPolicy
 tmpPolicy = (defaultBodyPolicy "./tmp/" 0 1000 1000)
 
-data BlogLang = EN | DE
 
 data Comment = Comment{
-	cauthor	:: String,
-	ctext	:: String,
-	cdate	:: Integer
+    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]
+    _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"
+    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
+    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"
-		 ]
+    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_
-		 ]
+    msum [ path $ \(year :: Int) -> path $ \(month :: Int) -> path $ --single entry
+                      \(day :: Int) -> path $ \(id_ :: String) -> showEntry lang year month day id_
+         , do nullDir
+              ok $ showIndex lang
+         ]
 
 showEntry :: BlogLang -> Int -> Int -> Int -> String -> ServerPart Response
 showEntry EN y m d i = undefined
@@ -81,8 +84,8 @@ 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 "
+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
 
 -- http://tazj.in/2012/02/10.155234
 
@@ -93,6 +96,6 @@ latestENView = "function(doc){ if(doc.lang == \"en\"){ emit([doc.year, doc.month
 latestDE = ViewMap "latestDE" latestDEView
 latestEN = ViewMap "latestEN" latestENView
 
-setupBlogViews :: IO () -- taking *reservations* DB name as parameter because we'll have multiple stores
+setupBlogViews :: IO ()
 setupBlogViews = runCouchDB' $ 
     newView "tazblog" "entries" [latestDE, latestEN]