From 8305c433832d3471a7d1500c5c5dbb9a95c42a67 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 28 Dec 2014 07:12:25 +0100 Subject: [PATCH] removed many compile time warnings --- Application.hs | 10 ++-------- Foundation.hs | 7 +------ Handler/Activate.hs | 6 +++--- Handler/AdminAlbumSettings.hs | 8 ++++---- Handler/AdminComments.hs | 4 ++-- Handler/AdminMediumSettings.hs | 4 ++-- Handler/AdminProfileSettings.hs | 8 ++++---- Handler/AlbumSettings.hs | 15 +++++---------- Handler/Commons.hs | 1 - Handler/Login.hs | 11 +++++++---- Handler/Medium.hs | 10 +++++----- Handler/MediumSettings.hs | 6 +++--- Handler/NewAlbum.hs | 2 +- Handler/Profile.hs | 2 +- Handler/ProfileDelete.hs | 7 +++---- Handler/ProfileSettings.hs | 2 +- Handler/Reactivate.hs | 6 +++--- Handler/Signup.hs | 4 ++-- Handler/Tag.hs | 1 - Handler/Upload.hs | 20 +++++--------------- Helper.hs | 11 ++--------- Model.hs | 10 ---------- Settings/StaticFiles.hs | 7 +------ templates/default-layout.hamlet | 2 +- templates/medium.hamlet | 2 +- 25 files changed, 59 insertions(+), 107 deletions(-) diff --git a/Application.hs b/Application.hs index fc5a340..5b7e7dd 100644 --- a/Application.hs +++ b/Application.hs @@ -7,18 +7,13 @@ module Application ) where import Import -import Settings import Yesod.Static import Yesod.Default.Config2 -import Yesod.Default.Main import Yesod.Default.Handlers -import qualified Database.Persist import Database.Persist.Sql (runMigration) import Network.HTTP.Client.Conduit (newManager) -import Control.Concurrent (forkIO, threadDelay) import Control.Monad -import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize, flushLogStr) -import Network.Wai.Logger (clockDateCacher) +import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize) import Data.Default (def) import Yesod.Core.Types (loggerSet) @@ -34,8 +29,7 @@ import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..), destination, mkRequestLogger, outputFormat) -import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, - toLogStr) +import System.Log.FastLogger (toLogStr) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! diff --git a/Foundation.hs b/Foundation.hs index 31d1501..3ea7a1b 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -3,12 +3,8 @@ module Foundation where import Prelude import Yesod import Yesod.Static -import Yesod.Default.Config2 import Yesod.Default.Util (addStaticContentExternal) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) -import qualified Settings -import Settings.Development (development) -import qualified Database.Persist import Database.Persist.Sql -- (ConnectionPool, runSqlPool) import Settings.StaticFiles import Settings @@ -18,7 +14,6 @@ import Text.Hamlet (hamletFile) import Yesod.Core.Types -- costom imports import Data.Text -import Data.Maybe import Helper -- | The site argument for your application. This can be a good place to @@ -56,7 +51,7 @@ instance Yesod App where approot = ApprootMaster $ appRoot . appSettings -- change maximum content length - maximumContentLength _ _ = Just $ 1024 ^ 5 + maximumContentLength _ _ = Just $ 1024 ^ (5 :: Int) -- Store session data on the client in encrypted cookies, -- default session idle timeout is 120 minutes diff --git a/Handler/Activate.hs b/Handler/Activate.hs index 30a286c..f1bab45 100644 --- a/Handler/Activate.hs +++ b/Handler/Activate.hs @@ -14,7 +14,7 @@ getActivateR token = do Nothing -> do mToken <- runDB $ selectFirst [TokenToken ==. (encodeUtf8 token), TokenKind ==. "activate"] [] case mToken of - Just (Entity uTokenId uToken) -> do + Just (Entity _ uToken) -> do user <- runDB $ getJust (fromJust $ tokenUser uToken) hexSalt <- return $ toHex $ userSalt user defaultLayout $ do @@ -23,11 +23,11 @@ getActivateR token = do _ -> do setMessage "Invalid token!" redirect $ HomeR - Just (Entity activatorKey activator) -> do + Just (Entity _ activator) -> do uSalt <- return $ userSalt $ activatorUser activator mToken <- runDB $ selectFirst [TokenToken ==. (encodeUtf8 token), TokenKind ==. "activate"] [] case mToken of - Just (Entity uTokenId uToken) -> do + Just (Entity _ _) -> do hexSalt <- return $ toHex uSalt defaultLayout $ do $(widgetFile "activate") diff --git a/Handler/AdminAlbumSettings.hs b/Handler/AdminAlbumSettings.hs index 54afd53..819f3a5 100644 --- a/Handler/AdminAlbumSettings.hs +++ b/Handler/AdminAlbumSettings.hs @@ -70,10 +70,10 @@ postAdminAlbumSettingsR albumId = do Just album -> do entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName] users <- return $ map (\u -> (userName $ entityVal u, entityKey u)) entities - ((res, adminAlbumSettingsWidget), enctype) <- runFormPost $ adminAlbumSettingsForm album albumId users + ((res, _), _) <- runFormPost $ adminAlbumSettingsForm album albumId users case res of FormSuccess temp -> do - aId <- runDB $ update albumId + _ <- runDB $ update albumId [ AlbumTitle =. albumTitle temp , AlbumShares =. albumShares temp , AlbumSamplePic =. albumSamplePic temp @@ -117,14 +117,14 @@ getAdminAlbumDeleteR albumId = do newAlbumList <- return $ removeItem albumId albumList runDB $ update ownerId [UserAlbums =. newAlbumList] -- delete album content and its comments - mapM (\a -> do + _ <- mapM (\a -> do -- delete files medium <- runDB $ getJust a liftIO $ removeFile (normalise $ L.tail $ mediumPath medium) liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium) -- delete comments commEnts <- runDB $ selectList [CommentOrigin ==. a] [] - mapM (\ent -> runDB $ delete $ entityKey ent) commEnts + _ <- mapM (\ent -> runDB $ delete $ entityKey ent) commEnts -- delete album database entry runDB $ delete a ) (albumContent album) diff --git a/Handler/AdminComments.hs b/Handler/AdminComments.hs index fc61479..144c103 100644 --- a/Handler/AdminComments.hs +++ b/Handler/AdminComments.hs @@ -28,10 +28,10 @@ getAdminCommentDeleteR commentId = do Right _ -> do tempComment <- runDB $ get commentId case tempComment of - Just comment -> do + Just _ -> do -- delete comment children children <- runDB $ selectList [CommentParent ==. (Just commentId)] [] - mapM (\ent -> runDB $ delete $ entityKey ent) children + _ <- mapM (\ent -> runDB $ delete $ entityKey ent) children -- delete comment itself runDB $ delete commentId setMessage "Comment deleted succesfully" diff --git a/Handler/AdminMediumSettings.hs b/Handler/AdminMediumSettings.hs index d42da76..4876ae8 100644 --- a/Handler/AdminMediumSettings.hs +++ b/Handler/AdminMediumSettings.hs @@ -46,7 +46,7 @@ postAdminMediumSettingsR mediumId = do tempMedium <- runDB $ get mediumId case tempMedium of Just medium -> do - ((res, adminMediumSetWidget), enctype) <- runFormPost $ adminMediumSetForm medium + ((res, _), _) <- runFormPost $ adminMediumSetForm medium case res of FormSuccess temp -> do runDB $ update mediumId @@ -94,7 +94,7 @@ getAdminMediumDeleteR mediumId = do runDB $ update albumId [AlbumContent =. newMediaList] -- delete comments commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] [] - mapM (\ent -> runDB $ delete $ entityKey ent) commEnts + _ <- mapM (\ent -> runDB $ delete $ entityKey ent) commEnts -- delete medium runDB $ delete mediumId -- delete files diff --git a/Handler/AdminProfileSettings.hs b/Handler/AdminProfileSettings.hs index 1100fa4..50af191 100644 --- a/Handler/AdminProfileSettings.hs +++ b/Handler/AdminProfileSettings.hs @@ -88,7 +88,7 @@ postAdminProfileSettingsR ownerId = do tempOwner <- runDB $ get ownerId case tempOwner of Just owner -> do - ((result, adminProfileSetWidget), enctype) <- runFormPost $ adminProfileForm owner + ((result, _), _) <- runFormPost $ adminProfileForm owner case result of FormSuccess temp -> do runDB $ update ownerId @@ -129,13 +129,13 @@ getAdminProfileDeleteR ownerId = do case tempOwner of Just owner -> do albumList <- return $ userAlbums owner - mapM (\albumId -> do + _ <- mapM (\albumId -> do album <- runDB $ getJust albumId mediaList <- return $ albumContent album - mapM (\med -> do + _ <- mapM (\med -> do -- delete comments commEnts <- runDB $ selectList [CommentOrigin ==. med] [] - mapM (\ent -> runDB $ delete $ entityKey ent) commEnts + _ <- mapM (\ent -> runDB $ delete $ entityKey ent) commEnts -- delete media files medium <- runDB $ getJust med liftIO $ removeFile (normalise $ L.tail $ mediumPath medium) diff --git a/Handler/AlbumSettings.hs b/Handler/AlbumSettings.hs index 0a34219..8ad3c2d 100644 --- a/Handler/AlbumSettings.hs +++ b/Handler/AlbumSettings.hs @@ -12,8 +12,6 @@ getAlbumSettingsR albumId = do case tempAlbum of Just album -> do ownerId <- return $ albumOwner album - owner <- runDB $ getJust ownerId - ownerName <- return $ userName owner msu <- lookupSession "userId" case msu of Just tempUserId -> do @@ -56,12 +54,12 @@ postAlbumSettingsR albumId = do True -> do entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName] users <- return $ map (\u -> (userName $ entityVal u, entityKey u)) entities - ((result, albumSettingsWidget), enctype) <- runFormPost $ albumSettingsForm album albumId users + ((result, _), _) <- runFormPost $ albumSettingsForm album albumId users case result of FormSuccess temp -> do newShares <- return (L.sort $ albumShares temp) oldShares <- return (L.sort $ albumShares album) - case newShares /= oldShares of + _ <- case newShares /= oldShares of True -> do link <- ($ AlbumR albumId) <$> getUrlRender rcptIds <- return $ L.nub $ newShares L.\\ oldShares @@ -81,7 +79,7 @@ postAlbumSettingsR albumId = do False -> do return [()] -- nothing to do here - aId <- runDB $ update albumId + _ <- runDB $ update albumId [ AlbumTitle =. albumTitle temp , AlbumShares =. newShares , AlbumSamplePic =. albumSamplePic temp @@ -122,8 +120,6 @@ getAlbumDeleteR albumId = do case tempAlbum of Just album -> do ownerId <- return $ albumOwner album - owner <- runDB $ getJust ownerId - ownerName <- return $ userName owner msu <- lookupSession "userId" case msu of Just tempUserId -> do @@ -151,7 +147,6 @@ postAlbumDeleteR albumId = do Just album -> do ownerId <- return $ albumOwner album owner <- runDB $ getJust ownerId - ownerName <- return $ userName owner msu <- lookupSession "userId" case msu of Just tempUserId -> do @@ -167,14 +162,14 @@ postAlbumDeleteR albumId = do newAlbumList <- return $ removeItem albumId albumList runDB $ update ownerId [UserAlbums =. newAlbumList] -- delete album content and its comments - mapM (\a -> do + _ <- mapM (\a -> do -- delete files medium <- runDB $ getJust a liftIO $ removeFile (normalise $ L.tail $ mediumPath medium) liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium) -- delete comments commEnts <- runDB $ selectList [CommentOrigin ==. a] [] - mapM (\ent -> runDB $ delete $ entityKey ent) commEnts + _ <- mapM (\ent -> runDB $ delete $ entityKey ent) commEnts runDB $ delete a ) (albumContent album) -- delete album diff --git a/Handler/Commons.hs b/Handler/Commons.hs index ff1f1bf..6923ddd 100644 --- a/Handler/Commons.hs +++ b/Handler/Commons.hs @@ -44,7 +44,6 @@ mediumCheck mediumId = do case tempMedium of Just medium -> do ownerId <- return $ mediumOwner medium - owner <- runDB $ getJust ownerId msu <- lookupSession "userId" case msu of Just tempUserId -> do diff --git a/Handler/Login.hs b/Handler/Login.hs index efe7e92..26abb99 100644 --- a/Handler/Login.hs +++ b/Handler/Login.hs @@ -2,13 +2,13 @@ module Handler.Login where import Import hiding (returnJson) import qualified Data.Text as T -import Yesod hiding (returnJson) import Crypto.HMAC import Crypto.Hash.CryptoAPI (SHA1) -import qualified Data.ByteString as B -import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Text.Encoding (encodeUtf8) import Data.Serialize (encode) import Data.Maybe +import qualified Data.ByteString as B +import Data.Aeson.Types data Credentials = Credentials { credentialsName :: Text @@ -37,7 +37,7 @@ postLoginR = do Just (Entity userId user) -> do salt <- return $ userSalt user token <- liftIO makeRandomToken - tokenId <- runDB $ insert $ Token (encodeUtf8 token) "login" (Just userId) + _ <- runDB $ insert $ Token (encodeUtf8 token) "login" (Just userId) returnJson ["salt" .= (toHex salt), "token" .= (toHex $ encodeUtf8 token)] Nothing -> returnJsonError ("No such user" :: T.Text) @@ -85,10 +85,13 @@ getLogoutR = do setMessage "Succesfully logged out" redirect $ HomeR +returnJson :: Monad m => [Pair] -> m RepJson returnJson = return . repJson . object +returnJsonError :: (ToJSON a, Monad m) => a -> m RepJson returnJsonError = returnJson . (:[]) . ("error" .=) +hmacSHA1 :: B.ByteString -> B.ByteString -> B.ByteString hmacSHA1 keyData msgData = let key = MacKey keyData sha1 :: SHA1 diff --git a/Handler/Medium.hs b/Handler/Medium.hs index 3133b61..32a07dc 100644 --- a/Handler/Medium.hs +++ b/Handler/Medium.hs @@ -51,10 +51,10 @@ postMediumR mediumId = do userId <- return $ Just $ getUserIdFromText tempUserId u <- runDB $ getJust $ fromJust userId userSl <- return $ Just $ userSlug u - ((res, commentiwdget), enctype) <- runFormPost $ commentForm userId userSl mediumId Nothing + ((res, _), _) <- runFormPost $ commentForm userId userSl mediumId Nothing case res of FormSuccess temp -> do - cId <- runDB $ insert temp + _ <- runDB $ insert temp --send mail to medium owner owner <- runDB $ getJust $ mediumOwner medium link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender @@ -124,10 +124,10 @@ postCommentReplyR commentId = do u <- runDB $ getJust $ fromJust userId userSl <- return $ Just $ userSlug u mediumId <- return $ commentOrigin comment - ((res, commentWidget), enctype) <- runFormPost $ commentForm userId userSl mediumId (Just commentId) + ((res, _), _) <- runFormPost $ commentForm userId userSl mediumId (Just commentId) case res of FormSuccess temp -> do - cId <- runDB $ insert temp + _ <- runDB $ insert temp --send mail to parent author parent <- runDB $ getJust $ fromJust $ commentParent temp parAuth <- runDB $ getJust $ fromJust $ commentAuthor parent @@ -209,7 +209,7 @@ postCommentDeleteR commentId = do Just "confirm" -> do -- delete comment children childEnts <- runDB $ selectList [CommentParent ==. (Just commentId)] [] - mapM (\ent -> runDB $ delete $ entityKey ent) childEnts + _ <- mapM (\ent -> runDB $ delete $ entityKey ent) childEnts -- delete comment itself runDB $ delete commentId -- outro diff --git a/Handler/MediumSettings.hs b/Handler/MediumSettings.hs index b1f2543..4698483 100644 --- a/Handler/MediumSettings.hs +++ b/Handler/MediumSettings.hs @@ -24,10 +24,10 @@ postMediumSettingsR mediumId = do checkRes <- mediumCheck mediumId case checkRes of Right medium -> do - ((result, mediumSettingsWidget), enctype) <- runFormPost $ mediumSettingsForm medium + ((result, _), _) <- runFormPost $ mediumSettingsForm medium case result of FormSuccess temp -> do - mId <- runDB $ update mediumId + _ <- runDB $ update mediumId [ MediumTitle =. mediumTitle temp , MediumDescription =. mediumDescription temp , MediumTags =. mediumTags temp @@ -75,7 +75,7 @@ postMediumDeleteR mediumId = do Just "confirm" -> do -- delete comments commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] [] - mapM (\ent -> runDB $ delete $ entityKey ent) commEnts + _ <- mapM (\ent -> runDB $ delete $ entityKey ent) commEnts -- delete references first albumId <- return $ mediumAlbum medium album <- runDB $ getJust albumId diff --git a/Handler/NewAlbum.hs b/Handler/NewAlbum.hs index ac80338..f3dc601 100644 --- a/Handler/NewAlbum.hs +++ b/Handler/NewAlbum.hs @@ -25,7 +25,7 @@ postNewAlbumR = do case msu of Just tempUserId -> do userId <- return $ getUserIdFromText tempUserId - ((result, albumWidget), enctype) <- runFormPost (albumForm userId) + ((result, _), _) <- runFormPost (albumForm userId) case result of FormSuccess album -> do -- Put album in Database diff --git a/Handler/Profile.hs b/Handler/Profile.hs index 04934d4..52ff349 100644 --- a/Handler/Profile.hs +++ b/Handler/Profile.hs @@ -37,7 +37,7 @@ getUserR :: Text -> Handler Html getUserR ownerName = do tempOwner <- runDB $ selectFirst [UserName ==. ownerName] [] case tempOwner of - Just (Entity ownerId owner) -> + Just (Entity ownerId _) -> getProfileR ownerId Nothing -> do setMessage "This user does not exist" diff --git a/Handler/ProfileDelete.hs b/Handler/ProfileDelete.hs index bc3903e..317c410 100644 --- a/Handler/ProfileDelete.hs +++ b/Handler/ProfileDelete.hs @@ -3,7 +3,6 @@ module Handler.ProfileDelete where import Import import Handler.Commons import qualified Data.Text as T -import Data.Maybe import qualified Data.List as L import System.Directory import System.FilePath @@ -29,12 +28,12 @@ postProfileDeleteR userId = do case confirm of Just "confirm" -> do albumList <- return $ userAlbums user - mapM (\albumId -> do + _ <- mapM (\albumId -> do album <- runDB $ getJust albumId mediaList <- return $ albumContent album - mapM (\med -> do + _ <- mapM (\med -> do commEnts <- runDB $ selectList [CommentOrigin ==. med] [] - mapM (\ent -> runDB $ delete $ entityKey ent) commEnts + _ <- mapM (\ent -> runDB $ delete $ entityKey ent) commEnts medium <- runDB $ getJust med liftIO $ removeFile (normalise $ L.tail $ mediumPath medium) liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium) diff --git a/Handler/ProfileSettings.hs b/Handler/ProfileSettings.hs index db4be5c..0a749ca 100644 --- a/Handler/ProfileSettings.hs +++ b/Handler/ProfileSettings.hs @@ -21,7 +21,7 @@ postProfileSettingsR userId = do checkRes <- profileCheck userId case checkRes of Right user -> do - ((result, profileSettingsWidget), enctype) <- runFormPost $ profileSettingsForm user + ((result, _), _) <- runFormPost $ profileSettingsForm user case result of FormSuccess temp -> do runDB $ update userId [ diff --git a/Handler/Reactivate.hs b/Handler/Reactivate.hs index 0eaab58..5718a07 100644 --- a/Handler/Reactivate.hs +++ b/Handler/Reactivate.hs @@ -13,7 +13,7 @@ getReactivateR = do postReactivateR :: Handler Html postReactivateR = do - ((result, reactivateWidget), enctype) <- runFormPost reactivateForm + ((result, _), _) <- runFormPost reactivateForm case result of FormSuccess temp -> do users <- runDB $ selectList [UserEmail ==. temp] [] @@ -21,10 +21,10 @@ postReactivateR = do True -> do userTokens <- foldM (\userTokens (Entity userId user) -> do token <- liftIO $ generateString - tId <- runDB $ insert $ Token (encodeUtf8 token) "activate" (Just userId) + _ <- runDB $ insert $ Token (encodeUtf8 token) "activate" (Just userId) return $ (user, token) : userTokens ) [] users - sent <- foldM (\sent (user, token) -> + _ <- foldM (\sent (user, token) -> case sent of False -> return False diff --git a/Handler/Signup.hs b/Handler/Signup.hs index c8aeee8..953f5f1 100644 --- a/Handler/Signup.hs +++ b/Handler/Signup.hs @@ -53,8 +53,8 @@ postSignupR = do [] False activatorText <- liftIO generateString - aId <- runDB $ insert $ Activator activatorText newUser - tId <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing + _ <- runDB $ insert $ Activator activatorText newUser + _ <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing activateLink <- ($ ActivateR activatorText) <$> getUrlRender sendMail (userEmail newUser) "Please activate your account!" $ [shamlet| diff --git a/Handler/Tag.hs b/Handler/Tag.hs index e5caee2..9ec8d09 100644 --- a/Handler/Tag.hs +++ b/Handler/Tag.hs @@ -2,7 +2,6 @@ module Handler.Tag where import Import import qualified Data.Text as T -import Data.Maybe getTagR :: Text -> Handler Html getTagR tag = do diff --git a/Handler/Upload.hs b/Handler/Upload.hs index 64aeb6c..d983c64 100644 --- a/Handler/Upload.hs +++ b/Handler/Upload.hs @@ -5,14 +5,8 @@ import Data.Time import Data.Maybe import qualified Data.Text as T import qualified System.FilePath as FP -import qualified Filesystem.Path as FSP import Filesystem.Path.CurrentOS import Graphics.ImageMagick.MagickWand -import Control.Monad.Trans.Resource -import Foreign -import Foreign.C.Types -import Foreign.C.String -import Helper data TempMedium = TempMedium { tempMediumTitle :: Text @@ -44,7 +38,7 @@ postUploadR = do case msu of Just tempUserId -> do userId <- lift $ pure $ getUserIdFromText tempUserId - ((result, uploadWidget), enctype) <- runFormPost (uploadForm userId) + ((result, _), _) <- runFormPost (uploadForm userId) case result of FormSuccess temp -> do fil <- return $ tempMediumFile temp @@ -88,8 +82,6 @@ getDirectUploadR albumId = do case tempAlbum of -- does the requested album exist Just album -> do ownerId <- return $ albumOwner album - owner <- runDB $ getJust ownerId - ownerName <- return $ userName owner msu <- lookupSession "userId" case msu of -- is anybody logged in Just tempUserId -> do @@ -117,8 +109,6 @@ postDirectUploadR albumId = do case tempAlbum of -- does the album exist Just album -> do ownerId <- return $ albumOwner album - owner <- runDB $ getJust ownerId - ownerName <- return $ userName owner msu <- lookupSession "userId" case msu of -- is anybody logged in Just tempUserId -> do @@ -126,7 +116,7 @@ postDirectUploadR albumId = do presence <- return $ (userId == ownerId) || (userId `elem` (albumShares album)) case presence of -- is the logged in user the owner or is the album shared with him True -> do - ((result, dUploadWidget), enctype) <- runFormPost (dUploadForm userId albumId) + ((result, _), _) <- runFormPost (dUploadForm userId albumId) case result of FormSuccess temp -> do fil <- return $ tempMediumFile temp @@ -134,8 +124,8 @@ postDirectUploadR albumId = do case mime `elem` acceptedTypes of True -> do albRef <- runDB $ getJust (tempMediumAlbum temp) - ownerId <- return $ albumOwner albRef - path <- writeOnDrive fil ownerId albumId + refOwnerId <- return $ albumOwner albRef + path <- writeOnDrive fil refOwnerId albumId thumbPath <- generateThumb path ownerId albumId medium <- return $ Medium (tempMediumTitle temp) @@ -182,7 +172,7 @@ generateThumb path userId albumId = do w1 <- getImageWidth w h1 <- getImageHeight w h2 <- return 220 - w2 <- return $ floor (((fromIntegral w1) / (fromIntegral h1)) * (fromIntegral h2)) + w2 <- return $ floor (((fromIntegral w1) / (fromIntegral h1)) * (fromIntegral h2) :: Double) resizeImage w w2 h2 lanczosFilter 1 setImageCompressionQuality w 95 writeImage w (Just (decodeString newPath)) diff --git a/Helper.hs b/Helper.hs index c84c2bc..8da823f 100644 --- a/Helper.hs +++ b/Helper.hs @@ -4,23 +4,16 @@ import Prelude import Yesod.Static import Model import Control.Applicative -import Control.Monad.Trans.Class import Data.Maybe -import Data.Either import Data.List import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Char8 as BC import qualified Data.Text as T import Data.Time import Data.Char import Database.Persist -import Database.Persist.Types -import System.FilePath import System.Random import System.Locale -import Yesod.Persist.Core -import Yesod.Core.Types import Yesod import Numeric (readHex, showHex) import Network.Mail.Mime @@ -77,7 +70,7 @@ tagField = Field False -> return $ Right $ Just $ removeItem "" $ T.splitOn " " x True -> return $ Right $ Nothing _ -> return $ Left $ error "unexpected tag list" - , fieldView = \idAttr nameAttr val eResult isReq -> + , fieldView = \idAttr nameAttr _ eResult _ -> [whamlet||] , fieldEnctype = UrlEncoded } @@ -95,7 +88,7 @@ userField users = Field True -> return $ Left $ error "Invalid username list" True -> return $ Right $ Just $ [] _ -> return $ Left $ error "unexpected username list" - , fieldView = \idAttr nameAttr val eResult isReq -> + , fieldView = \idAttr nameAttr _ eResult _ -> [whamlet||] , fieldEnctype = UrlEncoded } diff --git a/Model.hs b/Model.hs index 88bb917..b4d6d6e 100644 --- a/Model.hs +++ b/Model.hs @@ -2,17 +2,7 @@ module Model where import ClassyPrelude.Yesod import Yesod.Markdown (Markdown) -import Data.Text (Text) import Database.Persist.Quasi -import Database.Persist -import Database.Persist.TH -import Data.Typeable (Typeable) -import Data.Eq (Eq) -import Data.Time (UTCTime) -import Data.ByteString -import Data.Bool -import Data.Int -import Text.Show (Show) import qualified System.FilePath as FP -- You can define all of your database entities in the entities file. diff --git a/Settings/StaticFiles.hs b/Settings/StaticFiles.hs index d21770c..e2f8e26 100644 --- a/Settings/StaticFiles.hs +++ b/Settings/StaticFiles.hs @@ -1,12 +1,7 @@ module Settings.StaticFiles where -import Prelude (IO) -import Yesod.Static (staticFiles) import qualified Yesod.Static as Static import Settings (appStaticDir, compileTimeAppSettings) -import Settings.Development -import Language.Haskell.TH (Q, Exp, Name) -import Data.Default (def) -- | use this to create your static file serving site -- staticSite :: IO Static.Static @@ -17,7 +12,7 @@ import Data.Default (def) -- giving you compile-time verification that referenced files exist. -- Warning: any files added to your static directory during run-time can't be -- accessed this way. You'll have to use their FilePath or URL to access them. -staticFiles (appStaticDir compileTimeAppSettings) +Static.staticFiles (appStaticDir compileTimeAppSettings) -- combineSettings :: CombineSettings -- combineSettings = def diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet index ded6e5b..13c42c4 100644 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -3,7 +3,7 @@