Merge branch 'multi-github-mentions' of https://github.com/bergmark/stackage

Stackage/BuildPlan.hs

@@ -12,6 +12,7 @@ import           Distribution.Text (display, simpleParse)
 import           Stackage.Types
 import qualified System.IO.UTF8
 import           Data.Char         (isSpace)
+import           Stackage.Util
 
 readBuildPlan :: FilePath -> IO BuildPlan
 readBuildPlan fp = do
@@ -95,7 +96,7 @@ instance AsString SelectedPackageInfo where
     toString SelectedPackageInfo {..} = unwords
         [ display spiVersion
         , toString spiHasTests
-        , maybe "@" ("@" ++) spiGithubUser
+        , (\v -> if null v then "@" else v) $ githubMentions spiGithubUser
         , unMaintainer spiMaintainer
         ]
     fromString s1 = do
@@ -105,7 +106,7 @@ instance AsString SelectedPackageInfo where
         Right (SelectedPackageInfo
             { spiVersion = version
             , spiHasTests = hasTests
-            , spiGithubUser = gu
+            , spiGithubUser = [gu]
             , spiMaintainer = Maintainer m
             }, "")
 

Stackage/Config.hs

@@ -485,15 +485,15 @@ defaultStablePackages ghcVer requireHP = unPackageMap $ execWriter $ do
 -- organization. See:
 --
 -- https://github.com/fpco/stackage/issues/226#issuecomment-45644142
-convertGithubUser :: String -> String
+convertGithubUser :: String -> [String]
 convertGithubUser x =
-    fromMaybe x $ Map.lookup (map toLower x) pairs
+    fromMaybe [x] $ Map.lookup (map toLower x) pairs
   where
     pairs = Map.fromList
-        [ ("diagrams",     "diagrams/Core")
-        , ("yesodweb",     "snoyberg")
-        , ("fpco",         "snoyberg")
-        , ("faylang",      "bergmark")
-        , ("silkapp",      "silkapp/stackage")
-        , ("snapframework","mightybyte")
+        [ ("diagrams",     ["diagrams/Core"])
+        , ("yesodweb",     ["snoyberg"])
+        , ("fpco",         ["snoyberg"])
+        , ("faylang",      ["bergmark"])
+        , ("silkapp",      ["bergmark"])
+        , ("snapframework",["mightybyte"])
         ]

Stackage/InstallInfo.hs

@@ -153,9 +153,7 @@ showDep (PackageName name, BuildInfo {..}) =
         , showVersion biVersion
         , " ("
         , unMaintainer biMaintainer
-        , case biGithubUser of
-            Nothing -> ""
-            Just x -> " @" ++ x
+        , " " ++ githubMentions biGithubUser
         , ")"
         , ": "
         , unwords $ map unP biUsers
@@ -194,7 +192,7 @@ checkBadVersions settings core (PackageDB pdb) buildPlan =
             , " ("
             , unMaintainer $ biMaintainer bi
             , case Map.lookup name pdb of
-                Just PackageInfo { piGithubUser = Just gu } -> " @" ++ gu
+                Just PackageInfo { piGithubUser = gus } -> " " ++ githubMentions gus
                 _ -> ""
             , ")"
             ]

Stackage/LoadDatabase.hs

@@ -10,7 +10,7 @@ import qualified Data.ByteString.Lazy.Char8            as L8
 import           Data.List                             (stripPrefix)
 import qualified Data.Map                              as Map
 import           Data.Maybe                            (catMaybes, listToMaybe,
-                                                        mapMaybe)
+                                                        mapMaybe, fromMaybe)
 import           Data.Monoid                           (Monoid (..))
 import           Data.Set                              (member)
 import qualified Data.Set                              as Set
@@ -168,7 +168,7 @@ loadPackageDB settings coreMap core deps = do
             , piBuildToolsAll = buildToolsExe' `Set.union` buildToolsOther'
             , piGPD = mgpd
             , piExecs = execs
-            , piGithubUser = mgithub
+            , piGithubUser = fromMaybe [] mgithub
             }
 
     parseDeps p lbs =

Stackage/Test.hs

@@ -153,9 +153,7 @@ runTestSuite cabalVersion settings testdir (packageName, SelectedPackageInfo {..
                 , package
                 , "("
                 , unMaintainer spiMaintainer
-                , case spiGithubUser of
-                    Nothing -> ""
-                    Just x -> " @" ++ x
+                , githubMentions spiGithubUser
                 , ")"
                 ]
     rm_r dir

Stackage/Types.hs

@@ -34,7 +34,7 @@ data PackageInfo = PackageInfo
     , piBuildToolsAll :: Set Executable -- ^ required for all stanzas
     , piGPD        :: Maybe GenericPackageDescription
     , piExecs      :: Set Executable
-    , piGithubUser :: Maybe String
+    , piGithubUser :: [String]
     }
     deriving (Show, Eq)
 
@@ -47,7 +47,7 @@ data BuildInfo = BuildInfo
     , biUsers      :: [PackageName]
     , biMaintainer :: Maintainer
     , biDeps       :: Map PackageName VersionRange
-    , biGithubUser :: Maybe String
+    , biGithubUser :: [String]
     , biHasTests   :: Bool
     }
 
@@ -73,7 +73,7 @@ data InstallInfo = InstallInfo
 data SelectedPackageInfo = SelectedPackageInfo
     { spiVersion    :: Version
     , spiMaintainer :: Maintainer
-    , spiGithubUser :: Maybe String
+    , spiGithubUser :: [String]
     , spiHasTests   :: Bool
     }
     deriving (Show, Read)

Stackage/Util.hs

@@ -5,7 +5,7 @@ import qualified Codec.Archive.Tar               as Tar
 import qualified Codec.Archive.Tar.Entry         as TarEntry
 import           Control.Monad                   (guard, when)
 import           Data.Char                       (isSpace, toUpper)
-import           Data.List                       (stripPrefix)
+import           Data.List                       (intercalate, stripPrefix)
 import qualified Data.Map                        as Map
 import           Data.Maybe                      (mapMaybe)
 import qualified Data.Set                        as Set
@@ -168,3 +168,6 @@ replaceTarball tarballdir pkgname = do
         else return pkgname
   where
     fp = tarballdir </> pkgname <.> "tar.gz"
+
+githubMentions :: [String] -> String
+githubMentions = intercalate "," . map ('@' :)