Clean up warnings

This commit is contained in:
Michael Snoyman 2014-11-19 11:08:45 +02:00
parent 01b86d368c
commit fe4cda60f8
9 changed files with 13 additions and 25 deletions

View File

@ -9,12 +9,8 @@ module Application
import qualified Aws
import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (catch)
import Control.Monad.Logger (runLoggingT, LoggingT, runStdoutLoggingT, defaultLogStr, LogLevel (LevelDebug))
import Control.Monad.Reader (MonadReader (..))
import Control.Monad.Reader (runReaderT, ReaderT)
import Control.Monad.Trans.Control
import Control.Monad.Logger (runLoggingT, LoggingT, defaultLogStr)
import Data.BlobStore (fileStore, storeWrite, cachedS3Store)
import Data.Conduit.Lazy (MonadActive, monadActive)
import Data.Hackage
import Data.Hackage.Views
import Data.Time (diffUTCTime)

View File

@ -11,9 +11,7 @@ module Data.BlobStore
) where
import ClassyPrelude.Yesod
import Control.Exception.Lifted (bracketOnError)
import qualified Filesystem as F
import Control.Monad.Reader (MonadReader, ask)
import Control.Monad.Trans.Resource (release)
import qualified Aws
import Aws.S3 as Aws

View File

@ -14,13 +14,11 @@ import Types
import Data.BlobStore
import Data.Conduit.Lazy (MonadActive (..), lazyConsume)
import qualified Codec.Archive.Tar as Tar
import Control.Monad.Reader (MonadReader, ask, runReaderT)
import Control.Monad.Logger (runNoLoggingT)
import qualified Data.Text as T
import Data.Conduit.Zlib (ungzip, gzip)
import System.IO.Temp (withSystemTempFile, withSystemTempDirectory)
import System.IO (IOMode (ReadMode), openBinaryFile)
import Control.Monad.Catch (MonadMask)
import Model (Uploaded (Uploaded), Metadata (..))
import Filesystem (createTree)
import Distribution.PackageDescription.Parse (parsePackageDescription, ParseResult (ParseOk))

View File

@ -13,7 +13,6 @@ module Data.Slug
import ClassyPrelude.Yesod
import Database.Persist.Sql (PersistFieldSql (sqlType))
import qualified System.Random.MWC as MWC
import Control.Monad.Reader (MonadReader, ask)
import GHC.Prim (RealWorld)
import Text.Blaze (ToMarkup)
@ -32,9 +31,9 @@ mkSlug t
where
mkSlugLen :: MonadThrow m => Int -> Int -> Text -> m Slug
mkSlugLen minLen maxLen t
| length t < minLen = throwM $ InvalidSlugException t "Too short"
| length t > maxLen = throwM $ InvalidSlugException t "Too long"
mkSlugLen minLen' maxLen' t
| length t < minLen' = throwM $ InvalidSlugException t "Too short"
| length t > maxLen' = throwM $ InvalidSlugException t "Too long"
| any (not . validChar) t = throwM $ InvalidSlugException t "Contains invalid characters"
| "-" `isPrefixOf` t = throwM $ InvalidSlugException t "Must not start with a hyphen"
| otherwise = return $ Slug t

View File

@ -112,7 +112,7 @@ instance Yesod App where
mcurr <- getCurrentRoute
let notHome = mcurr /= Just HomeR
giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
-- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticRoot setting in Settings.hs

View File

@ -20,8 +20,6 @@ import Text.Email.Validate
getPackageR :: PackageName -> Handler Html
getPackageR pn = do
let maxSnaps = 10
asInt :: Int -> Int
asInt = id
haddocksLink ident version =
HaddockR ident [concat [toPathPiece pn, "-", toPathPiece version]]
muid <- maybeAuthId
@ -38,8 +36,8 @@ getPackageR pn = do
let getLiked uid = (>0) <$> count [LikePackage ==. pn, LikeVoter ==. uid]
liked <- maybe (return False) getLiked muid
downloads <- count [DownloadPackage ==. pn]
now <- liftIO getCurrentTime
let nowMinus30 = addUTCTime (-30 * 24 * 60 * 60) now
now' <- liftIO getCurrentTime
let nowMinus30 = addUTCTime (-30 * 24 * 60 * 60) now'
recentDownloads <- count [DownloadPackage ==. pn, DownloadTimestamp >=. nowMinus30]
metadata <- getBy404 (UniqueMetadata pn)

View File

@ -17,8 +17,8 @@ import Import
-- inclined, or create a single monolithic file.
getAllSnapshotsR :: Handler Html
getAllSnapshotsR = do
now <- liftIO getCurrentTime
groups <- fmap (groupBy (on (==) (\(_,_,uploaded,_,_) -> uploaded)) . map (uncrapify now)) $
now' <- liftIO getCurrentTime
groups <- fmap (groupBy (on (==) (\(_,_,uploaded,_,_) -> uploaded)) . map (uncrapify now')) $
runDB $ E.select $ E.from $ \(stackage `E.InnerJoin` user) -> do
E.on (stackage E.^. StackageUser E.==. user E.^. UserId)
E.orderBy [E.desc $ stackage E.^. StackageUploaded]
@ -32,6 +32,6 @@ getAllSnapshotsR = do
defaultLayout $ do
setTitle "Stackage Server"
$(widgetFile "all-snapshots")
where uncrapify now c =
let (E.Value ident, E.Value title, E.Value uploaded, E.Value display, E.Value handle) = c
in (ident,title,format (diff True) (diffUTCTime uploaded now),display,handle)
where uncrapify now' c =
let (E.Value ident, E.Value title, E.Value uploaded, E.Value display, E.Value handle') = c
in (ident,title,format (diff True) (diffUTCTime uploaded now'),display,handle')

View File

@ -2,7 +2,6 @@ module Handler.StackageIndex where
import Import
import Data.BlobStore
import Network.Wai (responseBuilder)
getStackageIndexR :: PackageSetIdent -> Handler TypedContent
getStackageIndexR ident = do

View File

@ -5,7 +5,7 @@
<h3>
#{uploaded}
<ul .snapshots>
$forall (ident, title, uploaded, display, handle) <- stackages
$forall (ident, title, _uploaded, display, handle) <- stackages
<li>
<strong>
<a href=@{StackageHomeR ident}>