on 6239264 help sign in
stackage/Stackage/GithubPings.hs
36 lines 1.2 kB history raw
1{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE ViewPatterns #-}
4module Stackage.GithubPings
5 ( getGithubPings
6 ) where
8import Distribution.PackageDescription
9import Stackage.BuildConstraints
10import Stackage.Prelude
12-- | Determine accounts to be pinged on Github based on various metadata in the
13-- package description.
14getGithubPings :: BuildConstraints -- ^ for mapping to pingees
15 -> GenericPackageDescription -> Set Text
16getGithubPings bc gpd =
17 foldMap (\(pack -> name) -> fromMaybe (singletonSet name) (lookup name (bcGithubUsers bc))) $
18 goHomepage (homepage $ packageDescription gpd) ++
19 concatMap goRepo (sourceRepos $ packageDescription gpd)
20 where
21 goHomepage t = do
22 prefix <-
23 [ "http://github.com/"
24 , "https://github.com/"
25 , "git://github.com/"
26 , "git@github.com:"
27 ]
28 t' <- maybeToList $ stripPrefix prefix t
29 let t'' = takeWhile (/= '/') t'
30 guard $ not $ null t''
31 return t''
33 goRepo sr =
34 case (repoType sr, repoLocation sr) of
35 (Just Git, Just s) -> goHomepage s
36 _ -> []