f105cab · stackage · git.iko.soy

git.iko.soy/stackage

Error output: display Github handle when possible (fixes #22)

commitf105cabe5203e9ead9de2fdeb824764d6d9f2de4 authorMichael Snoyman <michael@snoyman.com> dateWed 23 Jan 2013, 14:05 (14 years ago) parentdf836f4

3 files changed+44−9

compare with master

unifiedsplit

Stackage/InstallInfo.hs+6−2 Stackage/LoadDatabase.hs+37−7 Stackage/Types.hs+1

Stackage/InstallInfo.hs+6−2

@@ -41,7 +41,7 @@ getInstallInfo settings = do

4141 putStrLn "Printing build plan to build-plan.log"

4242 writeFile "build-plan.log" $ unlines $ map showDep $ Map.toList final

4343

44− case checkBadVersions settings final of

44+ case checkBadVersions settings pdb final of

4545 badVersions

4646 | Map.null badVersions -> return ()

4747 | otherwise -> do

@@ -85,9 +85,10 @@ iiPackageList = map packageVersionString . Map.toList . Map.map fst . iiPackages

8585

8686-- | Check for internal mismatches in required and actual package versions.

8787checkBadVersions :: BuildSettings

88+ -> PackageDB

8889 -> Map PackageName BuildInfo

8990 -> Map String (Map PackageName (Version, VersionRange))

90−checkBadVersions settings buildPlan =

91+checkBadVersions settings (PackageDB pdb) buildPlan =

9192 Map.unions $ map getBadVersions $ Map.toList $ Map.filterWithKey unexpectedFailure buildPlan

9293 where

9394 unexpectedFailure name _ = name `Set.notMember` expectedFailures settings

@@ -102,6 +103,9 @@ checkBadVersions settings buildPlan =

102103 [ packageVersionString (name, biVersion bi)

103104 , " ("

104105 , unMaintainer $ biMaintainer bi

106+ , case Map.lookup name pdb of

107+ Just PackageInfo { piGithubUser = Just gu } -> " @" ++ gu

108+ _ -> ""

105109 , ")"

106110 ]

107111

Stackage/LoadDatabase.hs+37−7

@@ -1,10 +1,13 @@

11module Stackage.LoadDatabase where

33import qualified Codec.Archive.Tar as Tar

4+import Control.Monad (guard)

45import qualified Data.ByteString.Lazy as L

56import qualified Data.ByteString.Lazy.Char8 as L8

7+import Data.List (stripPrefix)

68import qualified Data.Map as Map

7−import Data.Maybe (mapMaybe)

9+import Data.Maybe (catMaybes, listToMaybe,

10+ mapMaybe)

811import Data.Monoid (Monoid (..))

912import Data.Set (member)

1013import qualified Data.Set as Set

@@ -12,6 +15,9 @@ import Distribution.Compiler (CompilerFlavor (GHC))

1215import Distribution.Package (Dependency (Dependency))

1316import Distribution.PackageDescription (Condition (..),

1417 ConfVar (..),

18+ FlagName (FlagName),

19+ RepoType (Git),

20+ SourceRepo (..),

1521 benchmarkBuildInfo,

1622 buildInfo, buildTools,

1723 condBenchmarks,

@@ -23,13 +29,15 @@ import Distribution.PackageDescription (Condition (..),

2329 condTreeData,

2430 flagDefault, flagName,

2531 genPackageFlags,

26− libBuildInfo,

27− testBuildInfo,

28− FlagName (FlagName))

32+ homepage, libBuildInfo,

33+ packageDescription,

34+ sourceRepos,

35+ testBuildInfo)

2936import Distribution.PackageDescription.Parse (ParseResult (ParseOk),

3037 parsePackageDescription)

3138import Distribution.System (buildArch, buildOS)

32−import Distribution.Version (withinRange, unionVersionRanges)

39+import Distribution.Version (unionVersionRanges,

40+ withinRange)

3341import Stackage.Config

3442import Stackage.Types

3543import Stackage.Util

@@ -71,7 +79,7 @@ loadPackageDB settings core deps = do

7179 _ ->

7280 case Tar.entryContent e of

7381 Tar.NormalFile bs _ -> do

74− let (deps', hasTests, buildTools', mgpd, execs) = parseDeps bs

82+ let (deps', hasTests, buildTools', mgpd, execs, mgithub) = parseDeps bs

7583 return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo

7684 { piVersion = v

7785 , piDeps = deps'

@@ -79,6 +87,7 @@ loadPackageDB settings core deps = do

7987 , piBuildTools = buildTools'

8088 , piGPD = mgpd

8189 , piExecs = execs

90+ , piGithubUser = mgithub

8291 }

8392 _ -> return pdb

8493

@@ -93,8 +102,11 @@ loadPackageDB settings core deps = do

93102 , Set.fromList $ map depName $ allBuildInfo gpd

94103 , Just gpd

95104 , Set.fromList $ map (Executable . fst) $ condExecutables gpd

105+ , listToMaybe $ catMaybes

106+ $ parseGithubUserHP (homepage $ packageDescription gpd)

107+ : map parseGithubUserSR (sourceRepos $ packageDescription gpd)

96108 )

97− _ -> (mempty, defaultHasTestSuites, Set.empty, Nothing, Set.empty)

109+ _ -> (mempty, defaultHasTestSuites, Set.empty, Nothing, Set.empty, Nothing)

98110 where

99111 allBuildInfo gpd = concat

100112 [ maybe mempty (goBI libBuildInfo) $ condLibrary gpd

@@ -126,3 +138,21 @@ loadPackageDB settings core deps = do

126138

127139 flags' = map flagName (filter flagDefault $ genPackageFlags gpd) ++

128140 (map FlagName $ Set.toList $ Stackage.Types.flags settings)

141+

142+-- | Attempt to grab the Github username from a homepage.

143+parseGithubUserHP :: String -> Maybe String

144+parseGithubUserHP url1 = do

145+ url2 <- listToMaybe $ mapMaybe (flip stripPrefix url1)

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

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

148+ ]

149+ let x = takeWhile (/= '/') url2

150+ guard $ not $ null x

151+ Just x

152+

153+-- | Attempt to grab the Github username from a source repo.

154+parseGithubUserSR :: SourceRepo -> Maybe String

155+parseGithubUserSR sr =

156+ case (repoType sr, repoLocation sr) of

157+ (Just Git, Just s) -> parseGithubUserHP s

158+ _ -> Nothing

Stackage/Types.hs+1

@@ -33,6 +33,7 @@ data PackageInfo = PackageInfo

3333 , piBuildTools :: Set Executable

3434 , piGPD :: Maybe GenericPackageDescription

3535 , piExecs :: Set Executable

36+ , piGithubUser :: Maybe String

3637 }

3738 deriving (Show, Eq)

3839