+
+ #{unknownErrorText l}
+|]
diff --git a/src/BlogDB.hs b/src/BlogDB.hs
index 316c2fdc0..52e4e80c3 100644
--- a/src/BlogDB.hs
+++ b/src/BlogDB.hs
@@ -7,11 +7,9 @@ import Data.Acid.Advanced
import Data.Acid.Remote
import Data.ByteString (ByteString)
import Data.Data (Data, Typeable)
-import Data.IxSet (Indexable (..), IxSet (..), Proxy (..), getOne, ixFun, ixSet, (@=))
-import Data.List (insert)
-import Data.SafeCopy (SafeCopy, base, deriveSafeCopy)
+import Data.IxSet (Indexable (..), IxSet, Proxy (..), getOne, ixFun, ixSet, (@=))
+import Data.SafeCopy (base, deriveSafeCopy)
import Data.Text (Text, pack)
-import Data.Text.Lazy (toStrict)
import Data.Time
import Network (PortID (..))
import System.Environment (getEnv)
@@ -20,7 +18,6 @@ import qualified Crypto.Hash.SHA512 as SHA (hash)
import qualified Data.ByteString.Base64 as B64 (encode)
import qualified Data.ByteString.Char8 as B
import qualified Data.IxSet as IxSet
-import qualified Data.Text as Text
newtype EntryId = EntryId { unEntryId :: Integer }
deriving (Eq, Ord, Data, Enum, Typeable)
@@ -138,12 +135,12 @@ updateEntry e =
getEntry :: EntryId -> Query Blog (Maybe Entry)
getEntry eId =
- do b@Blog{..} <- ask
+ do Blog{..} <- ask
return $ getOne $ blogEntries @= eId
latestEntries :: BlogLang -> Query Blog [Entry]
latestEntries lang =
- do b@Blog{..} <- ask
+ do Blog{..} <- ask
return $ IxSet.toDescList (Proxy :: Proxy EDate) $ blogEntries @= lang
addSession :: Session -> Update Blog Session
@@ -154,7 +151,7 @@ addSession nSession =
getSession :: SessionID -> Query Blog (Maybe Session)
getSession sId =
- do b@Blog{..} <- ask
+ do Blog{..} <- ask
return $ getOne $ blogSessions @= sId
clearSessions :: Update Blog [Session]
@@ -172,12 +169,12 @@ addUser un pw =
getUser :: Username -> Query Blog (Maybe User)
getUser uN =
- do b@Blog{..} <- ask
+ do Blog{..} <- ask
return $ getOne $ blogUsers @= uN
checkUser :: Username -> String -> Query Blog Bool
checkUser uN pw =
- do b@Blog{..} <- ask
+ do Blog{..} <- ask
let user = getOne $ blogUsers @= uN
case user of
Nothing -> return False
diff --git a/src/Locales.hs b/src/Locales.hs
index a05379d41..e4ac9767c 100644
--- a/src/Locales.hs
+++ b/src/Locales.hs
@@ -1,7 +1,6 @@
module Locales where
import BlogDB (BlogLang (..))
-import Data.Data (Data, Typeable)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
@@ -10,7 +9,7 @@ import Network.URI
{- to add a language simply define its abbreviation and Show instance then
- translate the appropriate strings and add CouchDB views in Server.hs -}
-data BlogError = NotFound | DBError
+data BlogError = NotFound | UnknownError
version = "5.1-beta"
@@ -37,31 +36,33 @@ getMonth l y m = T.append (monthName l m) $ T.pack $ show y
where
monthName :: BlogLang -> Int -> Text
monthName DE m = case m of
- 1 -> "Januar "
- 2 -> "Februar "
- 3 -> "März "
- 4 -> "April "
- 5 -> "Mai "
- 6 -> "Juni "
- 7 -> "Juli "
- 8 -> "August "
- 9 -> "September "
+ 1 -> "Januar "
+ 2 -> "Februar "
+ 3 -> "März "
+ 4 -> "April "
+ 5 -> "Mai "
+ 6 -> "Juni "
+ 7 -> "Juli "
+ 8 -> "August "
+ 9 -> "September "
10 -> "Oktober "
11 -> "November "
12 -> "Dezember "
+ _ -> "Unbekannt "
monthName EN m = case m of
- 1 -> "January "
- 2 -> "February "
- 3 -> "March "
- 4 -> "April "
- 5 -> "May "
- 6 -> "June "
- 7 -> "July "
- 8 -> "August "
- 9 -> "September "
+ 1 -> "January "
+ 2 -> "February "
+ 3 -> "March "
+ 4 -> "April "
+ 5 -> "May "
+ 6 -> "June "
+ 7 -> "July "
+ 8 -> "August "
+ 9 -> "September "
10 -> "October "
11 -> "November "
12 -> "December "
+ _ -> "Unknown "
entireMonth :: BlogLang -> Text
entireMonth DE = "Ganzer Monat"
@@ -118,6 +119,10 @@ notFoundText :: BlogLang -> Text
notFoundText DE = "Das gewünschte Objekt wurde leider nicht gefunden."
notFoundText EN = "The requested object could not be found."
+unknownErrorText :: BlogLang -> Text
+unknownErrorText DE = "Ein unbekannter Fehler ist aufgetreten."
+unknownErrorText EN = "An unknown error has occured."
+
-- static information
repoURL :: Text = "http://hg.tazj.in/tazblog-haskell"
mailTo :: Text = "mailto:tazjin+blog@gmail.com"
diff --git a/src/Server.hs b/src/Server.hs
index 4eef611ed..30cf422a8 100644
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -2,15 +2,13 @@
module Server where
-import Control.Applicative (optional, pure, (<$>), (<*>))
-import Control.Monad (liftM, msum, mzero, unless, when)
+import Control.Applicative (optional)
+import Control.Monad (msum, mzero, unless)
import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Reader (ask)
import Data.Acid
import Data.Acid.Advanced
-import Data.ByteString.Char8 (ByteString, pack, unpack)
+import Data.ByteString.Char8 (unpack)
import Data.Char (toLower)
-import Data.Maybe (fromJust)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time
@@ -136,7 +134,7 @@ postEntry acid = do
timeToId t = EntryId . read $ formatTime defaultTimeLocale "%s" t
getLang :: String -> ServerPart BlogLang
getLang "de" = return DE
- getLang "en" = return EN
+ getLang _ = return EN -- English is default
entryList :: AcidState Blog -> BlogLang -> ServerPart Response
entryList acid lang = do