mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-12 04:08:29 +01:00
Package pages
This commit is contained in:
parent
deac45e202
commit
d77b87b6c2
@ -9,6 +9,7 @@ module Handler.Package
|
||||
, postPackageUnlikeR
|
||||
, postPackageTagR
|
||||
, postPackageUntagR
|
||||
, packagePage
|
||||
) where
|
||||
|
||||
import Data.Char
|
||||
@ -25,79 +26,65 @@ import Formatting
|
||||
import Import
|
||||
import qualified Text.Blaze.Html.Renderer.Text as LT
|
||||
import Text.Email.Validate
|
||||
import Stackage.Database
|
||||
|
||||
-- | Page metadata package.
|
||||
getPackageR :: PackageName -> Handler Html
|
||||
getPackageR pn =
|
||||
error "getPackageR"
|
||||
{-
|
||||
packagePage pn Nothing (selectFirst [DocsName ==. pn] [Desc DocsUploaded])
|
||||
getPackageR = packagePage Nothing
|
||||
|
||||
packagePage :: PackageName
|
||||
-> Maybe Version
|
||||
-> YesodDB App (Maybe (Entity Docs))
|
||||
packagePage :: Maybe (SnapName, Version)
|
||||
-> PackageName
|
||||
-> Handler Html
|
||||
packagePage pn mversion getDocs = do
|
||||
let haddocksLink ident version =
|
||||
HaddockR ident [concat [toPathPiece pn, "-", toPathPiece version]]
|
||||
packagePage mversion pname = do
|
||||
let pname' = toPathPiece pname
|
||||
(deprecated, inFavourOf) <- getDeprecated pname'
|
||||
latests <- getLatests pname'
|
||||
render <- getUrlRender
|
||||
muid <- maybeAuthId
|
||||
(mnightly, mlts, nLikes, liked,
|
||||
Entity _ metadata, revdeps', mdocs, deprecated, inFavourOf) <- runDB $ do
|
||||
mnightly <- getNightly pn
|
||||
mlts <- getLts pn
|
||||
nLikes <- count [LikePackage ==. pn]
|
||||
let getLiked uid = (>0) <$> count [LikePackage ==. pn, LikeVoter ==. uid]
|
||||
(nLikes, liked) <- runDB $ do
|
||||
nLikes <- count [LikePackage ==. pname]
|
||||
let getLiked uid = (>0) <$> count [LikePackage ==. pname, LikeVoter ==. uid]
|
||||
liked <- maybe (return False) getLiked muid
|
||||
|
||||
|
||||
|
||||
metadata <- getBy404 (UniqueMetadata pn)
|
||||
revdeps' <- reverseDeps pn
|
||||
mdocsent <- getDocs
|
||||
mdocs <- forM mdocsent $ \(Entity docsid (Docs _ version _ _)) -> (,)
|
||||
<$> pure version
|
||||
<*> (map entityVal <$>
|
||||
selectList [ModuleDocs ==. docsid] [Asc ModuleName])
|
||||
deprecated <- getDeprecated pn
|
||||
inFavourOf <- getInFavourOf pn
|
||||
return ( mnightly
|
||||
, mlts
|
||||
, nLikes
|
||||
, liked
|
||||
, metadata
|
||||
, revdeps'
|
||||
, mdocs
|
||||
, deprecated
|
||||
, inFavourOf
|
||||
)
|
||||
return (nLikes, liked)
|
||||
deps' <- getDeps pname'
|
||||
revdeps' <- getRevDeps pname'
|
||||
Entity _ package <- getPackage pname' >>= maybe notFound return
|
||||
let mdocs :: Maybe (SnapName, Text, [Text])
|
||||
mdocs = Nothing
|
||||
{-
|
||||
mdocs <- error "mdocs"
|
||||
-}
|
||||
|
||||
let ixInFavourOf = zip [0::Int ..] inFavourOf
|
||||
displayedVersion = fromMaybe (metadataVersion metadata) mversion
|
||||
displayedVersion = maybe (packageLatest package) (toPathPiece . snd) mversion
|
||||
|
||||
myTags <- maybe (return []) (runDB . user'sTagsOf pn) muid
|
||||
myTags <- maybe (return []) (runDB . user'sTagsOf pname) muid
|
||||
tags <- fmap (map (\(v,count') -> (v,count',any (==v) myTags)))
|
||||
(runDB (packageTags pn))
|
||||
(runDB (packageTags pname))
|
||||
|
||||
let likeTitle = if liked
|
||||
then "You liked this!"
|
||||
else "I like this!" :: Text
|
||||
|
||||
let homepage = case T.strip (metadataHomepage metadata) of
|
||||
let homepage = case T.strip (packageHomepage package) of
|
||||
x | null x -> Nothing
|
||||
| otherwise -> Just x
|
||||
synopsis = metadataSynopsis metadata
|
||||
deps = enumerate (metadataDeps metadata)
|
||||
synopsis = packageSynopsis package
|
||||
deps = enumerate deps'
|
||||
revdeps = enumerate revdeps'
|
||||
authors = enumerate (parseIdentitiesLiberally (metadataAuthor metadata))
|
||||
maintainers = let ms = enumerate (parseIdentitiesLiberally (metadataMaintainer metadata))
|
||||
authors = enumerate (parseIdentitiesLiberally (packageAuthor package))
|
||||
maintainers = let ms = enumerate (parseIdentitiesLiberally (packageMaintainer package))
|
||||
in if ms == authors
|
||||
then []
|
||||
else ms
|
||||
defaultLayout $ do
|
||||
setTitle $ toHtml pn
|
||||
setTitle $ toHtml pname
|
||||
$(combineStylesheets 'StaticR
|
||||
[ css_font_awesome_min_css
|
||||
])
|
||||
let pn = pname
|
||||
toPkgVer x y = concat [x, "-", y]
|
||||
$(widgetFile "package")
|
||||
where enumerate = zip [0::Int ..]
|
||||
|
||||
@ -127,60 +114,6 @@ user'sTagsOf pn uid =
|
||||
E.orderBy [E.asc (t ^. TagTag)]
|
||||
return (t ^. TagTag))))
|
||||
|
||||
-- | Get reverse dependencies of a package.
|
||||
reverseDeps :: PackageName -> YesodDB App [PackageName]
|
||||
reverseDeps pn = fmap (map boilerplate) $ E.select $ E.from $ \dep -> do
|
||||
E.where_ $ dep ^. DependencyDep E.==. E.val pn
|
||||
E.orderBy [E.asc $ dep ^. DependencyUser]
|
||||
return $ dep ^. DependencyUser
|
||||
where boilerplate (E.Value e) = e
|
||||
|
||||
-- | Get the latest nightly snapshot for the given package.
|
||||
getNightly :: PackageName -> YesodDB App (Maybe (Day, Text, Version, SnapSlug))
|
||||
getNightly pn =
|
||||
fmap (fmap boilerplate . listToMaybe)
|
||||
(E.select (E.from query))
|
||||
where boilerplate (E.Value a,E.Value b,E.Value c,E.Value d) =
|
||||
(a,b,c,d)
|
||||
query (p,n,s) =
|
||||
do E.where_ ((p ^. PackageName' E.==. E.val pn) E.&&.
|
||||
(p ^. PackageStackage E.==. n ^. NightlyStackage) E.&&.
|
||||
(s ^. StackageId E.==. n ^. NightlyStackage))
|
||||
E.orderBy [E.desc (n ^. NightlyDay)]
|
||||
return (n ^. NightlyDay
|
||||
,n ^. NightlyGhcVersion
|
||||
,p ^. PackageVersion
|
||||
,s ^. StackageSlug)
|
||||
|
||||
-- | Get the latest LTS snapshot for the given package.
|
||||
getLts :: PackageName -> YesodDB App (Maybe (Int,Int,Version,SnapSlug))
|
||||
getLts pn =
|
||||
fmap (fmap boilerplate . listToMaybe)
|
||||
(E.select (E.from query))
|
||||
where boilerplate (E.Value a,Value b,Value c,Value d) =
|
||||
(a,b,c,d)
|
||||
query (p,n,s) =
|
||||
do E.where_ ((p ^. PackageName' E.==. E.val pn) E.&&.
|
||||
(p ^. PackageStackage E.==. n ^. LtsStackage) E.&&.
|
||||
(s ^. StackageId E.==. n ^. LtsStackage))
|
||||
E.orderBy [E.desc (n ^. LtsMajor),E.desc (n ^. LtsMinor)]
|
||||
return (n ^. LtsMajor
|
||||
,n ^. LtsMinor
|
||||
,p ^. PackageVersion
|
||||
,s ^. StackageSlug)
|
||||
|
||||
getDeprecated :: PackageName -> YesodDB App Bool
|
||||
getDeprecated pn = fmap ((>0) . length) $ E.select $ E.from $ \d -> do
|
||||
E.where_ $ d ^. DeprecatedPackage E.==. E.val pn
|
||||
return ()
|
||||
|
||||
getInFavourOf :: PackageName -> YesodDB App [PackageName]
|
||||
getInFavourOf pn = fmap unBoilerplate $ E.select $ E.from $ \s -> do
|
||||
E.where_ $ s ^. SuggestedInsteadOf E.==. E.val pn
|
||||
return (s ^. SuggestedPackage)
|
||||
where
|
||||
unBoilerplate = map (\(E.Value p) -> p)
|
||||
|
||||
-- | An identifier specified in a package. Because this field has
|
||||
-- quite liberal requirements, we often encounter various forms. A
|
||||
-- name, a name and email, just an email, or maybe nothing at all.
|
||||
@ -275,7 +208,6 @@ renderEmail = T.decodeUtf8 . toByteString
|
||||
-- | Format a number with commas nicely.
|
||||
formatNum :: Int -> Text
|
||||
formatNum = sformat commas
|
||||
-}
|
||||
|
||||
postPackageLikeR :: PackageName -> Handler ()
|
||||
postPackageLikeR packageName = maybeAuthId >>= \muid -> case muid of
|
||||
|
||||
@ -113,12 +113,7 @@ getDocsR name = do
|
||||
Entity sid snapshot <- lookupSnapshot name >>= maybe notFound return
|
||||
mlis <- getSnapshotModules sid
|
||||
render <- getUrlRender
|
||||
let mliUrl mli = render $ HaddockR name
|
||||
[ mliPackageVersion mli
|
||||
, omap toDash (mliName mli) ++ ".html"
|
||||
]
|
||||
toDash '.' = '-'
|
||||
toDash c = c
|
||||
let mliUrl mli = render $ haddockUrl name (mliPackageVersion mli) (mliName mli)
|
||||
defaultLayout $ do
|
||||
setTitle $ toHtml $ "Module list for " ++ toPathPiece name
|
||||
$(widgetFile "doc-list")
|
||||
|
||||
@ -5,56 +5,28 @@ module Handler.StackageSdist
|
||||
import Import
|
||||
import Data.BlobStore
|
||||
import Stackage.Database
|
||||
import Handler.Package (packagePage)
|
||||
|
||||
getStackageSdistR :: SnapName -> PackageNameVersion -> Handler TypedContent
|
||||
getStackageSdistR slug (PNVTarball name version) = do
|
||||
error "getStackageSdistR"
|
||||
{-
|
||||
Entity _ stackage <- runDB $ getBy404 $ UniqueSnapshot slug
|
||||
let ident = stackageIdent stackage
|
||||
msrc1 <- storeRead (CustomSdist ident name version)
|
||||
msrc <-
|
||||
case msrc1 of
|
||||
Just src -> return $ Just src
|
||||
Nothing -> sourceHackageSdist name version
|
||||
case msrc of
|
||||
Nothing -> notFound
|
||||
Just src -> do
|
||||
addHeader "content-disposition" $ concat
|
||||
[ "attachment; filename=\""
|
||||
, toPathPiece name
|
||||
, "-"
|
||||
, toPathPiece version
|
||||
, ".tar.gz"
|
||||
]
|
||||
respondSource "application/x-gzip" $ mapOutput (Chunk . toBuilder) src
|
||||
getStackageSdistR slug (PNVName name) = runDB $ do
|
||||
Entity sid _ <- getBy404 $ UniqueSnapshot slug
|
||||
mp <- selectFirst
|
||||
[PackageStackage ==. sid, PackageName' ==. name]
|
||||
[Desc PackageVersion]
|
||||
case mp of
|
||||
Nothing -> notFound
|
||||
Just (Entity _ Package {..}) ->
|
||||
redirect $ SnapshotR slug
|
||||
$ StackageSdistR
|
||||
$ PNVNameVersion name packageVersion
|
||||
{- FIXME
|
||||
getStackageSdistR slug (PNVNameVersion name version) = packagePage
|
||||
name (Just version)
|
||||
(do
|
||||
Entity sid _ <- getBy404 $ UniqueSnapshot slug
|
||||
let loop [] = return Nothing
|
||||
loop (x:xs) = do
|
||||
mdocs <- selectFirst x []
|
||||
case mdocs of
|
||||
Nothing -> loop xs
|
||||
Just _ -> return mdocs
|
||||
loop
|
||||
[ [DocsName ==. name, DocsVersion ==. version, DocsSnapshot ==. Just sid]
|
||||
, [DocsName ==. name, DocsVersion ==. version]
|
||||
, [DocsName ==. name]
|
||||
getStackageSdistR _ (PNVTarball name version) = do
|
||||
redirect $ concat
|
||||
-- unfortunately using insecure HTTP for cabal's sake
|
||||
[ "http://hackage.fpcomplete.com/package/"
|
||||
, toPathPiece name
|
||||
, "-"
|
||||
, toPathPiece version
|
||||
, ".tar.gz"
|
||||
]
|
||||
) >>= sendResponse
|
||||
-}
|
||||
-}
|
||||
getStackageSdistR sname (PNVName pname) = do
|
||||
version <- versionHelper sname pname
|
||||
redirect $ SnapshotR sname $ StackageSdistR $ PNVNameVersion pname version
|
||||
getStackageSdistR sname (PNVNameVersion pname version) = do
|
||||
version' <- versionHelper sname pname
|
||||
if version == version'
|
||||
then packagePage (Just (sname, version)) pname >>= sendResponse
|
||||
else redirect $ SnapshotR sname $ StackageSdistR $ PNVNameVersion pname version'
|
||||
|
||||
versionHelper sname pname = do
|
||||
Entity sid _ <- lookupSnapshot sname >>= maybe notFound return
|
||||
Entity _ sp <- lookupSnapshotPackage sid (toPathPiece pname) >>= maybe notFound return
|
||||
maybe notFound return $ fromPathPiece $ snapshotPackageVersion sp
|
||||
|
||||
13
Import.hs
13
Import.hs
@ -13,6 +13,7 @@ import Yesod.Auth as Import
|
||||
import Data.Slug (mkSlug)
|
||||
import Data.WebsiteContent as Import (WebsiteContent (..))
|
||||
import Data.Text.Read (decimal)
|
||||
import Stackage.Database (SnapName)
|
||||
|
||||
requireAuthIdOrToken :: Handler UserId
|
||||
requireAuthIdOrToken = do
|
||||
@ -34,3 +35,15 @@ parseLtsPair t1 = do
|
||||
t3 <- stripPrefix "." t2
|
||||
(y, "") <- either (const Nothing) Just $ decimal t3
|
||||
Just (x, y)
|
||||
|
||||
haddockUrl :: SnapName
|
||||
-> Text -- ^ package-version
|
||||
-> Text -- ^ module name
|
||||
-> Route App
|
||||
haddockUrl sname pkgver name = HaddockR sname
|
||||
[ pkgver
|
||||
, omap toDash name ++ ".html"
|
||||
]
|
||||
where
|
||||
toDash '.' = '-'
|
||||
toDash c = c
|
||||
|
||||
@ -14,6 +14,16 @@ module Stackage.Database
|
||||
, openStackageDatabase
|
||||
, ModuleListingInfo (..)
|
||||
, getSnapshotModules
|
||||
, SnapshotPackage (..)
|
||||
, lookupSnapshotPackage
|
||||
, getDeprecated
|
||||
, LatestInfo (..)
|
||||
, getLatests
|
||||
, getDeps
|
||||
, getRevDeps
|
||||
, Package (..)
|
||||
, getPackage
|
||||
, prettyName
|
||||
) where
|
||||
|
||||
import Web.PathPieces (toPathPiece)
|
||||
@ -65,6 +75,10 @@ Package
|
||||
name Text
|
||||
latest Text
|
||||
synopsis Text
|
||||
homepage Text
|
||||
author Text
|
||||
maintainer Text
|
||||
licenseName Text
|
||||
description Html
|
||||
changelog Html
|
||||
UniquePackage name
|
||||
@ -80,12 +94,13 @@ Module
|
||||
UniqueModule package name
|
||||
Dep
|
||||
user PackageId
|
||||
usedBy PackageId
|
||||
uses Text -- avoid circular dependency issue when loading database
|
||||
range Text
|
||||
UniqueDep user usedBy
|
||||
UniqueDep user uses
|
||||
Deprecated
|
||||
package PackageId
|
||||
inFavorOf [PackageId]
|
||||
UniqueDeprecated package
|
||||
|]
|
||||
|
||||
newtype StackageDatabase = StackageDatabase ConnectionPool
|
||||
@ -158,12 +173,12 @@ createStackageDatabase fp = liftIO $ do
|
||||
runResourceT $ do
|
||||
flip runSqlPool pool $ sourcePackages root $$ getZipSink
|
||||
( ZipSink (mapM_C addPackage)
|
||||
*> ZipSink (foldlC getDeprecated [] >>= lift . mapM_ addDeprecated)
|
||||
*> ZipSink (foldlC getDeprecated' [] >>= lift . mapM_ addDeprecated)
|
||||
)
|
||||
sourceBuildPlans root $$ mapM_C (flip runSqlPool pool . addPlan)
|
||||
|
||||
getDeprecated :: [Deprecation] -> Tar.Entry -> [Deprecation]
|
||||
getDeprecated orig e =
|
||||
getDeprecated' :: [Deprecation] -> Tar.Entry -> [Deprecation]
|
||||
getDeprecated' orig e =
|
||||
case (Tar.entryPath e, Tar.entryContent e) of
|
||||
("deprecated.yaml", Tar.NormalFile lbs _) ->
|
||||
case decode $ toStrict lbs of
|
||||
@ -187,18 +202,31 @@ getPackageId x = do
|
||||
, packageSynopsis = "Metadata not found"
|
||||
, packageDescription = "Metadata not found"
|
||||
, packageChangelog = mempty
|
||||
, packageAuthor = ""
|
||||
, packageMaintainer = ""
|
||||
, packageHomepage = ""
|
||||
, packageLicenseName = ""
|
||||
}
|
||||
|
||||
addPackage :: Tar.Entry -> SqlPersistT (ResourceT IO) ()
|
||||
addPackage e =
|
||||
case ("packages/" `isPrefixOf` fp && takeExtension fp == ".yaml", Tar.entryContent e) of
|
||||
(True, Tar.NormalFile lbs _) | Just pi <- decode $ toStrict lbs ->
|
||||
insert_ Package
|
||||
(True, Tar.NormalFile lbs _) | Just pi <- decode $ toStrict lbs -> do
|
||||
pid <- insert Package
|
||||
{ packageName = pack base
|
||||
, packageLatest = display $ piLatest pi
|
||||
, packageSynopsis = piSynopsis pi
|
||||
, packageDescription = renderContent (piDescription pi) (piDescriptionType pi)
|
||||
, packageChangelog = renderContent (piChangeLog pi) (piChangeLogType pi)
|
||||
, packageAuthor = "FIXME author"
|
||||
, packageMaintainer = "FIXME maintainer"
|
||||
, packageHomepage = "FIXME homepage"
|
||||
, packageLicenseName = "FIXME license name"
|
||||
}
|
||||
forM_ (mapToList $ piBasicDeps pi) $ \(uses, range) -> insert_ Dep
|
||||
{ depUser = pid
|
||||
, depUses = display uses
|
||||
, depRange = display range
|
||||
}
|
||||
_ -> return ()
|
||||
where
|
||||
@ -293,11 +321,14 @@ lookupSnapshot :: GetStackageDatabase m => SnapName -> m (Maybe (Entity Snapshot
|
||||
lookupSnapshot name = run $ getBy $ UniqueSnapshot name
|
||||
|
||||
snapshotTitle :: Snapshot -> Text
|
||||
snapshotTitle s =
|
||||
concat [base, " - GHC ", snapshotGhc s]
|
||||
snapshotTitle s = prettyName (snapshotName s) (snapshotGhc s)
|
||||
|
||||
prettyName :: SnapName -> Text -> Text
|
||||
prettyName name ghc =
|
||||
concat [base, " - GHC ", ghc]
|
||||
where
|
||||
base =
|
||||
case snapshotName s of
|
||||
case name of
|
||||
SNLts x y -> concat ["LTS Haskell ", tshow x, ".", tshow y]
|
||||
SNNightly d -> "Stackage Nightly " ++ tshow d
|
||||
|
||||
@ -358,3 +389,91 @@ getSnapshotModules sid = liftM (map toMLI) $ run $ do
|
||||
{ mliName = name
|
||||
, mliPackageVersion = concat [pkg, "-", version]
|
||||
}
|
||||
|
||||
lookupSnapshotPackage
|
||||
:: GetStackageDatabase m
|
||||
=> SnapshotId
|
||||
-> Text
|
||||
-> m (Maybe (Entity SnapshotPackage))
|
||||
lookupSnapshotPackage sid pname = run $ do
|
||||
mp <- getBy $ UniquePackage pname
|
||||
case mp of
|
||||
Nothing -> return Nothing
|
||||
Just (Entity pid _) -> getBy $ UniqueSnapshotPackage sid pid
|
||||
|
||||
getDeprecated :: GetStackageDatabase m => Text -> m (Bool, [Text])
|
||||
getDeprecated name = run $ do
|
||||
pids <- selectKeysList [PackageName ==. name] []
|
||||
case pids of
|
||||
[pid] -> do
|
||||
mdep <- getBy $ UniqueDeprecated pid
|
||||
case mdep of
|
||||
Nothing -> return defRes
|
||||
Just (Entity _ (Deprecated _ favors)) -> do
|
||||
names <- mapM getName favors
|
||||
return (True, catMaybes names)
|
||||
_ -> return defRes
|
||||
where
|
||||
defRes = (False, [])
|
||||
|
||||
getName = fmap (fmap packageName) . get
|
||||
|
||||
data LatestInfo = LatestInfo
|
||||
{ liSnapName :: !SnapName
|
||||
, liVersion :: !Text
|
||||
, liGhc :: !Text
|
||||
}
|
||||
deriving Show
|
||||
|
||||
getLatests :: GetStackageDatabase m
|
||||
=> Text -- ^ package name
|
||||
-> m [LatestInfo]
|
||||
getLatests pname = run $ do
|
||||
mnightly <- latestHelper pname $ \s ln -> s E.^. SnapshotId E.==. ln E.^. NightlySnap
|
||||
mlts <- latestHelper pname $ \s ln -> s E.^. SnapshotId E.==. ln E.^. LtsSnap
|
||||
return $ concat [mnightly, mlts]
|
||||
|
||||
latestHelper pname clause = fmap (fmap toLatest) $ E.select $ E.from $ \(s,ln,p,sp) -> do
|
||||
E.where_ $
|
||||
clause s ln E.&&.
|
||||
(s E.^. SnapshotId E.==. sp E.^. SnapshotPackageSnapshot) E.&&.
|
||||
(p E.^. PackageName E.==. E.val pname) E.&&.
|
||||
(p E.^. PackageId E.==. sp E.^. SnapshotPackagePackage)
|
||||
E.orderBy [E.desc $ s E.^. SnapshotCreated]
|
||||
E.limit 1
|
||||
return
|
||||
( s E.^. SnapshotName
|
||||
, s E.^. SnapshotGhc
|
||||
, sp E.^. SnapshotPackageVersion
|
||||
)
|
||||
where
|
||||
toLatest (E.Value sname, E.Value ghc, E.Value version) = LatestInfo
|
||||
{ liSnapName = sname
|
||||
, liVersion = version
|
||||
, liGhc = ghc
|
||||
}
|
||||
|
||||
getDeps :: GetStackageDatabase m => Text -> m [(Text, Text)]
|
||||
getDeps pname = run $ do
|
||||
Just (Entity pid _) <- getBy $ UniquePackage pname
|
||||
fmap (map toPair) $ E.select $ E.from $ \d -> do
|
||||
E.where_ $
|
||||
(d E.^. DepUser E.==. E.val pid)
|
||||
E.orderBy [E.asc $ d E.^. DepUses]
|
||||
return (d E.^. DepUses, d E.^. DepRange)
|
||||
where
|
||||
toPair (E.Value x, E.Value y) = (x, y)
|
||||
|
||||
getRevDeps :: GetStackageDatabase m => Text -> m [(Text, Text)]
|
||||
getRevDeps pname = run $ do
|
||||
fmap (map toPair) $ E.select $ E.from $ \(d,p) -> do
|
||||
E.where_ $
|
||||
(d E.^. DepUses E.==. E.val pname) E.&&.
|
||||
(d E.^. DepUser E.==. p E.^. PackageId)
|
||||
E.orderBy [E.asc $ p E.^. PackageName]
|
||||
return (p E.^. PackageName, d E.^. DepRange)
|
||||
where
|
||||
toPair (E.Value x, E.Value y) = (x, y)
|
||||
|
||||
getPackage :: GetStackageDatabase m => Text -> m (Maybe (Entity Package))
|
||||
getPackage = run . getBy . UniquePackage
|
||||
|
||||
@ -12,7 +12,7 @@ $newline never
|
||||
$forall (i, pn) <- ixInFavourOf
|
||||
$if i /= 0
|
||||
, #
|
||||
<a href="@{PackageR pn}">
|
||||
<a href="@{PackageR $ PackageName pn}">
|
||||
#{pn}
|
||||
<h1>
|
||||
#{pn} #
|
||||
@ -25,21 +25,11 @@ $newline never
|
||||
<a href="#{url}">
|
||||
#{url}
|
||||
|
||||
$maybe (_ltsMajor,_ltsMinor,pkgVersion,ltsSlug) <- mlts
|
||||
<a href=@{SnapshotR ltsSlug StackageHomeR}>LTS Haskell
|
||||
\ (
|
||||
<a href=@{haddocksLink ltsSlug pkgVersion}>
|
||||
#{pkgVersion}
|
||||
)
|
||||
$maybe _ <- mnightly
|
||||
, #
|
||||
|
||||
$maybe (_nightlyDay,ghcVersion,pkgVersion,nightlySlug) <- mnightly
|
||||
<a href=@{SnapshotR nightlySlug StackageHomeR}>Stackage Nightly GHC #{ghcVersion}
|
||||
\ (
|
||||
<a href=@{haddocksLink nightlySlug pkgVersion}>
|
||||
#{pkgVersion}
|
||||
)
|
||||
$forall (idx, li) <- enumerate latests
|
||||
$if idx /= 0
|
||||
, #
|
||||
<a href=@{SnapshotR (liSnapName li) StackageHomeR}>
|
||||
#{prettyName (liSnapName li) (liGhc li)} (#{liVersion li})
|
||||
|
||||
<div .row>
|
||||
<div .span12>
|
||||
@ -73,7 +63,7 @@ $newline never
|
||||
<div .authorship>
|
||||
<span .license>
|
||||
<a href="">
|
||||
#{metadataLicenseName metadata} licensed #
|
||||
#{packageLicenseName package} licensed #
|
||||
$if null maintainers
|
||||
and maintained #
|
||||
$if not (null authors)
|
||||
@ -113,7 +103,7 @@ $newline never
|
||||
<a href="mailto:#{renderEmail email}">
|
||||
#{renderEmail email}
|
||||
|
||||
$maybe (version, modules) <- mdocs
|
||||
$maybe (sname, version, modules) <- mdocs
|
||||
<div .docs>
|
||||
<h4>
|
||||
Module documentation for #{version}
|
||||
@ -121,20 +111,20 @@ $newline never
|
||||
<p>There are no documented modules for this package.
|
||||
$else
|
||||
<ul .docs-list>
|
||||
$forall Module _ name url <- modules
|
||||
$forall mname <- modules
|
||||
<li>
|
||||
<a href=#{url}>#{name}
|
||||
<a href=@{haddockUrl sname (toPkgVer pname' version) mname}>#{mname}
|
||||
|
||||
$if not (LT.null (LT.renderHtml (metadataReadme metadata)))
|
||||
$if not (LT.null (LT.renderHtml (packageDescription package)))
|
||||
<div .markdown-container .readme-container>
|
||||
<div .container .content>
|
||||
<div .row>
|
||||
<div .span12 .expanding>
|
||||
#{metadataReadme metadata}
|
||||
#{packageDescription package}
|
||||
<div .bottom-gradient>
|
||||
<i class="fa fa-angle-down">
|
||||
|
||||
$maybe log <- metadataChangelog metadata
|
||||
$if not (LT.null (LT.renderHtml (packageChangelog package)))
|
||||
<div .container .content>
|
||||
<div .row>
|
||||
<div .span12>
|
||||
@ -143,7 +133,7 @@ $maybe log <- metadataChangelog metadata
|
||||
<div .container>
|
||||
<div .row>
|
||||
<div .span12 .expanding>
|
||||
#{log}
|
||||
#{packageChangelog package}
|
||||
<div .bottom-gradient>
|
||||
<i class="fa fa-angle-down">
|
||||
|
||||
@ -153,19 +143,19 @@ $maybe log <- metadataChangelog metadata
|
||||
<div .dependencies #dependencies>
|
||||
Depends on
|
||||
<div .dep-list>
|
||||
$forall (i,name) <- deps
|
||||
$forall (i,(name, range)) <- deps
|
||||
$if i /= 0
|
||||
, #
|
||||
<a href=@{PackageR (PackageName name)}>
|
||||
<a href=@{PackageR $ PackageName name} title=#{range}>
|
||||
#{name}
|
||||
$if not $ null revdeps
|
||||
<div .reverse-dependencies .expanding #reverse-dependencies>
|
||||
Used by
|
||||
<div .dep-list>
|
||||
$forall (i,name) <- revdeps
|
||||
$forall (i,(name, range)) <- revdeps
|
||||
$if i /= 0
|
||||
, #
|
||||
<a href=@{PackageR name}>
|
||||
<a href=@{PackageR $ PackageName name} title=#{range}>
|
||||
#{name}
|
||||
<div .bottom-gradient>
|
||||
<i class="fa fa-angle-down">
|
||||
|
||||
Loading…
Reference in New Issue
Block a user