mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-11 19:58:28 +01:00
Fix compiler warnings
This commit is contained in:
parent
6ac46c12b7
commit
2499b7b390
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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}>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user