haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-01-23 04:31:57 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Provide replacement Github names #226

Browse Source
This commit is contained in:
Michael Snoyman 2014-06-11 08:03:20 +03:00
parent 684bf6d452
commit ceac2c4a98
2 changed files with 20 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Stackage/Config.hs
View File

@ -3,7 +3,9 @@ module Stackage.Config where
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Trans.Writer (execWriter, tell) import Control.Monad.Trans.Writer (execWriter, tell)
import Data.Char (toLower)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Set (fromList, singleton) import Data.Set (fromList, singleton)
import Distribution.Text (simpleParse) import Distribution.Text (simpleParse)
import Stackage.Types import Stackage.Types
@ -452,3 +454,19 @@ defaultStablePackages ghcVer requireHP = unPackageMap $ execWriter $ do
case simpleParse range of case simpleParse range of
Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package
Just range' -> tell $ PackageMap $ Map.singleton (PackageName package) (range', Maintainer maintainer) Just range' -> tell $ PackageMap $ Map.singleton (PackageName package) (range', Maintainer maintainer)
-- | Replacement Github users. This is useful when a project is owned by an
-- organization, and you'd like to ping either an individual or a team in that
-- organization. See:
--
-- https://github.com/fpco/stackage/issues/226#issuecomment-45644142
convertGithubUser :: String -> String
convertGithubUser x =
fromMaybe x $ Map.lookup (map toLower x) pairs
where
pairs = Map.fromList
[ ("diagrams", "byorgey")
, ("yesodweb", "snoyberg")
, ("fpco", "snoyberg")
, ("faylang", "bergmark")
]

3
Stackage/LoadDatabase.hs
View File

@ -43,6 +43,7 @@ import Distribution.Text (simpleParse)
import Distribution.Version (Version (Version), import Distribution.Version (Version (Version),
unionVersionRanges, unionVersionRanges,
withinRange) withinRange)
import Stackage.Config (convertGithubUser)
import Stackage.Types import Stackage.Types
import Stackage.Util import Stackage.Util
import System.Directory (doesFileExist, getDirectoryContents) import System.Directory (doesFileExist, getDirectoryContents)
@ -184,7 +185,7 @@ loadPackageDB settings coreMap core deps = do
, Set.fromList $ map depName $ testBenchBuildInfo gpd , Set.fromList $ map depName $ testBenchBuildInfo gpd
, Just gpd , Just gpd
, Set.fromList $ map (Executable . fst) $ condExecutables gpd , Set.fromList $ map (Executable . fst) $ condExecutables gpd
, listToMaybe $ catMaybes , fmap convertGithubUser $ listToMaybe $ catMaybes
$ parseGithubUserHP (homepage $ packageDescription gpd) $ parseGithubUserHP (homepage $ packageDescription gpd)
: map parseGithubUserSR (sourceRepos $ packageDescription gpd) : map parseGithubUserSR (sourceRepos $ packageDescription gpd)
) )