diff options
| -rw-r--r-- | src/Locales.hs | 4 | ||||
| -rw-r--r-- | src/Server.hs | 18 | ||||
| -rw-r--r-- | tazblog.cabal | 4 |
3 files changed, 13 insertions, 13 deletions
diff --git a/src/Locales.hs b/src/Locales.hs index 10cce8389f4b..b326da648f9c 100644 --- a/src/Locales.hs +++ b/src/Locales.hs @@ -5,8 +5,6 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import Network.URI - - import BlogDB (BlogLang (..)) {- to add a language simply define its abbreviation and Show instance then @@ -14,7 +12,7 @@ import BlogDB (BlogLang (..)) data BlogError = NotFound | DBError -version = "5.0" +version = "5.0.1" allLang = [EN, DE] diff --git a/src/Server.hs b/src/Server.hs index b71b070f1b21..3b70f348acda 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -21,6 +21,14 @@ import BlogDB hiding (updateEntry) import Locales import RSS + +instance FromReqURI BlogLang where + fromReqURI sub = + case map toLower sub of + "de" -> Just DE + "en" -> Just EN + _ -> Nothing + tmpPolicy :: BodyPolicy tmpPolicy = defaultBodyPolicy "/tmp" 0 200000 1000 @@ -31,8 +39,7 @@ runBlog acid port respath = tazBlog :: AcidState Blog -> String -> ServerPart Response tazBlog acid resDir = do msum [ nullDir >> blogHandler acid EN - , dir "de" $ blogHandler acid DE - , path $ \(year :: Int) -> path $ \(month :: Int) -> path $ \(id_ :: String) -> formatOldLink year month id_ + , path $ \(lang :: BlogLang) -> blogHandler acid lang , dir "notice" $ ok $ toResponse showSiteNotice {- :Admin handlers -} , do dirs "admin/postentry" nullDir @@ -62,7 +69,7 @@ tazBlog acid resDir = do setHeaderM "expires" "Tue, 20 Jan 2037 04:20:42 GMT" dir "static" $ serveDirectory DisableBrowsing [] resDir , serveDirectory DisableBrowsing [] resDir - , notFound $ toResponse $ showError NotFound EN + , notFound $ toResponse $ showError NotFound DE ] blogHandler :: AcidState Blog -> BlogLang -> ServerPart Response @@ -74,11 +81,6 @@ blogHandler acid lang = , notFound $ toResponse $ showError NotFound lang ] -formatOldLink :: Int -> Int -> String -> ServerPart Response -formatOldLink y m id_ = - flip seeOther (toResponse ()) $ - concat $ intersperse' "/" ["de", show y, show m, replace '.' '/' id_] - showEntry :: AcidState Blog -> BlogLang -> EntryId -> ServerPart Response showEntry acid lang eId = do entry <- query' acid (GetEntry eId) diff --git a/tazblog.cabal b/tazblog.cabal index ee759dfb04ca..5de69e26b445 100644 --- a/tazblog.cabal +++ b/tazblog.cabal @@ -1,5 +1,5 @@ Name: tazblog -Version: 5.0 +Version: 5.0.1 Synopsis: Tazjin's Blog License: MIT License-file: LICENSE @@ -11,7 +11,7 @@ cabal-version: >= 1.10 library hs-source-dirs: src - default-language: Haskell2010 + default-language: Haskell2010 exposed-modules: Blog, BlogDB, Locales, Server, RSS build-depends: base, bytestring, |