git.iko.soy/stackage
on master help sign in
GithubPings
commit55a5e9a7de2b8f48d9ca11b1b8358fe813afe177 authorMichael Snoyman <michael@snoyman.com> dateThu 4 Dec 2014, 18:34 (12 years ago) parentbf47ded
3 files changed+39
compare with master
unifiedsplit
Stackage2/BuildPlan.hs+5 Stackage2/GithubPings.hs+33 stackage.cabal+1
Stackage2/BuildPlan.hs+5
@@ -20,6 +20,7 @@ import Stackage2.CorePackages
2020import Stackage2.PackageConstraints
2121import Stackage2.PackageIndex
2222import Stackage2.Prelude
23+import Stackage2.GithubPings
2324import Control.Monad.State.Strict (execState, get, put)
2425import qualified Data.Map as Map
2526import qualified Data.Set as Set
@@ -77,6 +78,7 @@ instance desc ~ () => FromJSON (BuildPlan desc) where
7778data PackageBuild desc = PackageBuild
7879 { pbVersion :: Version
7980 , pbMaintainer :: Maybe Maintainer
81+ , pbGithubPings :: Set Text
8082 , pbUsers :: Set PackageName
8183 , pbFlags :: Map FlagName Bool
8284 , pbTestState :: TestState
@@ -95,6 +97,7 @@ instance ToJSON (PackageBuild desc) where
9597 [ maybe [] (\m -> ["maintainer" .= m]) pbMaintainer
9698 ,
9799 [ "version" .= asText (display pbVersion)
100+ , "github-pings" .= pbGithubPings
98101 , "users" .= map unPackageName (unpack pbUsers)
99102 , "flags" .= Map.mapKeysWith const (\(FlagName f) -> asText $ pack f) pbFlags
100103 , "test-state" .= pbTestState
@@ -106,6 +109,7 @@ instance desc ~ () => FromJSON (PackageBuild desc) where
106109 parseJSON = withObject "PackageBuild" $ \o -> PackageBuild
107110 <$> (o .: "version" >>= efail . simpleParse . asText)
108111 <*> o .:? "maintainer"
112+ <*> o .:? "github-pings" .!= mempty
109113 <*> (Set.map PackageName <$> (o .:? "users" .!= mempty))
110114 <*> (toFlags <$> (o .:? "flags" .!= mempty))
111115 <*> o .: "test-state"
@@ -267,6 +271,7 @@ simplifyDesc gpd = do
267271 return PackageBuild
268272 { pbVersion = version
269273 , pbMaintainer = fmap snd $ lookup name $ pcPackages defaultPackageConstraints
274+ , pbGithubPings = getGithubPings gpd
270275 , pbUsers = mempty -- must be filled in later
271276 , pbFlags = packageFlags name
272277 , pbTestState =
Stackage2/GithubPings.hsnew file+33
@@ -0,0 +1,33 @@
1+{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}
2+module Stackage2.GithubPings
3+ ( getGithubPings
4+ ) where
5+
6+import Stackage2.Prelude
7+import Distribution.PackageDescription
8+import qualified Stackage.Config as Old
9+
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
3636 Stackage2.CorePackages
3737 Stackage2.PackageIndex
3838 Stackage2.BuildPlan
39+ Stackage2.GithubPings
3940 build-depends: base >= 4 && < 5
4041 , containers
4142 , Cabal >= 1.14