about summary refs log tree commit diff
diff options
context:
space:
mode:
author"Vincent Ambo ext:(%22) <tazjin@gmail.com>2013-04-28T12·44+0200
committer"Vincent Ambo ext:(%22) <tazjin@gmail.com>2013-04-28T12·44+0200
commitc5206173e6445507f8468457ac5534065e8b9909 (patch)
tree6bb9cc9f00b04c0037eb984208b108804bdfdb93
parent9719b5a62de0795a5cb62778de06c3aa7f206e95 (diff)
ran hlint
-rw-r--r--src/Blog.hs2
-rw-r--r--src/BlogDB.hs8
-rw-r--r--src/Main.hs43
-rw-r--r--src/RSS.hs13
4 files changed, 33 insertions, 33 deletions
diff --git a/src/Blog.hs b/src/Blog.hs
index 2c1a546a2a57..e999d18fad10 100644
--- a/src/Blog.hs
+++ b/src/Blog.hs
@@ -163,7 +163,7 @@ renderEntry e@Entry{..} = [shamlet|
   ^{renderCommentBox lang entryId}
 |]
   where
-   woText = flip T.append author $ T.pack $ (formatTime defaultTimeLocale (eTimeFormat lang) edate)
+   woText = flip T.append author $ T.pack $ formatTime defaultTimeLocale (eTimeFormat lang) edate
 
 renderComments :: [Comment] -> BlogLang -> Html
 renderComments [] lang = [shamlet|<li>#{noComments lang}|]
diff --git a/src/BlogDB.hs b/src/BlogDB.hs
index b2551ecc3d99..c054d7f17dd2 100644
--- a/src/BlogDB.hs
+++ b/src/BlogDB.hs
@@ -97,7 +97,7 @@ instance Indexable Entry where
                   , ixFun $ \e -> [ MText $ mtext e]
                   , ixFun $ \e -> [ EDate $ edate e]
                   , ixFun $ \e -> map Tag (tags e)
-                  , ixFun $ comments
+                  , ixFun comments
                   ]
 
 data User = User {
@@ -209,13 +209,13 @@ getUser uN =
   do b@Blog{..} <- ask
      return $ getOne $ blogUsers @= uN
 
-checkUser :: Username -> String -> Query Blog (Bool)
+checkUser :: Username -> String -> Query Blog Bool
 checkUser uN pw =
   do b@Blog{..} <- ask
      let user = getOne $ blogUsers @= uN
      case user of
        Nothing  -> return False
-       (Just u) -> return $ (password u) == hashString pw
+       (Just u) -> return $ password u == hashString pw
 
 -- various functions
 hashString :: String -> ByteString
@@ -251,7 +251,7 @@ flushSessions :: IO ()
 flushSessions = do
   tbDir <- getEnv "TAZBLOG"
   acid <- openLocalStateFrom (tbDir ++ "/BlogState") initialBlogState
-  update' acid (ClearSessions)
+  update' acid ClearSessions
   closeAcidState acid
 
 archiveState :: IO ()
diff --git a/src/Main.hs b/src/Main.hs
index 09215ba9d54f..3f806328e536 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -12,7 +12,7 @@ module Main where
 
 import           Control.Applicative          (optional, pure, (<$>), (<*>))
 import           Control.Exception            (bracket)
-import           Control.Monad                (msum, mzero, unless, when)
+import           Control.Monad                (liftM, msum, mzero, unless, when)
 import           Control.Monad.IO.Class       (liftIO)
 import           Control.Monad.Reader         (ask)
 import           Control.Monad.State          (get, put)
@@ -53,14 +53,14 @@ defineOptions "MainOptions" $ do
     "The port to run the web server on. Default is 8000"
 
 tmpPolicy :: BodyPolicy
-tmpPolicy = (defaultBodyPolicy "./tmp/" 0 200000 1000)
+tmpPolicy = defaultBodyPolicy "./tmp/" 0 200000 1000
 
 main :: IO()
 main = do
     putStrLn ("TazBlog " ++ version ++ " in Haskell starting")
     runCommand $ \opts args ->
       bracket (openLocalStateFrom (optState opts ++ "BlogState") initialBlogState)
-              (createCheckpointAndClose)
+              createCheckpointAndClose
               (\acid -> simpleHTTP nullConf {port = optPort opts} $ tazBlog acid $ optCaptcha opts)
 
 tazBlog :: AcidState Blog -> String -> ServerPart Response
@@ -74,13 +74,13 @@ tazBlog acid captchakey = do
          , dir "res" $ serveDirectory DisableBrowsing [] "../res"
          , dir "notice" $ ok $ toResponse showSiteNotice
          {- :Admin handlers -}
-         , do dirs "admin/postentry" $ nullDir
+         , do dirs "admin/postentry" nullDir
               guardSession acid
               postEntry acid
-         , do dirs "admin/entrylist" $ dir (show DE) $ nullDir
+         , do dirs "admin/entrylist" $ dir (show DE) nullDir
               guardSession acid
               entryList acid DE
-         , do dirs "admin/entrylist" $ dir (show EN) $ nullDir
+         , do dirs "admin/entrylist" $ dir (show EN) nullDir
               guardSession acid
               entryList acid EN
          , do guardSession acid
@@ -90,16 +90,16 @@ tazBlog acid captchakey = do
          , do guardSession acid
               dirs "admin/cdelete" $ path $ \(eId :: Integer) -> path $ \(cId :: String) ->
                 deleteComment acid (EntryId eId) cId
-         , do dir "admin" $ nullDir
+         , do dir "admin" nullDir
               guardSession acid
               ok $ toResponse $ adminIndex ("tazjin" :: Text)
-         , dir "admin" $ ok $ toResponse $ adminLogin
+         , dir "admin" $ ok $ toResponse adminLogin
          , dir "dologin" $ processLogin acid
-         , do dirs "static/blogv34.css" $ nullDir
+         , do dirs "static/blogv34.css" nullDir
               setHeaderM "content-type" "text/css"
               setHeaderM "cache-control" "max-age=630720000"
               setHeaderM "expires" "Tue, 20 Jan 2037 04:20:42 GMT"
-              ok $ toResponse $ blogStyle
+              ok $ toResponse blogStyle
          , do setHeaderM "cache-control" "max-age=630720000"
               setHeaderM "expires" "Tue, 20 Jan 2037 04:20:42 GMT"
               dir "static" $ serveDirectory DisableBrowsing [] "../res"
@@ -156,7 +156,7 @@ showRSS acid lang = do
 
 addComment :: AcidState Blog -> BlogLang -> String -> EntryId -> ServerPart Response
 addComment acid lang captchakey eId = do
-  now <- liftIO $ getCurrentTime >>= return
+  now <- liftIO getCurrentTime
   nCtext <- lookText' "ctext"
   nComment <- Comment <$> pure now
                       <*> lookText' "cname"
@@ -164,12 +164,12 @@ addComment acid lang captchakey eId = do
   -- captcha verification
   challenge <- look "recaptcha_challenge_field"
   response <- look "recaptcha_response_field"
-  (userIp, _) <- askRq >>= return . rqPeer
+  (userIp, _) <- liftM rqPeer askRq -- FIXME askRq >>= return . rqPeer
   validation <- liftIO $ validateCaptcha captchakey userIp challenge response
   case validation of
     Right _ -> update' acid (AddComment eId nComment)
                 >> seeOther ("/" ++ show lang ++ "/" ++ show eId) (toResponse())
-    Left _ -> (liftIO $ putStrLn "Captcha failed") >> seeOther ("/" ++ show lang ++ "/" ++ show eId) (toResponse())
+    Left _ -> liftIO (putStrLn "Captcha failed") >> seeOther ("/" ++ show lang ++ "/" ++ show eId) (toResponse())
 
 commentEscape :: Text -> Text
 commentEscape = newlineEscape . ltEscape . gtEscape . ampEscape
@@ -184,7 +184,7 @@ commentEscape = newlineEscape . ltEscape . gtEscape . ampEscape
 postEntry :: AcidState Blog -> ServerPart Response
 postEntry acid = do
     decodeBody tmpPolicy
-    now <- liftIO $ getCurrentTime
+    now <- liftIO getCurrentTime
     let eId = timeToId now
     lang <- look "lang"
     nBtext <- lookText' "btext"
@@ -245,16 +245,15 @@ guardSession :: AcidState Blog -> ServerPartT IO ()
 guardSession acid = do
     (sId :: Text) <- readCookieValue "session"
     (uName :: Text) <- readCookieValue "sUser"
-    now <- liftIO $ getCurrentTime
+    now <- liftIO getCurrentTime
     mS <- query' acid (GetSession $ SessionID sId)
     case mS of
       Nothing -> mzero
-      (Just Session{..}) -> unless (and [ uName == username user
-                                        , sessionTimeDiff now sdate])
-                                    mzero
+      (Just Session{..}) -> unless ((uName == username user) && sessionTimeDiff now sdate)
+                                   mzero
   where
     sessionTimeDiff :: UTCTime -> UTCTime -> Bool
-    sessionTimeDiff now sdate = (diffUTCTime now sdate) < 43200
+    sessionTimeDiff now sdate = diffUTCTime now sdate < 43200
 
 
 processLogin :: AcidState Blog -> ServerPart Response
@@ -263,9 +262,9 @@ processLogin acid = do
     account <- lookText' "account"
     password <- look "password"
     login <- query' acid (CheckUser (Username account) password)
-    if' login
-      (createSession account)
-      (ok $ toResponse $ adminLogin)
+    if login
+      then createSession account
+      else ok $ toResponse adminLogin
   where
     createSession account = do
       now <- liftIO getCurrentTime
diff --git a/src/RSS.hs b/src/RSS.hs
index 50531c3f8065..045702ece443 100644
--- a/src/RSS.hs
+++ b/src/RSS.hs
@@ -2,14 +2,15 @@
 
 module RSS (renderFeed) where
 
-import qualified Data.Text   as T
+import qualified Data.Text     as T
 
-import           Data.Maybe  (fromMaybe)
-import           Data.Time   (UTCTime, getCurrentTime)
+import           Control.Monad (liftM)
+import           Data.Maybe    (fromMaybe)
+import           Data.Time     (UTCTime, getCurrentTime)
 import           Network.URI
 import           Text.RSS
 
-import           BlogDB      hiding (Title)
+import           BlogDB        hiding (Title)
 import           Locales
 
 createChannel :: BlogLang -> UTCTime -> [ChannelElem]
@@ -20,7 +21,7 @@ createChannel l  now = [ Language $ show l
                        ]
 
 createRSS :: BlogLang -> UTCTime -> [Item] -> RSS
-createRSS l t i = RSS (rssTitle l) (rssLink l) (rssDesc l) (createChannel l t) i
+createRSS l t = RSS (rssTitle l) (rssLink l) (rssDesc l) (createChannel l t)
 
 createItem :: Entry -> Item
 createItem Entry{..} = [ Title $ T.unpack title
@@ -39,4 +40,4 @@ createFeed :: BlogLang -> [Entry] -> IO RSS
 createFeed l e = getCurrentTime >>= (\t -> return $ createRSS l t $ createItems e )
 
 renderFeed :: BlogLang -> [Entry] -> IO String
-renderFeed l e = createFeed l e >>= (\feed -> return $ showXML $ rssToXML feed)
+renderFeed l e = liftM (showXML . rssToXML) (createFeed l e)