[all] Fix all warnings
This commit is contained in:
parent
c2fe73b027
commit
77c376e283
4 changed files with 46 additions and 43 deletions
17
src/Blog.hs
17
src/Blog.hs
|
@ -1,11 +1,8 @@
|
||||||
module Blog where
|
module Blog where
|
||||||
|
|
||||||
import BlogDB
|
import BlogDB
|
||||||
import Control.Monad (unless, when)
|
|
||||||
import Data.Data (Data, Typeable)
|
|
||||||
import Data.List (intersperse)
|
import Data.List (intersperse)
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import Data.Monoid (mempty)
|
|
||||||
import Data.Text (Text, append, empty, pack)
|
import Data.Text (Text, append, empty, pack)
|
||||||
import Data.Text.Lazy (fromStrict)
|
import Data.Text.Lazy (fromStrict)
|
||||||
import Data.Time
|
import Data.Time
|
||||||
|
@ -60,7 +57,7 @@ $doctype 5
|
||||||
<div .container>
|
<div .container>
|
||||||
^{body}
|
^{body}
|
||||||
<footer .footer>
|
<footer .footer>
|
||||||
^{showFooter lang $ pack version}
|
^{showFooter $ pack version}
|
||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
rssUrl = T.concat ["/", show' lang, "/rss.xml"]
|
rssUrl = T.concat ["/", show' lang, "/rss.xml"]
|
||||||
|
@ -71,8 +68,8 @@ $doctype 5
|
||||||
<a class="link" href=#{twitter} target="_blank">Twitter
|
<a class="link" href=#{twitter} target="_blank">Twitter
|
||||||
|]
|
|]
|
||||||
|
|
||||||
showFooter :: BlogLang -> Text -> Html
|
showFooter :: Text -> Html
|
||||||
showFooter l v = [shamlet|
|
showFooter v = [shamlet|
|
||||||
<div .container>
|
<div .container>
|
||||||
<div .row>
|
<div .row>
|
||||||
<div .span12 .righttext style="text-align: right;margin-right:-200px">
|
<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>
|
<div .span12 .notFoundText>
|
||||||
#{notFoundText l}
|
#{notFoundText l}
|
||||||
|]
|
|]
|
||||||
|
showError UnknownError l = blogTemplate l "" $ [shamlet|
|
||||||
|
<div .row .text-center>
|
||||||
|
<div .span12 .notFoundFace>:(
|
||||||
|
<div .row .text-center>
|
||||||
|
<div .span12 .notFoundText>
|
||||||
|
#{unknownErrorText l}
|
||||||
|
|]
|
||||||
|
|
|
@ -7,11 +7,9 @@ import Data.Acid.Advanced
|
||||||
import Data.Acid.Remote
|
import Data.Acid.Remote
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import Data.Data (Data, Typeable)
|
import Data.Data (Data, Typeable)
|
||||||
import Data.IxSet (Indexable (..), IxSet (..), Proxy (..), getOne, ixFun, ixSet, (@=))
|
import Data.IxSet (Indexable (..), IxSet, Proxy (..), getOne, ixFun, ixSet, (@=))
|
||||||
import Data.List (insert)
|
import Data.SafeCopy (base, deriveSafeCopy)
|
||||||
import Data.SafeCopy (SafeCopy, base, deriveSafeCopy)
|
|
||||||
import Data.Text (Text, pack)
|
import Data.Text (Text, pack)
|
||||||
import Data.Text.Lazy (toStrict)
|
|
||||||
import Data.Time
|
import Data.Time
|
||||||
import Network (PortID (..))
|
import Network (PortID (..))
|
||||||
import System.Environment (getEnv)
|
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.Base64 as B64 (encode)
|
||||||
import qualified Data.ByteString.Char8 as B
|
import qualified Data.ByteString.Char8 as B
|
||||||
import qualified Data.IxSet as IxSet
|
import qualified Data.IxSet as IxSet
|
||||||
import qualified Data.Text as Text
|
|
||||||
|
|
||||||
newtype EntryId = EntryId { unEntryId :: Integer }
|
newtype EntryId = EntryId { unEntryId :: Integer }
|
||||||
deriving (Eq, Ord, Data, Enum, Typeable)
|
deriving (Eq, Ord, Data, Enum, Typeable)
|
||||||
|
@ -138,12 +135,12 @@ updateEntry e =
|
||||||
|
|
||||||
getEntry :: EntryId -> Query Blog (Maybe Entry)
|
getEntry :: EntryId -> Query Blog (Maybe Entry)
|
||||||
getEntry eId =
|
getEntry eId =
|
||||||
do b@Blog{..} <- ask
|
do Blog{..} <- ask
|
||||||
return $ getOne $ blogEntries @= eId
|
return $ getOne $ blogEntries @= eId
|
||||||
|
|
||||||
latestEntries :: BlogLang -> Query Blog [Entry]
|
latestEntries :: BlogLang -> Query Blog [Entry]
|
||||||
latestEntries lang =
|
latestEntries lang =
|
||||||
do b@Blog{..} <- ask
|
do Blog{..} <- ask
|
||||||
return $ IxSet.toDescList (Proxy :: Proxy EDate) $ blogEntries @= lang
|
return $ IxSet.toDescList (Proxy :: Proxy EDate) $ blogEntries @= lang
|
||||||
|
|
||||||
addSession :: Session -> Update Blog Session
|
addSession :: Session -> Update Blog Session
|
||||||
|
@ -154,7 +151,7 @@ addSession nSession =
|
||||||
|
|
||||||
getSession :: SessionID -> Query Blog (Maybe Session)
|
getSession :: SessionID -> Query Blog (Maybe Session)
|
||||||
getSession sId =
|
getSession sId =
|
||||||
do b@Blog{..} <- ask
|
do Blog{..} <- ask
|
||||||
return $ getOne $ blogSessions @= sId
|
return $ getOne $ blogSessions @= sId
|
||||||
|
|
||||||
clearSessions :: Update Blog [Session]
|
clearSessions :: Update Blog [Session]
|
||||||
|
@ -172,12 +169,12 @@ addUser un pw =
|
||||||
|
|
||||||
getUser :: Username -> Query Blog (Maybe User)
|
getUser :: Username -> Query Blog (Maybe User)
|
||||||
getUser uN =
|
getUser uN =
|
||||||
do b@Blog{..} <- ask
|
do Blog{..} <- ask
|
||||||
return $ getOne $ blogUsers @= uN
|
return $ getOne $ blogUsers @= uN
|
||||||
|
|
||||||
checkUser :: Username -> String -> Query Blog Bool
|
checkUser :: Username -> String -> Query Blog Bool
|
||||||
checkUser uN pw =
|
checkUser uN pw =
|
||||||
do b@Blog{..} <- ask
|
do Blog{..} <- ask
|
||||||
let user = getOne $ blogUsers @= uN
|
let user = getOne $ blogUsers @= uN
|
||||||
case user of
|
case user of
|
||||||
Nothing -> return False
|
Nothing -> return False
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
module Locales where
|
module Locales where
|
||||||
|
|
||||||
import BlogDB (BlogLang (..))
|
import BlogDB (BlogLang (..))
|
||||||
import Data.Data (Data, Typeable)
|
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
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
|
{- to add a language simply define its abbreviation and Show instance then
|
||||||
- translate the appropriate strings and add CouchDB views in Server.hs -}
|
- translate the appropriate strings and add CouchDB views in Server.hs -}
|
||||||
|
|
||||||
data BlogError = NotFound | DBError
|
data BlogError = NotFound | UnknownError
|
||||||
|
|
||||||
version = "5.1-beta"
|
version = "5.1-beta"
|
||||||
|
|
||||||
|
@ -37,31 +36,33 @@ getMonth l y m = T.append (monthName l m) $ T.pack $ show y
|
||||||
where
|
where
|
||||||
monthName :: BlogLang -> Int -> Text
|
monthName :: BlogLang -> Int -> Text
|
||||||
monthName DE m = case m of
|
monthName DE m = case m of
|
||||||
1 -> "Januar "
|
1 -> "Januar "
|
||||||
2 -> "Februar "
|
2 -> "Februar "
|
||||||
3 -> "März "
|
3 -> "März "
|
||||||
4 -> "April "
|
4 -> "April "
|
||||||
5 -> "Mai "
|
5 -> "Mai "
|
||||||
6 -> "Juni "
|
6 -> "Juni "
|
||||||
7 -> "Juli "
|
7 -> "Juli "
|
||||||
8 -> "August "
|
8 -> "August "
|
||||||
9 -> "September "
|
9 -> "September "
|
||||||
10 -> "Oktober "
|
10 -> "Oktober "
|
||||||
11 -> "November "
|
11 -> "November "
|
||||||
12 -> "Dezember "
|
12 -> "Dezember "
|
||||||
|
_ -> "Unbekannt "
|
||||||
monthName EN m = case m of
|
monthName EN m = case m of
|
||||||
1 -> "January "
|
1 -> "January "
|
||||||
2 -> "February "
|
2 -> "February "
|
||||||
3 -> "March "
|
3 -> "March "
|
||||||
4 -> "April "
|
4 -> "April "
|
||||||
5 -> "May "
|
5 -> "May "
|
||||||
6 -> "June "
|
6 -> "June "
|
||||||
7 -> "July "
|
7 -> "July "
|
||||||
8 -> "August "
|
8 -> "August "
|
||||||
9 -> "September "
|
9 -> "September "
|
||||||
10 -> "October "
|
10 -> "October "
|
||||||
11 -> "November "
|
11 -> "November "
|
||||||
12 -> "December "
|
12 -> "December "
|
||||||
|
_ -> "Unknown "
|
||||||
|
|
||||||
entireMonth :: BlogLang -> Text
|
entireMonth :: BlogLang -> Text
|
||||||
entireMonth DE = "Ganzer Monat"
|
entireMonth DE = "Ganzer Monat"
|
||||||
|
@ -118,6 +119,10 @@ notFoundText :: BlogLang -> Text
|
||||||
notFoundText DE = "Das gewünschte Objekt wurde leider nicht gefunden."
|
notFoundText DE = "Das gewünschte Objekt wurde leider nicht gefunden."
|
||||||
notFoundText EN = "The requested object could not be found."
|
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
|
-- static information
|
||||||
repoURL :: Text = "http://hg.tazj.in/tazblog-haskell"
|
repoURL :: Text = "http://hg.tazj.in/tazblog-haskell"
|
||||||
mailTo :: Text = "mailto:tazjin+blog@gmail.com"
|
mailTo :: Text = "mailto:tazjin+blog@gmail.com"
|
||||||
|
|
|
@ -2,15 +2,13 @@
|
||||||
|
|
||||||
module Server where
|
module Server where
|
||||||
|
|
||||||
import Control.Applicative (optional, pure, (<$>), (<*>))
|
import Control.Applicative (optional)
|
||||||
import Control.Monad (liftM, msum, mzero, unless, when)
|
import Control.Monad (msum, mzero, unless)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Reader (ask)
|
|
||||||
import Data.Acid
|
import Data.Acid
|
||||||
import Data.Acid.Advanced
|
import Data.Acid.Advanced
|
||||||
import Data.ByteString.Char8 (ByteString, pack, unpack)
|
import Data.ByteString.Char8 (unpack)
|
||||||
import Data.Char (toLower)
|
import Data.Char (toLower)
|
||||||
import Data.Maybe (fromJust)
|
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Time
|
import Data.Time
|
||||||
|
@ -136,7 +134,7 @@ postEntry acid = do
|
||||||
timeToId t = EntryId . read $ formatTime defaultTimeLocale "%s" t
|
timeToId t = EntryId . read $ formatTime defaultTimeLocale "%s" t
|
||||||
getLang :: String -> ServerPart BlogLang
|
getLang :: String -> ServerPart BlogLang
|
||||||
getLang "de" = return DE
|
getLang "de" = return DE
|
||||||
getLang "en" = return EN
|
getLang _ = return EN -- English is default
|
||||||
|
|
||||||
entryList :: AcidState Blog -> BlogLang -> ServerPart Response
|
entryList :: AcidState Blog -> BlogLang -> ServerPart Response
|
||||||
entryList acid lang = do
|
entryList acid lang = do
|
||||||
|
|
Loading…
Add table
Reference in a new issue