diff --git a/Handler/Package.hs b/Handler/Package.hs index 596e1c6..cd4c4da 100644 --- a/Handler/Package.hs +++ b/Handler/Package.hs @@ -6,6 +6,7 @@ module Handler.Package ( getPackageR , getPackageSnapshotsR , packagePage + , getPackageBadgeR ) where import Data.Char @@ -13,15 +14,34 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as LT import Distribution.Package.ModuleForest +import Graphics.Badge.Barrier +import Control.Lens import Import import qualified Text.Blaze.Html.Renderer.Text as LT import Text.Email.Validate -import Stackage.Database +import Stackage.Database -- | Page metadata package. getPackageR :: PackageName -> Handler Html getPackageR = packagePage Nothing +getPackageBadgeR :: PackageName -> SnapshotBranch -> Handler TypedContent +getPackageBadgeR pname branch = do + snapName <- maybe notFound pure =<< newestSnapshot branch + Entity sid _ <- maybe notFound pure =<< lookupSnapshot snapName + mVersion <- do mSnapPackage <- lookupSnapshotPackage sid (unPackageName pname) + pure (Version . snapshotPackageVersion . entityVal <$> mSnapPackage) + respond typeSvg $ renderStackageBadge snapName mVersion + +renderStackageBadge :: SnapName -> Maybe Version -> LByteString +renderStackageBadge (badgeLabel -> label) = \case + Nothing -> renderBadge (flat & right .~ red) label "not available" + Just (Version x) -> renderBadge flat label x + +badgeLabel :: SnapName -> Text +badgeLabel (SNNightly _) = "stackage nightly" +badgeLabel (SNLts x _) = "stackage lts-" <> tshow x + packagePage :: Maybe (SnapName, Version) -> PackageName -> Handler Html diff --git a/config/routes b/config/routes index 9303cd0..1607bbc 100644 --- a/config/routes +++ b/config/routes @@ -30,6 +30,7 @@ /haddock/#SnapName/*Texts HaddockR GET /package/#PackageName PackageR GET /package/#PackageName/snapshots PackageSnapshotsR GET +/package/#PackageName/badge/#SnapshotBranch PackageBadgeR GET /package PackageListR GET /authors AuthorsR GET diff --git a/stack.yaml b/stack.yaml index 6bf90a2..6498c22 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,4 @@ resolver: lts-3.8 extra-deps: - these-0.6.1.0 + - barrier-0.1.0 diff --git a/stackage-server.cabal b/stackage-server.cabal index 4242295..7d91335 100644 --- a/stackage-server.cabal +++ b/stackage-server.cabal @@ -92,6 +92,7 @@ library base >= 4.8 && < 4.9 , aeson >= 0.8 && < 0.9 , aws >= 0.12 && < 0.13 + , barrier >= 0.1 && < 0.2 , base16-bytestring >= 0.1 && < 0.2 , blaze-markup >= 0.7 && < 0.8 , byteable >= 0.1 && < 0.2