Browse Source

Badges

jsonDiff
Konstantin Zudov 6 years ago
parent
commit
b798ac8236
  1. 22
      Handler/Package.hs
  2. 1
      config/routes
  3. 1
      stack.yaml
  4. 1
      stackage-server.cabal

22
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

1
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

1
stack.yaml

@ -1,3 +1,4 @@
resolver: lts-3.8
extra-deps:
- these-0.6.1.0
- barrier-0.1.0

1
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

Loading…
Cancel
Save