{-# 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]