about summary refs log tree commit diff
path: root/src
diff options
context:
space:
mode:
authorVincent Ambo <vincent@kivra.com>2015-11-21T02·18+0100
committerVincent Ambo <vincent@kivra.com>2015-11-21T02·18+0100
commit77c376e283e5dd2bde32ab1f20555c28c4adad89 (patch)
treee58288525e64ff4d76e373b288d9c05a73d59aea /src
parentc2fe73b02715f05cae8721d0e8474e6baa683adf (diff)
[all] Fix all warnings
Diffstat (limited to 'src')
-rw-r--r--src/Blog.hs17
-rw-r--r--src/BlogDB.hs17
-rw-r--r--src/Locales.hs45
-rw-r--r--src/Server.hs10
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