Fix compiler warnings

This commit is contained in:
Chris Done 2014-12-16 12:03:25 +01:00
parent 6ac46c12b7
commit 2499b7b390
5 changed files with 12 additions and 22 deletions

View File

@ -314,7 +314,7 @@ getUploadDocMapR = do
<*> areq textField "Stackage ID" { fsName = Just "snapshot" } Nothing
case res of
FormSuccess (fi, snapshot) -> do
Entity sid stackage <-
Entity _sid stackage <-
runDB $ getBy404 $ UniqueStackage $ PackageSetIdent snapshot
bs <- fileSource fi $$ foldC
case Y.decodeEither bs of

View File

@ -10,7 +10,7 @@ import Data.Tag
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import Data.Time (addUTCTime)
import Database.Esqueleto ((^.), (&&.), Value (Value))
import qualified Database.Esqueleto as E
import qualified Database.Persist as P
@ -22,21 +22,19 @@ import Text.Email.Validate
-- | Page metadata package.
getPackageR :: PackageName -> Handler Html
getPackageR pn = do
let maxSnaps = 10
haddocksLink ident version =
let haddocksLink ident version =
HaddockR ident [concat [toPathPiece pn, "-", toPathPiece version]]
muid <- maybeAuthId
(mnightly, mlts, downloads, recentDownloads, nLikes, liked,
(mnightly, mlts, nLikes, liked,
Entity _ metadata, revdeps', mdocs) <- runDB $ do
mnightly <- getNightly pn
mlts <- getLts pn
nLikes <- count [LikePackage ==. pn]
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'
recentDownloads <- count [DownloadPackage ==. pn, DownloadTimestamp >=. nowMinus30]
metadata <- getBy404 (UniqueMetadata pn)
revdeps' <- reverseDeps pn
mdocsent <- selectFirst [DocsName ==. pn] [Desc DocsUploaded]
@ -46,8 +44,6 @@ getPackageR pn = do
selectList [ModuleDocs ==. docsid] [Asc ModuleName])
return ( mnightly
, mlts
, downloads
, recentDownloads
, nLikes
, liked
, metadata
@ -56,7 +52,7 @@ getPackageR pn = do
)
myTags <- maybe (return []) (runDB . user'sTagsOf pn) muid
tags <- fmap (map (\(v,count) -> (v,count,any (==v) myTags)))
tags <- fmap (map (\(v,count') -> (v,count',any (==v) myTags)))
(runDB (packageTags pn))
let likeTitle = if liked
@ -81,8 +77,6 @@ getPackageR pn = do
])
$(widgetFile "package")
where enumerate = zip [0::Int ..]
reformat (Value version, Value title, Value ident, Value hasHaddocks) =
(version,fromMaybe title (stripPrefix "Stackage build for " title),ident,hasHaddocks)
-- | Get tags of the given package.
packageTags :: PackageName -> YesodDB App [(Slug,Int)]
@ -292,7 +286,6 @@ getPackageSnapshotsR :: PackageName -> Handler Html
getPackageSnapshotsR pn =
do let haddocksLink ident version =
HaddockR ident [concat [toPathPiece pn, "-", toPathPiece version]]
muid <- maybeAuthId
snapshots <- (runDB .
fmap (map reformat) .
E.select . E.from)

View File

@ -9,11 +9,9 @@ import Handler.PackageList (cachedWidget)
getStackageHomeR :: SnapSlug -> Handler Html
getStackageHomeR slug = do
muid <- maybeAuthId
stackage <- runDB $ do
Entity _ stackage <- getBy404 $ UniqueSnapshot slug
return stackage
let isOwner = muid == Just (stackageUser stackage)
hasBundle <- storeExists $ SnapshotBundle $ stackageIdent stackage
let minclusive =
@ -63,7 +61,6 @@ getStackageHomeR slug = do
| otherwise = Just v
$(widgetFile "stackage-home")
where strip x = fromMaybe x (stripSuffix "." x)
mback = Just (SnapshotR slug StackageHomeR, "Return to snapshot")
getStackageMetadataR :: SnapSlug -> Handler TypedContent
getStackageMetadataR slug = do

View File

@ -21,14 +21,14 @@ getStackageBundleR :: SnapSlug -> Handler TypedContent
getStackageBundleR slug = do
Entity _ stackage <- runDB $ getBy404 $ UniqueSnapshot slug
let ident = stackageIdent stackage
slug = stackageSlug stackage
slug' = stackageSlug stackage
msrc <- storeRead $ SnapshotBundle ident
case msrc of
Nothing -> notFound
Just src -> do
addHeader "content-disposition" $ mconcat
[ "attachment; filename=\"bundle-"
, toPathPiece slug
, toPathPiece slug'
, ".tar.gz\""
]
respondSource "application/x-gzip" $ mapOutput (Chunk . toBuilder) src

View File

@ -13,7 +13,7 @@ $newline never
<a href="#{url}">
#{url}
$maybe (ltsMajor,ltsMinor,pkgVersion,ltsSlug) <- mlts
$maybe (_ltsMajor,_ltsMinor,pkgVersion,ltsSlug) <- mlts
<a href=@{SnapshotR ltsSlug StackageHomeR}>LTS Haskell
\ (
<a href=@{haddocksLink ltsSlug pkgVersion}>
@ -22,7 +22,7 @@ $newline never
$maybe _ <- mnightly
, #
$maybe (nightlyDay,ghcVersion,pkgVersion,nightlySlug) <- mnightly
$maybe (_nightlyDay,ghcVersion,pkgVersion,nightlySlug) <- mnightly
<a href=@{SnapshotR nightlySlug StackageHomeR}>Stackage Nightly GHC #{ghcVersion}
\ (
<a href=@{haddocksLink nightlySlug pkgVersion}>