* initial checkin

src/Blog.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
+module Blog where
+
+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
+
+blogTemplate :: String -> String -> String -> Html
+blogTemplate t h o = H.docTypeHtml $ do
+    H.head $ do
+        H.title $ (toHtml t)
+        H.link ! A.rel "alternate" ! A.type_ "application/rss+xml" ! A.title "RSS-Feed" ! A.href "/rss"
+        H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "/res/blogstyle.css" ! A.media "all"
+        H.meta ! A.httpEquiv "content-type" ! A.content "text/html;charset=UTF-8"
+{-        H.style ! A.type_ "text/css" ! A.title "iOS iMessage" ! A.media "screen and (max-device-width: 1024px)" $ "#cosx{display:none;} #cios{display:block;}" -}
+    H.body $ do
+        H.div ! A.class_ "mainshell" $ H.div ! A.class_ "gradBox" $ H.div ! A.class_ "header" $ do
+                H.a ! A.href "/" ! A.style "text-decoration:none;color:black;font-size:x-large;font-weight:bold;" $
+                        (toHtml t)
+                H.br
+                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"
+    where
+        contactInfo (imu :: String) = do
+            toHtml h
+            H.a ! A.href "mailto:hej@tazj.in" $ "Mail"
+            ", "
+            H.a ! A.href "http://twitter.com/#!/tazjin" ! A.target "_blank" $ "Twitter"
+            toHtml o
+            H.a ! A.href (toValue imu) ! A.target "_blank" $ "iMessage"
+            "."

src/Server.hs

@@ -0,0 +1,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]