diff --git a/Stackage2/BuildPlan.hs b/Stackage2/BuildPlan.hs index c3a35739..16d26606 100644 --- a/Stackage2/BuildPlan.hs +++ b/Stackage2/BuildPlan.hs @@ -20,6 +20,7 @@ import Stackage2.CorePackages import Stackage2.PackageConstraints import Stackage2.PackageIndex import Stackage2.Prelude +import Stackage2.GithubPings import Control.Monad.State.Strict (execState, get, put) import qualified Data.Map as Map import qualified Data.Set as Set @@ -77,6 +78,7 @@ instance desc ~ () => FromJSON (BuildPlan desc) where data PackageBuild desc = PackageBuild { pbVersion :: Version , pbMaintainer :: Maybe Maintainer + , pbGithubPings :: Set Text , pbUsers :: Set PackageName , pbFlags :: Map FlagName Bool , pbTestState :: TestState @@ -95,6 +97,7 @@ instance ToJSON (PackageBuild desc) where [ maybe [] (\m -> ["maintainer" .= m]) pbMaintainer , [ "version" .= asText (display pbVersion) + , "github-pings" .= pbGithubPings , "users" .= map unPackageName (unpack pbUsers) , "flags" .= Map.mapKeysWith const (\(FlagName f) -> asText $ pack f) pbFlags , "test-state" .= pbTestState @@ -106,6 +109,7 @@ instance desc ~ () => FromJSON (PackageBuild desc) where parseJSON = withObject "PackageBuild" $ \o -> PackageBuild <$> (o .: "version" >>= efail . simpleParse . asText) <*> o .:? "maintainer" + <*> o .:? "github-pings" .!= mempty <*> (Set.map PackageName <$> (o .:? "users" .!= mempty)) <*> (toFlags <$> (o .:? "flags" .!= mempty)) <*> o .: "test-state" @@ -267,6 +271,7 @@ simplifyDesc gpd = do return PackageBuild { pbVersion = version , pbMaintainer = fmap snd $ lookup name $ pcPackages defaultPackageConstraints + , pbGithubPings = getGithubPings gpd , pbUsers = mempty -- must be filled in later , pbFlags = packageFlags name , pbTestState = diff --git a/Stackage2/GithubPings.hs b/Stackage2/GithubPings.hs new file mode 100644 index 00000000..8891518d --- /dev/null +++ b/Stackage2/GithubPings.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-} +module Stackage2.GithubPings + ( getGithubPings + ) where + +import Stackage2.Prelude +import Distribution.PackageDescription +import qualified Stackage.Config as Old + +-- | Determine accounts to be pinged on Github based on various metadata in the +-- package description. +getGithubPings :: GenericPackageDescription -> Set Text +getGithubPings gpd = + setFromList $ map pack $ foldMap Old.convertGithubUser $ + goHomepage (homepage $ packageDescription gpd) ++ + concatMap goRepo (sourceRepos $ packageDescription gpd) + where + goHomepage t = do + prefix <- + [ "http://github.com/" + , "https://github.com/" + , "git://github.com/" + , "git@github.com:" + ] + t' <- maybeToList $ stripPrefix prefix t + let t'' = takeWhile (/= '/') t' + guard $ not $ null t'' + return t'' + + goRepo sr = + case (repoType sr, repoLocation sr) of + (Just Git, Just s) -> goHomepage s + _ -> [] diff --git a/stackage.cabal b/stackage.cabal index ec1e44ef..3dcd6686 100644 --- a/stackage.cabal +++ b/stackage.cabal @@ -36,6 +36,7 @@ library Stackage2.CorePackages Stackage2.PackageIndex Stackage2.BuildPlan + Stackage2.GithubPings build-depends: base >= 4 && < 5 , containers , Cabal >= 1.14