55a5e9a · stackage · git.iko.soy

git.iko.soy/stackage

on master help sign in

GithubPings

55a5e9aMichael Snoyman12 years ago

Stackage2/BuildPlan.hs+5

compare with master

unifiedsplit

@@ -20,6 +20,7 @@ import Stackage2.CorePackages

20import Stackage2.PackageConstraints

21import Stackage2.PackageIndex

22import Stackage2.Prelude

23+import Stackage2.GithubPings

23import Control.Monad.State.Strict (execState, get, put)

24import Control.Monad.State.Strict (execState, get, put)

24import qualified Data.Map as Map

25import qualified Data.Map as Map

25import qualified Data.Set as Set

26import qualified Data.Set as Set

@@ -77,6 +78,7 @@ instance desc ~ () => FromJSON (BuildPlan desc) where

77data PackageBuild desc = PackageBuild

78data PackageBuild desc = PackageBuild

78 { pbVersion :: Version

79 { pbVersion :: Version

79 , pbMaintainer :: Maybe Maintainer

80 , pbMaintainer :: Maybe Maintainer

81+ , pbGithubPings :: Set Text

80 , pbUsers :: Set PackageName

82 , pbUsers :: Set PackageName

81 , pbFlags :: Map FlagName Bool

83 , pbFlags :: Map FlagName Bool

82 , pbTestState :: TestState

84 , pbTestState :: TestState

@@ -95,6 +97,7 @@ instance ToJSON (PackageBuild desc) where

95 [ maybe [] (\m -> ["maintainer" .= m]) pbMaintainer

97 [ maybe [] (\m -> ["maintainer" .= m]) pbMaintainer

96 ,

98 ,

97 [ "version" .= asText (display pbVersion)

99 [ "version" .= asText (display pbVersion)

100+ , "github-pings" .= pbGithubPings

98 , "users" .= map unPackageName (unpack pbUsers)

101 , "users" .= map unPackageName (unpack pbUsers)

99 , "flags" .= Map.mapKeysWith const (\(FlagName f) -> asText $ pack f) pbFlags

102 , "flags" .= Map.mapKeysWith const (\(FlagName f) -> asText $ pack f) pbFlags

100 , "test-state" .= pbTestState

103 , "test-state" .= pbTestState

@@ -106,6 +109,7 @@ instance desc ~ () => FromJSON (PackageBuild desc) where

106 parseJSON = withObject "PackageBuild" $ \o -> PackageBuild

109 parseJSON = withObject "PackageBuild" $ \o -> PackageBuild

107 <$> (o .: "version" >>= efail . simpleParse . asText)

110 <$> (o .: "version" >>= efail . simpleParse . asText)

108 <*> o .:? "maintainer"

111 <*> o .:? "maintainer"

112+ <*> o .:? "github-pings" .!= mempty

109 <*> (Set.map PackageName <$> (o .:? "users" .!= mempty))

113 <*> (Set.map PackageName <$> (o .:? "users" .!= mempty))

110 <*> (toFlags <$> (o .:? "flags" .!= mempty))

114 <*> (toFlags <$> (o .:? "flags" .!= mempty))

111 <*> o .: "test-state"

115 <*> o .: "test-state"

@@ -267,6 +271,7 @@ simplifyDesc gpd = do

267 return PackageBuild

271 return PackageBuild

268 { pbVersion = version

272 { pbVersion = version

269 , pbMaintainer = fmap snd $ lookup name $ pcPackages defaultPackageConstraints

273 , pbMaintainer = fmap snd $ lookup name $ pcPackages defaultPackageConstraints

274+ , pbGithubPings = getGithubPings gpd

270 , pbUsers = mempty -- must be filled in later

275 , pbUsers = mempty -- must be filled in later

271 , pbFlags = packageFlags name

276 , pbFlags = packageFlags name

272 , pbTestState =

277 , pbTestState =

Stackage2/GithubPings.hsnew file+33

@@ -0,0 +1,33 @@

1+{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}

2+module Stackage2.GithubPings

3+ ( getGithubPings

4+ ) where

6+import Stackage2.Prelude

7+import Distribution.PackageDescription

8+import qualified Stackage.Config as Old

10+-- | Determine accounts to be pinged on Github based on various metadata in the

11+-- package description.

12+getGithubPings :: GenericPackageDescription -> Set Text

13+getGithubPings gpd =

14+ setFromList $ map pack $ foldMap Old.convertGithubUser $

15+ goHomepage (homepage $ packageDescription gpd) ++

16+ concatMap goRepo (sourceRepos $ packageDescription gpd)

17+ where

18+ goHomepage t = do

19+ prefix <-

20+ [ "http://github.com/"

21+ , "https://github.com/"

22+ , "git://github.com/"

23+ , "git@github.com:"

24+ ]

25+ t' <- maybeToList $ stripPrefix prefix t

26+ let t'' = takeWhile (/= '/') t'

27+ guard $ not $ null t''

28+ return t''

29+

30+ goRepo sr =

31+ case (repoType sr, repoLocation sr) of

32+ (Just Git, Just s) -> goHomepage s

33+ _ -> []

stackage.cabal+1

@@ -36,6 +36,7 @@ library

36 Stackage2.CorePackages

37 Stackage2.PackageIndex

38 Stackage2.BuildPlan

39+ Stackage2.GithubPings

39 build-depends: base >= 4 && < 5

40 build-depends: base >= 4 && < 5

40 , containers

41 , containers

41 , Cabal >= 1.14

42 , Cabal >= 1.14