diff options
Diffstat (limited to 'services/tazblog/src/Server.hs')
-rw-r--r-- | services/tazblog/src/Server.hs | 75 |
1 files changed, 40 insertions, 35 deletions
diff --git a/services/tazblog/src/Server.hs b/services/tazblog/src/Server.hs index 8a7384ccca3e..492849a2f39d 100644 --- a/services/tazblog/src/Server.hs +++ b/services/tazblog/src/Server.hs @@ -1,16 +1,19 @@ -{-# LANGUAGE RecordWildCards, ScopedTypeVariables, OverloadedStrings, FlexibleContexts #-} -module Server where +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} -import Control.Applicative (optional) -import Control.Monad (msum) -import Control.Monad.IO.Class (liftIO) -import Data.Char (toLower) -import qualified Data.Text as T -import Happstack.Server hiding (Session) -import Data.Maybe (maybe) +module Server where import Blog import BlogStore +import Control.Applicative (optional) +import Control.Monad (msum) +import Control.Monad.IO.Class (liftIO) +import Data.Char (toLower) +import Data.Maybe (maybe) +import qualified Data.Text as T +import Happstack.Server hiding (Session) import Locales import RSS @@ -19,7 +22,7 @@ instance FromReqURI BlogLang where case map toLower sub of "de" -> Just DE "en" -> Just EN - _ -> Nothing + _ -> Nothing pageSize :: Int pageSize = 3 @@ -34,21 +37,23 @@ runBlog port respath = do tazBlog :: BlogCache -> String -> ServerPart Response tazBlog cache resDir = do - msum [ path $ \(lang :: BlogLang) -> blogHandler cache lang - , dir "static" $ staticHandler resDir - , blogHandler cache EN - , staticHandler resDir - , notFound $ toResponse $ showError NotFound DE - ] + msum + [ path $ \(lang :: BlogLang) -> blogHandler cache lang, + dir "static" $ staticHandler resDir, + blogHandler cache EN, + staticHandler resDir, + notFound $ toResponse $ showError NotFound DE + ] blogHandler :: BlogCache -> BlogLang -> ServerPart Response blogHandler cache lang = - msum [ path $ \(eId :: Integer) -> showEntry cache lang $ EntryId eId - , nullDir >> showIndex cache lang - , dir "rss" $ nullDir >> showRSS cache lang - , dir "rss.xml" $ nullDir >> showRSS cache lang - , notFound $ toResponse $ showError NotFound lang - ] + msum + [ path $ \(eId :: Integer) -> showEntry cache lang $ EntryId eId, + nullDir >> showIndex cache lang, + dir "rss" $ nullDir >> showRSS cache lang, + dir "rss.xml" $ nullDir >> showRSS cache lang, + notFound $ toResponse $ showError NotFound lang + ] staticHandler :: String -> ServerPart Response staticHandler resDir = do @@ -58,29 +63,29 @@ staticHandler resDir = do showEntry :: BlogCache -> BlogLang -> EntryId -> ServerPart Response showEntry cache lang eId = do - entry <- getEntry cache eId - tryEntry entry lang + entry <- getEntry cache eId + tryEntry entry lang tryEntry :: Maybe Entry -> BlogLang -> ServerPart Response tryEntry Nothing lang = notFound $ toResponse $ showError NotFound lang tryEntry (Just entry) _ = ok $ toResponse $ blogTemplate eLang eTitle $ renderEntry entry - where - eTitle = T.append ": " (title entry) - eLang = lang entry + where + eTitle = T.append ": " (title entry) + eLang = lang entry offset :: Maybe Int -> Int offset = maybe 0 ((*) pageSize) showIndex :: BlogCache -> BlogLang -> ServerPart Response showIndex cache lang = do - (page :: Maybe Int) <- optional $ lookRead "page" - entries <- listEntries cache (offset page) pageSize - ok $ toResponse $ blogTemplate lang "" $ - renderEntries entries (Just $ showLinks page lang) + (page :: Maybe Int) <- optional $ lookRead "page" + entries <- listEntries cache (offset page) pageSize + ok $ toResponse $ blogTemplate lang "" + $ renderEntries entries (Just $ showLinks page lang) showRSS :: BlogCache -> BlogLang -> ServerPart Response showRSS cache lang = do - entries <- listEntries cache 0 4 - feed <- liftIO $ renderFeed lang entries - setHeaderM "content-type" "text/xml" - ok $ toResponse feed + entries <- listEntries cache 0 4 + feed <- liftIO $ renderFeed lang entries + setHeaderM "content-type" "text/xml" + ok $ toResponse feed |