diff options
author | Vincent Ambo <viam@humac.com> | 2012-03-06T22·34+0100 |
---|---|---|
committer | Vincent Ambo <viam@humac.com> | 2012-03-06T22·34+0100 |
commit | cd3a5f2cb5f73c6aff16a153864d56faca59e30b (patch) | |
tree | e4adea150d65a0c3ecf57b2a18bca796405c60af /src/Main.hs | |
parent | 6220988fc5fa89a3f581c446fddd103beabc32cd (diff) |
* links on right side
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 17 |
1 files changed, 9 insertions, 8 deletions
diff --git a/src/Main.hs b/src/Main.hs index 5bc2ef2ce46d..e0714c95e5b4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -39,13 +39,14 @@ tazBlog = do , do dir " " $ nullDir seeOther ("https://plus.google.com/115916629925754851590" :: String) (toResponse ()) , dir "res" $ serveDirectory DisableBrowsing [] "../res" + , dir "notice" $ ok $ toResponse showSiteNotice , serveDirectory DisableBrowsing [] "../res" ] blogHandler :: BlogLang -> ServerPart Response blogHandler lang = msum [ path $ \(year :: Int) -> path $ \(month :: Int) -> path $ --single entry - \(day :: Int) -> path $ \(id_ :: String) -> showEntry year month day id_ + \(day :: Int) -> path $ \(id_ :: String) -> showEntry lang id_ , path $ \(year :: Int ) -> path $ \(month :: Int) -> showMonth year month lang , do decodeBody tmpPolicy @@ -54,15 +55,15 @@ blogHandler lang = showIndex lang ] -showEntry :: Int -> Int -> Int -> String -> ServerPart Response -showEntry y m d i = do - entryJS <- liftIO $ runCouchDB' $ getDoc (db "tazblog") (doc i) +showEntry :: BlogLang -> String -> ServerPart Response +showEntry lang id_ = do + entryJS <- liftIO $ runCouchDB' $ getDoc (db "tazblog") (doc id_) let entry = maybeDoc entryJS - ok $ tryEntry entry + ok $ tryEntry entry lang -tryEntry :: Maybe Entry -> Response -tryEntry Nothing = toResponse $ showError NotFound -tryEntry (Just entry) = toResponse $ blogTemplate eLang eTitle $ renderEntry entry +tryEntry :: Maybe Entry -> BlogLang -> Response +tryEntry Nothing lang = toResponse $ showError NotFound lang +tryEntry (Just entry) _ = toResponse $ blogTemplate eLang eTitle $ renderEntry entry where eTitle = T.pack $ ": " ++ title entry eLang = lang entry |