diff options
| -rw-r--r-- | src/Blog.hs | 17 | ||||
| -rw-r--r-- | src/BlogDB.hs | 17 | ||||
| -rw-r--r-- | src/Locales.hs | 45 | ||||
| -rw-r--r-- | src/Server.hs | 10 |
4 files changed, 46 insertions, 43 deletions
diff --git a/src/Blog.hs b/src/Blog.hs index 70adcc1ac722..602fe5989439 100644 --- a/src/Blog.hs +++ b/src/Blog.hs @@ -1,11 +1,8 @@ module Blog where import BlogDB -import Control.Monad (unless, when) -import Data.Data (Data, Typeable) import Data.List (intersperse) import Data.Maybe (fromJust) -import Data.Monoid (mempty) import Data.Text (Text, append, empty, pack) import Data.Text.Lazy (fromStrict) import Data.Time @@ -60,7 +57,7 @@ $doctype 5 <div .container> ^{body} <footer .footer> - ^{showFooter lang $ pack version} + ^{showFooter $ pack version} |] where rssUrl = T.concat ["/", show' lang, "/rss.xml"] @@ -71,8 +68,8 @@ $doctype 5 <a class="link" href=#{twitter} target="_blank">Twitter |] -showFooter :: BlogLang -> Text -> Html -showFooter l v = [shamlet| +showFooter :: Text -> Html +showFooter v = [shamlet| <div .container> <div .row> <div .span12 .righttext style="text-align: right;margin-right:-200px"> @@ -271,4 +268,10 @@ showError NotFound l = blogTemplate l (T.append ": " $ notFoundTitle l) $ [shaml <div .span12 .notFoundText> #{notFoundText l} |] - +showError UnknownError l = blogTemplate l "" $ [shamlet| +<div .row .text-center> + <div .span12 .notFoundFace>:( +<div .row .text-center> + <div .span12 .notFoundText> + #{unknownErrorText l} +|] diff --git a/src/BlogDB.hs b/src/BlogDB.hs index 316c2fdc08ff..52e4e80c397a 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 a05379d410d7..e4ac9767c34d 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 4eef611edcfc..30cf422a83c5 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 |